{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-
Copyright (C) 2014 Matthew Pickering <matthewtpickering@gmail.com>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}
{- |

Parses MathML in conformance with the MathML3 specification.

Unimplemented features:

  - mpadded
  - malignmark
  - maligngroup
  - Elementary Math

To Improve:

  - Handling of menclose
  - Handling of mstyle
-}

module Text.TeXMath.Readers.MathML (readMathML) where

import Text.XML.Light hiding (onlyText)
import Text.TeXMath.Types
import Text.TeXMath.Readers.MathML.MMLDict (getMathMLOperator)
import Text.TeXMath.Readers.MathML.EntityMap (getUnicode)
import Text.TeXMath.Shared (getTextType, readLength, getOperator, fixTree,
                            getSpaceWidth, isEmpty, empty)
import Text.TeXMath.Unicode.ToTeX (getSymbolType)
import Text.TeXMath.Unicode.ToUnicode (fromUnicode)
import Text.TeXMath.Compat (throwError, Except, runExcept, MonadError)
import Control.Applicative ((<$>), (<|>), (<*>))
import Control.Arrow ((&&&))
import Data.Char (toLower)
import Data.Maybe (fromMaybe, listToMaybe, isJust)
import Data.Monoid (mconcat, First(..), getFirst)
import Data.Semigroup ((<>))
import Data.List (transpose)
import qualified Data.Text as T
import Control.Monad (filterM, guard)
import Control.Monad.Reader (ReaderT, runReaderT, asks, local)
import Data.Either (rights)

-- | Parse a MathML expression to a list of 'Exp'.
readMathML :: T.Text -> Either T.Text [Exp]
readMathML :: Text -> Either Text [Exp]
readMathML Text
inp = (Exp -> Exp) -> [Exp] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Exp
fixTree ([Exp] -> [Exp]) -> Either Text [Exp] -> Either Text [Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (Except Text [Exp] -> Either Text [Exp]
forall e a. Except e a -> Either e a
runExcept ((ReaderT MMLState (Except Text) [Exp]
 -> MMLState -> Except Text [Exp])
-> MMLState
-> ReaderT MMLState (Except Text) [Exp]
-> Except Text [Exp]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT MMLState (Except Text) [Exp]
-> MMLState -> Except Text [Exp]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT MMLState
defaultState (ReaderT MMLState (Except Text) Element
i ReaderT MMLState (Except Text) Element
-> (Element -> ReaderT MMLState (Except Text) [Exp])
-> ReaderT MMLState (Except Text) [Exp]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> ReaderT MMLState (Except Text) [Exp]
parseMathML)))
  where
    i :: ReaderT MMLState (Except Text) Element
i = Text -> Maybe Element -> ReaderT MMLState (Except Text) Element
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither Text
"Invalid XML" (Text -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc Text
inp)

data MMLState = MMLState { MMLState -> [Attr]
attrs :: [Attr]
                         , MMLState -> Maybe FormType
position :: Maybe FormType
                         , MMLState -> Bool
inAccent :: Bool
                         , MMLState -> TextType
curStyle :: TextType }

type MML = ReaderT MMLState (Except T.Text)

data SupOrSub = Sub | Sup deriving (Int -> SupOrSub -> ShowS
[SupOrSub] -> ShowS
SupOrSub -> String
(Int -> SupOrSub -> ShowS)
-> (SupOrSub -> String) -> ([SupOrSub] -> ShowS) -> Show SupOrSub
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SupOrSub] -> ShowS
$cshowList :: [SupOrSub] -> ShowS
show :: SupOrSub -> String
$cshow :: SupOrSub -> String
showsPrec :: Int -> SupOrSub -> ShowS
$cshowsPrec :: Int -> SupOrSub -> ShowS
Show, SupOrSub -> SupOrSub -> Bool
(SupOrSub -> SupOrSub -> Bool)
-> (SupOrSub -> SupOrSub -> Bool) -> Eq SupOrSub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SupOrSub -> SupOrSub -> Bool
$c/= :: SupOrSub -> SupOrSub -> Bool
== :: SupOrSub -> SupOrSub -> Bool
$c== :: SupOrSub -> SupOrSub -> Bool
Eq)

data IR a = Stretchy TeXSymbolType (T.Text -> Exp) T.Text
          | Trailing (Exp -> Exp -> Exp) Exp
          | E a

instance Show a => Show (IR a) where
  show :: IR a -> String
show (Stretchy TeXSymbolType
t Text -> Exp
_ Text
s) = String
"Stretchy " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TeXSymbolType -> String
forall a. Show a => a -> String
show TeXSymbolType
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
s
  show (Trailing Exp -> Exp -> Exp
_ Exp
s) = String
"Trailing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Exp -> String
forall a. Show a => a -> String
show Exp
s
  show (E a
s) = String
"E " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
s

parseMathML :: Element -> MML [Exp]
parseMathML :: Element -> ReaderT MMLState (Except Text) [Exp]
parseMathML e :: Element
e@(Element -> Text
name -> Text
"math") = do
  Exp
e' <- Element -> MML Exp
row Element
e
  [Exp] -> ReaderT MMLState (Except Text) [Exp]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Exp] -> ReaderT MMLState (Except Text) [Exp])
-> [Exp] -> ReaderT MMLState (Except Text) [Exp]
forall a b. (a -> b) -> a -> b
$
    case Exp
e' of
      EGrouped [Exp]
es -> [Exp]
es
      Exp
_ -> [Exp
e']
parseMathML Element
_ = Text -> ReaderT MMLState (Except Text) [Exp]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"Root must be math element"

expr :: Element -> MML [IR Exp]
expr :: Element -> MML [IR Exp]
expr Element
e = (MMLState -> MMLState) -> MML [IR Exp] -> MML [IR Exp]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ([Attr] -> MMLState -> MMLState
addAttrs (Element -> [Attr]
elAttribs Element
e)) (Element -> MML [IR Exp]
expr' Element
e)

expr' :: Element -> MML [IR Exp]
expr' :: Element -> MML [IR Exp]
expr' Element
e =
  case Element -> Text
name Element
e of
    Text
"mi" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
ident Element
e
    Text
"mn" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
number Element
e
    Text
"mo" -> (IR Exp -> [IR Exp] -> [IR Exp]
forall a. a -> [a] -> [a]
:[]) (IR Exp -> [IR Exp])
-> ReaderT MMLState (Except Text) (IR Exp) -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> ReaderT MMLState (Except Text) (IR Exp)
op Element
e
    Text
"mtext" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
text Element
e
    Text
"ms" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
literal Element
e
    Text
"mspace" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
space Element
e
    Text
"mrow" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
row Element
e
    Text
"mstyle" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
style Element
e
    Text
"mfrac" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
frac Element
e
    Text
"msqrt" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
msqrt Element
e
    Text
"mroot" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
kroot Element
e
    Text
"merror" -> [IR Exp] -> MML [IR Exp]
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> [IR Exp]
mkE Exp
empty)
    Text
"mpadded" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
row Element
e
    Text
"mphantom" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
phantom Element
e
    Text
"mfenced" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
fenced Element
e
    Text
"menclose" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
enclosed Element
e
    Text
"msub" ->  Element -> MML [IR Exp]
sub Element
e
    Text
"msup" ->  Element -> MML [IR Exp]
sup Element
e
    Text
"msubsup" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
subsup Element
e
    Text
"munder" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
under Element
e
    Text
"mover" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
over Element
e
    Text
"munderover" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
underover Element
e
    Text
"mtable" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
table Element
e
    Text
"maction" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
action Element
e
    Text
"semantics" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
semantics Element
e
    Text
"maligngroup" -> [IR Exp] -> MML [IR Exp]
forall (m :: * -> *) a. Monad m => a -> m a
return ([IR Exp] -> MML [IR Exp]) -> [IR Exp] -> MML [IR Exp]
forall a b. (a -> b) -> a -> b
$ Exp -> [IR Exp]
mkE Exp
empty
    Text
"malignmark" -> [IR Exp] -> MML [IR Exp]
forall (m :: * -> *) a. Monad m => a -> m a
return ([IR Exp] -> MML [IR Exp]) -> [IR Exp] -> MML [IR Exp]
forall a b. (a -> b) -> a -> b
$ Exp -> [IR Exp]
mkE Exp
empty
    Text
"mmultiscripts" -> Exp -> [IR Exp]
mkE (Exp -> [IR Exp]) -> MML Exp -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
multiscripts Element
e
    Text
_ -> Text -> MML [IR Exp]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> MML [IR Exp]) -> Text -> MML [IR Exp]
forall a b. (a -> b) -> a -> b
$ Text
"Unexpected element " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element -> Text
err Element
e
  where
    mkE :: Exp -> [IR Exp]
    mkE :: Exp -> [IR Exp]
mkE = (IR Exp -> [IR Exp] -> [IR Exp]
forall a. a -> [a] -> [a]
:[]) (IR Exp -> [IR Exp]) -> (Exp -> IR Exp) -> Exp -> [IR Exp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> IR Exp
forall a. a -> IR a
E


-- Tokens

ident :: Element -> MML Exp
ident :: Element -> MML Exp
ident Element
e =  do
  Text
s <- Element -> MML Text
getString Element
e
  let base :: Exp
base = case Exp -> Maybe TeX
getOperator (Text -> Exp
EMathOperator Text
s) of
                   Just TeX
_   -> Text -> Exp
EMathOperator Text
s
                   Maybe TeX
Nothing  -> Text -> Exp
EIdentifier Text
s
  Maybe Text
mbVariant <- String -> Element -> MML (Maybe Text)
findAttrQ String
"mathvariant" Element
e
  TextType
curstyle <- (MMLState -> TextType) -> ReaderT MMLState (Except Text) TextType
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MMLState -> TextType
curStyle
  case Maybe Text
mbVariant of
       Maybe Text
Nothing  -> Exp -> MML Exp
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
base
       Just Text
v
         | TextType
curstyle TextType -> TextType -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> TextType
getTextType Text
v -> Exp -> MML Exp
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
base
         | Bool
otherwise  -> Exp -> MML Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> MML Exp) -> Exp -> MML Exp
forall a b. (a -> b) -> a -> b
$ TextType -> [Exp] -> Exp
EStyled (Text -> TextType
getTextType Text
v) [Exp
base]

number :: Element -> MML Exp
number :: Element -> MML Exp
number Element
e = Text -> Exp
ENumber (Text -> Exp) -> MML Text -> MML Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Text
getString Element
e

op :: Element -> MML (IR Exp)
op :: Element -> ReaderT MMLState (Except Text) (IR Exp)
op Element
e = do
  Maybe FormType
mInferredPosition <- Maybe FormType -> Maybe FormType -> Maybe FormType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (Maybe FormType -> Maybe FormType -> Maybe FormType)
-> ReaderT MMLState (Except Text) (Maybe FormType)
-> ReaderT
     MMLState (Except Text) (Maybe FormType -> Maybe FormType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Text -> Maybe FormType
getFormType (Maybe Text -> Maybe FormType)
-> MML (Maybe Text)
-> ReaderT MMLState (Except Text) (Maybe FormType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Element -> MML (Maybe Text)
findAttrQ String
"form" Element
e)
                            ReaderT MMLState (Except Text) (Maybe FormType -> Maybe FormType)
-> ReaderT MMLState (Except Text) (Maybe FormType)
-> ReaderT MMLState (Except Text) (Maybe FormType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MMLState -> Maybe FormType)
-> ReaderT MMLState (Except Text) (Maybe FormType)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MMLState -> Maybe FormType
position
  FormType
inferredPosition <- case Maybe FormType
mInferredPosition of
    Just FormType
inferredPosition -> FormType -> ReaderT MMLState (Except Text) FormType
forall (f :: * -> *) a. Applicative f => a -> f a
pure FormType
inferredPosition
    Maybe FormType
Nothing               -> Text -> ReaderT MMLState (Except Text) FormType
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"Did not find an inferred position"
  Text
opString <- Element -> MML Text
getString Element
e
  let dummy :: Operator
dummy = Text -> Text -> FormType -> Int -> Int -> Int -> [Text] -> Operator
Operator Text
opString Text
"" FormType
inferredPosition Int
0 Int
0 Int
0 []
  let opLookup :: Maybe Operator
opLookup = Text -> FormType -> Maybe Operator
getMathMLOperator Text
opString FormType
inferredPosition
  let opDict :: Operator
opDict = Operator -> Maybe Operator -> Operator
forall a. a -> Maybe a -> a
fromMaybe Operator
dummy Maybe Operator
opLookup
  [Text]
props <- (Text -> ReaderT MMLState (Except Text) Bool)
-> [Text] -> ReaderT MMLState (Except Text) [Text]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ([Text] -> Text -> ReaderT MMLState (Except Text) Bool
forall (t :: * -> *).
Foldable t =>
t Text -> Text -> ReaderT MMLState (Except Text) Bool
checkAttr (Operator -> [Text]
properties Operator
opDict))
            [Text
"fence", Text
"accent", Text
"stretchy"]
  let objectPosition :: TeXSymbolType
objectPosition = FormType -> TeXSymbolType
getPosition (FormType -> TeXSymbolType) -> FormType -> TeXSymbolType
forall a b. (a -> b) -> a -> b
$ Operator -> FormType
form Operator
opDict
  Bool
inScript <- (MMLState -> Bool) -> ReaderT MMLState (Except Text) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MMLState -> Bool
inAccent
  let ts :: [(Text, Text -> Exp)]
ts =  [(Text
"accent", TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Accent), (Text
"fence", TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
objectPosition)]
  let fallback :: Text -> Exp
fallback = case Text -> String
T.unpack Text
opString of
                   [Char
t] -> TeXSymbolType -> Text -> Exp
ESymbol (Char -> TeXSymbolType
getSymbolType Char
t)
                   String
_   -> if Maybe Operator -> Bool
forall a. Maybe a -> Bool
isJust Maybe Operator
opLookup
                          then TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Ord
                          else Text -> Exp
EMathOperator
  let constructor :: Text -> Exp
constructor =
        (Text -> Exp) -> Maybe (Text -> Exp) -> Text -> Exp
forall a. a -> Maybe a -> a
fromMaybe Text -> Exp
fallback
          (First (Text -> Exp) -> Maybe (Text -> Exp)
forall a. First a -> Maybe a
getFirst (First (Text -> Exp) -> Maybe (Text -> Exp))
-> ([First (Text -> Exp)] -> First (Text -> Exp))
-> [First (Text -> Exp)]
-> Maybe (Text -> Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [First (Text -> Exp)] -> First (Text -> Exp)
forall a. Monoid a => [a] -> a
mconcat ([First (Text -> Exp)] -> Maybe (Text -> Exp))
-> [First (Text -> Exp)] -> Maybe (Text -> Exp)
forall a b. (a -> b) -> a -> b
$ (Text -> First (Text -> Exp)) -> [Text] -> [First (Text -> Exp)]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (Text -> Exp) -> First (Text -> Exp)
forall a. Maybe a -> First a
First (Maybe (Text -> Exp) -> First (Text -> Exp))
-> (Text -> Maybe (Text -> Exp)) -> Text -> First (Text -> Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [(Text, Text -> Exp)] -> Maybe (Text -> Exp))
-> [(Text, Text -> Exp)] -> Text -> Maybe (Text -> Exp)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [(Text, Text -> Exp)] -> Maybe (Text -> Exp)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(Text, Text -> Exp)]
ts) [Text]
props)
  if (Text
"stretchy" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
props) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
inScript
    then IR Exp -> ReaderT MMLState (Except Text) (IR Exp)
forall (m :: * -> *) a. Monad m => a -> m a
return (IR Exp -> ReaderT MMLState (Except Text) (IR Exp))
-> IR Exp -> ReaderT MMLState (Except Text) (IR Exp)
forall a b. (a -> b) -> a -> b
$ TeXSymbolType -> (Text -> Exp) -> Text -> IR Exp
forall a. TeXSymbolType -> (Text -> Exp) -> Text -> IR a
Stretchy TeXSymbolType
objectPosition Text -> Exp
constructor Text
opString
    else do
      IR Exp -> ReaderT MMLState (Except Text) (IR Exp)
forall (m :: * -> *) a. Monad m => a -> m a
return (IR Exp -> ReaderT MMLState (Except Text) (IR Exp))
-> IR Exp -> ReaderT MMLState (Except Text) (IR Exp)
forall a b. (a -> b) -> a -> b
$ (Exp -> IR Exp
forall a. a -> IR a
E (Exp -> IR Exp) -> (Text -> Exp) -> Text -> IR Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Exp
constructor) Text
opString
  where
    checkAttr :: t Text -> Text -> ReaderT MMLState (Except Text) Bool
checkAttr t Text
ps Text
v = Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
v Text -> t Text -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Text
ps) (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
"true") (Maybe Text -> Bool)
-> MML (Maybe Text) -> ReaderT MMLState (Except Text) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Element -> MML (Maybe Text)
findAttrQ (Text -> String
T.unpack Text
v) Element
e

text :: Element -> MML Exp
text :: Element -> MML Exp
text Element
e = do
  TextType
textStyle <- TextType -> (Text -> TextType) -> Maybe Text -> TextType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TextType
TextNormal Text -> TextType
getTextType
                (Maybe Text -> TextType)
-> MML (Maybe Text) -> ReaderT MMLState (Except Text) TextType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Element -> MML (Maybe Text)
findAttrQ String
"mathvariant" Element
e)
  Text
s <- Element -> MML Text
getString Element
e
  -- mathml seems to use mtext for spacing often; we get
  -- more idiomatic math if we replace these with ESpace:
  Exp -> MML Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> MML Exp) -> Exp -> MML Exp
forall a b. (a -> b) -> a -> b
$ case (TextType
textStyle, Text -> String
T.unpack Text
s) of
       (TextType
TextNormal, [Char
c]) ->
         case Char -> Maybe Rational
getSpaceWidth Char
c of
              Just Rational
w  -> Rational -> Exp
ESpace Rational
w
              Maybe Rational
Nothing -> TextType -> Text -> Exp
EText TextType
textStyle Text
s
       (TextType, String)
_ -> TextType -> Text -> Exp
EText TextType
textStyle Text
s

literal :: Element -> MML Exp
literal :: Element -> MML Exp
literal Element
e = do
  Text
lquote <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"\x201C" (Maybe Text -> Text) -> MML (Maybe Text) -> MML Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Element -> MML (Maybe Text)
findAttrQ String
"lquote" Element
e
  Text
rquote <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"\x201D" (Maybe Text -> Text) -> MML (Maybe Text) -> MML Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Element -> MML (Maybe Text)
findAttrQ String
"rquote" Element
e
  TextType
textStyle <- TextType -> (Text -> TextType) -> Maybe Text -> TextType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TextType
TextNormal Text -> TextType
getTextType
                (Maybe Text -> TextType)
-> MML (Maybe Text) -> ReaderT MMLState (Except Text) TextType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Element -> MML (Maybe Text)
findAttrQ String
"mathvariant" Element
e)
  Text
s <- Element -> MML Text
getString Element
e
  Exp -> MML Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> MML Exp) -> Exp -> MML Exp
forall a b. (a -> b) -> a -> b
$ TextType -> Text -> Exp
EText TextType
textStyle (Text -> Exp) -> Text -> Exp
forall a b. (a -> b) -> a -> b
$ Text
lquote Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rquote

space :: Element -> MML Exp
space :: Element -> MML Exp
space Element
e = do
  Text
width <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"0.0em" (Maybe Text -> Text) -> MML (Maybe Text) -> MML Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Element -> MML (Maybe Text)
findAttrQ String
"width" Element
e)
  Exp -> MML Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> MML Exp) -> Exp -> MML Exp
forall a b. (a -> b) -> a -> b
$ Rational -> Exp
ESpace (Text -> Rational
widthToNum Text
width)

-- Layout

style :: Element -> MML Exp
style :: Element -> MML Exp
style Element
e = do
  TextType
tt <- TextType -> (Text -> TextType) -> Maybe Text -> TextType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TextType
TextNormal Text -> TextType
getTextType (Maybe Text -> TextType)
-> MML (Maybe Text) -> ReaderT MMLState (Except Text) TextType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Element -> MML (Maybe Text)
findAttrQ String
"mathvariant" Element
e
  TextType
curstyle <- (MMLState -> TextType) -> ReaderT MMLState (Except Text) TextType
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MMLState -> TextType
curStyle
  -- We do not want to propagate the mathvariant else
  -- we end up with nested EStyled applying the same
  -- style
  Exp
result <- (MMLState -> MMLState) -> MML Exp -> MML Exp
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (MMLState -> MMLState
filterMathVariant (MMLState -> MMLState)
-> (MMLState -> MMLState) -> MMLState -> MMLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextType -> MMLState -> MMLState
enterStyled TextType
tt) (Element -> MML Exp
row Element
e)
  Exp -> MML Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> MML Exp) -> Exp -> MML Exp
forall a b. (a -> b) -> a -> b
$ if TextType
curstyle TextType -> TextType -> Bool
forall a. Eq a => a -> a -> Bool
== TextType
tt
              then Exp
result
              else TextType -> [Exp] -> Exp
EStyled TextType
tt [Exp
result]

row :: Element -> MML Exp
row :: Element -> MML Exp
row Element
e = [IR Exp] -> Exp
mkExp ([IR Exp] -> Exp) -> MML [IR Exp] -> MML Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML [IR Exp]
group Element
e

-- 1. matchNesting strips all additional IR
-- 2. toEDelim
-- 3. toExp makes sure that no additional nesting happens
mkExp :: [IR Exp] -> Exp
mkExp :: [IR Exp] -> Exp
mkExp = [InEDelimited] -> Exp
toExp ([InEDelimited] -> Exp)
-> ([IR Exp] -> [InEDelimited]) -> [IR Exp] -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IR InEDelimited] -> [InEDelimited]
toEDelim ([IR InEDelimited] -> [InEDelimited])
-> ([IR Exp] -> [IR InEDelimited]) -> [IR Exp] -> [InEDelimited]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IR Exp] -> [IR InEDelimited]
matchNesting

toExp :: [InEDelimited] -> Exp
toExp :: [InEDelimited] -> Exp
toExp [] = Exp
empty
toExp [InEDelimited]
xs =
  if (InEDelimited -> Bool) -> [InEDelimited] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any InEDelimited -> Bool
isStretchy [InEDelimited]
xs
    then case [InEDelimited]
xs of
              [InEDelimited
x] -> (Text -> Exp) -> (Exp -> Exp) -> InEDelimited -> Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Ord) Exp -> Exp
forall a. a -> a
id InEDelimited
x
              [InEDelimited]
_ -> Text -> Text -> [InEDelimited] -> Exp
EDelimited Text
"" Text
"" [InEDelimited]
xs
    else
      case [InEDelimited]
xs of
        [Right Exp
x] -> Exp
x
        [InEDelimited]
_ -> [Exp] -> Exp
EGrouped ([InEDelimited] -> [Exp]
forall a b. [Either a b] -> [b]
rights [InEDelimited]
xs)


toEDelim :: [IR InEDelimited] -> [InEDelimited]
toEDelim :: [IR InEDelimited] -> [InEDelimited]
toEDelim [] = []
toEDelim [Stretchy TeXSymbolType
_ Text -> Exp
con Text
s] = [Exp -> InEDelimited
forall a b. b -> Either a b
Right (Exp -> InEDelimited) -> Exp -> InEDelimited
forall a b. (a -> b) -> a -> b
$ Text -> Exp
con Text
s]
toEDelim ([IR InEDelimited]
xs) = (IR InEDelimited -> InEDelimited)
-> [IR InEDelimited] -> [InEDelimited]
forall a b. (a -> b) -> [a] -> [b]
map IR InEDelimited -> InEDelimited
forall a. IR a -> a
removeIR [IR InEDelimited]
xs

-- Strips internal representation from processed list
removeIR :: IR a -> a
removeIR :: IR a -> a
removeIR (E a
e) = a
e
removeIR IR a
_ = String -> a
forall a. HasCallStack => String -> a
error String
"removeIR, should only be ever called on processed lists"

-- Convers stretch to InEDelimited element
removeStretch :: [IR Exp] -> [IR InEDelimited]
removeStretch :: [IR Exp] -> [IR InEDelimited]
removeStretch [Stretchy TeXSymbolType
_ Text -> Exp
constructor Text
s] = [InEDelimited -> IR InEDelimited
forall a. a -> IR a
E (InEDelimited -> IR InEDelimited)
-> InEDelimited -> IR InEDelimited
forall a b. (a -> b) -> a -> b
$ Exp -> InEDelimited
forall a b. b -> Either a b
Right (Text -> Exp
constructor Text
s)]
removeStretch [IR Exp]
xs = (IR Exp -> IR InEDelimited) -> [IR Exp] -> [IR InEDelimited]
forall a b. (a -> b) -> [a] -> [b]
map IR Exp -> IR InEDelimited
forall b. IR b -> IR (Either Text b)
f [IR Exp]
xs
  where
    f :: IR b -> IR (Either Text b)
f (Stretchy TeXSymbolType
_ Text -> Exp
_ Text
s) = Either Text b -> IR (Either Text b)
forall a. a -> IR a
E (Either Text b -> IR (Either Text b))
-> Either Text b -> IR (Either Text b)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text b
forall a b. a -> Either a b
Left Text
s
    f (E b
e) = Either Text b -> IR (Either Text b)
forall a. a -> IR a
E (Either Text b -> IR (Either Text b))
-> Either Text b -> IR (Either Text b)
forall a b. (a -> b) -> a -> b
$ b -> Either Text b
forall a b. b -> Either a b
Right b
e
    f (Trailing Exp -> Exp -> Exp
a Exp
b) = (Exp -> Exp -> Exp) -> Exp -> IR (Either Text b)
forall a. (Exp -> Exp -> Exp) -> Exp -> IR a
Trailing Exp -> Exp -> Exp
a Exp
b

isStretchy :: InEDelimited -> Bool
isStretchy :: InEDelimited -> Bool
isStretchy (Left Text
_) = Bool
True
isStretchy (Right Exp
_) = Bool
False

-- If at the end of a delimiter we need to apply the script to the whole
-- expression. We only insert Trailing when reordering Stretchy
trailingSup :: Maybe (T.Text, T.Text -> Exp)  -> Maybe (T.Text, T.Text -> Exp)  -> [IR InEDelimited] -> Exp
trailingSup :: Maybe (Text, Text -> Exp)
-> Maybe (Text, Text -> Exp) -> [IR InEDelimited] -> Exp
trailingSup Maybe (Text, Text -> Exp)
open Maybe (Text, Text -> Exp)
close [IR InEDelimited]
es = [IR InEDelimited] -> Exp
go [IR InEDelimited]
es
  where
    go :: [IR InEDelimited] -> Exp
go [] = case (Maybe (Text, Text -> Exp)
open, Maybe (Text, Text -> Exp)
close) of
              (Maybe (Text, Text -> Exp)
Nothing, Maybe (Text, Text -> Exp)
Nothing) -> Exp
empty
              (Just (Text
openFence, Text -> Exp
conOpen), Maybe (Text, Text -> Exp)
Nothing) -> Text -> Exp
conOpen Text
openFence
              (Maybe (Text, Text -> Exp)
Nothing, Just (Text
closeFence, Text -> Exp
conClose)) -> Text -> Exp
conClose Text
closeFence
              (Just (Text
openFence, Text -> Exp
conOpen), Just (Text
closeFence, Text -> Exp
conClose))  ->
                [Exp] -> Exp
EGrouped [Text -> Exp
conOpen Text
openFence, Text -> Exp
conClose Text
closeFence]
    go es' :: [IR InEDelimited]
es'@([IR InEDelimited] -> IR InEDelimited
forall a. [a] -> a
last -> Trailing Exp -> Exp -> Exp
constructor Exp
e) = (Exp -> Exp -> Exp
constructor ([IR InEDelimited] -> Exp
go ([IR InEDelimited] -> [IR InEDelimited]
forall a. [a] -> [a]
init [IR InEDelimited]
es')) Exp
e)
    go [IR InEDelimited]
es' = Text -> Text -> [InEDelimited] -> Exp
EDelimited (Maybe (Text, Text -> Exp) -> Text
forall b. Maybe (Text, b) -> Text
getFence Maybe (Text, Text -> Exp)
open) (Maybe (Text, Text -> Exp) -> Text
forall b. Maybe (Text, b) -> Text
getFence Maybe (Text, Text -> Exp)
close) ([IR InEDelimited] -> [InEDelimited]
toEDelim [IR InEDelimited]
es')
    getFence :: Maybe (Text, b) -> Text
getFence = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text)
-> (Maybe (Text, b) -> Maybe Text) -> Maybe (Text, b) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, b) -> Text) -> Maybe (Text, b) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, b) -> Text
forall a b. (a, b) -> a
fst

-- TODO: Break this into two functions
-- Matches open and closing brackets
-- The result of this function is a list with only E elements.
matchNesting :: [IR Exp] -> [IR InEDelimited]
matchNesting :: [IR Exp] -> [IR InEDelimited]
matchNesting (((IR Exp -> Bool) -> [IR Exp] -> ([IR Exp], [IR Exp])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break IR Exp -> Bool
forall a. IR a -> Bool
isFence) -> ([IR Exp]
inis, [IR Exp]
rest)) =
  let inis' :: [IR InEDelimited]
inis' = [IR Exp] -> [IR InEDelimited]
removeStretch [IR Exp]
inis in
  case [IR Exp]
rest of
    [] -> [IR InEDelimited]
inis'
    ((Stretchy TeXSymbolType
Open Text -> Exp
conOpen Text
opens): [IR Exp]
rs) ->
      let jOpen :: Maybe (Text, Text -> Exp)
jOpen = (Text, Text -> Exp) -> Maybe (Text, Text -> Exp)
forall a. a -> Maybe a
Just (Text
opens, Text -> Exp
conOpen)
          ([IR Exp]
body, [IR Exp]
rems) = [IR Exp] -> Int -> [IR Exp] -> ([IR Exp], [IR Exp])
forall a. [IR a] -> Int -> [IR a] -> ([IR a], [IR a])
go [IR Exp]
rs Int
0 []
          body' :: [IR InEDelimited]
body' = [IR Exp] -> [IR InEDelimited]
matchNesting [IR Exp]
body in
        case [IR Exp]
rems of
          [] -> [IR InEDelimited]
inis' [IR InEDelimited] -> [IR InEDelimited] -> [IR InEDelimited]
forall a. [a] -> [a] -> [a]
++ [InEDelimited -> IR InEDelimited
forall a. a -> IR a
E (InEDelimited -> IR InEDelimited)
-> InEDelimited -> IR InEDelimited
forall a b. (a -> b) -> a -> b
$ Exp -> InEDelimited
forall a b. b -> Either a b
Right (Exp -> InEDelimited) -> Exp -> InEDelimited
forall a b. (a -> b) -> a -> b
$ Maybe (Text, Text -> Exp)
-> Maybe (Text, Text -> Exp) -> [IR InEDelimited] -> Exp
trailingSup Maybe (Text, Text -> Exp)
jOpen Maybe (Text, Text -> Exp)
forall a. Maybe a
Nothing [IR InEDelimited]
body']
          (Stretchy TeXSymbolType
Close Text -> Exp
conClose Text
closes : [IR Exp]
rs') ->
            let jClose :: Maybe (Text, Text -> Exp)
jClose = (Text, Text -> Exp) -> Maybe (Text, Text -> Exp)
forall a. a -> Maybe a
Just (Text
closes, Text -> Exp
conClose) in
            [IR InEDelimited]
inis' [IR InEDelimited] -> [IR InEDelimited] -> [IR InEDelimited]
forall a. [a] -> [a] -> [a]
++ (InEDelimited -> IR InEDelimited
forall a. a -> IR a
E (InEDelimited -> IR InEDelimited)
-> InEDelimited -> IR InEDelimited
forall a b. (a -> b) -> a -> b
$ Exp -> InEDelimited
forall a b. b -> Either a b
Right (Exp -> InEDelimited) -> Exp -> InEDelimited
forall a b. (a -> b) -> a -> b
$ Maybe (Text, Text -> Exp)
-> Maybe (Text, Text -> Exp) -> [IR InEDelimited] -> Exp
trailingSup Maybe (Text, Text -> Exp)
jOpen Maybe (Text, Text -> Exp)
jClose [IR InEDelimited]
body') IR InEDelimited -> [IR InEDelimited] -> [IR InEDelimited]
forall a. a -> [a] -> [a]
: [IR Exp] -> [IR InEDelimited]
matchNesting [IR Exp]
rs'
          [IR Exp]
_ -> (String -> [IR InEDelimited]
forall a. HasCallStack => String -> a
error String
"matchNesting: Logical error 1")
    ((Stretchy TeXSymbolType
Close Text -> Exp
conClose Text
closes): [IR Exp]
rs) ->
      let jClose :: Maybe (Text, Text -> Exp)
jClose = (Text, Text -> Exp) -> Maybe (Text, Text -> Exp)
forall a. a -> Maybe a
Just (Text
closes, Text -> Exp
conClose) in
      (InEDelimited -> IR InEDelimited
forall a. a -> IR a
E (InEDelimited -> IR InEDelimited)
-> InEDelimited -> IR InEDelimited
forall a b. (a -> b) -> a -> b
$ Exp -> InEDelimited
forall a b. b -> Either a b
Right (Exp -> InEDelimited) -> Exp -> InEDelimited
forall a b. (a -> b) -> a -> b
$ Maybe (Text, Text -> Exp)
-> Maybe (Text, Text -> Exp) -> [IR InEDelimited] -> Exp
trailingSup Maybe (Text, Text -> Exp)
forall a. Maybe a
Nothing Maybe (Text, Text -> Exp)
jClose ([IR Exp] -> [IR InEDelimited]
matchNesting [IR Exp]
inis)) IR InEDelimited -> [IR InEDelimited] -> [IR InEDelimited]
forall a. a -> [a] -> [a]
: [IR Exp] -> [IR InEDelimited]
matchNesting [IR Exp]
rs
    [IR Exp]
_ -> String -> [IR InEDelimited]
forall a. HasCallStack => String -> a
error String
"matchNesting: Logical error 2"
  where
    isOpen :: IR a -> Bool
isOpen (Stretchy TeXSymbolType
Open Text -> Exp
_ Text
_) = Bool
True
    isOpen IR a
_ = Bool
False
    isClose :: IR a -> Bool
isClose (Stretchy TeXSymbolType
Close Text -> Exp
_ Text
_) = Bool
True
    isClose IR a
_ = Bool
False
    go :: [IR a] -> Int -> [IR a] -> ([IR a], [IR a])
    go :: [IR a] -> Int -> [IR a] -> ([IR a], [IR a])
go (IR a
x:[IR a]
xs) Int
0 [IR a]
a | IR a -> Bool
forall a. IR a -> Bool
isClose IR a
x = ([IR a] -> [IR a]
forall a. [a] -> [a]
reverse [IR a]
a, IR a
xIR a -> [IR a] -> [IR a]
forall a. a -> [a] -> [a]
:[IR a]
xs)
    go (IR a
x:[IR a]
xs) Int
n [IR a]
a | IR a -> Bool
forall a. IR a -> Bool
isOpen IR a
x  = [IR a] -> Int -> [IR a] -> ([IR a], [IR a])
forall a. [IR a] -> Int -> [IR a] -> ([IR a], [IR a])
go [IR a]
xs (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (IR a
xIR a -> [IR a] -> [IR a]
forall a. a -> [a] -> [a]
:[IR a]
a)
    go (IR a
x:[IR a]
xs) Int
n [IR a]
a | IR a -> Bool
forall a. IR a -> Bool
isClose IR a
x = [IR a] -> Int -> [IR a] -> ([IR a], [IR a])
forall a. [IR a] -> Int -> [IR a] -> ([IR a], [IR a])
go [IR a]
xs (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (IR a
xIR a -> [IR a] -> [IR a]
forall a. a -> [a] -> [a]
:[IR a]
a)
    go (IR a
x:[IR a]
xs) Int
n [IR a]
a = [IR a] -> Int -> [IR a] -> ([IR a], [IR a])
forall a. [IR a] -> Int -> [IR a] -> ([IR a], [IR a])
go [IR a]
xs Int
n (IR a
xIR a -> [IR a] -> [IR a]
forall a. a -> [a] -> [a]
:[IR a]
a)
    go [] Int
_ [IR a]
a = ([IR a] -> [IR a]
forall a. [a] -> [a]
reverse [IR a]
a, [])

isFence :: IR a -> Bool
isFence :: IR a -> Bool
isFence (Stretchy TeXSymbolType
Open Text -> Exp
_ Text
_) = Bool
True
isFence (Stretchy TeXSymbolType
Close Text -> Exp
_ Text
_) = Bool
True
isFence IR a
_ = Bool
False

group :: Element -> MML [IR Exp]
group :: Element -> MML [IR Exp]
group Element
e = do
  [IR Exp]
front <- [[IR Exp]] -> [IR Exp]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[IR Exp]] -> [IR Exp])
-> ReaderT MMLState (Except Text) [[IR Exp]] -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> MML [IR Exp])
-> [Element] -> ReaderT MMLState (Except Text) [[IR Exp]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> MML [IR Exp]
expr [Element]
frontSpaces
  [IR Exp]
middle <- (MMLState -> MMLState) -> MML [IR Exp] -> MML [IR Exp]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local MMLState -> MMLState
resetPosition ([Element] -> MML [IR Exp]
row' [Element]
body)
  [IR Exp]
end <- [[IR Exp]] -> [IR Exp]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[IR Exp]] -> [IR Exp])
-> ReaderT MMLState (Except Text) [[IR Exp]] -> MML [IR Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MMLState -> MMLState)
-> ReaderT MMLState (Except Text) [[IR Exp]]
-> ReaderT MMLState (Except Text) [[IR Exp]]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local MMLState -> MMLState
resetPosition ((Element -> MML [IR Exp])
-> [Element] -> ReaderT MMLState (Except Text) [[IR Exp]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> MML [IR Exp]
expr [Element]
endSpaces)
  [IR Exp] -> MML [IR Exp]
forall (m :: * -> *) a. Monad m => a -> m a
return ([IR Exp] -> MML [IR Exp]) -> [IR Exp] -> MML [IR Exp]
forall a b. (a -> b) -> a -> b
$ ([IR Exp]
front [IR Exp] -> [IR Exp] -> [IR Exp]
forall a. [a] -> [a] -> [a]
++ [IR Exp]
middle [IR Exp] -> [IR Exp] -> [IR Exp]
forall a. [a] -> [a] -> [a]
++ [IR Exp]
end)
  where
    cs :: [Element]
cs = Element -> [Element]
elChildren Element
e
    ([Element]
frontSpaces, [Element]
noFront)  = (Element -> Bool) -> [Element] -> ([Element], [Element])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Element -> Bool
spacelike [Element]
cs
    ([Element]
endSpaces, [Element]
body) = let ([Element]
as, [Element]
bs) = (Element -> Bool) -> [Element] -> ([Element], [Element])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Element -> Bool
spacelike ([Element] -> [Element]
forall a. [a] -> [a]
reverse [Element]
noFront) in
                          ([Element] -> [Element]
forall a. [a] -> [a]
reverse [Element]
as, [Element] -> [Element]
forall a. [a] -> [a]
reverse [Element]
bs)

row' :: [Element] -> MML [IR Exp]
row' :: [Element] -> MML [IR Exp]
row' [] = [IR Exp] -> MML [IR Exp]
forall (m :: * -> *) a. Monad m => a -> m a
return []
row' [Element
x] = do
              FormType
pos <- FormType -> (FormType -> FormType) -> Maybe FormType -> FormType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FormType
FInfix (FormType -> FormType -> FormType
forall a b. a -> b -> a
const FormType
FPostfix) (Maybe FormType -> FormType)
-> ReaderT MMLState (Except Text) (Maybe FormType)
-> ReaderT MMLState (Except Text) FormType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MMLState -> Maybe FormType)
-> ReaderT MMLState (Except Text) (Maybe FormType)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MMLState -> Maybe FormType
position
              (MMLState -> MMLState) -> MML [IR Exp] -> MML [IR Exp]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (FormType -> MMLState -> MMLState
setPosition FormType
pos) (Element -> MML [IR Exp]
expr Element
x)
row' (Element
x:[Element]
xs) =
  do
    FormType
pos <- FormType -> (FormType -> FormType) -> Maybe FormType -> FormType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FormType
FPrefix (FormType -> FormType -> FormType
forall a b. a -> b -> a
const FormType
FInfix) (Maybe FormType -> FormType)
-> ReaderT MMLState (Except Text) (Maybe FormType)
-> ReaderT MMLState (Except Text) FormType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MMLState -> Maybe FormType)
-> ReaderT MMLState (Except Text) (Maybe FormType)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MMLState -> Maybe FormType
position
    [IR Exp]
e  <- (MMLState -> MMLState) -> MML [IR Exp] -> MML [IR Exp]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (FormType -> MMLState -> MMLState
setPosition FormType
pos) (Element -> MML [IR Exp]
expr Element
x)
    [IR Exp]
es <- (MMLState -> MMLState) -> MML [IR Exp] -> MML [IR Exp]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (FormType -> MMLState -> MMLState
setPosition FormType
pos) ([Element] -> MML [IR Exp]
row' [Element]
xs)
    [IR Exp] -> MML [IR Exp]
forall (m :: * -> *) a. Monad m => a -> m a
return ([IR Exp]
e [IR Exp] -> [IR Exp] -> [IR Exp]
forall a. [a] -> [a] -> [a]
++ [IR Exp]
es)

-- Indicates the closure of scope
safeExpr :: Element -> MML Exp
safeExpr :: Element -> MML Exp
safeExpr Element
e = [IR Exp] -> Exp
mkExp ([IR Exp] -> Exp) -> MML [IR Exp] -> MML Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML [IR Exp]
expr Element
e

frac :: Element -> MML Exp
frac :: Element -> MML Exp
frac Element
e = do
  (Exp
num, Exp
denom) <- (Element -> MML Exp)
-> (Element, Element) -> ReaderT MMLState (Except Text) (Exp, Exp)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> (a, a) -> m (b, b)
mapPairM Element -> MML Exp
safeExpr ((Element, Element) -> ReaderT MMLState (Except Text) (Exp, Exp))
-> ReaderT MMLState (Except Text) (Element, Element)
-> ReaderT MMLState (Except Text) (Exp, Exp)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Element -> ReaderT MMLState (Except Text) (Element, Element)
checkArgs2 Element
e)
  Maybe Text
rawThick <- String -> Element -> MML (Maybe Text)
findAttrQ String
"linethickness" Element
e
  Exp -> MML Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> MML Exp) -> Exp -> MML Exp
forall a b. (a -> b) -> a -> b
$
    if Maybe Text -> Bool
thicknessZero Maybe Text
rawThick
       then FractionType -> Exp -> Exp -> Exp
EFraction FractionType
NoLineFrac Exp
num Exp
denom
       else FractionType -> Exp -> Exp -> Exp
EFraction FractionType
NormalFrac Exp
num Exp
denom

msqrt :: Element -> MML Exp
msqrt :: Element -> MML Exp
msqrt Element
e = Exp -> Exp
ESqrt (Exp -> Exp) -> MML Exp -> MML Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> MML Exp
row Element
e)

kroot :: Element -> MML Exp
kroot :: Element -> MML Exp
kroot Element
e = do
  (Exp
base, Exp
index) <- (Element -> MML Exp)
-> (Element, Element) -> ReaderT MMLState (Except Text) (Exp, Exp)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> (a, a) -> m (b, b)
mapPairM Element -> MML Exp
safeExpr ((Element, Element) -> ReaderT MMLState (Except Text) (Exp, Exp))
-> ReaderT MMLState (Except Text) (Element, Element)
-> ReaderT MMLState (Except Text) (Exp, Exp)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Element -> ReaderT MMLState (Except Text) (Element, Element)
checkArgs2 Element
e)
  Exp -> MML Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> MML Exp) -> Exp -> MML Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
ERoot Exp
index Exp
base

phantom :: Element -> MML Exp
phantom :: Element -> MML Exp
phantom Element
e = Exp -> Exp
EPhantom (Exp -> Exp) -> MML Exp -> MML Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
row Element
e

fenced :: Element -> MML Exp
fenced :: Element -> MML Exp
fenced Element
e = do
  Text
open  <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"(" (Maybe Text -> Text) -> MML (Maybe Text) -> MML Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Element -> MML (Maybe Text)
findAttrQ String
"open" Element
e)
  Text
close <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
")" (Maybe Text -> Text) -> MML (Maybe Text) -> MML Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Element -> MML (Maybe Text)
findAttrQ String
"close" Element
e)
  Text
sep  <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"," (Maybe Text -> Text) -> MML (Maybe Text) -> MML Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Element -> MML (Maybe Text)
findAttrQ String
"separators" Element
e)
  let expanded :: [Element]
expanded =
        case Text
sep of
          Text
"" -> Element -> [Element]
elChildren Element
e
          Text
_  ->
            let seps :: [Element]
seps = (Char -> Element) -> String -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
"mo" [Char
x]) (String -> [Element]) -> String -> [Element]
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
sep
                sepsList :: [Element]
sepsList = [Element]
seps [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ Element -> [Element]
forall a. a -> [a]
repeat ([Element] -> Element
forall a. [a] -> a
last [Element]
seps) in
                [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
fInterleave (Element -> [Element]
elChildren Element
e) ([Element]
sepsList)
  Element -> MML Exp
safeExpr (Element -> MML Exp) -> Element -> MML Exp
forall a b. (a -> b) -> a -> b
$ String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"mrow"
              ([String -> Text -> Element
tunode String
"mo" Text
open | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
open] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
               [String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"mrow" [Element]
expanded] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
               [String -> Text -> Element
tunode String
"mo" Text
close | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
close])

-- This could approximate the variants
enclosed :: Element -> MML Exp
enclosed :: Element -> MML Exp
enclosed Element
e = do
  Maybe Text
mbNotation <- String -> Element -> MML (Maybe Text)
findAttrQ String
"notation" Element
e
  case Maybe Text
mbNotation of
       Just Text
"box" -> Exp -> Exp
EBoxed (Exp -> Exp) -> MML Exp -> MML Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
row Element
e
       Maybe Text
_ -> Element -> MML Exp
row Element
e

action :: Element -> MML Exp
action :: Element -> MML Exp
action Element
e = do
  Int
selection <-  Int -> (Text -> Int) -> Maybe Text -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> (Text -> String) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (Maybe Text -> Int)
-> MML (Maybe Text) -> ReaderT MMLState (Except Text) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Element -> MML (Maybe Text)
findAttrQ String
"selection" Element
e)  -- 1-indexing
  Element -> MML Exp
safeExpr (Element -> MML Exp)
-> ReaderT MMLState (Except Text) Element -> MML Exp
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Maybe Element -> ReaderT MMLState (Except Text) Element
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither (Text
"Selection out of range")
            ([Element] -> Maybe Element
forall a. [a] -> Maybe a
listToMaybe ([Element] -> Maybe Element) -> [Element] -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Int -> [Element] -> [Element]
forall a. Int -> [a] -> [a]
drop (Int
selection Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Element -> [Element]
elChildren Element
e))

-- Scripts and Limits

sub :: Element -> MML [IR Exp]
sub :: Element -> MML [IR Exp]
sub Element
e =  do
  (Element
base, Element
subs) <- Element -> ReaderT MMLState (Except Text) (Element, Element)
checkArgs2 Element
e
  Element -> Element -> (Exp -> Exp -> Exp) -> MML [IR Exp]
reorderScripts Element
base Element
subs Exp -> Exp -> Exp
ESub

-- Handles case with strethy elements in the base of sub/sup
reorderScripts :: Element -> Element -> (Exp -> Exp -> Exp) -> MML [IR Exp]
reorderScripts :: Element -> Element -> (Exp -> Exp -> Exp) -> MML [IR Exp]
reorderScripts Element
e Element
subs Exp -> Exp -> Exp
c = do
  [IR Exp]
baseExpr <- Element -> MML [IR Exp]
expr Element
e
  Exp
subExpr <- Element -> MML Exp
postfixExpr Element
subs
  [IR Exp] -> MML [IR Exp]
forall (m :: * -> *) a. Monad m => a -> m a
return ([IR Exp] -> MML [IR Exp]) -> [IR Exp] -> MML [IR Exp]
forall a b. (a -> b) -> a -> b
$
    case [IR Exp]
baseExpr of
      [s :: IR Exp
s@(Stretchy TeXSymbolType
Open Text -> Exp
_ Text
_)] -> [IR Exp
s, Exp -> IR Exp
forall a. a -> IR a
E (Exp -> IR Exp) -> Exp -> IR Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
c Exp
empty Exp
subExpr]  -- Open
      [s :: IR Exp
s@(Stretchy TeXSymbolType
Close Text -> Exp
_ Text
_)] -> [(Exp -> Exp -> Exp) -> Exp -> IR Exp
forall a. (Exp -> Exp -> Exp) -> Exp -> IR a
Trailing Exp -> Exp -> Exp
c Exp
subExpr, IR Exp
s] -- Close
      [s :: IR Exp
s@(Stretchy TeXSymbolType
_ Text -> Exp
_ Text
_)] -> [IR Exp
s, Exp -> IR Exp
forall a. a -> IR a
E (Exp -> IR Exp) -> Exp -> IR Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
ESub Exp
empty Exp
subExpr] -- Middle
      [IR Exp]
_ -> [Exp -> IR Exp
forall a. a -> IR a
E (Exp -> IR Exp) -> Exp -> IR Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
c ([IR Exp] -> Exp
mkExp [IR Exp]
baseExpr) Exp
subExpr] -- No stretch

sup :: Element -> MML [IR Exp]
sup :: Element -> MML [IR Exp]
sup Element
e = do
  (Element
base, Element
sups) <- Element -> ReaderT MMLState (Except Text) (Element, Element)
checkArgs2 Element
e
  Element -> Element -> (Exp -> Exp -> Exp) -> MML [IR Exp]
reorderScripts Element
base Element
sups Exp -> Exp -> Exp
ESuper

subsup :: Element -> MML Exp
subsup :: Element -> MML Exp
subsup Element
e = do
  (Element
base, Element
subs, Element
sups) <- Element -> MML (Element, Element, Element)
checkArgs3 Element
e
  Exp -> Exp -> Exp -> Exp
ESubsup (Exp -> Exp -> Exp -> Exp)
-> MML Exp -> ReaderT MMLState (Except Text) (Exp -> Exp -> Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
safeExpr Element
base ReaderT MMLState (Except Text) (Exp -> Exp -> Exp)
-> MML Exp -> ReaderT MMLState (Except Text) (Exp -> Exp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Element -> MML Exp
postfixExpr Element
subs)
                         ReaderT MMLState (Except Text) (Exp -> Exp) -> MML Exp -> MML Exp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Element -> MML Exp
postfixExpr Element
sups)

under :: Element -> MML Exp
under :: Element -> MML Exp
under Element
e = do
  (Element
base, Element
below) <- Element -> ReaderT MMLState (Except Text) (Element, Element)
checkArgs2 Element
e
  Bool -> Exp -> Exp -> Exp
EUnder Bool
False (Exp -> Exp -> Exp)
-> MML Exp -> ReaderT MMLState (Except Text) (Exp -> Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
safeExpr Element
base ReaderT MMLState (Except Text) (Exp -> Exp) -> MML Exp -> MML Exp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Element -> MML Exp
postfixExpr Element
below

over :: Element -> MML Exp
over :: Element -> MML Exp
over Element
e = do
  (Element
base, Element
above) <- Element -> ReaderT MMLState (Except Text) (Element, Element)
checkArgs2 Element
e
  Bool -> Exp -> Exp -> Exp
EOver Bool
False (Exp -> Exp -> Exp)
-> MML Exp -> ReaderT MMLState (Except Text) (Exp -> Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
safeExpr Element
base ReaderT MMLState (Except Text) (Exp -> Exp) -> MML Exp -> MML Exp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Element -> MML Exp
postfixExpr Element
above

underover :: Element -> MML Exp
underover :: Element -> MML Exp
underover Element
e = do
  (Element
base, Element
below, Element
above) <- Element -> MML (Element, Element, Element)
checkArgs3 Element
e
  Bool -> Exp -> Exp -> Exp -> Exp
EUnderover Bool
False (Exp -> Exp -> Exp -> Exp)
-> MML Exp -> ReaderT MMLState (Except Text) (Exp -> Exp -> Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
safeExpr Element
base  ReaderT MMLState (Except Text) (Exp -> Exp -> Exp)
-> MML Exp -> ReaderT MMLState (Except Text) (Exp -> Exp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Element -> MML Exp
postfixExpr Element
below)
                                      ReaderT MMLState (Except Text) (Exp -> Exp) -> MML Exp -> MML Exp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Element -> MML Exp
postfixExpr Element
above)

-- Other

semantics :: Element -> MML Exp
semantics :: Element -> MML Exp
semantics Element
e = do
  Bool -> ReaderT MMLState (Except Text) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Element] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Element]
cs)
  Exp
first <- Element -> MML Exp
safeExpr ([Element] -> Element
forall a. [a] -> a
head [Element]
cs)
  if Exp -> Bool
isEmpty Exp
first
    then Exp -> Maybe Exp -> Exp
forall a. a -> Maybe a -> a
fromMaybe Exp
empty (Maybe Exp -> Exp)
-> ([First Exp] -> Maybe Exp) -> [First Exp] -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. First Exp -> Maybe Exp
forall a. First a -> Maybe a
getFirst (First Exp -> Maybe Exp)
-> ([First Exp] -> First Exp) -> [First Exp] -> Maybe Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [First Exp] -> First Exp
forall a. Monoid a => [a] -> a
mconcat ([First Exp] -> Exp)
-> ReaderT MMLState (Except Text) [First Exp] -> MML Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> ReaderT MMLState (Except Text) (First Exp))
-> [Element] -> ReaderT MMLState (Except Text) [First Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> ReaderT MMLState (Except Text) (First Exp)
annotation ([Element] -> [Element]
forall a. [a] -> [a]
tail [Element]
cs)
    else Exp -> MML Exp
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
first
  where
    cs :: [Element]
cs = Element -> [Element]
elChildren Element
e

annotation :: Element -> MML (First Exp)
annotation :: Element -> ReaderT MMLState (Except Text) (First Exp)
annotation Element
e = do
  Maybe Text
encoding <- String -> Element -> MML (Maybe Text)
findAttrQ String
"encoding" Element
e
  case Maybe Text
encoding of
    Just Text
"application/mathml-presentation+xml" ->
      Maybe Exp -> First Exp
forall a. Maybe a -> First a
First (Maybe Exp -> First Exp) -> (Exp -> Maybe Exp) -> Exp -> First Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> First Exp)
-> MML Exp -> ReaderT MMLState (Except Text) (First Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
row Element
e
    Just Text
"MathML-Presentation" ->
      Maybe Exp -> First Exp
forall a. Maybe a -> First a
First (Maybe Exp -> First Exp) -> (Exp -> Maybe Exp) -> Exp -> First Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> First Exp)
-> MML Exp -> ReaderT MMLState (Except Text) (First Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
row Element
e
    Maybe Text
_ -> First Exp -> ReaderT MMLState (Except Text) (First Exp)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Exp -> First Exp
forall a. Maybe a -> First a
First Maybe Exp
forall a. Maybe a
Nothing)

multiscripts :: Element -> MML Exp
multiscripts :: Element -> MML Exp
multiscripts Element
e = do
  let ([Element]
xs, [Element]
pres) = (Element -> Bool) -> [Element] -> ([Element], [Element])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"mprescripts") (Text -> Bool) -> (Element -> Text) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
name) (Element -> [Element]
elChildren Element
e)
  let row'' :: Element -> MML Exp
row'' Element
e' = if Element -> Text
name Element
e' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"none"
                    then Exp -> MML Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> MML Exp) -> Exp -> MML Exp
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
EGrouped []
                    else Element -> MML Exp
row Element
e'
  [Exp]
xs' <- (Element -> MML Exp)
-> [Element] -> ReaderT MMLState (Except Text) [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> MML Exp
row'' [Element]
xs
  let base :: Exp
base =
        case [Exp]
xs' of
          [Exp
x]       -> Exp
x
          [Exp
x,Exp
y]     -> Exp -> Exp -> Exp
ESub Exp
x Exp
y
          (Exp
x:Exp
y:Exp
z:[Exp]
_) -> Exp -> Exp -> Exp -> Exp
ESubsup Exp
x Exp
y Exp
z
          []        -> [Exp] -> Exp
EGrouped []
  [Exp]
pres' <- (Element -> MML Exp)
-> [Element] -> ReaderT MMLState (Except Text) [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> MML Exp
row'' ([Element] -> ReaderT MMLState (Except Text) [Exp])
-> [Element] -> ReaderT MMLState (Except Text) [Exp]
forall a b. (a -> b) -> a -> b
$ Int -> [Element] -> [Element]
forall a. Int -> [a] -> [a]
drop Int
1 [Element]
pres
  Exp -> MML Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> MML Exp) -> Exp -> MML Exp
forall a b. (a -> b) -> a -> b
$
    case [Exp]
pres' of
        (Exp
x:Exp
y:[Exp]
_) -> [Exp] -> Exp
EGrouped [Exp -> Exp -> Exp -> Exp
ESubsup ([Exp] -> Exp
EGrouped []) Exp
x Exp
y, Exp
base]
        [Exp
x]     -> [Exp] -> Exp
EGrouped [Exp -> Exp -> Exp
ESub Exp
x ([Exp] -> Exp
EGrouped []), Exp
base]
        []      -> Exp
base


-- Table

table :: Element -> MML Exp
table :: Element -> MML Exp
table Element
e = do
  Alignment
defAlign <- Alignment -> (Text -> Alignment) -> Maybe Text -> Alignment
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Alignment
AlignCenter Text -> Alignment
toAlignment (Maybe Text -> Alignment)
-> MML (Maybe Text) -> ReaderT MMLState (Except Text) Alignment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Element -> MML (Maybe Text)
findAttrQ String
"columnalign" Element
e)
  [[(Alignment, [Exp])]]
rs <- (Element -> ReaderT MMLState (Except Text) [(Alignment, [Exp])])
-> [Element]
-> ReaderT MMLState (Except Text) [[(Alignment, [Exp])]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Alignment
-> Element -> ReaderT MMLState (Except Text) [(Alignment, [Exp])]
tableRow Alignment
defAlign) (Element -> [Element]
elChildren Element
e)
  let ([[Alignment]]
onlyAligns, [[[Exp]]]
exprs) = (([(Alignment, [Exp])] -> [Alignment])
-> [[(Alignment, [Exp])]] -> [[Alignment]]
forall a b. (a -> b) -> [a] -> [b]
map (([(Alignment, [Exp])] -> [Alignment])
 -> [[(Alignment, [Exp])]] -> [[Alignment]])
-> (((Alignment, [Exp]) -> Alignment)
    -> [(Alignment, [Exp])] -> [Alignment])
-> ((Alignment, [Exp]) -> Alignment)
-> [[(Alignment, [Exp])]]
-> [[Alignment]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Alignment, [Exp]) -> Alignment)
-> [(Alignment, [Exp])] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map) (Alignment, [Exp]) -> Alignment
forall a b. (a, b) -> a
fst ([[(Alignment, [Exp])]] -> [[Alignment]])
-> ([[(Alignment, [Exp])]] -> [[[Exp]]])
-> [[(Alignment, [Exp])]]
-> ([[Alignment]], [[[Exp]]])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (([(Alignment, [Exp])] -> [[Exp]])
-> [[(Alignment, [Exp])]] -> [[[Exp]]]
forall a b. (a -> b) -> [a] -> [b]
map (([(Alignment, [Exp])] -> [[Exp]])
 -> [[(Alignment, [Exp])]] -> [[[Exp]]])
-> (((Alignment, [Exp]) -> [Exp])
    -> [(Alignment, [Exp])] -> [[Exp]])
-> ((Alignment, [Exp]) -> [Exp])
-> [[(Alignment, [Exp])]]
-> [[[Exp]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Alignment, [Exp]) -> [Exp]) -> [(Alignment, [Exp])] -> [[Exp]]
forall a b. (a -> b) -> [a] -> [b]
map) (Alignment, [Exp]) -> [Exp]
forall a b. (a, b) -> b
snd ([[(Alignment, [Exp])]] -> ([[Alignment]], [[[Exp]]]))
-> [[(Alignment, [Exp])]] -> ([[Alignment]], [[[Exp]]])
forall a b. (a -> b) -> a -> b
$ [[(Alignment, [Exp])]]
rs
  let rs' :: [[[Exp]]]
rs' = ([[Exp]] -> [[Exp]]) -> [[[Exp]]] -> [[[Exp]]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [[Exp]] -> [[Exp]]
forall a. Int -> [[a]] -> [[a]]
pad ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (([(Alignment, [Exp])] -> Int) -> [[(Alignment, [Exp])]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [(Alignment, [Exp])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[(Alignment, [Exp])]]
rs))) [[[Exp]]]
exprs
  let aligns :: [Alignment]
aligns = ([Alignment] -> Alignment) -> [[Alignment]] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map [Alignment] -> Alignment
forall (t :: * -> *). Foldable t => t Alignment -> Alignment
findAlign ([[Alignment]] -> [[Alignment]]
forall a. [[a]] -> [[a]]
transpose [[Alignment]]
onlyAligns)
  Exp -> MML Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> MML Exp) -> Exp -> MML Exp
forall a b. (a -> b) -> a -> b
$ [Alignment] -> [[[Exp]]] -> Exp
EArray [Alignment]
aligns [[[Exp]]]
rs'
  where
    findAlign :: t Alignment -> Alignment
findAlign t Alignment
xs = if t Alignment -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t Alignment
xs then Alignment
AlignCenter
                    else (Alignment -> Alignment -> Alignment) -> t Alignment -> Alignment
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Alignment -> Alignment -> Alignment
combine t Alignment
xs
    combine :: Alignment -> Alignment -> Alignment
combine Alignment
x Alignment
y = if Alignment
x Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
y then Alignment
x else Alignment
AlignCenter

tableRow :: Alignment -> Element -> MML [(Alignment, [Exp])]
tableRow :: Alignment
-> Element -> ReaderT MMLState (Except Text) [(Alignment, [Exp])]
tableRow Alignment
a Element
e = do
  Alignment
align <- Alignment -> (Text -> Alignment) -> Maybe Text -> Alignment
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Alignment
a Text -> Alignment
toAlignment (Maybe Text -> Alignment)
-> MML (Maybe Text) -> ReaderT MMLState (Except Text) Alignment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Element -> MML (Maybe Text)
findAttrQ String
"columnalign" Element
e)
  case Element -> Text
name Element
e of
    Text
"mtr" -> (Element -> ReaderT MMLState (Except Text) (Alignment, [Exp]))
-> [Element] -> ReaderT MMLState (Except Text) [(Alignment, [Exp])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Alignment
-> Element -> ReaderT MMLState (Except Text) (Alignment, [Exp])
tableCell Alignment
align) (Element -> [Element]
elChildren Element
e)
    Text
"mlabeledtr" -> (Element -> ReaderT MMLState (Except Text) (Alignment, [Exp]))
-> [Element] -> ReaderT MMLState (Except Text) [(Alignment, [Exp])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Alignment
-> Element -> ReaderT MMLState (Except Text) (Alignment, [Exp])
tableCell Alignment
align) ([Element] -> [Element]
forall a. [a] -> [a]
tail ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
e)
    Text
_ -> Text -> ReaderT MMLState (Except Text) [(Alignment, [Exp])]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> ReaderT MMLState (Except Text) [(Alignment, [Exp])])
-> Text -> ReaderT MMLState (Except Text) [(Alignment, [Exp])]
forall a b. (a -> b) -> a -> b
$ Text
"Invalid Element: Only expecting mtr elements " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element -> Text
err Element
e

tableCell :: Alignment -> Element -> MML (Alignment, [Exp])
tableCell :: Alignment
-> Element -> ReaderT MMLState (Except Text) (Alignment, [Exp])
tableCell Alignment
a Element
e = do
  Alignment
align <- Alignment -> (Text -> Alignment) -> Maybe Text -> Alignment
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Alignment
a Text -> Alignment
toAlignment (Maybe Text -> Alignment)
-> MML (Maybe Text) -> ReaderT MMLState (Except Text) Alignment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Element -> MML (Maybe Text)
findAttrQ String
"columnalign" Element
e)
  case Element -> Text
name Element
e of
    Text
"mtd" -> (,) Alignment
align ([Exp] -> (Alignment, [Exp]))
-> (Exp -> [Exp]) -> Exp -> (Alignment, [Exp])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp -> [Exp] -> [Exp]
forall a. a -> [a] -> [a]
:[]) (Exp -> (Alignment, [Exp]))
-> MML Exp -> ReaderT MMLState (Except Text) (Alignment, [Exp])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
row Element
e
    Text
_ -> Text -> ReaderT MMLState (Except Text) (Alignment, [Exp])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> ReaderT MMLState (Except Text) (Alignment, [Exp]))
-> Text -> ReaderT MMLState (Except Text) (Alignment, [Exp])
forall a b. (a -> b) -> a -> b
$ Text
"Invalid Element: Only expecting mtd elements " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element -> Text
err Element
e

-- Fixup

-- Library Functions

maybeToEither :: (MonadError e m) => e -> Maybe a -> m a
maybeToEither :: e -> Maybe a -> m a
maybeToEither = (m a -> (a -> m a) -> Maybe a -> m a)
-> (a -> m a) -> m a -> Maybe a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (m a -> Maybe a -> m a) -> (e -> m a) -> e -> Maybe a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError

--interleave up to end of shorter list
fInterleave :: [a] -> [a] -> [a]
fInterleave :: [a] -> [a] -> [a]
fInterleave [] [a]
_ = []
fInterleave [a]
_ [] = []
fInterleave (a
x:[a]
xs) [a]
ys = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
fInterleave [a]
ys [a]
xs

-- MMLState helper functions

defaultState :: MMLState
defaultState :: MMLState
defaultState = [Attr] -> Maybe FormType -> Bool -> TextType -> MMLState
MMLState [] Maybe FormType
forall a. Maybe a
Nothing Bool
False TextType
TextNormal

addAttrs :: [Attr] -> MMLState -> MMLState
addAttrs :: [Attr] -> MMLState -> MMLState
addAttrs [Attr]
as MMLState
s = MMLState
s {attrs :: [Attr]
attrs = ((Attr -> Attr) -> [Attr] -> [Attr]
forall a b. (a -> b) -> [a] -> [b]
map Attr -> Attr
renameAttr [Attr]
as) [Attr] -> [Attr] -> [Attr]
forall a. [a] -> [a] -> [a]
++ MMLState -> [Attr]
attrs MMLState
s }

renameAttr :: Attr -> Attr
renameAttr :: Attr -> Attr
renameAttr v :: Attr
v@(QName -> String
qName (QName -> String) -> (Attr -> QName) -> Attr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> QName
attrKey -> String
"accentunder") =
  QName -> String -> Attr
Attr (String -> QName
unqual String
"accent") (Attr -> String
attrVal Attr
v)
renameAttr Attr
a = Attr
a

filterMathVariant :: MMLState -> MMLState
filterMathVariant :: MMLState -> MMLState
filterMathVariant s :: MMLState
s@(MMLState -> [Attr]
attrs -> [Attr]
as) =
  MMLState
s{attrs :: [Attr]
attrs = (Attr -> Bool) -> [Attr] -> [Attr]
forall a. (a -> Bool) -> [a] -> [a]
filter ((QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> QName
unqual String
"mathvariant") (QName -> Bool) -> (Attr -> QName) -> Attr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> QName
attrKey) [Attr]
as}

setPosition :: FormType -> MMLState -> MMLState
setPosition :: FormType -> MMLState -> MMLState
setPosition FormType
p MMLState
s = MMLState
s {position :: Maybe FormType
position = FormType -> Maybe FormType
forall a. a -> Maybe a
Just FormType
p}

resetPosition :: MMLState -> MMLState
resetPosition :: MMLState -> MMLState
resetPosition MMLState
s = MMLState
s {position :: Maybe FormType
position = Maybe FormType
forall a. Maybe a
Nothing}

enterAccent :: MMLState -> MMLState
enterAccent :: MMLState -> MMLState
enterAccent MMLState
s = MMLState
s{ inAccent :: Bool
inAccent = Bool
True }

enterStyled :: TextType -> MMLState -> MMLState
enterStyled :: TextType -> MMLState -> MMLState
enterStyled TextType
tt MMLState
s = MMLState
s{ curStyle :: TextType
curStyle = TextType
tt }

-- Utility

getString :: Element -> MML T.Text
getString :: Element -> MML Text
getString Element
e = do
  TextType
tt <- (MMLState -> TextType) -> ReaderT MMLState (Except Text) TextType
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MMLState -> TextType
curStyle
  Text -> MML Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MML Text) -> Text -> MML Text
forall a b. (a -> b) -> a -> b
$ TextType -> Text -> Text
fromUnicode TextType
tt (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
stripSpaces (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (CData -> String) -> [CData] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CData -> String
cdData
         ([CData] -> String) -> [CData] -> String
forall a b. (a -> b) -> a -> b
$ [Content] -> [CData]
onlyText ([Content] -> [CData]) -> [Content] -> [CData]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Element
e

-- Finds only text data and replaces entity references with corresponding
-- characters
onlyText :: [Content] -> [CData]
onlyText :: [Content] -> [CData]
onlyText [] = []
onlyText ((Text CData
c):[Content]
xs) = CData
c CData -> [CData] -> [CData]
forall a. a -> [a] -> [a]
: [Content] -> [CData]
onlyText [Content]
xs
onlyText (CRef String
s : [Content]
xs)  = (CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
s (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
getUnicode' String
s) Maybe Line
forall a. Maybe a
Nothing) CData -> [CData] -> [CData]
forall a. a -> [a] -> [a]
: [Content] -> [CData]
onlyText [Content]
xs
  where getUnicode' :: String -> Maybe String
getUnicode' = (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack (Maybe Text -> Maybe String)
-> (String -> Maybe Text) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
getUnicode (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
onlyText (Content
_:[Content]
xs) = [Content] -> [CData]
onlyText [Content]
xs

checkArgs2 :: Element -> MML (Element, Element)
checkArgs2 :: Element -> ReaderT MMLState (Except Text) (Element, Element)
checkArgs2 Element
e = case Element -> [Element]
elChildren Element
e of
  [Element
a, Element
b] -> (Element, Element)
-> ReaderT MMLState (Except Text) (Element, Element)
forall (m :: * -> *) a. Monad m => a -> m a
return (Element
a, Element
b)
  [Element]
_      -> Text -> ReaderT MMLState (Except Text) (Element, Element)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text
"Incorrect number of arguments for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element -> Text
err Element
e)

checkArgs3 :: Element -> MML (Element, Element, Element)
checkArgs3 :: Element -> MML (Element, Element, Element)
checkArgs3 Element
e = case Element -> [Element]
elChildren Element
e of
  [Element
a, Element
b, Element
c] -> (Element, Element, Element) -> MML (Element, Element, Element)
forall (m :: * -> *) a. Monad m => a -> m a
return (Element
a, Element
b, Element
c)
  [Element]
_         -> Text -> MML (Element, Element, Element)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text
"Incorrect number of arguments for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element -> Text
err Element
e)

mapPairM :: Monad m => (a -> m b) -> (a, a) -> m (b, b)
mapPairM :: (a -> m b) -> (a, a) -> m (b, b)
mapPairM a -> m b
f (a
a, a
b) = (,) (b -> b -> (b, b)) -> m b -> m (b -> (b, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m b
f a
a) m (b -> (b, b)) -> m b -> m (b, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> m b
f a
b)

err :: Element -> T.Text
err :: Element -> Text
err Element
e = Element -> Text
name Element
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Line -> Text) -> Maybe Line -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Line
x -> Text
" line " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Line -> String
forall a. Show a => a -> String
show Line
x)) (Element -> Maybe Line
elLine Element
e)

-- Kept as String for Text.XML.Light
findAttrQ :: String -> Element -> MML (Maybe T.Text)
findAttrQ :: String -> Element -> MML (Maybe Text)
findAttrQ String
s Element
e = do
  Maybe String
inherit <- case (Element -> Text
name Element
e, String
s) of
            (Text
"mfenced", String
"open") -> Maybe String -> ReaderT MMLState (Except Text) (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
            (Text
"mfenced", String
"close") -> Maybe String -> ReaderT MMLState (Except Text) (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
            (Text
"mfenced", String
"separators") -> Maybe String -> ReaderT MMLState (Except Text) (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
            (Text, String)
_ -> (MMLState -> Maybe String)
-> ReaderT MMLState (Except Text) (Maybe String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (String -> [Attr] -> Maybe String
lookupAttrQ String
s ([Attr] -> Maybe String)
-> (MMLState -> [Attr]) -> MMLState -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MMLState -> [Attr]
attrs)
  Maybe Text -> MML (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> MML (Maybe Text)) -> Maybe Text -> MML (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Maybe String -> Maybe Text) -> Maybe String -> Maybe Text
forall a b. (a -> b) -> a -> b
$
    QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
s Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing) Element
e
      Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
inherit

-- Kept as String for Text.XML.Light
lookupAttrQ :: String -> [Attr] -> Maybe String
lookupAttrQ :: String -> [Attr] -> Maybe String
lookupAttrQ String
s = QName -> [Attr] -> Maybe String
lookupAttr (String -> Maybe String -> Maybe String -> QName
QName ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s) Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)

name :: Element -> T.Text
name :: Element -> Text
name (Element -> QName
elName -> (QName String
n Maybe String
_ Maybe String
_)) = Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
n

-- Kept as String for Text.XML.Light
tunode :: String -> T.Text -> Element
tunode :: String -> Text -> Element
tunode String
s = String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
s (String -> Element) -> (Text -> String) -> Text -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

stripSpaces :: T.Text -> T.Text
stripSpaces :: Text -> Text
stripSpaces = (Char -> Bool) -> Text -> Text
T.dropAround Char -> Bool
isSpace

toAlignment :: T.Text -> Alignment
toAlignment :: Text -> Alignment
toAlignment Text
"left" = Alignment
AlignLeft
toAlignment Text
"center" = Alignment
AlignCenter
toAlignment Text
"right" = Alignment
AlignRight
toAlignment Text
_ = Alignment
AlignCenter

getPosition :: FormType -> TeXSymbolType
getPosition :: FormType -> TeXSymbolType
getPosition (FormType
FPrefix) = TeXSymbolType
Open
getPosition (FormType
FPostfix) = TeXSymbolType
Close
getPosition (FormType
FInfix) = TeXSymbolType
Op

getFormType :: Maybe T.Text -> Maybe FormType
getFormType :: Maybe Text -> Maybe FormType
getFormType (Just Text
"infix") = (FormType -> Maybe FormType
forall a. a -> Maybe a
Just FormType
FInfix)
getFormType (Just Text
"prefix") = (FormType -> Maybe FormType
forall a. a -> Maybe a
Just FormType
FPrefix)
getFormType (Just Text
"postfix") = (FormType -> Maybe FormType
forall a. a -> Maybe a
Just FormType
FPostfix)
getFormType Maybe Text
_ = Maybe FormType
forall a. Maybe a
Nothing

pad :: Int -> [[a]] -> [[a]]
pad :: Int -> [[a]] -> [[a]]
pad Int
n [[a]]
xs = [[a]]
xs [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ (Int -> [a] -> [[a]]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) [])
  where
    len :: Int
len = [[a]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
xs

isSpace :: Char -> Bool
isSpace :: Char -> Bool
isSpace Char
' '  = Bool
True
isSpace Char
'\t' = Bool
True
isSpace Char
'\n' = Bool
True
isSpace Char
_    = Bool
False

spacelikeElems, cSpacelikeElems :: [T.Text]
spacelikeElems :: [Text]
spacelikeElems = [Text
"mtext", Text
"mspace", Text
"maligngroup", Text
"malignmark"]
cSpacelikeElems :: [Text]
cSpacelikeElems = [Text
"mrow", Text
"mstyle", Text
"mphantom", Text
"mpadded"]

spacelike :: Element -> Bool
spacelike :: Element -> Bool
spacelike e :: Element
e@(Element -> Text
name -> Text
uid) =
  Text
uid Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
spacelikeElems Bool -> Bool -> Bool
|| Text
uid Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cSpacelikeElems Bool -> Bool -> Bool
&&
    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Element -> Bool) -> [Element] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Bool
spacelike (Element -> [Element]
elChildren Element
e))

thicknessZero :: Maybe T.Text -> Bool
thicknessZero :: Maybe Text -> Bool
thicknessZero (Just Text
s) = Text -> Rational
thicknessToNum Text
s Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0.0
thicknessZero Maybe Text
Nothing  = Bool
False

widthToNum :: T.Text -> Rational
widthToNum :: Text -> Rational
widthToNum Text
s =
  case Text
s of
       Text
"veryverythinmathspace"  -> Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"verythinmathspace"      -> Rational
2Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"thinmathspace"          -> Rational
3Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"mediummathspace"        -> Rational
4Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"thickmathspace"         -> Rational
5Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"verythickmathspace"     -> Rational
6Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"veryverythickmathspace" -> Rational
7Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"negativeveryverythinmathspace"  -> -Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"negativeverythinmathspace"      -> -Rational
2Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"negativethinmathspace"          -> -Rational
3Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"negativemediummathspace"        -> -Rational
4Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"negativethickmathspace"         -> -Rational
5Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"negativeverythickmathspace"     -> -Rational
6Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"negativeveryverythickmathspace" -> -Rational
7Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18
       Text
_ -> Rational -> Maybe Rational -> Rational
forall a. a -> Maybe a -> a
fromMaybe Rational
0 (Text -> Maybe Rational
readLength Text
s)

thicknessToNum :: T.Text -> Rational
thicknessToNum :: Text -> Rational
thicknessToNum Text
s =
  case Text
s of
       Text
"thin" -> (Rational
3Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18)
       Text
"medium" -> (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)
       Text
"thick" -> Rational
1
       Text
v -> Rational -> Maybe Rational -> Rational
forall a. a -> Maybe a -> a
fromMaybe Rational
0.5 (Text -> Maybe Rational
readLength Text
v)

postfixExpr :: Element -> MML Exp
postfixExpr :: Element -> MML Exp
postfixExpr Element
e = (MMLState -> MMLState) -> MML Exp -> MML Exp
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (FormType -> MMLState -> MMLState
setPosition FormType
FPostfix (MMLState -> MMLState)
-> (MMLState -> MMLState) -> MMLState -> MMLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MMLState -> MMLState
enterAccent) (Element -> MML Exp
safeExpr Element
e)