ideas-1.8: src/Ideas/Text/MathML.hs
-----------------------------------------------------------------------------
-- Copyright 2019, Ideas project team. This file is distributed under the
-- terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer : bastiaan.heeren@ou.nl
-- Stability : provisional
-- Portability : portable (depends on ghc)
--
-----------------------------------------------------------------------------
module Ideas.Text.MathML
( MathML(..), xml2mathml, mathml2xml
) where
import Data.Maybe
import Ideas.Text.XML
import Ideas.Utils.Uniplate hiding (children)
data MathML = MRow [MathML]
| MId String
| MNumber String
| MOperator String
| MString String
| MText String
| MSqrt MathML
| MRoot MathML MathML
| MSup MathML MathML -- base, superscript
| MSub MathML MathML -- base, subscript
| MSubSup MathML MathML MathML -- base, subscript, superscript
| MFrac MathML MathML -- numerator, denominator
| MFenced String String MathML -- left, right, content
| MSpace
| MStyle
| MPadded
| MPhantom
| MError
| MEnclose
| MUnder
| MOver
| MUnderOver
| MTable
| MTableRow
| MLabeledTableRow
| MTableData
deriving (Show, Eq)
{-
from: https://www.w3.org/TR/MathML2/chapter3.html#presm.mn @ 3.2.1
Conversely, since mn is a presentation element, there are a few situations where it may desirable to include arbitrary text in the content of an mn that should merely render as a numeric literal
-}
instance ToXML MathML where
toXML = mathml2xml
instance InXML MathML where
fromXML = either fail return . xml2mathml
instance Uniplate MathML where
uniplate math =
case math of
MRow xs -> plate MRow ||* xs
_ -> plate math
----------------------------------------------------------
-- conversion functions: XML <-> MathML
xml2mathml :: XML -> Either String MathML
xml2mathml = rec
where
rec xml = case name xml of
"mrow" -> MRow <$> mapM rec (children xml)
"mi" -> return (MId (getData xml))
"mn" -> return (MNumber (getData xml))
"mo" -> return (MOperator (getData xml))
"ms" -> return (MString (getData xml))
"mtext" -> return (MText (getData xml))
"mroot" -> case children xml of
[c, d] -> MRoot <$> rec c <*> rec d
_ -> fail "invalid mroot"
"msup" -> case children xml of
[c, d] -> MSup <$> rec c <*> rec d
_ -> fail "invalid msup"
"msub" -> case children xml of
[c, d] -> MSub <$> rec c <*> rec d
_ -> fail "invalid msub"
"msubsup" -> case children xml of
[c, d, e] -> MSubSup <$> rec c <*> rec d <*> rec e
_ -> fail "invalid msubsup"
"mfrac" -> case children xml of
[c, d] -> MFrac <$> rec c <*> rec d
_ -> fail "invalid mfrac"
"mfenced" -> case children xml of
[c] -> MFenced (fromMaybe "(" (findAttribute "open" xml)) (fromMaybe ")" (findAttribute "close" xml)) <$> rec c
_ -> fail "invalid mfenced"
"mspace" -> return MSpace
"mtable" -> return MTable
"mtr" -> return MTableRow
"mlabeledtr" -> return MLabeledTableRow
"munder" -> return MUnder
"mover" -> return MOver
"munderover" -> return MUnderOver
-- below are cases that have 1* arguments, when none-one an mrow is implied.
"math" -> impliedMRow xml
"msqrt" -> MSqrt <$> impliedMRow xml
"mphantom" -> return MPhantom
"mpadded" -> return MPadded
"mstyle" -> return MStyle
"merror" -> return MError
"mtd" -> return MTableData
"menclose" -> return MEnclose
_ -> fail ("unsupported MathML: " ++ show xml)
impliedMRow :: XML -> Either String MathML
impliedMRow xml =
case children xml of
[x] -> rec x
xs -> MRow <$> mapM rec xs
mathml2xml :: MathML -> XML
mathml2xml = makeXML "math" . rec
where
rec :: MathML -> XMLBuilder
rec math =
case math of
MRow ms -> element "mrow" (map rec ms)
MId s -> element "mi" [string s]
MNumber s -> element "mn" [string s]
MOperator s -> element "mo" [string s]
MString s -> element "ms" [string s]
MText s -> element "mtext" [string s]
MSqrt m -> element "msqrt" [rec m]
MRoot m1 m2 -> element "mroot" [rec m1, rec m2]
MSup m1 m2 -> element "msup" [rec m1, rec m2]
MSub m1 m2 -> element "msub" [rec m1, rec m2]
MSubSup m1 m2 m3 -> element "msubsup" [rec m1, rec m2, rec m3]
MFrac m1 m2 -> element "mfrac" [rec m1, rec m2]
MFenced s1 s2 m -> element "mfenced" ["open" .=. s1, "close" .=. s2, rec m]
MSpace -> element "mspace" []
MStyle -> element "mstyle" []
MPadded -> element "mpadded" []
MPhantom -> element "mphantom" []
MError -> element "merror" []
MEnclose -> element "menclose" []
MUnder -> element "munder" []
MOver -> element "mover" []
MUnderOver -> element "munderover" []
MTable -> element "mtable" []
MTableRow -> element "mtr" []
MLabeledTableRow -> element "mlabeledtr" []
MTableData -> element "mtd" []