    {-# 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, mzero)
    import Control.Monad.Reader (ReaderT, runReaderT, asks, local)
    import Data.Either (rights)

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

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

    type MML = ReaderT MMLState (Except T.Text)

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

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

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

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

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

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

    -- Tokens

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

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

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

    text :: Element -> MML Exp
    text :: Element -> MML Exp
    text Element
    e = do
      textStyle <- TextType -> (Text -> TextType) -> Maybe Text -> TextType
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe TextType
    TextNormal Text -> TextType
    getTextType
                    (Maybe Text -> TextType)
    -> MML (Maybe Text) -> ReaderT MMLState (Except Text) TextType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (String -> Element -> MML (Maybe Text)
    findAttrQ String
    "mathvariant" Element
    e)
      s <- getString e
      -- mathml seems to use mtext for spacing often; we get
      -- more idiomatic math if we replace these with ESpace:
      return $ case (textStyle, T.unpack 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
      lquote <- Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "\x201C" (Maybe Text -> Text) -> MML (Maybe Text) -> MML Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> Element -> MML (Maybe Text)
    findAttrQ String
    "lquote" Element
    e
      rquote <- fromMaybe "\x201D" <$> findAttrQ "rquote" e
      textStyle <- maybe TextNormal getTextType
                    <$> (findAttrQ "mathvariant" e)
      s <- getString e
      return $ EText textStyle $ lquote <> s <> rquote

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

    -- Layout

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

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

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

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

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

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

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

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

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

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

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

    row' :: [Element] -> MML [IR Exp]
    row' :: [Element] -> MML [IR Exp]
    row' [] = [IR Exp] -> MML [IR Exp]
    forall a. a -> ReaderT MMLState (Except Text) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    row' [Element
    x] = do
                  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
                  local (setPosition pos) (expr x)
    row' (Element
    x:[Element]
    xs) =
      do
        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
        e  <- local (setPosition pos) (expr x)
        es <- local (setPosition pos) (row' xs)
        return (e ++ es)

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

    frac :: Element -> MML Exp
    frac :: Element -> MML Exp
    frac Element
    e = do
      (num, 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)
      rawThick <- findAttrQ "linethickness" e
      return $
        if thicknessZero rawThick
           then EFraction NoLineFrac num denom
           else EFraction NormalFrac num denom

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

    kroot :: Element -> MML Exp
    kroot :: Element -> MML Exp
    kroot Element
    e = do
      (base, 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)
      return $ ERoot index base

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

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

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

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

    -- Scripts and Limits

    sub :: Element -> MML [IR Exp]
    sub :: Element -> MML [IR Exp]
    sub Element
    e =  do
      (base, subs) <- Element -> ReaderT MMLState (Except Text) (Element, Element)
    checkArgs2 Element
    e
      reorderScripts base subs 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
      baseExpr <- Element -> MML [IR Exp]
    expr Element
    e
      subExpr <- postfixExpr subs
      return $
        case baseExpr of
          [s :: IR Exp
    s@(Stretchy TeXSymbolType
    Open Text -> Exp
    _ Text
    _)] -> [IR Exp
    s, Exp -> IR Exp
    forall a. a -> IR a
    E (Exp -> IR Exp) -> Exp -> IR Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    c Exp
    empty Exp
    subExpr]  -- Open
          [s :: IR Exp
    s@(Stretchy TeXSymbolType
    Close Text -> Exp
    _ Text
    _)] -> [(Exp -> Exp -> Exp) -> Exp -> IR Exp
    forall a. (Exp -> Exp -> Exp) -> Exp -> IR a
    Trailing Exp -> Exp -> Exp
    c Exp
    subExpr, IR Exp
    s] -- Close
          [s :: IR Exp
    s@(Stretchy TeXSymbolType
    _ Text -> Exp
    _ Text
    _)] -> [IR Exp
    s, Exp -> IR Exp
    forall a. a -> IR a
    E (Exp -> IR Exp) -> Exp -> IR Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    ESub Exp
    empty Exp
    subExpr] -- Middle
          [IR Exp]
    _ -> [Exp -> IR Exp
    forall a. a -> IR a
    E (Exp -> IR Exp) -> Exp -> IR Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    c ([IR Exp] -> Exp
    mkExp [IR Exp]
    baseExpr) Exp
    subExpr] -- No stretch

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

    subsup :: Element -> MML Exp
    subsup :: Element -> MML Exp
    subsup Element
    e = do
      (base, subs, sups) <- Element -> MML (Element, Element, Element)
    checkArgs3 Element
    e
      ESubsup <$> safeExpr base <*> (postfixExpr subs)
                             <*> (postfixExpr sups)

    under :: Element -> MML Exp
    under :: Element -> MML Exp
    under Element
    e = do
      (base, below) <- Element -> ReaderT MMLState (Except Text) (Element, Element)
    checkArgs2 Element
    e
      EUnder False <$> safeExpr base <*> postfixExpr below

    over :: Element -> MML Exp
    over :: Element -> MML Exp
    over Element
    e = do
      (base, above) <- Element -> ReaderT MMLState (Except Text) (Element, Element)
    checkArgs2 Element
    e
      EOver False <$> safeExpr base <*> postfixExpr above

    underover :: Element -> MML Exp
    underover :: Element -> MML Exp
    underover Element
    e = do
      (base, below, above) <- Element -> MML (Element, Element, Element)
    checkArgs3 Element
    e
      EUnderover False <$> safeExpr base  <*> (postfixExpr below)
                                          <*> (postfixExpr above)

    -- Other

    semantics :: Element -> MML Exp
    semantics :: Element -> MML Exp
    semantics Element
    e =
      case Element -> [Element]
    elChildren Element
    e of
        [] -> MML Exp
    forall a. ReaderT MMLState (Except Text) a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
        (Element
    c:[Element]
    cs) -> do
          first <- Element -> MML Exp
    safeExpr Element
    c
          if isEmpty first
            then fromMaybe empty . getFirst . mconcat <$> mapM annotation cs
            else return first

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

    multiscripts :: Element -> MML Exp
    multiscripts :: Element -> MML Exp
    multiscripts Element
    e = do
      let ([Element]
    xs, [Element]
    pres) = (Element -> Bool) -> [Element] -> ([Element], [Element])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break ((Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "mprescripts") (Text -> Bool) -> (Element -> Text) -> Element -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Element -> Text
    name) (Element -> [Element]
    elChildren Element
    e)
      let row'' :: Element -> MML Exp
    row'' Element
    e' = case Element -> Text
    name Element
    e' of
                       Text
    "none" -> Exp -> MML Exp
    forall a. a -> ReaderT MMLState (Except Text) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> MML Exp) -> Exp -> MML Exp
    forall a b. (a -> b) -> a -> b
    $ [Exp] -> Exp
    EGrouped []
                       Text
    "mrow" -> Element -> MML Exp
    row Element
    e'
                       Text
    _ -> [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'
      let maybeGroup :: [Exp] -> Exp
    maybeGroup [Exp
    w] = Exp
    w
          maybeGroup [Exp]
    ws = [Exp] -> Exp
    EGrouped [Exp]
    ws
      xs' <- (Element -> MML Exp)
    -> [Element] -> ReaderT MMLState (Except Text) [Exp]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Element -> MML Exp
    row'' [Element]
    xs
      let getSubs [] = []
          getSubs [a
    w] = [a
    w]
          getSubs (a
    w:a
    _:[a]
    ws) = a
    w a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a] -> [a]
    getSubs [a]
    ws
      let getSups [] = []
          getSups [a
    _] = []
          getSups (a
    _:a
    w:[a]
    ws) = a
    w a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a] -> [a]
    getSups [a]
    ws
      let (base, postSubs, postSups) =
             case xs' of
               [] -> ([Exp] -> Exp
    EGrouped [], [], [])
               (Exp
    w:[Exp]
    ws) -> (Exp
    w, [Exp] -> [Exp]
    forall a. [a] -> [a]
    getSubs [Exp]
    ws, [Exp] -> [Exp]
    forall a. [a] -> [a]
    getSups [Exp]
    ws)
      let rightSide =
            case ([Exp]
    postSubs, [Exp]
    postSups) of
              ([],[])   -> Exp
    base
              ([Exp]
    ws,[])   -> Exp -> Exp -> Exp
    ESub Exp
    base ([Exp] -> Exp
    maybeGroup [Exp]
    ws)
              ([],[Exp]
    ws)   -> Exp -> Exp -> Exp
    ESuper Exp
    base ([Exp] -> Exp
    maybeGroup [Exp]
    ws)
              ([Exp]
    ws,[Exp]
    ys)   -> Exp -> Exp -> Exp -> Exp
    ESubsup Exp
    base ([Exp] -> Exp
    maybeGroup [Exp]
    ws) ([Exp] -> Exp
    maybeGroup [Exp]
    ys)
      pres' <- mapM row'' $ drop 1 pres
      let (preSubs, preSups) = (getSubs pres', getSups pres')
      let leftSide =
            case ([Exp]
    preSubs, [Exp]
    preSups) of
              ([],[])   -> [Exp] -> Exp
    EGrouped []
              ([Exp]
    ws,[])   -> Exp -> Exp -> Exp
    ESub ([Exp] -> Exp
    EGrouped []) ([Exp] -> Exp
    maybeGroup [Exp]
    ws)
              ([],[Exp]
    ws)   -> Exp -> Exp -> Exp
    ESuper ([Exp] -> Exp
    EGrouped []) ([Exp] -> Exp
    maybeGroup [Exp]
    ws)
              ([Exp]
    ws,[Exp]
    ys)   -> Exp -> Exp -> Exp -> Exp
    ESubsup ([Exp] -> Exp
    EGrouped []) ([Exp] -> Exp
    maybeGroup [Exp]
    ws) ([Exp] -> Exp
    maybeGroup [Exp]
    ys)
      return $ EGrouped [leftSide, rightSide]

    -- Table

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

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

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

    -- Fixup

    -- Library Functions

    maybeToEither :: (MonadError e m) => e -> Maybe a -> m a
    maybeToEither :: forall e (m :: * -> *) a. MonadError e m => 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 a. 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 a. e -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError

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

    -- MMLState helper functions

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

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

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

    filterMathVariant :: MMLState -> MMLState
    filterMathVariant :: MMLState -> MMLState
    filterMathVariant s :: MMLState
    s@(MMLState -> [Attr]
    attrs -> [Attr]
    as) =
      MMLState
    s{attrs = filter ((/= unqual "mathvariant") . attrKey) as}

    setPosition :: FormType -> MMLState -> MMLState
    setPosition :: FormType -> MMLState -> MMLState
    setPosition FormType
    p MMLState
    s = MMLState
    s {position = Just p}

    resetPosition :: MMLState -> MMLState
    resetPosition :: MMLState -> MMLState
    resetPosition MMLState
    s = MMLState
    s {position = Nothing}

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

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

    -- Utility

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    postfixExpr :: Element -> MML Exp
    postfixExpr :: Element -> MML Exp
    postfixExpr Element
    e = (MMLState -> MMLState) -> MML Exp -> MML Exp
    forall a.
    (MMLState -> MMLState)
    -> ReaderT MMLState (Except Text) a
    -> ReaderT MMLState (Except Text) a
    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)