{-# 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 Control.Monad.Except (throwError, Except, runExcept, MonadError)
import Control.Arrow ((&&&))
import Data.Char (toLower)
import Data.Maybe (fromMaybe, listToMaybe, isJust)
import Data.Monoid (First(..), getFirst)
import Data.List (transpose)
import Control.Applicative ((<|>))
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 = forall a b. (a -> b) -> [a] -> [b]
map Exp -> Exp
fixTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (forall e a. Except e a -> Either e a
runExcept (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT MMLState
defaultState (ReaderT MMLState (Except Text) Element
i 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 = forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither Text
"Invalid XML" (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
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
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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TeXSymbolType
t forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
s
  show (Trailing Exp -> Exp -> Exp
_ Exp
s) = String
"Trailing " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Exp
s
  show (E a
s) = String
"E " forall a. [a] -> [a] -> [a]
++ 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
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    case Exp
e' of
      EGrouped [Exp]
es -> [Exp]
es
      Exp
_ -> [Exp
e']
parseMathML Element
_ = 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 = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
ident Element
e
    Text
"mn" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
number Element
e
    Text
"mo" -> (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML (IR Exp)
op Element
e
    Text
"mtext" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
text Element
e
    Text
"ms" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
literal Element
e
    Text
"mspace" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
space Element
e
    Text
"mrow" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
row Element
e
    Text
"mstyle" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
style Element
e
    Text
"mfrac" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
frac Element
e
    Text
"msqrt" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
msqrt Element
e
    Text
"mroot" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
kroot Element
e
    Text
"merror" -> forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> [IR Exp]
mkE Exp
empty)
    Text
"mpadded" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
row Element
e
    Text
"mphantom" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
phantom Element
e
    Text
"mfenced" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
fenced Element
e
    Text
"menclose" -> Exp -> [IR Exp]
mkE 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
subsup Element
e
    Text
"munder" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
under Element
e
    Text
"mover" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
over Element
e
    Text
"munderover" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
underover Element
e
    Text
"mtable" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
table Element
e
    Text
"maction" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
action Element
e
    Text
"semantics" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
semantics Element
e
    Text
"maligngroup" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exp -> [IR Exp]
mkE Exp
empty
    Text
"malignmark" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exp -> [IR Exp]
mkE Exp
empty
    Text
"mmultiscripts" -> Exp -> [IR Exp]
mkE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
multiscripts Element
e
    Text
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text
"Unexpected element " forall a. Semigroup a => a -> a -> a
<> Element -> Text
err Element
e
  where
    mkE :: Exp -> [IR Exp]
    mkE :: Exp -> [IR Exp]
mkE = (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MMLState -> TextType
curStyle
  case Maybe Text
mbVariant of
       Maybe Text
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return Exp
base
       Just Text
v
         | TextType
curstyle forall a. Eq a => a -> a -> Bool
== Text -> TextType
getTextType Text
v -> forall (m :: * -> *) a. Monad m => a -> m a
return Exp
base
         | Bool
otherwise  -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 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 -> MML (IR Exp)
op Element
e = do
  Maybe FormType
mInferredPosition <- forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Text -> Maybe FormType
getFormType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Element -> MML (Maybe Text)
findAttrQ String
"form" Element
e)
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure FormType
inferredPosition
    Maybe FormType
Nothing               -> 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 = forall a. a -> Maybe a -> a
fromMaybe Operator
dummy Maybe Operator
opLookup
  [Text]
props <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (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 forall a b. (a -> b) -> a -> b
$ Operator -> FormType
form Operator
opDict
  Bool
inScript <- 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 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 =
        forall a. a -> Maybe a -> a
fromMaybe Text -> Exp
fallback
          (forall a. First a -> Maybe a
getFirst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Maybe a -> First a
First forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(Text, Text -> Exp)]
ts) [Text]
props)
  if (Text
"stretchy" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
props) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
inScript
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. TeXSymbolType -> (Text -> Exp) -> Text -> IR a
Stretchy TeXSymbolType
objectPosition Text -> Exp
constructor Text
opString
    else do
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall a. a -> IR a
E 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
v forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Text
ps) (forall a. Eq a => a -> a -> Bool
==Text
"true") 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 <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe TextType
TextNormal Text -> TextType
getTextType
                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:
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall a. a -> Maybe a -> a
fromMaybe Text
"\x201C" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Element -> MML (Maybe Text)
findAttrQ String
"lquote" Element
e
  Text
rquote <- forall a. a -> Maybe a -> a
fromMaybe Text
"\x201D" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Element -> MML (Maybe Text)
findAttrQ String
"rquote" Element
e
  TextType
textStyle <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe TextType
TextNormal Text -> TextType
getTextType
                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
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TextType -> Text -> Exp
EText TextType
textStyle forall a b. (a -> b) -> a -> b
$ Text
lquote forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
rquote

space :: Element -> MML Exp
space :: Element -> MML Exp
space Element
e = do
  Text
width <- forall a. a -> Maybe a -> a
fromMaybe Text
"0.0em" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Element -> MML (Maybe Text)
findAttrQ String
"width" Element
e)
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe TextType
TextNormal Text -> TextType
getTextType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Element -> MML (Maybe Text)
findAttrQ String
"mathvariant" Element
e
  TextType
curstyle <- 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (MMLState -> MMLState
filterMathVariant forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextType -> MMLState -> MMLState
enterStyled TextType
tt) (Element -> MML Exp
row Element
e)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if TextType
curstyle 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IR InEDelimited] -> [InEDelimited]
toEDelim 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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any InEDelimited -> Bool
isStretchy [InEDelimited]
xs
    then case [InEDelimited]
xs of
              [InEDelimited
x] -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Ord) 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 (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] = [forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text -> Exp
con Text
s]
toEDelim ([IR InEDelimited]
xs) = forall a b. (a -> b) -> [a] -> [b]
map forall a. IR a -> a
removeIR [IR InEDelimited]
xs

-- Strips internal representation from processed list
removeIR :: IR a -> a
removeIR :: forall a. IR a -> a
removeIR (E a
e) = a
e
removeIR IR 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] = [forall a. a -> IR a
E forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Text -> Exp
constructor Text
s)]
removeStretch [IR Exp]
xs = forall a b. (a -> b) -> [a] -> [b]
map 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) = forall a. a -> IR a
E forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Text
s
    f (E b
e) = forall a. a -> IR a
E forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right b
e
    f (Trailing Exp -> Exp -> Exp
a Exp
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'@(forall a. [a] -> a
last -> Trailing Exp -> Exp -> Exp
constructor Exp
e) = (Exp -> Exp -> Exp
constructor ([IR InEDelimited] -> Exp
go (forall a. [a] -> [a]
init [IR InEDelimited]
es')) Exp
e)
    go [IR InEDelimited]
es' = Text -> Text -> [InEDelimited] -> Exp
EDelimited (forall {b}. Maybe (Text, b) -> Text
getFence Maybe (Text, Text -> Exp)
open) (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 = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 ((forall a. (a -> Bool) -> [a] -> ([a], [a])
break 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 = forall a. a -> Maybe a
Just (Text
opens, Text -> Exp
conOpen)
          ([IR Exp]
body, [IR Exp]
rems) = 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' forall a. [a] -> [a] -> [a]
++ [forall a. a -> IR a
E forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Maybe (Text, Text -> Exp)
-> Maybe (Text, Text -> Exp) -> [IR InEDelimited] -> Exp
trailingSup Maybe (Text, Text -> Exp)
jOpen 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 = forall a. a -> Maybe a
Just (Text
closes, Text -> Exp
conClose) in
            [IR InEDelimited]
inis' forall a. [a] -> [a] -> [a]
++ (forall a. a -> IR a
E forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right 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') forall a. a -> [a] -> [a]
: [IR Exp] -> [IR InEDelimited]
matchNesting [IR Exp]
rs'
          [IR Exp]
_ -> (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 = forall a. a -> Maybe a
Just (Text
closes, Text -> Exp
conClose) in
      (forall a. a -> IR a
E forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Maybe (Text, Text -> Exp)
-> Maybe (Text, Text -> Exp) -> [IR InEDelimited] -> Exp
trailingSup forall a. Maybe a
Nothing Maybe (Text, Text -> Exp)
jClose ([IR Exp] -> [IR InEDelimited]
matchNesting [IR Exp]
inis)) forall a. a -> [a] -> [a]
: [IR Exp] -> [IR InEDelimited]
matchNesting [IR Exp]
rs
    [IR Exp]
_ -> 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 :: forall a. [IR a] -> Int -> [IR a] -> ([IR a], [IR a])
go (IR a
x:[IR a]
xs) Int
0 [IR a]
a | forall a. IR a -> Bool
isClose IR a
x = (forall a. [a] -> [a]
reverse [IR a]
a, IR a
xforall a. a -> [a] -> [a]
:[IR a]
xs)
    go (IR a
x:[IR a]
xs) Int
n [IR a]
a | forall a. IR a -> Bool
isOpen IR a
x  = forall a. [IR a] -> Int -> [IR a] -> ([IR a], [IR a])
go [IR a]
xs (Int
n forall a. Num a => a -> a -> a
+ Int
1) (IR a
xforall a. a -> [a] -> [a]
:[IR a]
a)
    go (IR a
x:[IR a]
xs) Int
n [IR a]
a | forall a. IR a -> Bool
isClose IR a
x = forall a. [IR a] -> Int -> [IR a] -> ([IR a], [IR a])
go [IR a]
xs (Int
n forall a. Num a => a -> a -> a
- Int
1) (IR a
xforall a. a -> [a] -> [a]
:[IR a]
a)
    go (IR a
x:[IR a]
xs) Int
n [IR a]
a = forall a. [IR a] -> Int -> [IR a] -> ([IR a], [IR a])
go [IR a]
xs Int
n (IR a
xforall a. a -> [a] -> [a]
:[IR a]
a)
    go [] Int
_ [IR a]
a = (forall a. [a] -> [a]
reverse [IR a]
a, [])

isFence :: IR a -> Bool
isFence :: forall a. 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 <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- 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 <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local MMLState -> MMLState
resetPosition (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)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ([IR Exp]
front forall a. [a] -> [a] -> [a]
++ [IR Exp]
middle forall a. [a] -> [a] -> [a]
++ [IR Exp]
end)
  where
    cs :: [Element]
cs = Element -> [Element]
elChildren Element
e
    ([Element]
frontSpaces, [Element]
noFront)  = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Element -> Bool
spacelike [Element]
cs
    ([Element]
endSpaces, [Element]
body) = let ([Element]
as, [Element]
bs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Element -> Bool
spacelike (forall a. [a] -> [a]
reverse [Element]
noFront) in
                          (forall a. [a] -> [a]
reverse [Element]
as, forall a. [a] -> [a]
reverse [Element]
bs)

row' :: [Element] -> MML [IR Exp]
row' :: [Element] -> MML [IR Exp]
row' [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
row' [Element
x] = do
              FormType
pos <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe FormType
FInfix (forall a b. a -> b -> a
const FormType
FPostfix) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MMLState -> Maybe FormType
position
              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 <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe FormType
FPrefix (forall a b. a -> b -> a
const FormType
FInfix) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MMLState -> Maybe FormType
position
    [IR Exp]
e  <- 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 <- 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)
    forall (m :: * -> *) a. Monad m => a -> m a
return ([IR Exp]
e 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 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) <- forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> (a, a) -> m (b, b)
mapPairM Element -> MML Exp
safeExpr forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Element -> MML (Element, Element)
checkArgs2 Element
e)
  Maybe Text
rawThick <- String -> Element -> MML (Maybe Text)
findAttrQ String
"linethickness" Element
e
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 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) <- forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> (a, a) -> m (b, b)
mapPairM Element -> MML Exp
safeExpr forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Element -> MML (Element, Element)
checkArgs2 Element
e)
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 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  <- forall a. a -> Maybe a -> a
fromMaybe 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 <- forall a. a -> Maybe a -> a
fromMaybe 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  <- forall a. a -> Maybe a -> a
fromMaybe 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 = forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> forall t. Node t => String -> t -> Element
unode String
"mo" [Char
x]) forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
sep
                sepsList :: [Element]
sepsList = [Element]
seps forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat (forall a. [a] -> a
last [Element]
seps) in
                forall a. [a] -> [a] -> [a]
fInterleave (Element -> [Element]
elChildren Element
e) ([Element]
sepsList)
  Element -> MML Exp
safeExpr forall a b. (a -> b) -> a -> b
$ forall t. Node t => String -> t -> Element
unode String
"mrow"
              ([String -> Text -> Element
tunode String
"mo" Text
open | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
open] forall a. [a] -> [a] -> [a]
++
               [forall t. Node t => String -> t -> Element
unode String
"mrow" [Element]
expanded] forall a. [a] -> [a] -> [a]
++
               [String -> Text -> Element
tunode String
"mo" Text
close | Bool -> Bool
not 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 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 <-  forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 (forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) 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 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither (Text
"Selection out of range")
            (forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (Int
selection 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 -> MML (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
  forall (m :: * -> *) a. Monad m => a -> m a
return 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, forall a. a -> IR a
E 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
_)] -> [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, forall a. a -> IR a
E forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
ESub Exp
empty Exp
subExpr] -- Middle
      [IR Exp]
_ -> [forall a. a -> IR a
E 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 -> MML (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
safeExpr Element
base forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Element -> MML Exp
postfixExpr Element
subs)
                         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 -> MML (Element, Element)
checkArgs2 Element
e
  Bool -> Exp -> Exp -> Exp
EUnder Bool
False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
safeExpr Element
base 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 -> MML (Element, Element)
checkArgs2 Element
e
  Bool -> Exp -> Exp -> Exp
EOver Bool
False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
safeExpr Element
base 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
safeExpr Element
base  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Element -> MML Exp
postfixExpr Element
below)
                                      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
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Element]
cs)
  Exp
first <- Element -> MML Exp
safeExpr (forall a. [a] -> a
head [Element]
cs)
  if Exp -> Bool
isEmpty Exp
first
    then forall a. a -> Maybe a -> a
fromMaybe Exp
empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. First a -> Maybe a
getFirst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> MML (First Exp)
annotation (forall a. [a] -> [a]
tail [Element]
cs)
    else 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 -> MML (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" ->
      forall a. Maybe a -> First a
First forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
row Element
e
    Just Text
"MathML-Presentation" ->
      forall a. Maybe a -> First a
First forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
row Element
e
    Maybe Text
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a -> First a
First forall a. Maybe a
Nothing)

multiscripts :: Element -> MML Exp
multiscripts :: Element -> MML Exp
multiscripts Element
e = do
  let ([Element]
xs, [Element]
pres) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((forall a. Eq a => a -> a -> Bool
== Text
"mprescripts") 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' forall a. Eq a => a -> a -> Bool
== Text
"none"
                    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
EGrouped []
                    else Element -> MML Exp
row Element
e'
  [Exp]
xs' <- 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' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> MML Exp
row'' forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 [Element]
pres
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe Alignment
AlignCenter Text -> Alignment
toAlignment 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 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Alignment -> Element -> MML [(Alignment, [Exp])]
tableRow Alignment
defAlign) (Element -> [Element]
elChildren Element
e)
  let ([[Alignment]]
onlyAligns, [[[Exp]]]
exprs) = (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a -> b) -> [a] -> [b]
map) forall a b. (a, b) -> a
fst forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map) forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ [[(Alignment, [Exp])]]
rs
  let rs' :: [[[Exp]]]
rs' = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> [[a]] -> [[a]]
pad (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [[(Alignment, [Exp])]]
rs))) [[[Exp]]]
exprs
  let aligns :: [Alignment]
aligns = forall a b. (a -> b) -> [a] -> [b]
map forall {t :: * -> *}. Foldable t => t Alignment -> Alignment
findAlign (forall a. [[a]] -> [[a]]
transpose [[Alignment]]
onlyAligns)
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null t Alignment
xs then Alignment
AlignCenter
                    else 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 forall a. Eq a => a -> a -> Bool
== Alignment
y then Alignment
x else Alignment
AlignCenter

tableRow :: Alignment -> Element -> MML [(Alignment, [Exp])]
tableRow :: Alignment -> Element -> MML [(Alignment, [Exp])]
tableRow Alignment
a Element
e = do
  Alignment
align <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe Alignment
a Text -> Alignment
toAlignment 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" -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Alignment -> Element -> MML (Alignment, [Exp])
tableCell Alignment
align) (Element -> [Element]
elChildren Element
e)
    Text
"mlabeledtr" -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Alignment -> Element -> MML (Alignment, [Exp])
tableCell Alignment
align) (forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
e)
    Text
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text
"Invalid Element: Only expecting mtr elements " forall a. Semigroup a => a -> a -> a
<> Element -> Text
err Element
e

tableCell :: Alignment -> Element -> MML (Alignment, [Exp])
tableCell :: Alignment -> Element -> MML (Alignment, [Exp])
tableCell Alignment
a Element
e = do
  Alignment
align <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe Alignment
a Text -> Alignment
toAlignment 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> MML Exp
row Element
e
    Text
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text
"Invalid Element: Only expecting mtd elements " 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 :: forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError

--interleave up to end of shorter list
fInterleave :: [a] -> [a] -> [a]
fInterleave :: forall a. [a] -> [a] -> [a]
fInterleave [] [a]
_ = []
fInterleave [a]
_ [] = []
fInterleave (a
x:[a]
xs) [a]
ys = a
x forall 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 [] 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 = (forall a b. (a -> b) -> [a] -> [b]
map Attr -> Attr
renameAttr [Attr]
as) forall a. [a] -> [a] -> [a]
++ MMLState -> [Attr]
attrs MMLState
s }

renameAttr :: Attr -> Attr
renameAttr :: Attr -> Attr
renameAttr v :: Attr
v@(QName -> String
qName 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 = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= String -> QName
unqual String
"mathvariant") 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 = forall a. a -> Maybe a
Just FormType
p}

resetPosition :: MMLState -> MMLState
resetPosition :: MMLState -> MMLState
resetPosition MMLState
s = MMLState
s {position :: Maybe FormType
position = 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MMLState -> TextType
curStyle
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TextType -> Text -> Text
fromUnicode TextType
tt forall a b. (a -> b) -> a -> b
$ Text -> Text
stripSpaces forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CData -> String
cdData
         forall a b. (a -> b) -> a -> b
$ [Content] -> [CData]
onlyText forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent 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 forall a. a -> [a] -> [a]
: [Content] -> [CData]
onlyText [Content]
xs
onlyText (CRef String
s : [Content]
xs)  = (CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText (forall a. a -> Maybe a -> a
fromMaybe String
s forall a b. (a -> b) -> a -> b
$ String -> Maybe String
getUnicode' String
s) forall a. Maybe a
Nothing) forall a. a -> [a] -> [a]
: [Content] -> [CData]
onlyText [Content]
xs
  where getUnicode' :: String -> Maybe String
getUnicode' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
getUnicode 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 -> MML (Element, Element)
checkArgs2 Element
e = case Element -> [Element]
elChildren Element
e of
  [Element
a, Element
b] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Element
a, Element
b)
  [Element]
_      -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text
"Incorrect number of arguments for " 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] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Element
a, Element
b, Element
c)
  [Element]
_         -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text
"Incorrect number of arguments for " forall a. Semigroup a => a -> a -> a
<> Element -> Text
err Element
e)

mapPairM :: Monad m => (a -> m b) -> (a, a) -> m (b, b)
mapPairM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> (a, a) -> m (b, b)
mapPairM a -> m b
f (a
a, a
b) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m b
f a
a) 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 forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Line
x -> Text
" line " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (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") -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            (Text
"mfenced", String
"close") -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            (Text
"mfenced", String
"separators") -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            (Text, String)
_ -> forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (String -> [Attr] -> Maybe String
lookupAttrQ String
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. MMLState -> [Attr]
attrs)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack forall a b. (a -> b) -> a -> b
$
    QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
s forall a. Maybe a
Nothing forall a. Maybe a
Nothing) Element
e
      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 (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s) forall a. Maybe a
Nothing 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 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 = forall t. Node t => String -> t -> Element
unode String
s 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") = (forall a. a -> Maybe a
Just FormType
FInfix)
getFormType (Just Text
"prefix") = (forall a. a -> Maybe a
Just FormType
FPrefix)
getFormType (Just Text
"postfix") = (forall a. a -> Maybe a
Just FormType
FPostfix)
getFormType Maybe Text
_ = forall a. Maybe a
Nothing

pad :: Int -> [[a]] -> [[a]]
pad :: forall a. Int -> [[a]] -> [[a]]
pad Int
n [[a]]
xs = [[a]]
xs forall a. [a] -> [a] -> [a]
++ (forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- Int
len) [])
  where
    len :: Int
len = 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
spacelikeElems Bool -> Bool -> Bool
|| Text
uid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cSpacelikeElems Bool -> Bool -> Bool
&&
    forall (t :: * -> *). Foldable t => t Bool -> Bool
and (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 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
1forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"verythinmathspace"      -> Rational
2forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"thinmathspace"          -> Rational
3forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"mediummathspace"        -> Rational
4forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"thickmathspace"         -> Rational
5forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"verythickmathspace"     -> Rational
6forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"veryverythickmathspace" -> Rational
7forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"negativeveryverythinmathspace"  -> -Rational
1forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"negativeverythinmathspace"      -> -Rational
2forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"negativethinmathspace"          -> -Rational
3forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"negativemediummathspace"        -> -Rational
4forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"negativethickmathspace"         -> -Rational
5forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"negativeverythickmathspace"     -> -Rational
6forall a. Fractional a => a -> a -> a
/Rational
18
       Text
"negativeveryverythickmathspace" -> -Rational
7forall a. Fractional a => a -> a -> a
/Rational
18
       Text
_ -> 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
3forall a. Fractional a => a -> a -> a
/Rational
18)
       Text
"medium" -> (Rational
1forall a. Fractional a => a -> a -> a
/Rational
2)
       Text
"thick" -> Rational
1
       Text
v -> 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 = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (FormType -> MMLState -> MMLState
setPosition FormType
FPostfix forall b c a. (b -> c) -> (a -> b) -> a -> c
. MMLState -> MMLState
enterAccent) (Element -> MML Exp
safeExpr Element
e)