1{-# LANGUAGE ViewPatterns #-} 2{-# LANGUAGE OverloadedStrings #-} 3{- 4Copyright (C) 2014 Matthew Pickering <matthewtpickering@gmail.com> 5 6This program is free software; you can redistribute it and/or modify 7it under the terms of the GNU General Public License as published by 8the Free Software Foundation; either version 2 of the License, or 9(at your option) any later version. 10 11This program is distributed in the hope that it will be useful, 12but WITHOUT ANY WARRANTY; without even the implied warranty of 13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14GNU General Public License for more details. 15 16You should have received a copy of the GNU General Public License 17along with this program; if not, write to the Free Software 18Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19-} 20{- | 21 22Parses MathML in conformance with the MathML3 specification. 23 24Unimplemented features: 25 26 - mpadded 27 - malignmark 28 - maligngroup 29 - Elementary Math 30 31To Improve: 32 33 - Handling of menclose 34 - Handling of mstyle 35-} 36 37module Text.TeXMath.Readers.MathML (readMathML) where 38 39import Text.XML.Light hiding (onlyText) 40import Text.TeXMath.Types 41import Text.TeXMath.Readers.MathML.MMLDict (getMathMLOperator) 42import Text.TeXMath.Readers.MathML.EntityMap (getUnicode) 43import Text.TeXMath.Shared (getTextType, readLength, getOperator, fixTree, 44 getSpaceWidth, isEmpty, empty) 45import Text.TeXMath.Unicode.ToTeX (getSymbolType) 46import Text.TeXMath.Unicode.ToUnicode (fromUnicode) 47import Text.TeXMath.Compat (throwError, Except, runExcept, MonadError) 48import Control.Applicative ((<$>), (<|>), (<*>)) 49import Control.Arrow ((&&&)) 50import Data.Char (toLower) 51import Data.Maybe (fromMaybe, listToMaybe, isJust) 52import Data.Monoid (mconcat, First(..), getFirst) 53import Data.Semigroup ((<>)) 54import Data.List (transpose) 55import qualified Data.Text as T 56import Control.Monad (filterM, guard) 57import Control.Monad.Reader (ReaderT, runReaderT, asks, local) 58import Data.Either (rights) 59 60-- | Parse a MathML expression to a list of 'Exp'. 61readMathML :: T.Text -> Either T.Text [Exp] 62readMathML inp = map fixTree <$> 63 (runExcept (flip runReaderT defaultState (i >>= parseMathML))) 64 where 65 i = maybeToEither "Invalid XML" (parseXMLDoc inp) 66 67data MMLState = MMLState { attrs :: [Attr] 68 , position :: Maybe FormType 69 , inAccent :: Bool 70 , curStyle :: TextType } 71 72type MML = ReaderT MMLState (Except T.Text) 73 74data SupOrSub = Sub | Sup deriving (Show, Eq) 75 76data IR a = Stretchy TeXSymbolType (T.Text -> Exp) T.Text 77 | Trailing (Exp -> Exp -> Exp) Exp 78 | E a 79 80instance Show a => Show (IR a) where 81 show (Stretchy t _ s) = "Stretchy " ++ show t ++ " " ++ show s 82 show (Trailing _ s) = "Trailing " ++ show s 83 show (E s) = "E " ++ show s 84 85parseMathML :: Element -> MML [Exp] 86parseMathML e@(name -> "math") = do 87 e' <- row e 88 return $ 89 case e' of 90 EGrouped es -> es 91 _ -> [e'] 92parseMathML _ = throwError "Root must be math element" 93 94expr :: Element -> MML [IR Exp] 95expr e = local (addAttrs (elAttribs e)) (expr' e) 96 97expr' :: Element -> MML [IR Exp] 98expr' e = 99 case name e of 100 "mi" -> mkE <$> ident e 101 "mn" -> mkE <$> number e 102 "mo" -> (:[]) <$> op e 103 "mtext" -> mkE <$> text e 104 "ms" -> mkE <$> literal e 105 "mspace" -> mkE <$> space e 106 "mrow" -> mkE <$> row e 107 "mstyle" -> mkE <$> style e 108 "mfrac" -> mkE <$> frac e 109 "msqrt" -> mkE <$> msqrt e 110 "mroot" -> mkE <$> kroot e 111 "merror" -> return (mkE empty) 112 "mpadded" -> mkE <$> row e 113 "mphantom" -> mkE <$> phantom e 114 "mfenced" -> mkE <$> fenced e 115 "menclose" -> mkE <$> enclosed e 116 "msub" -> sub e 117 "msup" -> sup e 118 "msubsup" -> mkE <$> subsup e 119 "munder" -> mkE <$> under e 120 "mover" -> mkE <$> over e 121 "munderover" -> mkE <$> underover e 122 "mtable" -> mkE <$> table e 123 "maction" -> mkE <$> action e 124 "semantics" -> mkE <$> semantics e 125 "maligngroup" -> return $ mkE empty 126 "malignmark" -> return $ mkE empty 127 "mmultiscripts" -> mkE <$> multiscripts e 128 _ -> throwError $ "Unexpected element " <> err e 129 where 130 mkE :: Exp -> [IR Exp] 131 mkE = (:[]) . E 132 133 134-- Tokens 135 136ident :: Element -> MML Exp 137ident e = do 138 s <- getString e 139 let base = case getOperator (EMathOperator s) of 140 Just _ -> EMathOperator s 141 Nothing -> EIdentifier s 142 mbVariant <- findAttrQ "mathvariant" e 143 curstyle <- asks curStyle 144 case mbVariant of 145 Nothing -> return base 146 Just v 147 | curstyle == getTextType v -> return base 148 | otherwise -> return $ EStyled (getTextType v) [base] 149 150number :: Element -> MML Exp 151number e = ENumber <$> getString e 152 153op :: Element -> MML (IR Exp) 154op e = do 155 mInferredPosition <- (<|>) <$> (getFormType <$> findAttrQ "form" e) 156 <*> asks position 157 inferredPosition <- case mInferredPosition of 158 Just inferredPosition -> pure inferredPosition 159 Nothing -> throwError "Did not find an inferred position" 160 opString <- getString e 161 let dummy = Operator opString "" inferredPosition 0 0 0 [] 162 let opLookup = getMathMLOperator opString inferredPosition 163 let opDict = fromMaybe dummy opLookup 164 props <- filterM (checkAttr (properties opDict)) 165 ["fence", "accent", "stretchy"] 166 let objectPosition = getPosition $ form opDict 167 inScript <- asks inAccent 168 let ts = [("accent", ESymbol Accent), ("fence", ESymbol objectPosition)] 169 let fallback = case T.unpack opString of 170 [t] -> ESymbol (getSymbolType t) 171 _ -> if isJust opLookup 172 then ESymbol Ord 173 else EMathOperator 174 let constructor = 175 fromMaybe fallback 176 (getFirst . mconcat $ map (First . flip lookup ts) props) 177 if ("stretchy" `elem` props) && not inScript 178 then return $ Stretchy objectPosition constructor opString 179 else do 180 return $ (E . constructor) opString 181 where 182 checkAttr ps v = maybe (v `elem` ps) (=="true") <$> findAttrQ (T.unpack v) e 183 184text :: Element -> MML Exp 185text e = do 186 textStyle <- maybe TextNormal getTextType 187 <$> (findAttrQ "mathvariant" e) 188 s <- getString e 189 -- mathml seems to use mtext for spacing often; we get 190 -- more idiomatic math if we replace these with ESpace: 191 return $ case (textStyle, T.unpack s) of 192 (TextNormal, [c]) -> 193 case getSpaceWidth c of 194 Just w -> ESpace w 195 Nothing -> EText textStyle s 196 _ -> EText textStyle s 197 198literal :: Element -> MML Exp 199literal e = do 200 lquote <- fromMaybe "\x201C" <$> findAttrQ "lquote" e 201 rquote <- fromMaybe "\x201D" <$> findAttrQ "rquote" e 202 textStyle <- maybe TextNormal getTextType 203 <$> (findAttrQ "mathvariant" e) 204 s <- getString e 205 return $ EText textStyle $ lquote <> s <> rquote 206 207space :: Element -> MML Exp 208space e = do 209 width <- fromMaybe "0.0em" <$> (findAttrQ "width" e) 210 return $ ESpace (widthToNum width) 211 212-- Layout 213 214style :: Element -> MML Exp 215style e = do 216 tt <- maybe TextNormal getTextType <$> findAttrQ "mathvariant" e 217 curstyle <- asks curStyle 218 -- We do not want to propagate the mathvariant else 219 -- we end up with nested EStyled applying the same 220 -- style 221 result <- local (filterMathVariant . enterStyled tt) (row e) 222 return $ if curstyle == tt 223 then result 224 else EStyled tt [result] 225 226row :: Element -> MML Exp 227row e = mkExp <$> group e 228 229-- 1. matchNesting strips all additional IR 230-- 2. toEDelim 231-- 3. toExp makes sure that no additional nesting happens 232mkExp :: [IR Exp] -> Exp 233mkExp = toExp . toEDelim . matchNesting 234 235toExp :: [InEDelimited] -> Exp 236toExp [] = empty 237toExp xs = 238 if any isStretchy xs 239 then case xs of 240 [x] -> either (ESymbol Ord) id x 241 _ -> EDelimited "" "" xs 242 else 243 case xs of 244 [Right x] -> x 245 _ -> EGrouped (rights xs) 246 247 248toEDelim :: [IR InEDelimited] -> [InEDelimited] 249toEDelim [] = [] 250toEDelim [Stretchy _ con s] = [Right $ con s] 251toEDelim (xs) = map removeIR xs 252 253-- Strips internal representation from processed list 254removeIR :: IR a -> a 255removeIR (E e) = e 256removeIR _ = error "removeIR, should only be ever called on processed lists" 257 258-- Convers stretch to InEDelimited element 259removeStretch :: [IR Exp] -> [IR InEDelimited] 260removeStretch [Stretchy _ constructor s] = [E $ Right (constructor s)] 261removeStretch xs = map f xs 262 where 263 f (Stretchy _ _ s) = E $ Left s 264 f (E e) = E $ Right e 265 f (Trailing a b) = Trailing a b 266 267isStretchy :: InEDelimited -> Bool 268isStretchy (Left _) = True 269isStretchy (Right _) = False 270 271-- If at the end of a delimiter we need to apply the script to the whole 272-- expression. We only insert Trailing when reordering Stretchy 273trailingSup :: Maybe (T.Text, T.Text -> Exp) -> Maybe (T.Text, T.Text -> Exp) -> [IR InEDelimited] -> Exp 274trailingSup open close es = go es 275 where 276 go [] = case (open, close) of 277 (Nothing, Nothing) -> empty 278 (Just (openFence, conOpen), Nothing) -> conOpen openFence 279 (Nothing, Just (closeFence, conClose)) -> conClose closeFence 280 (Just (openFence, conOpen), Just (closeFence, conClose)) -> 281 EGrouped [conOpen openFence, conClose closeFence] 282 go es'@(last -> Trailing constructor e) = (constructor (go (init es')) e) 283 go es' = EDelimited (getFence open) (getFence close) (toEDelim es') 284 getFence = fromMaybe "" . fmap fst 285 286-- TODO: Break this into two functions 287-- Matches open and closing brackets 288-- The result of this function is a list with only E elements. 289matchNesting :: [IR Exp] -> [IR InEDelimited] 290matchNesting ((break isFence) -> (inis, rest)) = 291 let inis' = removeStretch inis in 292 case rest of 293 [] -> inis' 294 ((Stretchy Open conOpen opens): rs) -> 295 let jOpen = Just (opens, conOpen) 296 (body, rems) = go rs 0 [] 297 body' = matchNesting body in 298 case rems of 299 [] -> inis' ++ [E $ Right $ trailingSup jOpen Nothing body'] 300 (Stretchy Close conClose closes : rs') -> 301 let jClose = Just (closes, conClose) in 302 inis' ++ (E $ Right $ trailingSup jOpen jClose body') : matchNesting rs' 303 _ -> (error "matchNesting: Logical error 1") 304 ((Stretchy Close conClose closes): rs) -> 305 let jClose = Just (closes, conClose) in 306 (E $ Right $ trailingSup Nothing jClose (matchNesting inis)) : matchNesting rs 307 _ -> error "matchNesting: Logical error 2" 308 where 309 isOpen (Stretchy Open _ _) = True 310 isOpen _ = False 311 isClose (Stretchy Close _ _) = True 312 isClose _ = False 313 go :: [IR a] -> Int -> [IR a] -> ([IR a], [IR a]) 314 go (x:xs) 0 a | isClose x = (reverse a, x:xs) 315 go (x:xs) n a | isOpen x = go xs (n + 1) (x:a) 316 go (x:xs) n a | isClose x = go xs (n - 1) (x:a) 317 go (x:xs) n a = go xs n (x:a) 318 go [] _ a = (reverse a, []) 319 320isFence :: IR a -> Bool 321isFence (Stretchy Open _ _) = True 322isFence (Stretchy Close _ _) = True 323isFence _ = False 324 325group :: Element -> MML [IR Exp] 326group e = do 327 front <- concat <$> mapM expr frontSpaces 328 middle <- local resetPosition (row' body) 329 end <- concat <$> local resetPosition (mapM expr endSpaces) 330 return $ (front ++ middle ++ end) 331 where 332 cs = elChildren e 333 (frontSpaces, noFront) = span spacelike cs 334 (endSpaces, body) = let (as, bs) = span spacelike (reverse noFront) in 335 (reverse as, reverse bs) 336 337row' :: [Element] -> MML [IR Exp] 338row' [] = return [] 339row' [x] = do 340 pos <- maybe FInfix (const FPostfix) <$> asks position 341 local (setPosition pos) (expr x) 342row' (x:xs) = 343 do 344 pos <- maybe FPrefix (const FInfix) <$> asks position 345 e <- local (setPosition pos) (expr x) 346 es <- local (setPosition pos) (row' xs) 347 return (e ++ es) 348 349-- Indicates the closure of scope 350safeExpr :: Element -> MML Exp 351safeExpr e = mkExp <$> expr e 352 353frac :: Element -> MML Exp 354frac e = do 355 (num, denom) <- mapPairM safeExpr =<< (checkArgs2 e) 356 rawThick <- findAttrQ "linethickness" e 357 return $ 358 if thicknessZero rawThick 359 then EFraction NoLineFrac num denom 360 else EFraction NormalFrac num denom 361 362msqrt :: Element -> MML Exp 363msqrt e = ESqrt <$> (row e) 364 365kroot :: Element -> MML Exp 366kroot e = do 367 (base, index) <- mapPairM safeExpr =<< (checkArgs2 e) 368 return $ ERoot index base 369 370phantom :: Element -> MML Exp 371phantom e = EPhantom <$> row e 372 373fenced :: Element -> MML Exp 374fenced e = do 375 open <- fromMaybe "(" <$> (findAttrQ "open" e) 376 close <- fromMaybe ")" <$> (findAttrQ "close" e) 377 sep <- fromMaybe "," <$> (findAttrQ "separators" e) 378 let expanded = 379 case sep of 380 "" -> elChildren e 381 _ -> 382 let seps = map (\x -> unode "mo" [x]) $ T.unpack sep 383 sepsList = seps ++ repeat (last seps) in 384 fInterleave (elChildren e) (sepsList) 385 safeExpr $ unode "mrow" 386 ([tunode "mo" open | not $ T.null open] ++ 387 [unode "mrow" expanded] ++ 388 [tunode "mo" close | not $ T.null close]) 389 390-- This could approximate the variants 391enclosed :: Element -> MML Exp 392enclosed e = do 393 mbNotation <- findAttrQ "notation" e 394 case mbNotation of 395 Just "box" -> EBoxed <$> row e 396 _ -> row e 397 398action :: Element -> MML Exp 399action e = do 400 selection <- maybe 1 (read . T.unpack) <$> (findAttrQ "selection" e) -- 1-indexing 401 safeExpr =<< maybeToEither ("Selection out of range") 402 (listToMaybe $ drop (selection - 1) (elChildren e)) 403 404-- Scripts and Limits 405 406sub :: Element -> MML [IR Exp] 407sub e = do 408 (base, subs) <- checkArgs2 e 409 reorderScripts base subs ESub 410 411-- Handles case with strethy elements in the base of sub/sup 412reorderScripts :: Element -> Element -> (Exp -> Exp -> Exp) -> MML [IR Exp] 413reorderScripts e subs c = do 414 baseExpr <- expr e 415 subExpr <- postfixExpr subs 416 return $ 417 case baseExpr of 418 [s@(Stretchy Open _ _)] -> [s, E $ c empty subExpr] -- Open 419 [s@(Stretchy Close _ _)] -> [Trailing c subExpr, s] -- Close 420 [s@(Stretchy _ _ _)] -> [s, E $ ESub empty subExpr] -- Middle 421 _ -> [E $ c (mkExp baseExpr) subExpr] -- No stretch 422 423sup :: Element -> MML [IR Exp] 424sup e = do 425 (base, sups) <- checkArgs2 e 426 reorderScripts base sups ESuper 427 428subsup :: Element -> MML Exp 429subsup e = do 430 (base, subs, sups) <- checkArgs3 e 431 ESubsup <$> safeExpr base <*> (postfixExpr subs) 432 <*> (postfixExpr sups) 433 434under :: Element -> MML Exp 435under e = do 436 (base, below) <- checkArgs2 e 437 EUnder False <$> safeExpr base <*> postfixExpr below 438 439over :: Element -> MML Exp 440over e = do 441 (base, above) <- checkArgs2 e 442 EOver False <$> safeExpr base <*> postfixExpr above 443 444underover :: Element -> MML Exp 445underover e = do 446 (base, below, above) <- checkArgs3 e 447 EUnderover False <$> safeExpr base <*> (postfixExpr below) 448 <*> (postfixExpr above) 449 450-- Other 451 452semantics :: Element -> MML Exp 453semantics e = do 454 guard (not $ null cs) 455 first <- safeExpr (head cs) 456 if isEmpty first 457 then fromMaybe empty . getFirst . mconcat <$> mapM annotation (tail cs) 458 else return first 459 where 460 cs = elChildren e 461 462annotation :: Element -> MML (First Exp) 463annotation e = do 464 encoding <- findAttrQ "encoding" e 465 case encoding of 466 Just "application/mathml-presentation+xml" -> 467 First . Just <$> row e 468 Just "MathML-Presentation" -> 469 First . Just <$> row e 470 _ -> return (First Nothing) 471 472multiscripts :: Element -> MML Exp 473multiscripts e = do 474 let (xs, pres) = break ((== "mprescripts") . name) (elChildren e) 475 let row'' e' = if name e' == "none" 476 then return $ EGrouped [] 477 else row e' 478 xs' <- mapM row'' xs 479 let base = 480 case xs' of 481 [x] -> x 482 [x,y] -> ESub x y 483 (x:y:z:_) -> ESubsup x y z 484 [] -> EGrouped [] 485 pres' <- mapM row'' $ drop 1 pres 486 return $ 487 case pres' of 488 (x:y:_) -> EGrouped [ESubsup (EGrouped []) x y, base] 489 [x] -> EGrouped [ESub x (EGrouped []), base] 490 [] -> base 491 492 493-- Table 494 495table :: Element -> MML Exp 496table e = do 497 defAlign <- maybe AlignCenter toAlignment <$> (findAttrQ "columnalign" e) 498 rs <- mapM (tableRow defAlign) (elChildren e) 499 let (onlyAligns, exprs) = (map .map) fst &&& (map . map) snd $ rs 500 let rs' = map (pad (maximum (map length rs))) exprs 501 let aligns = map findAlign (transpose onlyAligns) 502 return $ EArray aligns rs' 503 where 504 findAlign xs = if null xs then AlignCenter 505 else foldl1 combine xs 506 combine x y = if x == y then x else AlignCenter 507 508tableRow :: Alignment -> Element -> MML [(Alignment, [Exp])] 509tableRow a e = do 510 align <- maybe a toAlignment <$> (findAttrQ "columnalign" e) 511 case name e of 512 "mtr" -> mapM (tableCell align) (elChildren e) 513 "mlabeledtr" -> mapM (tableCell align) (tail $ elChildren e) 514 _ -> throwError $ "Invalid Element: Only expecting mtr elements " <> err e 515 516tableCell :: Alignment -> Element -> MML (Alignment, [Exp]) 517tableCell a e = do 518 align <- maybe a toAlignment <$> (findAttrQ "columnalign" e) 519 case name e of 520 "mtd" -> (,) align . (:[]) <$> row e 521 _ -> throwError $ "Invalid Element: Only expecting mtd elements " <> err e 522 523-- Fixup 524 525-- Library Functions 526 527maybeToEither :: (MonadError e m) => e -> Maybe a -> m a 528maybeToEither = flip maybe return . throwError 529 530--interleave up to end of shorter list 531fInterleave :: [a] -> [a] -> [a] 532fInterleave [] _ = [] 533fInterleave _ [] = [] 534fInterleave (x:xs) ys = x : fInterleave ys xs 535 536-- MMLState helper functions 537 538defaultState :: MMLState 539defaultState = MMLState [] Nothing False TextNormal 540 541addAttrs :: [Attr] -> MMLState -> MMLState 542addAttrs as s = s {attrs = (map renameAttr as) ++ attrs s } 543 544renameAttr :: Attr -> Attr 545renameAttr v@(qName . attrKey -> "accentunder") = 546 Attr (unqual "accent") (attrVal v) 547renameAttr a = a 548 549filterMathVariant :: MMLState -> MMLState 550filterMathVariant s@(attrs -> as) = 551 s{attrs = filter ((/= unqual "mathvariant") . attrKey) as} 552 553setPosition :: FormType -> MMLState -> MMLState 554setPosition p s = s {position = Just p} 555 556resetPosition :: MMLState -> MMLState 557resetPosition s = s {position = Nothing} 558 559enterAccent :: MMLState -> MMLState 560enterAccent s = s{ inAccent = True } 561 562enterStyled :: TextType -> MMLState -> MMLState 563enterStyled tt s = s{ curStyle = tt } 564 565-- Utility 566 567getString :: Element -> MML T.Text 568getString e = do 569 tt <- asks curStyle 570 return $ fromUnicode tt $ stripSpaces $ T.pack $ concatMap cdData 571 $ onlyText $ elContent $ e 572 573-- Finds only text data and replaces entity references with corresponding 574-- characters 575onlyText :: [Content] -> [CData] 576onlyText [] = [] 577onlyText ((Text c):xs) = c : onlyText xs 578onlyText (CRef s : xs) = (CData CDataText (fromMaybe s $ getUnicode' s) Nothing) : onlyText xs 579 where getUnicode' = fmap T.unpack . getUnicode . T.pack 580onlyText (_:xs) = onlyText xs 581 582checkArgs2 :: Element -> MML (Element, Element) 583checkArgs2 e = case elChildren e of 584 [a, b] -> return (a, b) 585 _ -> throwError ("Incorrect number of arguments for " <> err e) 586 587checkArgs3 :: Element -> MML (Element, Element, Element) 588checkArgs3 e = case elChildren e of 589 [a, b, c] -> return (a, b, c) 590 _ -> throwError ("Incorrect number of arguments for " <> err e) 591 592mapPairM :: Monad m => (a -> m b) -> (a, a) -> m (b, b) 593mapPairM f (a, b) = (,) <$> (f a) <*> (f b) 594 595err :: Element -> T.Text 596err e = name e <> maybe "" (\x -> " line " <> T.pack (show x)) (elLine e) 597 598-- Kept as String for Text.XML.Light 599findAttrQ :: String -> Element -> MML (Maybe T.Text) 600findAttrQ s e = do 601 inherit <- case (name e, s) of 602 ("mfenced", "open") -> return Nothing 603 ("mfenced", "close") -> return Nothing 604 ("mfenced", "separators") -> return Nothing 605 _ -> asks (lookupAttrQ s . attrs) 606 return $ fmap T.pack $ 607 findAttr (QName s Nothing Nothing) e 608 <|> inherit 609 610-- Kept as String for Text.XML.Light 611lookupAttrQ :: String -> [Attr] -> Maybe String 612lookupAttrQ s = lookupAttr (QName (map toLower s) Nothing Nothing) 613 614name :: Element -> T.Text 615name (elName -> (QName n _ _)) = T.toLower $ T.pack n 616 617-- Kept as String for Text.XML.Light 618tunode :: String -> T.Text -> Element 619tunode s = unode s . T.unpack 620 621stripSpaces :: T.Text -> T.Text 622stripSpaces = T.dropAround isSpace 623 624toAlignment :: T.Text -> Alignment 625toAlignment "left" = AlignLeft 626toAlignment "center" = AlignCenter 627toAlignment "right" = AlignRight 628toAlignment _ = AlignCenter 629 630getPosition :: FormType -> TeXSymbolType 631getPosition (FPrefix) = Open 632getPosition (FPostfix) = Close 633getPosition (FInfix) = Op 634 635getFormType :: Maybe T.Text -> Maybe FormType 636getFormType (Just "infix") = (Just FInfix) 637getFormType (Just "prefix") = (Just FPrefix) 638getFormType (Just "postfix") = (Just FPostfix) 639getFormType _ = Nothing 640 641pad :: Int -> [[a]] -> [[a]] 642pad n xs = xs ++ (replicate (n - len) []) 643 where 644 len = length xs 645 646isSpace :: Char -> Bool 647isSpace ' ' = True 648isSpace '\t' = True 649isSpace '\n' = True 650isSpace _ = False 651 652spacelikeElems, cSpacelikeElems :: [T.Text] 653spacelikeElems = ["mtext", "mspace", "maligngroup", "malignmark"] 654cSpacelikeElems = ["mrow", "mstyle", "mphantom", "mpadded"] 655 656spacelike :: Element -> Bool 657spacelike e@(name -> uid) = 658 uid `elem` spacelikeElems || uid `elem` cSpacelikeElems && 659 and (map spacelike (elChildren e)) 660 661thicknessZero :: Maybe T.Text -> Bool 662thicknessZero (Just s) = thicknessToNum s == 0.0 663thicknessZero Nothing = False 664 665widthToNum :: T.Text -> Rational 666widthToNum s = 667 case s of 668 "veryverythinmathspace" -> 1/18 669 "verythinmathspace" -> 2/18 670 "thinmathspace" -> 3/18 671 "mediummathspace" -> 4/18 672 "thickmathspace" -> 5/18 673 "verythickmathspace" -> 6/18 674 "veryverythickmathspace" -> 7/18 675 "negativeveryverythinmathspace" -> -1/18 676 "negativeverythinmathspace" -> -2/18 677 "negativethinmathspace" -> -3/18 678 "negativemediummathspace" -> -4/18 679 "negativethickmathspace" -> -5/18 680 "negativeverythickmathspace" -> -6/18 681 "negativeveryverythickmathspace" -> -7/18 682 _ -> fromMaybe 0 (readLength s) 683 684thicknessToNum :: T.Text -> Rational 685thicknessToNum s = 686 case s of 687 "thin" -> (3/18) 688 "medium" -> (1/2) 689 "thick" -> 1 690 v -> fromMaybe 0.5 (readLength v) 691 692postfixExpr :: Element -> MML Exp 693postfixExpr e = local (setPosition FPostfix . enterAccent) (safeExpr e) 694