{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
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.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)
readMathML :: T.Text -> Either T.Text [Exp]
readMathML :: Text -> Either Text [Exp]
readMathML inp :: 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 "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 t :: TeXSymbolType
t _ s :: Text
s) = "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 -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
s
show (Trailing _ s :: Exp
s) = "Trailing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Exp -> String
forall a. Show a => a -> String
show Exp
s
show (E s :: a
s) = "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 es :: [Exp]
es -> [Exp]
es
_ -> [Exp
e']
parseMathML _ = Text -> ReaderT MMLState (Except Text) [Exp]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "Root must be math element"
expr :: Element -> MML [IR Exp]
expr :: Element -> MML [IR Exp]
expr e :: 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' e :: Element
e =
case Element -> Text
name Element
e of
"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
"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
"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
"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
"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
"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
"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
"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
"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
"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
"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
"merror" -> [IR Exp] -> MML [IR Exp]
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> [IR Exp]
mkE Exp
empty)
"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
"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
"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
"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
"msub" -> Element -> MML [IR Exp]
sub Element
e
"msup" -> Element -> MML [IR Exp]
sup Element
e
"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
"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
"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
"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
"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
"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
"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
"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
"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 -> 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
$ "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
ident :: Element -> MML Exp
ident :: Element -> MML Exp
ident e :: 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 _ -> Text -> Exp
EMathOperator Text
s
Nothing -> Text -> Exp
EIdentifier Text
s
Maybe Text
mbVariant <- String -> Element -> MML (Maybe Text)
findAttrQ "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
Nothing -> Exp -> MML Exp
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
base
Just v :: 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 e :: 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 e :: 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 "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 inferredPosition :: FormType
inferredPosition -> FormType -> ReaderT MMLState (Except Text) FormType
forall (f :: * -> *) a. Applicative f => a -> f a
pure FormType
inferredPosition
Nothing -> Text -> ReaderT MMLState (Except Text) FormType
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "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 "" FormType
inferredPosition 0 0 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))
["fence", "accent", "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 = [("accent", TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Accent), ("fence", TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
objectPosition)]
let fallback :: Text -> Exp
fallback = case Text -> String
T.unpack Text
opString of
[t :: Char
t] -> TeXSymbolType -> Text -> Exp
ESymbol (Char -> TeXSymbolType
getSymbolType Char
t)
_ -> 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 ("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 ps :: t Text
ps v :: 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
=="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 e :: 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 "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
$ case (TextType
textStyle, Text -> String
T.unpack Text
s) of
(TextNormal, [c :: Char
c]) ->
case Char -> Maybe Rational
getSpaceWidth Char
c of
Just w :: Rational
w -> Rational -> Exp
ESpace Rational
w
Nothing -> TextType -> Text -> Exp
EText TextType
textStyle Text
s
_ -> TextType -> Text -> Exp
EText TextType
textStyle Text
s
literal :: Element -> MML Exp
literal :: Element -> MML Exp
literal e :: Element
e = do
Text
lquote <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "\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 "lquote" Element
e
Text
rquote <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "\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 "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 "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 e :: Element
e = do
Text
width <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "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 "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)
style :: Element -> MML Exp
style :: Element -> MML Exp
style e :: 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 "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
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 e :: 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
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 xs :: [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
[x :: 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
_ -> Text -> Text -> [InEDelimited] -> Exp
EDelimited "" "" [InEDelimited]
xs
else
case [InEDelimited]
xs of
[Right x :: Exp
x] -> Exp
x
_ -> [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 _ con :: Text -> Exp
con s :: 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
removeIR :: IR a -> a
removeIR :: IR a -> a
removeIR (E e :: a
e) = a
e
removeIR _ = String -> a
forall a. HasCallStack => String -> a
error "removeIR, should only be ever called on processed lists"
removeStretch :: [IR Exp] -> [IR InEDelimited]
removeStretch :: [IR Exp] -> [IR InEDelimited]
removeStretch [Stretchy _ constructor :: Text -> Exp
constructor s :: 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 xs :: [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 _ _ s :: 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 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 a :: Exp -> Exp -> Exp
a b :: 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 _) = Bool
True
isStretchy (Right _) = Bool
False
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 open :: Maybe (Text, Text -> Exp)
open close :: Maybe (Text, Text -> Exp)
close es :: [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
(Nothing, Nothing) -> Exp
empty
(Just (openFence :: Text
openFence, conOpen :: Text -> Exp
conOpen), Nothing) -> Text -> Exp
conOpen Text
openFence
(Nothing, Just (closeFence :: Text
closeFence, conClose :: Text -> Exp
conClose)) -> Text -> Exp
conClose Text
closeFence
(Just (openFence :: Text
openFence, conOpen :: Text -> Exp
conOpen), Just (closeFence :: Text
closeFence, conClose :: 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 constructor :: Exp -> Exp -> Exp
constructor e :: 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 es' :: [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 "" (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
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) -> (inis :: [IR Exp]
inis, rest :: [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 Open conOpen :: Text -> Exp
conOpen opens :: Text
opens): rs :: [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)
(body :: [IR Exp]
body, rems :: [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 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 Close conClose :: Text -> Exp
conClose closes :: Text
closes : rs' :: [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'
_ -> (String -> [IR InEDelimited]
forall a. HasCallStack => String -> a
error "matchNesting: Logical error 1")
((Stretchy Close conClose :: Text -> Exp
conClose closes :: Text
closes): rs :: [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
_ -> String -> [IR InEDelimited]
forall a. HasCallStack => String -> a
error "matchNesting: Logical error 2"
where
isOpen :: IR a -> Bool
isOpen (Stretchy Open _ _) = Bool
True
isOpen _ = Bool
False
isClose :: IR a -> Bool
isClose (Stretchy Close _ _) = Bool
True
isClose _ = Bool
False
go :: [IR a] -> Int -> [IR a] -> ([IR a], [IR a])
go :: [IR a] -> Int -> [IR a] -> ([IR a], [IR a])
go (x :: IR a
x:xs :: [IR a]
xs) 0 a :: [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 (x :: IR a
x:xs :: [IR a]
xs) n :: Int
n a :: [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
+ 1) (IR a
xIR a -> [IR a] -> [IR a]
forall a. a -> [a] -> [a]
:[IR a]
a)
go (x :: IR a
x:xs :: [IR a]
xs) n :: Int
n a :: [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
- 1) (IR a
xIR a -> [IR a] -> [IR a]
forall a. a -> [a] -> [a]
:[IR a]
a)
go (x :: IR a
x:xs :: [IR a]
xs) n :: Int
n a :: [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 [] _ a :: [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 Open _ _) = Bool
True
isFence (Stretchy Close _ _) = Bool
True
isFence _ = Bool
False
group :: Element -> MML [IR Exp]
group :: Element -> MML [IR Exp]
group e :: 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
(frontSpaces :: [Element]
frontSpaces, noFront :: [Element]
noFront) = (Element -> Bool) -> [Element] -> ([Element], [Element])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Element -> Bool
spacelike [Element]
cs
(endSpaces :: [Element]
endSpaces, body :: [Element]
body) = let (as :: [Element]
as, bs :: [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' [x :: 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' (x :: Element
x:xs :: [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)
safeExpr :: Element -> MML Exp
safeExpr :: Element -> MML Exp
safeExpr e :: 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 e :: Element
e = do
(num :: Exp
num, denom :: 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 "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 e :: 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 e :: Element
e = do
(base :: Exp
base, index :: 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 e :: 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 e :: Element
e = do
Text
open <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "(" (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 "open" Element
e)
Text
close <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe ")" (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 "close" Element
e)
Text
sep <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "," (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 "separators" Element
e)
let expanded :: [Element]
expanded =
case Text
sep of
"" -> Element -> [Element]
elChildren Element
e
_ ->
let seps :: [Element]
seps = (Char -> Element) -> String -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Char
x -> String -> String -> Element
forall t. Node t => String -> t -> Element
unode "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 "mrow"
([String -> Text -> Element
tunode "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 "mrow" [Element]
expanded] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[String -> Text -> Element
tunode "mo" Text
close | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
close])
enclosed :: Element -> MML Exp
enclosed :: Element -> MML Exp
enclosed e :: Element
e = do
Maybe Text
mbNotation <- String -> Element -> MML (Maybe Text)
findAttrQ "notation" Element
e
case Maybe Text
mbNotation of
Just "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
_ -> Element -> MML Exp
row Element
e
action :: Element -> MML Exp
action :: Element -> MML Exp
action e :: Element
e = do
Int
selection <- Int -> (Text -> Int) -> Maybe Text -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe 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 "selection" Element
e)
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 ("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
- 1) (Element -> [Element]
elChildren Element
e))
sub :: Element -> MML [IR Exp]
sub :: Element -> MML [IR Exp]
sub e :: Element
e = do
(base :: Element
base, subs :: 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
reorderScripts :: Element -> Element -> (Exp -> Exp -> Exp) -> MML [IR Exp]
reorderScripts :: Element -> Element -> (Exp -> Exp -> Exp) -> MML [IR Exp]
reorderScripts e :: Element
e subs :: Element
subs c :: 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 Open _ _)] -> [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]
[s :: IR Exp
s@(Stretchy Close _ _)] -> [(Exp -> Exp -> Exp) -> Exp -> IR Exp
forall a. (Exp -> Exp -> Exp) -> Exp -> IR a
Trailing Exp -> Exp -> Exp
c Exp
subExpr, IR Exp
s]
[s :: IR Exp
s@(Stretchy _ _ _)] -> [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]
_ -> [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]
sup :: Element -> MML [IR Exp]
sup :: Element -> MML [IR Exp]
sup e :: Element
e = do
(base :: Element
base, sups :: 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 e :: Element
e = do
(base :: Element
base, subs :: Element
subs, sups :: 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 e :: Element
e = do
(base :: Element
base, below :: 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 e :: Element
e = do
(base :: Element
base, above :: 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 e :: Element
e = do
(base :: Element
base, below :: Element
below, above :: 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)
semantics :: Element -> MML Exp
semantics :: Element -> MML Exp
semantics e :: 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 e :: Element
e = do
Maybe Text
encoding <- String -> Element -> MML (Maybe Text)
findAttrQ "encoding" Element
e
case Maybe Text
encoding of
Just "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 "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
_ -> 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)
table :: Element -> MML Exp
table :: Element -> MML Exp
table e :: 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 "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 (onlyAligns :: [[Alignment]]
onlyAligns, exprs :: [[[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 xs :: 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 x :: Alignment
x y :: 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 a :: Alignment
a e :: 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 "columnalign" Element
e)
case Element -> Text
name Element
e of
"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)
"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 -> 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
$ "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 a :: Alignment
a e :: 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 "columnalign" Element
e)
case Element -> Text
name Element
e of
"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 -> 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
$ "Invalid Element: Only expecting mtd elements " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element -> Text
err Element
e
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
fInterleave :: [a] -> [a] -> [a]
fInterleave :: [a] -> [a] -> [a]
fInterleave [] _ = []
fInterleave _ [] = []
fInterleave (x :: a
x:xs :: [a]
xs) ys :: [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
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 as :: [Attr]
as s :: 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 "accent") (Attr -> String
attrVal Attr
v)
renameAttr a :: 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 "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 p :: FormType
p s :: 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 s :: MMLState
s = MMLState
s {position :: Maybe FormType
position = Maybe FormType
forall a. Maybe a
Nothing}
enterAccent :: MMLState -> MMLState
enterAccent :: MMLState -> MMLState
enterAccent s :: MMLState
s = MMLState
s{ inAccent :: Bool
inAccent = Bool
True }
enterStyled :: TextType -> MMLState -> MMLState
enterStyled :: TextType -> MMLState -> MMLState
enterStyled tt :: TextType
tt s :: MMLState
s = MMLState
s{ curStyle :: TextType
curStyle = TextType
tt }
getString :: Element -> MML T.Text
getString :: Element -> MML Text
getString e :: 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
onlyText :: [Content] -> [CData]
onlyText :: [Content] -> [CData]
onlyText [] = []
onlyText ((Text c :: CData
c):xs :: [Content]
xs) = CData
c CData -> [CData] -> [CData]
forall a. a -> [a] -> [a]
: [Content] -> [CData]
onlyText [Content]
xs
onlyText (CRef s :: String
s : xs :: [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 (_:xs :: [Content]
xs) = [Content] -> [CData]
onlyText [Content]
xs
checkArgs2 :: Element -> MML (Element, Element)
checkArgs2 :: Element -> ReaderT MMLState (Except Text) (Element, Element)
checkArgs2 e :: Element
e = case Element -> [Element]
elChildren Element
e of
[a :: Element
a, b :: Element
b] -> (Element, Element)
-> ReaderT MMLState (Except Text) (Element, Element)
forall (m :: * -> *) a. Monad m => a -> m a
return (Element
a, Element
b)
_ -> Text -> ReaderT MMLState (Except Text) (Element, Element)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ("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 e :: Element
e = case Element -> [Element]
elChildren Element
e of
[a :: Element
a, b :: Element
b, c :: Element
c] -> (Element, Element, Element) -> MML (Element, Element, Element)
forall (m :: * -> *) a. Monad m => a -> m a
return (Element
a, Element
b, Element
c)
_ -> Text -> MML (Element, Element, Element)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ("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 f :: a -> m b
f (a :: a
a, b :: 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 e :: 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 "" (\x :: Line
x -> " 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)
findAttrQ :: String -> Element -> MML (Maybe T.Text)
findAttrQ :: String -> Element -> MML (Maybe Text)
findAttrQ s :: String
s e :: Element
e = do
Maybe String
inherit <- (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
lookupAttrQ :: String -> [Attr] -> Maybe String
lookupAttrQ :: String -> [Attr] -> Maybe String
lookupAttrQ s :: String
s = QName -> [Attr] -> Maybe String
lookupAttr (String -> Maybe String -> Maybe String -> QName
QName 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 n :: String
n _ _)) = String -> Text
T.pack String
n
tunode :: String -> T.Text -> Element
tunode :: String -> Text -> Element
tunode s :: 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 "left" = Alignment
AlignLeft
toAlignment "center" = Alignment
AlignCenter
toAlignment "right" = Alignment
AlignRight
toAlignment _ = 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 "infix") = (FormType -> Maybe FormType
forall a. a -> Maybe a
Just FormType
FInfix)
getFormType (Just "prefix") = (FormType -> Maybe FormType
forall a. a -> Maybe a
Just FormType
FPrefix)
getFormType (Just "postfix") = (FormType -> Maybe FormType
forall a. a -> Maybe a
Just FormType
FPostfix)
getFormType _ = Maybe FormType
forall a. Maybe a
Nothing
pad :: Int -> [[a]] -> [[a]]
pad :: Int -> [[a]] -> [[a]]
pad n :: Int
n xs :: [[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 ' ' = Bool
True
isSpace '\t' = Bool
True
isSpace '\n' = Bool
True
isSpace _ = Bool
False
spacelikeElems, cSpacelikeElems :: [T.Text]
spacelikeElems :: [Text]
spacelikeElems = ["mtext", "mspace", "maligngroup", "malignmark"]
cSpacelikeElems :: [Text]
cSpacelikeElems = ["mrow", "mstyle", "mphantom", "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 s :: Text
s) = Text -> Rational
thicknessToNum Text
s Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== 0.0
thicknessZero Nothing = Bool
False
widthToNum :: T.Text -> Rational
widthToNum :: Text -> Rational
widthToNum s :: Text
s =
case Text
s of
"veryverythinmathspace" -> 1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/18
"verythinmathspace" -> 2Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/18
"thinmathspace" -> 3Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/18
"mediummathspace" -> 4Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/18
"thickmathspace" -> 5Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/18
"verythickmathspace" -> 6Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/18
"veryverythickmathspace" -> 7Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/18
"negativeveryverythinmathspace" -> -1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/18
"negativeverythinmathspace" -> -2Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/18
"negativethinmathspace" -> -3Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/18
"negativemediummathspace" -> -4Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/18
"negativethickmathspace" -> -5Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/18
"negativeverythickmathspace" -> -6Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/18
"negativeveryverythickmathspace" -> -7Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/18
_ -> Rational -> Maybe Rational -> Rational
forall a. a -> Maybe a -> a
fromMaybe 0 (Text -> Maybe Rational
readLength Text
s)
thicknessToNum :: T.Text -> Rational
thicknessToNum :: Text -> Rational
thicknessToNum s :: Text
s =
case Text
s of
"thin" -> (3Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/18)
"medium" -> (1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/2)
"thick" -> 1
v :: Text
v -> Rational -> Maybe Rational -> Rational
forall a. a -> Maybe a -> a
fromMaybe 0.5 (Text -> Maybe Rational
readLength Text
v)
postfixExpr :: Element -> MML Exp
postfixExpr :: Element -> MML Exp
postfixExpr e :: 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)