Docx reader: Split math out into math module.

Could use some cleanup, but this is the first step for getting
an OMML reader into TeXMath.
This commit is contained in:
Jesse Rosenthal 2014-08-07 12:20:22 -04:00
parent 13f26af84f
commit a7967d1aef
3 changed files with 15 additions and 560 deletions

View file

@ -323,6 +323,7 @@ Library
Other-Modules: Text.Pandoc.Readers.Docx.Lists, Other-Modules: Text.Pandoc.Readers.Docx.Lists,
Text.Pandoc.Readers.Docx.Reducible, Text.Pandoc.Readers.Docx.Reducible,
Text.Pandoc.Readers.Docx.Parse, Text.Pandoc.Readers.Docx.Parse,
Text.Pandoc.Readers.Docx.OMath,
Text.Pandoc.Writers.Shared, Text.Pandoc.Writers.Shared,
Text.Pandoc.Asciify, Text.Pandoc.Asciify,
Text.Pandoc.MIME, Text.Pandoc.MIME,

View file

@ -84,11 +84,10 @@ import Text.Pandoc.Readers.Docx.Lists
import Text.Pandoc.Readers.Docx.Reducible import Text.Pandoc.Readers.Docx.Reducible
import Text.Pandoc.Shared import Text.Pandoc.Shared
import Text.Pandoc.MediaBag (insertMedia, MediaBag) import Text.Pandoc.MediaBag (insertMedia, MediaBag)
import Data.Maybe (mapMaybe, fromMaybe) import Data.Maybe (mapMaybe)
import Data.List (delete, stripPrefix, (\\), intersperse, intersect) import Data.List (delete, stripPrefix, (\\), intersect)
import Data.Monoid import Data.Monoid
import Text.TeXMath (writeTeX) import Text.TeXMath (writeTeX)
import qualified Text.TeXMath.Types as TM
import Data.Default (Default) import Data.Default (Default)
import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy as B
import qualified Data.Map as M import qualified Data.Map as M
@ -374,193 +373,8 @@ parPartToInlines (InternalHyperLink anchor runs) = do
parPartToInlines (ExternalHyperLink target runs) = do parPartToInlines (ExternalHyperLink target runs) = do
ils <- concatMapM runToInlines runs ils <- concatMapM runToInlines runs
return [Link ils (target, "")] return [Link ils (target, "")]
parPartToInlines (PlainOMath omath) = do parPartToInlines (PlainOMath exps) = do
e <- oMathToExps omath return [Math InlineMath (writeTeX exps)]
return [Math InlineMath (writeTeX e)]
oMathToExps :: OMath -> DocxContext [TM.Exp]
oMathToExps (OMath oMathElems) = concatMapM oMathElemToExps oMathElems
oMathElemToExps :: OMathElem -> DocxContext [TM.Exp]
oMathElemToExps (Accent style base) = do
baseExp <- baseToExp base
let chr = case accentChar style of
Just c -> c
Nothing -> '\180' -- default to acute.
return [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
oMathElemToExps(Bar style base) = do
baseExp <- baseToExp base
return $ case barPos style of
Top -> [TM.EOver False baseExp (TM.ESymbol TM.Accent "\175")]
Bottom -> [TM.EUnder False baseExp (TM.ESymbol TM.Accent "\818")]
oMathElemToExps (Box base) =
(\e -> return [e]) =<< baseToExp base
oMathElemToExps (BorderBox base) =
-- TODO: This should be "\\boxed" somehow
(\e -> return [e]) =<< baseToExp base
oMathElemToExps (Delimiter dPr bases) = do
baseExps <- mapM baseToExp bases
let inDelimExps = map Right baseExps
beg = fromMaybe '(' (delimBegChar dPr)
end = fromMaybe ')' (delimEndChar dPr)
sep = fromMaybe '|' (delimSepChar dPr)
exps = intersperse (Left [sep]) inDelimExps
return [TM.EDelimited [beg] [end] exps]
oMathElemToExps (EquationArray bases) = do
let f b = do bs <- baseToExp' b
return [bs]
baseExps <- mapM f bases
return [TM.EArray [] baseExps]
oMathElemToExps (Fraction num denom) = do
numExp <- concatMapM oMathElemToExps num >>= (return . TM.EGrouped)
denExp <- concatMapM oMathElemToExps denom >>= (return . TM.EGrouped)
return [TM.EFraction TM.NormalFrac numExp denExp]
oMathElemToExps (Function fname base) = do
-- We need a string for the fname, but omml gives it to us as a
-- series of oMath elems. We're going to filter out the oMathRuns,
-- which should work for us most of the time.
let f :: OMathElem -> String
f (OMathRun _ run) = runToString run
f _ = ""
fnameString = concatMap f fname
baseExp <- baseToExp base
return [TM.EMathOperator fnameString, baseExp]
oMathElemToExps (Group style base)
| Just Top <- groupPos style = do
baseExp <- baseToExp base
let chr = case groupChr style of
Just c -> c
Nothing -> '\65079' -- default to overbrace
return [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
| otherwise = do
baseExp <- baseToExp base
let chr = case groupChr style of
Just c -> c
Nothing -> '\65080' -- default to underbrace
return [TM.EUnder False baseExp (TM.ESymbol TM.Accent [chr])]
oMathElemToExps (LowerLimit base limElems) = do
baseExp <- baseToExp base
lim <- concatMapM oMathElemToExps limElems >>= (return . TM.EGrouped)
return [TM.EUnder True lim baseExp]
oMathElemToExps (UpperLimit base limElems) = do
baseExp <- baseToExp base
lim <- concatMapM oMathElemToExps limElems >>= (return . TM.EGrouped)
return [TM.EOver True lim baseExp]
oMathElemToExps (Matrix bases) = do
rows <- mapM (mapM (\b -> baseToExp' b)) bases
return [TM.EArray [TM.AlignCenter] rows]
oMathElemToExps (NAry style sub sup base) = do
subExps <- concatMapM oMathElemToExps sub
supExps <- concatMapM oMathElemToExps sup
baseExp <- baseToExp base
let opChar = case nAryChar style of
Just c -> c
-- default to integral
Nothing -> '\8747'
return [ TM.ESubsup
(TM.ESymbol TM.Op [opChar])
(TM.EGrouped subExps)
(TM.EGrouped supExps)
, baseExp]
oMathElemToExps (Phantom base) =
(\e -> return [TM.EPhantom e]) =<< baseToExp base
oMathElemToExps (Radical degree base) = do
degExps <- concatMapM oMathElemToExps degree
baseExp <- baseToExp base
return $ case degExps of
[] -> [TM.ESqrt baseExp]
ds -> [TM.ERoot (TM.EGrouped ds) baseExp]
oMathElemToExps (PreSubSuper sub sup base) = do
subExps <- concatMapM oMathElemToExps sub
supExps <- concatMapM oMathElemToExps sup
baseExp <- baseToExp base
return [ TM.ESubsup
(TM.EIdentifier "") (TM.EGrouped subExps) (TM.EGrouped supExps)
, baseExp]
oMathElemToExps (Sub base sub) = do
baseExp <- baseToExp base
subExps <- concatMapM oMathElemToExps sub
return [TM.ESub baseExp (TM.EGrouped subExps)]
oMathElemToExps (SubSuper base sub sup) = do
baseExp <- baseToExp base
subExps <- concatMapM oMathElemToExps sub
supExps <- concatMapM oMathElemToExps sup
return [TM.ESubsup baseExp (TM.EGrouped subExps) (TM.EGrouped supExps)]
oMathElemToExps (Super base sup) = do
baseExp <- baseToExp base
supExps <- concatMapM oMathElemToExps sup
return [TM.ESuper baseExp (TM.EGrouped supExps)]
oMathElemToExps (OMathRun sty run@(Run _ _))
| NoStyle <- oMathRunTextStyle sty =
return $ [TM.EIdentifier $ runToString run]
| Nothing <- oMathRunStyleToTextType sty =
return $ [TM.EIdentifier $ runToString run]
| Just textType <- oMathRunStyleToTextType sty =
return $ if oMathLit sty
then [TM.EText textType (runToString run)]
else [TM.EStyled textType [TM.EIdentifier $ runToString run]]
oMathElemToExps (OMathRun _ _) = return []
oMathRunStyleToTextType :: OMathRunStyle -> Maybe TM.TextType
oMathRunStyleToTextType mrPr
| Normal <- oMathRunTextStyle mrPr =
Just $ TM.TextNormal
| Styled scr sty <- oMathRunTextStyle mrPr
,Just OBold <- sty
, Just OSansSerif <- scr =
Just $ TM.TextSansSerifBold
| Styled scr sty <- oMathRunTextStyle mrPr
, Just OBoldItalic <- sty
, Just OSansSerif <- scr =
Just $ TM.TextSansSerifBoldItalic
| Styled scr sty <- oMathRunTextStyle mrPr
, Just OBold <- sty
, Just OScript <- scr =
Just $ TM.TextBoldScript
| Styled scr sty <- oMathRunTextStyle mrPr
, Just OBold <- sty
, Just OFraktur <- scr =
Just $ TM.TextBoldFraktur
| Styled scr sty <- oMathRunTextStyle mrPr
, Just OItalic <- sty
, Just OSansSerif <- scr =
Just $ TM.TextSansSerifItalic
| Styled _ sty <- oMathRunTextStyle mrPr
, Just OBold <- sty =
Just $ TM.TextBold
| Styled _ sty <- oMathRunTextStyle mrPr
, Just OItalic <- sty =
Just $ TM.TextItalic
| Styled scr _ <- oMathRunTextStyle mrPr
, Just OMonospace <- scr =
Just $ TM.TextMonospace
| Styled scr _ <- oMathRunTextStyle mrPr
, Just OSansSerif <- scr =
Just $ TM.TextSansSerif
| Styled scr _ <- oMathRunTextStyle mrPr
, Just ODoubleStruck <- scr =
Just $ TM.TextDoubleStruck
| Styled scr _ <- oMathRunTextStyle mrPr
, Just OScript <- scr =
Just $ TM.TextDoubleStruck
| Styled scr _ <- oMathRunTextStyle mrPr
, Just OFraktur <- scr =
Just $ TM.TextFraktur
| Styled _ sty <- oMathRunTextStyle mrPr
, Just OBoldItalic <- sty =
Just $ TM.TextBoldItalic
| otherwise = Nothing
baseToExp :: Base -> DocxContext TM.Exp
baseToExp (Base mathElems) =
concatMapM oMathElemToExps mathElems >>= (return . TM.EGrouped)
-- an ungrouped version of baseToExp
baseToExp' :: Base -> DocxContext [TM.Exp]
baseToExp' (Base mathElems) =
concatMapM oMathElemToExps mathElems
isAnchorSpan :: Inline -> Bool isAnchorSpan :: Inline -> Bool
@ -686,11 +500,10 @@ bodyPartToBlocks (Tbl cap _ look (r:rs)) = do
widths = replicate size 0 :: [Double] widths = replicate size 0 :: [Double]
return [Table caption alignments widths hdrCells cells] return [Table caption alignments widths hdrCells cells]
bodyPartToBlocks (OMathPara _ maths) = do bodyPartToBlocks (OMathPara exps) = do
omaths <- mapM oMathToExps maths
return [Para $ return [Para $
map (\m -> Math DisplayMath (writeTeX m)) map (\e -> Math DisplayMath (writeTeX e))
omaths] exps]
-- replace targets with generated anchors. -- replace targets with generated anchors.
rewriteLink :: Inline -> DocxContext Inline rewriteLink :: Inline -> DocxContext Inline

View file

@ -36,19 +36,6 @@ module Text.Pandoc.Readers.Docx.Parse ( Docx(..)
, BodyPart(..) , BodyPart(..)
, TblLook(..) , TblLook(..)
, ParPart(..) , ParPart(..)
, OMath(..)
, OMathElem(..)
, Base(..)
, TopBottom(..)
, AccentStyle(..)
, BarStyle(..)
, NAryStyle(..)
, DelimStyle(..)
, GroupStyle(..)
, OMathRunStyle(..)
, OMathRunTextStyle(..)
, OMathTextScript(..)
, OMathTextStyle(..)
, Run(..) , Run(..)
, RunElem(..) , RunElem(..)
, Notes , Notes
@ -74,6 +61,8 @@ import qualified Text.Pandoc.UTF8 as UTF8
import Control.Monad.Reader import Control.Monad.Reader
import qualified Data.Map as M import qualified Data.Map as M
import Text.Pandoc.Compat.Except import Text.Pandoc.Compat.Except
import Text.Pandoc.Readers.Docx.OMath (elemToExps)
import Text.TeXMath (Exp)
data ReaderEnv = ReaderEnv { envNotes :: Notes data ReaderEnv = ReaderEnv { envNotes :: Notes
, envNumbering :: Numbering , envNumbering :: Numbering
@ -161,7 +150,7 @@ defaultParagraphStyle = ParagraphStyle { pStyle = []
data BodyPart = Paragraph ParagraphStyle [ParPart] data BodyPart = Paragraph ParagraphStyle [ParPart]
| ListItem ParagraphStyle String String Level [ParPart] | ListItem ParagraphStyle String String Level [ParPart]
| Tbl String TblGrid TblLook [Row] | Tbl String TblGrid TblLook [Row]
| OMathPara OMathParaStyle [OMath] | OMathPara [[Exp]]
deriving Show deriving Show
type TblGrid = [Integer] type TblGrid = [Integer]
@ -185,100 +174,9 @@ data ParPart = PlainRun Run
| InternalHyperLink Anchor [Run] | InternalHyperLink Anchor [Run]
| ExternalHyperLink URL [Run] | ExternalHyperLink URL [Run]
| Drawing FilePath B.ByteString | Drawing FilePath B.ByteString
| PlainOMath OMath | PlainOMath [Exp]
deriving Show deriving Show
data OMath = OMath [OMathElem]
deriving Show
data OMathElem = Accent AccentStyle Base
| Bar BarStyle Base
| Box Base
| BorderBox Base
| Delimiter DelimStyle [Base]
| EquationArray [Base]
| Fraction [OMathElem] [OMathElem]
| Function [OMathElem] Base
| Group GroupStyle Base
| LowerLimit Base [OMathElem]
| UpperLimit Base [OMathElem]
| Matrix [[Base]]
| NAry NAryStyle [OMathElem] [OMathElem] Base
| Phantom Base
| Radical [OMathElem] Base
| PreSubSuper [OMathElem] [OMathElem] Base
| Sub Base [OMathElem]
| SubSuper Base [OMathElem] [OMathElem]
| Super Base [OMathElem]
| OMathRun OMathRunStyle Run
deriving Show
data Base = Base [OMathElem]
deriving Show
-- placeholders
type OMathParaStyle = [String]
data TopBottom = Top | Bottom
deriving Show
data AccentStyle = AccentStyle { accentChar :: Maybe Char }
deriving Show
data BarStyle = BarStyle { barPos :: TopBottom}
deriving Show
data NAryStyle = NAryStyle { nAryChar :: Maybe Char
, nAryLimLoc :: LimLoc}
deriving Show
data OMathRunStyle = OMathRunStyle { oMathLit :: Bool
, oMathRunTextStyle :: OMathRunTextStyle }
deriving Show
data OMathRunTextStyle = NoStyle
| Normal
| Styled { oMathScript :: Maybe OMathTextScript
, oMathStyle :: Maybe OMathTextStyle }
deriving Show
data OMathTextScript = ORoman
| OScript
| OFraktur
| ODoubleStruck
| OSansSerif
| OMonospace
deriving (Show, Eq)
data OMathTextStyle = OPlain
| OBold
| OItalic
| OBoldItalic
deriving (Show, Eq)
defaultNAryStyle :: NAryStyle
defaultNAryStyle = NAryStyle { nAryChar = Nothing -- integral, in practice
, nAryLimLoc = SubSup }
data LimLoc = SubSup | UnderOver deriving Show
data DelimStyle = DelimStyle { delimBegChar :: Maybe Char
, delimSepChar :: Maybe Char
, delimEndChar :: Maybe Char}
deriving Show
defaultDelimStyle :: DelimStyle
defaultDelimStyle = DelimStyle { delimBegChar = Nothing
, delimSepChar = Nothing
, delimEndChar = Nothing }
data GroupStyle = GroupStyle { groupChr :: Maybe Char
, groupPos :: Maybe TopBottom }
deriving Show
defaultGroupStyle :: GroupStyle
defaultGroupStyle = GroupStyle {groupChr = Nothing, groupPos = Nothing}
data Run = Run RunStyle [RunElem] data Run = Run RunStyle [RunElem]
| Footnote [BodyPart] | Footnote [BodyPart]
| Endnote [BodyPart] | Endnote [BodyPart]
@ -576,9 +474,8 @@ elemToBodyPart ns element
| isElem ns "w" "p" element | isElem ns "w" "p" element
, (c:_) <- findChildren (elemName ns "m" "oMathPara") element = , (c:_) <- findChildren (elemName ns "m" "oMathPara") element =
do do
let style = [] -- placeholder expsLst <- mapD (\e -> (maybeToD $ elemToExps ns e)) (elChildren c)
maths <- mapD (elemToMath ns) (elChildren c) return $ OMathPara expsLst
return $ OMathPara style maths
elemToBodyPart ns element elemToBodyPart ns element
| isElem ns "w" "p" element | isElem ns "w" "p" element
, Just (numId, lvl) <- elemToNumInfo ns element = do , Just (numId, lvl) <- elemToNumInfo ns element = do
@ -614,262 +511,6 @@ elemToBodyPart ns element
return $ Tbl caption grid tblLook rows return $ Tbl caption grid tblLook rows
elemToBodyPart _ _ = throwError WrongElem elemToBodyPart _ _ = throwError WrongElem
elemToMath :: NameSpaces -> Element -> D OMath
elemToMath ns element | isElem ns "m" "oMath" element =
mapD (elemToMathElem ns) (elChildren element) >>=
(\es -> return $ OMath es)
elemToMath _ _ = throwError WrongElem
elemToBase :: NameSpaces -> Element -> D Base
elemToBase ns element | isElem ns "m" "e" element =
mapD (elemToMathElem ns) (elChildren element) >>=
(\es -> return $ Base es)
elemToBase _ _ = throwError WrongElem
-- TODO: The right way to do this is to use the ampersand to break the
-- text lines into multiple columns. That's tricky, though, and this
-- will get us most of the way for the time being.
filterAmpersand :: OMathElem -> OMathElem
filterAmpersand (OMathRun mrPr (Run wrPr elems)) =
let f (TextRun s) = TextRun $ filter ('&' /=) s
f re = re
in
OMathRun mrPr $ Run wrPr (map f elems)
filterAmpersand e = e
elemToBaseNoAmpersand :: NameSpaces -> Element -> D Base
elemToBaseNoAmpersand ns element | isElem ns "m" "e" element =
mapD
(\e -> (elemToMathElem ns e >>= (return . filterAmpersand)))
(elChildren element) >>=
(\es -> return $ Base es)
elemToBaseNoAmpersand _ _ = throwError WrongElem
elemToOMathRunStyle :: NameSpaces -> Element -> OMathRunStyle
elemToOMathRunStyle ns element =
let lit =
case
findChild (elemName ns "m" "lit") element >>=
findAttr (elemName ns "m" "val")
of
Just "on" -> True
_ -> False
in
OMathRunStyle { oMathLit = lit
, oMathRunTextStyle = (elemToOMathRunTextStyle ns element)
}
elemToOMathRunTextStyle :: NameSpaces -> Element -> OMathRunTextStyle
elemToOMathRunTextStyle ns element
| Just mrPr <- findChild (elemName ns "m" "rPr") element
, Just _ <- findChild (elemName ns "m" "nor") mrPr =
Normal
| Just mrPr <- findChild (elemName ns "m" "rPr") element =
let scr =
case
findChild (elemName ns "m" "scr") mrPr >>=
findAttr (elemName ns "m" "val")
of
Just "roman" -> Just ORoman
Just "script" -> Just OScript
Just "fraktur" -> Just OFraktur
Just "double-struck" -> Just ODoubleStruck
Just "sans-serif" -> Just OSansSerif
Just "monospace" -> Just OMonospace
_ -> Nothing
sty =
case
findChild (elemName ns "m" "sty") mrPr >>=
findAttr (elemName ns "m" "val")
of
Just "p" -> Just OPlain
Just "b" -> Just OBold
Just "i" -> Just OItalic
Just "bi" -> Just OBoldItalic
_ -> Nothing
in
Styled { oMathScript = scr, oMathStyle = sty }
| otherwise = NoStyle
elemToNAryStyle :: NameSpaces -> Element -> NAryStyle
elemToNAryStyle ns element
| Just narypr <- findChild (QName "naryPr" (lookup "m" ns) (Just "m")) element =
let
chr = findChild (QName "chr" (lookup "m" ns) (Just "m")) narypr >>=
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
Just . head
limLoc = findChild (QName "limLoc" (lookup "m" ns) (Just "m")) narypr >>=
findAttr (QName "val" (lookup "m" ns) (Just "m"))
limLoc' = case limLoc of
Just "undOver" -> UnderOver
Just "subSup" -> SubSup
_ -> SubSup
in
NAryStyle { nAryChar = chr, nAryLimLoc = limLoc'}
elemToNAryStyle _ _ = defaultNAryStyle
elemToDelimStyle :: NameSpaces -> Element -> DelimStyle
elemToDelimStyle ns element
| Just dPr <- findChild (QName "dPr" (lookup "m" ns) (Just "m")) element =
let begChr = findChild (QName "begChr" (lookup "m" ns) (Just "m")) dPr >>=
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
(\c -> if null c then (Just ' ') else (Just $ head c))
sepChr = findChild (QName "sepChr" (lookup "m" ns) (Just "m")) dPr >>=
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
(\c -> if null c then (Just ' ') else (Just $ head c))
endChr = findChild (QName "endChr" (lookup "m" ns) (Just "m")) dPr >>=
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
(\c -> if null c then (Just ' ') else (Just $ head c))
in
DelimStyle { delimBegChar = begChr
, delimSepChar = sepChr
, delimEndChar = endChr}
elemToDelimStyle _ _ = defaultDelimStyle
elemToGroupStyle :: NameSpaces -> Element -> GroupStyle
elemToGroupStyle ns element
| Just gPr <- findChild (QName "groupChrPr" (lookup "m" ns) (Just "m")) element =
let chr = findChild (QName "chr" (lookup "m" ns) (Just "m")) gPr >>=
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
Just . head
pos = findChild (QName "pos" (lookup "m" ns) (Just "m")) gPr >>=
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
(\s -> Just $ if s == "top" then Top else Bottom)
in
GroupStyle { groupChr = chr, groupPos = pos }
elemToGroupStyle _ _ = defaultGroupStyle
elemToMathElem :: NameSpaces -> Element -> D OMathElem
elemToMathElem ns element | isElem ns "m" "acc" element = do
let accChar =
findChild (elemName ns "m" "accPr") element >>=
findChild (elemName ns "m" "chr") >>=
findAttr (elemName ns "m" "val") >>=
Just . head
accPr = AccentStyle { accentChar = accChar}
base <-(maybeToD $ findChild (elemName ns "m" "e") element) >>=
elemToBase ns
return $ Accent accPr base
elemToMathElem ns element | isElem ns "m" "bar" element = do
barPr <- maybeToD $
findChild (QName "barPr" (lookup "m" ns) (Just "m")) element >>=
findChild (QName "pos" (lookup "m" ns) (Just "m")) >>=
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
(\s ->
Just $ BarStyle {
barPos = (if s == "bot" then Bottom else Top)
})
base <-maybeToD (findChild (QName "e" (lookup "m" ns) (Just "m")) element) >>=
elemToBase ns
return $ Bar barPr base
elemToMathElem ns element | isElem ns "m" "box" element =
maybeToD (findChild (elemName ns "m" "e") element) >>=
elemToBase ns >>=
(\b -> return $ Box b)
elemToMathElem ns element | isElem ns "m" "borderBox" element =
maybeToD (findChild (elemName ns "m" "e") element) >>=
elemToBase ns >>=
(\b -> return $ BorderBox b)
elemToMathElem ns element | isElem ns "m" "d" element =
let style = elemToDelimStyle ns element
in
mapD (elemToBase ns) (elChildren element) >>=
(\es -> return $ Delimiter style es)
elemToMathElem ns element | isElem ns "m" "eqArr" element =
mapD (elemToBaseNoAmpersand ns) (elChildren element) >>=
(\es -> return $ EquationArray es)
elemToMathElem ns element | isElem ns "m" "f" element = do
num <- maybeToD $ findChild (elemName ns "m" "num") element
den <- maybeToD $ findChild (elemName ns "m" "den") element
numElems <- mapD (elemToMathElem ns) (elChildren num)
denElems <- mapD (elemToMathElem ns) (elChildren den)
return $ Fraction numElems denElems
elemToMathElem ns element | isElem ns "m" "func" element = do
fName <- maybeToD $ findChild (elemName ns "m" "fName") element
base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
elemToBase ns
fnElems <- mapD (elemToMathElem ns) (elChildren fName)
return $ Function fnElems base
elemToMathElem ns element | isElem ns "m" "groupChr" element =
let style = elemToGroupStyle ns element
in
maybeToD (findChild (elemName ns "m" "e") element) >>=
elemToBase ns >>=
(\b -> return $ Group style b)
elemToMathElem ns element | isElem ns "m" "limLow" element = do
base <- maybeToD (findChild (elemName ns "m" "e") element)
>>= elemToBase ns
lim <- maybeToD $ findChild (elemName ns "m" "lim") element
limElems <- mapD (elemToMathElem ns) (elChildren lim)
return $ LowerLimit base limElems
elemToMathElem ns element | isElem ns "m" "limUpp" element = do
base <- maybeToD (findChild (elemName ns "m" "e") element)
>>= elemToBase ns
lim <- maybeToD $ findChild (elemName ns "m" "lim") element
limElems <- mapD (elemToMathElem ns) (elChildren lim)
return $ UpperLimit base limElems
elemToMathElem ns element | isElem ns "m" "m" element = do
let rows = findChildren (elemName ns "m" "mr") element
bases <- mapD (\mr -> mapD (elemToBase ns) (elChildren mr)) rows
return $ Matrix bases
elemToMathElem ns element | isElem ns "m" "nary" element = do
let style = elemToNAryStyle ns element
sub <- maybeToD (findChild (elemName ns "m" "sub") element) >>=
(\e -> mapD (elemToMathElem ns) (elChildren e))
sup <- maybeToD (findChild (elemName ns "m" "sup") element) >>=
(\e -> mapD (elemToMathElem ns) (elChildren e))
base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
elemToBase ns
return $ NAry style sub sup base
elemToMathElem ns element | isElem ns "m" "rad" element = do
deg <- maybeToD (findChild (elemName ns "m" "deg") element) >>=
(\e -> mapD (elemToMathElem ns) (elChildren e))
base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
elemToBase ns
return $ Radical deg base
elemToMathElem ns element | isElem ns "m" "phant" element = do
base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
elemToBase ns
return $ Phantom base
elemToMathElem ns element | isElem ns "m" "sPre" element = do
sub <- maybeToD (findChild (elemName ns "m" "sub") element) >>=
(\e -> mapD (elemToMathElem ns) (elChildren e))
sup <- maybeToD (findChild (elemName ns "m" "sup") element) >>=
(\e -> mapD (elemToMathElem ns) (elChildren e))
base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
elemToBase ns
return $ PreSubSuper sub sup base
elemToMathElem ns element | isElem ns "m" "sSub" element = do
base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
elemToBase ns
sub <- maybeToD (findChild (elemName ns "m" "sub") element) >>=
(\e -> mapD (elemToMathElem ns) (elChildren e))
return $ Sub base sub
elemToMathElem ns element | isElem ns "m" "sSubSup" element = do
base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
elemToBase ns
sub <- maybeToD (findChild (elemName ns "m" "sub") element) >>=
(\e -> mapD (elemToMathElem ns) (elChildren e))
sup <- maybeToD (findChild (elemName ns "m" "sup") element) >>=
(\e -> mapD (elemToMathElem ns) (elChildren e))
return $ SubSuper base sub sup
elemToMathElem ns element | isElem ns "m" "sSup" element = do
base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
elemToBase ns
sup <- maybeToD (findChild (elemName ns "m" "sup") element) >>=
(\e -> mapD (elemToMathElem ns) (elChildren e))
return $ Super base sup
elemToMathElem ns element | isElem ns "m" "r" element = do
let mrPr = elemToOMathRunStyle ns element
wrPr = elemToRunStyle ns element
relems <- elemToRunElems ns element
return $ OMathRun mrPr $ Run wrPr relems
elemToMathElem _ _ = throwError WrongElem
lookupRelationship :: RelId -> [Relationship] -> Maybe Target lookupRelationship :: RelId -> [Relationship] -> Maybe Target
lookupRelationship relid rels = lookupRelationship relid rels =
lookup relid (map (\(Relationship pair) -> pair) rels) lookup relid (map (\(Relationship pair) -> pair) rels)
@ -933,7 +574,7 @@ elemToParPart ns element
Nothing -> ExternalHyperLink "" runs Nothing -> ExternalHyperLink "" runs
elemToParPart ns element elemToParPart ns element
| isElem ns "m" "oMath" element = | isElem ns "m" "oMath" element =
elemToMath ns element >>= (return . PlainOMath) (maybeToD $ elemToExps ns element) >>= (return . PlainOMath)
elemToParPart _ _ = throwError WrongElem elemToParPart _ _ = throwError WrongElem
lookupFootnote :: String -> Notes -> Maybe Element lookupFootnote :: String -> Notes -> Maybe Element