@@ -30,75 +30,38 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
3030Types and functions for conversion of OMML into TeXMath.
3131-}
3232
33−module Text.Pandoc.Readers.Docx.OMath ( elemToExps
33+module Text.Pandoc.Readers.Docx.OMath (readOMML
3434 ) where
3535
3636import Text.XML.Light
3737import Data.Maybe (mapMaybe, fromMaybe)
3838import Data.List (intersperse)
3939import qualified Text.TeXMath.Types as TM
40−import Control.Applicative ((<$>))
41−
42−type NameSpaces = [(String, String)]
43−
44−elemName :: NameSpaces -> String -> String -> QName
45−elemName ns prefix name = (QName name (lookup prefix ns) (Just prefix))
46−
47−isElem :: NameSpaces -> String -> String -> Element -> Bool
48−isElem ns prefix name element =
49− qName (elName element) == name &&
50− qURI (elName element) == (lookup prefix ns)
51−
52−
53−data OMath = OMath [OMathElem]
54− deriving Show
55−
56−data OMathElem = Accent AccentStyle Base
57− | Bar BarStyle Base
58− | Box Base
59− | BorderBox Base
60− | Delimiter DelimStyle [Base]
61− | EquationArray [Base]
62− | Fraction [OMathElem] [OMathElem]
63− | Function [OMathElem] Base
64− | Group GroupStyle Base
65− | LowerLimit Base [OMathElem]
66− | UpperLimit Base [OMathElem]
67− | Matrix [[Base]]
68− | NAry NAryStyle [OMathElem] [OMathElem] Base
69− | Phantom Base
70− | Radical [OMathElem] Base
71− | PreSubSuper [OMathElem] [OMathElem] Base
72− | Sub Base [OMathElem]
73− | SubSuper Base [OMathElem] [OMathElem]
74− | Super Base [OMathElem]
75− | OMathRun OMathRunStyle [OMathRunElem]
76− deriving Show
7740
78−data OMathRunElem = TextRun String
79− | LnBrk
80− | Tab
81− deriving Show
82−
83−data Base = Base [OMathElem]
84− deriving Show
41+readOMML :: Element -> Maybe [TM.Exp]
42+readOMML element | isElem "m" "oMath" element =
43+ Just $ concat $ mapMaybe (elemToExps') (elChildren element)
44+readOMML _ = Nothing
8545
86−data TopBottom = Top | Bottom
87− deriving Show
8846
89−data AccentStyle = AccentStyle { accentChar :: Maybe Char }
90− deriving Show
91−
92−data BarStyle = BarStyle { barPos :: TopBottom}
93− deriving Show
47+isElem :: String -> String -> Element -> Bool
48+isElem prefix name element =
49+ let qp = fromMaybe "" (qPrefix (elName element))
50+ in
51+ qName (elName element) == name &&
52+ qp == prefix
9453
95−data NAryStyle = NAryStyle { nAryChar :: Maybe Char
96− , nAryLimLoc :: LimLoc}
97− deriving Show
54+hasElemName:: String -> String -> QName -> Bool
55+hasElemName prefix name qn =
56+ let qp = fromMaybe "" (qPrefix qn)
57+ in
58+ qName qn == name &&
59+ qp == prefix
9860
99−data OMathRunStyle = OMathRunStyle { oMathLit :: Bool
100− , oMathRunTextStyle :: OMathRunTextStyle }
101− deriving Show
61+data OMathRunElem = TextRun String
62+ | LnBrk
63+ | Tab
64+ deriving Show
10265
10366data OMathRunTextStyle = NoStyle
10467 | Normal
@@ -120,82 +83,40 @@ data OMathTextStyle = OPlain
12083 | OBoldItalic
12184 deriving (Show, Eq)
12285
123−defaultNAryStyle :: NAryStyle
124−defaultNAryStyle = NAryStyle { nAryChar = Nothing -- integral, in practice
125− , nAryLimLoc = SubSup }
126−
127−data LimLoc = SubSup | UnderOver deriving Show
128−
129−data DelimStyle = DelimStyle { delimBegChar :: Maybe Char
130− , delimSepChar :: Maybe Char
131− , delimEndChar :: Maybe Char}
132− deriving Show
133−
134−defaultDelimStyle :: DelimStyle
135−defaultDelimStyle = DelimStyle { delimBegChar = Nothing
136− , delimSepChar = Nothing
137− , delimEndChar = Nothing }
138−
139−data GroupStyle = GroupStyle { groupChr :: Maybe Char
140− , groupPos :: Maybe TopBottom }
141− deriving Show
142−
143−defaultGroupStyle :: GroupStyle
144−defaultGroupStyle = GroupStyle {groupChr = Nothing, groupPos = Nothing}
86+elemToBase :: Element -> Maybe TM.Exp
87+elemToBase element | isElem "m" "e" element = do
88+ bs <- elemToBases element
89+ return $ case bs of
90+ (e : []) -> e
91+ exps -> TM.EGrouped exps
92+elemToBase _ = Nothing
14593
146−elemToMath :: NameSpaces -> Element -> Maybe OMath
147−elemToMath ns element | isElem ns "m" "oMath" element =
148− Just $ OMath $ mapMaybe (elemToMathElem ns) (elChildren element)
149−elemToMath _ _ = Nothing
94+elemToBases :: Element -> Maybe [TM.Exp]
95+elemToBases element | isElem "m" "e" element =
96+ return $ concat $ mapMaybe elemToExps' (elChildren element)
97+elemToBases _ = Nothing
15098
151−elemToBase :: NameSpaces -> Element -> Maybe Base
152−elemToBase ns element | isElem ns "m" "e" element =
153− Just $ Base $ mapMaybe (elemToMathElem ns) (elChildren element)
154−elemToBase _ _ = Nothing
15599
156100-- TODO: The right way to do this is to use the ampersand to break the
157101-- text lines into multiple columns. That's tricky, though, and this
158102-- will get us most of the way for the time being.
159−filterAmpersand :: OMathElem -> OMathElem
160−filterAmpersand (OMathRun mrPr elems) =
161− let f (TextRun s) = TextRun $ filter ('&' /=) s
162− f re = re
163− in
164− OMathRun mrPr (map f elems)
165−filterAmpersand e = e
166−
167−elemToBaseNoAmpersand :: NameSpaces -> Element -> Maybe Base
168−elemToBaseNoAmpersand ns element | isElem ns "m" "e" element =
169− return $ Base $
170− mapMaybe
171− (\e -> (elemToMathElem ns e >>= (return . filterAmpersand)))
172− (elChildren element)
173−elemToBaseNoAmpersand _ _ = Nothing
174−
175−elemToOMathRunStyle :: NameSpaces -> Element -> OMathRunStyle
176−elemToOMathRunStyle ns element =
177− let lit =
178− case
179− findChild (elemName ns "m" "lit") element >>=
180− findAttr (elemName ns "m" "val")
181− of
182− Just "on" -> True
183− _ -> False
184− in
185− OMathRunStyle { oMathLit = lit
186− , oMathRunTextStyle = (elemToOMathRunTextStyle ns element)
187− }
188−
189−elemToOMathRunTextStyle :: NameSpaces -> Element -> OMathRunTextStyle
190−elemToOMathRunTextStyle ns element
191− | Just mrPr <- findChild (elemName ns "m" "rPr") element
192− , Just _ <- findChild (elemName ns "m" "nor") mrPr =
103+filterAmpersand :: TM.Exp -> TM.Exp
104+filterAmpersand (TM.EIdentifier s) = TM.EIdentifier (filter ('&' /=) s)
105+filterAmpersand (TM.EText tt s) = TM.EText tt (filter ('&' /=) s)
106+filterAmpersand (TM.EStyled tt exps) = TM.EStyled tt (map filterAmpersand exps)
107+filterAmpersand (TM.EGrouped exps) = TM.EGrouped (map filterAmpersand exps)
108+filterAmpersand e = e
109+
110+elemToOMathRunTextStyle :: Element -> OMathRunTextStyle
111+elemToOMathRunTextStyle element
112+ | Just mrPr <- filterChildName (hasElemName"m" "rPr") element
113+ , Just _ <- filterChildName (hasElemName"m" "nor") mrPr =
193114 Normal
194− | Just mrPr <- findChild (elemName ns "m" "rPr") element =
115+ | Just mrPr <- filterChildName (hasElemName"m" "rPr") element =
195116 let scr =
196117 case
197− findChild (elemName ns "m" "scr") mrPr >>=
198− findAttr (elemName ns "m" "val")
118+ filterChildName (hasElemName"m" "scr") mrPr >>=
119+ findAttrBy (hasElemName"m" "val")
199120 of
200121 Just "roman" -> Just ORoman
201122 Just "script" -> Just OScript
@@ -207,8 +128,8 @@ elemToOMathRunTextStyle ns element
207128
208129 sty =
209130 case
210− findChild (elemName ns "m" "sty") mrPr >>=
211− findAttr (elemName ns "m" "val")
131+ filterChildName (hasElemName"m" "sty") mrPr >>=
132+ findAttrBy (hasElemName"m" "val")
212133 of
213134 Just "p" -> Just OPlain
214135 Just "b" -> Just OBold
@@ -219,194 +140,21 @@ elemToOMathRunTextStyle ns element
219140 Styled { oMathScript = scr, oMathStyle = sty }
220141 | otherwise = NoStyle
221142
222−
223−
224−elemToNAryStyle :: NameSpaces -> Element -> NAryStyle
225−elemToNAryStyle ns element
226− | Just narypr <- findChild (QName "naryPr" (lookup "m" ns) (Just "m")) element =
227− let
228− chr = findChild (QName "chr" (lookup "m" ns) (Just "m")) narypr >>=
229− findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
230− Just . head
231− limLoc = findChild (QName "limLoc" (lookup "m" ns) (Just "m")) narypr >>=
232− findAttr (QName "val" (lookup "m" ns) (Just "m"))
233− limLoc' = case limLoc of
234− Just "undOver" -> UnderOver
235− Just "subSup" -> SubSup
236− _ -> SubSup
237− in
238− NAryStyle { nAryChar = chr, nAryLimLoc = limLoc'}
239−elemToNAryStyle _ _ = defaultNAryStyle
240−
241−elemToDelimStyle :: NameSpaces -> Element -> DelimStyle
242−elemToDelimStyle ns element
243− | Just dPr <- findChild (QName "dPr" (lookup "m" ns) (Just "m")) element =
244− let begChr = findChild (QName "begChr" (lookup "m" ns) (Just "m")) dPr >>=
245− findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
246− (\c -> if null c then (Just ' ') else (Just $ head c))
247− sepChr = findChild (QName "sepChr" (lookup "m" ns) (Just "m")) dPr >>=
248− findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
249− (\c -> if null c then (Just ' ') else (Just $ head c))
250− endChr = findChild (QName "endChr" (lookup "m" ns) (Just "m")) dPr >>=
251− findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
252− (\c -> if null c then (Just ' ') else (Just $ head c))
253− in
254− DelimStyle { delimBegChar = begChr
255− , delimSepChar = sepChr
256− , delimEndChar = endChr}
257−elemToDelimStyle _ _ = defaultDelimStyle
258−
259−elemToGroupStyle :: NameSpaces -> Element -> GroupStyle
260−elemToGroupStyle ns element
261− | Just gPr <- findChild (QName "groupChrPr" (lookup "m" ns) (Just "m")) element =
262− let chr = findChild (QName "chr" (lookup "m" ns) (Just "m")) gPr >>=
263− findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
264− Just . head
265− pos = findChild (QName "pos" (lookup "m" ns) (Just "m")) gPr >>=
266− findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
267− (\s -> Just $ if s == "top" then Top else Bottom)
268− in
269− GroupStyle { groupChr = chr, groupPos = pos }
270−elemToGroupStyle _ _ = defaultGroupStyle
271−
272−elemToMathElem :: NameSpaces -> Element -> Maybe OMathElem
273−elemToMathElem ns element | isElem ns "m" "acc" element = do
274− let accChar =
275− findChild (elemName ns "m" "accPr") element >>=
276− findChild (elemName ns "m" "chr") >>=
277− findAttr (elemName ns "m" "val") >>=
278− Just . head
279− accPr = AccentStyle { accentChar = accChar}
280− base <- findChild (elemName ns "m" "e") element >>=
281− elemToBase ns
282− return $ Accent accPr base
283−elemToMathElem ns element | isElem ns "m" "bar" element = do
284− barPr <- findChild (QName "barPr" (lookup "m" ns) (Just "m")) element >>=
285− findChild (QName "pos" (lookup "m" ns) (Just "m")) >>=
286− findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
287− (\s ->
288− Just $ BarStyle {
289− barPos = (if s == "bot" then Bottom else Top)
290− })
291− base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
292− elemToBase ns
293− return $ Bar barPr base
294−elemToMathElem ns element | isElem ns "m" "box" element =
295− findChild (elemName ns "m" "e") element >>=
296− elemToBase ns >>=
297− (\b -> return $ Box b)
298−elemToMathElem ns element | isElem ns "m" "borderBox" element =
299− findChild (elemName ns "m" "e") element >>=
300− elemToBase ns >>=
301− (\b -> return $ BorderBox b)
302−elemToMathElem ns element | isElem ns "m" "d" element =
303− let style = elemToDelimStyle ns element
304− in
305− return $ Delimiter style $ mapMaybe (elemToBase ns) (elChildren element)
306−elemToMathElem ns element | isElem ns "m" "eqArr" element =
307− return $ EquationArray $ mapMaybe (elemToBaseNoAmpersand ns) (elChildren element)
308−elemToMathElem ns element | isElem ns "m" "f" element = do
309− num <- findChild (elemName ns "m" "num") element
310− den <- findChild (elemName ns "m" "den") element
311− let numElems = mapMaybe (elemToMathElem ns) (elChildren num)
312− denElems = mapMaybe (elemToMathElem ns) (elChildren den)
313− return $ Fraction numElems denElems
314−elemToMathElem ns element | isElem ns "m" "func" element = do
315− fName <- findChild (elemName ns "m" "fName") element
316− base <- findChild (elemName ns "m" "e") element >>=
317− elemToBase ns
318− let fnElems = mapMaybe (elemToMathElem ns) (elChildren fName)
319− return $ Function fnElems base
320−elemToMathElem ns element | isElem ns "m" "groupChr" element =
321− let style = elemToGroupStyle ns element
322− in
323− findChild (elemName ns "m" "e") element >>=
324− elemToBase ns >>=
325− (\b -> return $ Group style b)
326−elemToMathElem ns element | isElem ns "m" "limLow" element = do
327− base <- findChild (elemName ns "m" "e") element
328− >>= elemToBase ns
329− lim <- findChild (elemName ns "m" "lim") element
330− let limElems = mapMaybe (elemToMathElem ns) (elChildren lim)
331− return $ LowerLimit base limElems
332−elemToMathElem ns element | isElem ns "m" "limUpp" element = do
333− base <- findChild (elemName ns "m" "e") element
334− >>= elemToBase ns
335− lim <- findChild (elemName ns "m" "lim") element
336− let limElems = mapMaybe (elemToMathElem ns) (elChildren lim)
337− return $ UpperLimit base limElems
338−elemToMathElem ns element | isElem ns "m" "m" element = do
339− let rows = findChildren (elemName ns "m" "mr") element
340− let bases = mapMaybe (\mr -> mapM (elemToBase ns) (elChildren mr)) rows
341− return $ Matrix bases
342−elemToMathElem ns element | isElem ns "m" "nary" element = do
343− let style = elemToNAryStyle ns element
344− sub <- findChild (elemName ns "m" "sub") element >>=
345− (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
346− sup <- findChild (elemName ns "m" "sup") element >>=
347− (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
348− base <- findChild (elemName ns "m" "e") element >>=
349− elemToBase ns
350− return $ NAry style sub sup base
351−elemToMathElem ns element | isElem ns "m" "rad" element = do
352− deg <- findChild (elemName ns "m" "deg") element >>=
353− (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
354− base <- findChild (elemName ns "m" "e") element >>=
355− elemToBase ns
356− return $ Radical deg base
357−elemToMathElem ns element | isElem ns "m" "phant" element = do
358− base <- findChild (elemName ns "m" "e") element >>=
359− elemToBase ns
360− return $ Phantom base
361−elemToMathElem ns element | isElem ns "m" "sPre" element = do
362− sub <- findChild (elemName ns "m" "sub") element >>=
363− (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
364− sup <- findChild (elemName ns "m" "sup") element >>=
365− (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
366− base <- findChild (elemName ns "m" "e") element >>=
367− elemToBase ns
368− return $ PreSubSuper sub sup base
369−elemToMathElem ns element | isElem ns "m" "sSub" element = do
370− base <- findChild (elemName ns "m" "e") element >>=
371− elemToBase ns
372− sub <- findChild (elemName ns "m" "sub") element >>=
373− (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
374− return $ Sub base sub
375−elemToMathElem ns element | isElem ns "m" "sSubSup" element = do
376− base <- findChild (elemName ns "m" "e") element >>=
377− elemToBase ns
378− sub <- findChild (elemName ns "m" "sub") element >>=
379− (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
380− sup <- findChild (elemName ns "m" "sup") element >>=
381− (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
382− return $ SubSuper base sub sup
383−elemToMathElem ns element | isElem ns "m" "sSup" element = do
384− base <- findChild (elemName ns "m" "e") element >>=
385− elemToBase ns
386− sup <- findChild (elemName ns "m" "sup") element >>=
387− (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
388− return $ Super base sup
389−elemToMathElem ns element | isElem ns "m" "r" element = do
390− let mrPr = elemToOMathRunStyle ns element
391− mrElems <- elemToOMathRunElems ns element
392− return $ OMathRun mrPr mrElems
393−elemToMathElem _ _ = Nothing
394−
395−elemToOMathRunElem :: NameSpaces -> Element -> Maybe OMathRunElem
396−elemToOMathRunElem ns element
397− | isElem ns "w" "t" element
398− || isElem ns "m" "t" element
399− || isElem ns "w" "delText" element = Just $ TextRun $ strContent element
400− | isElem ns "w" "br" element = Just LnBrk
401− | isElem ns "w" "tab" element = Just Tab
143+elemToOMathRunElem :: Element -> Maybe OMathRunElem
144+elemToOMathRunElem element
145+ | isElem "w" "t" element
146+ || isElem "m" "t" element
147+ || isElem "w" "delText" element = Just $ TextRun $ strContent element
148+ | isElem "w" "br" element = Just LnBrk
149+ | isElem "w" "tab" element = Just Tab
402150 | otherwise = Nothing
403151
404−elemToOMathRunElems :: NameSpaces -> Element -> Maybe [OMathRunElem]
405−elemToOMathRunElems ns element
406− | isElem ns "w" "r" element
407− || isElem ns "m" "r" element =
408− Just $ mapMaybe (elemToOMathRunElem ns) (elChildren element)
409−elemToOMathRunElems _ _ = Nothing
152+elemToOMathRunElems :: Element -> Maybe [OMathRunElem]
153+elemToOMathRunElems element
154+ | isElem "w" "r" element
155+ || isElem "m" "r" element =
156+ Just $ mapMaybe (elemToOMathRunElem) (elChildren element)
157+elemToOMathRunElems _ = Nothing
410158
411159----- And now the TeXMath Creation
412160
@@ -418,205 +166,264 @@ oMathRunElemToString (Tab) = ['\t']
418166oMathRunElemsToString :: [OMathRunElem] -> String
419167oMathRunElemsToString = concatMap oMathRunElemToString
420168
421−oMathElemToString :: OMathElem -> String
422−oMathElemToString (OMathRun _ oMathRunElems) =
423− oMathRunElemsToString oMathRunElems
424−oMathElemToString _ = ""
425−
426−
427−oMathToExps :: OMath -> [TM.Exp]
428−oMathToExps (OMath oMathElems) = concatMap oMathElemToExps oMathElems
429−
430−oMathElemToExps :: OMathElem -> [TM.Exp]
431−oMathElemToExps (Accent style base) =
432− let baseExp = baseToExp base
433− chr = case accentChar style of
434− Just c -> c
435− Nothing -> '\180' -- default to acute.
436− in
437− [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
438−oMathElemToExps(Bar style base) =
439− let baseExp = baseToExp base
440− in
441− case barPos style of
442− Top -> [TM.EOver False baseExp (TM.ESymbol TM.Accent "\175")]
443− Bottom -> [TM.EUnder False baseExp (TM.ESymbol TM.Accent "\818")]
444−oMathElemToExps (Box base) = [baseToExp base]
445−oMathElemToExps (BorderBox base) =
446− -- TODO: This should be "\\boxed" somehow
447− [baseToExp base]
448−oMathElemToExps (Delimiter dPr bases) =
449− let baseExps = map baseToExp bases
450− inDelimExps = map Right baseExps
451− beg = fromMaybe '(' (delimBegChar dPr)
452− end = fromMaybe ')' (delimEndChar dPr)
453− sep = fromMaybe '|' (delimSepChar dPr)
454− exps = intersperse (Left [sep]) inDelimExps
455− in
456− [TM.EDelimited [beg] [end] exps]
457−oMathElemToExps (EquationArray bases) =
458− let baseExps = map (\b -> [baseToExp' b]) bases
459− in
460− [TM.EArray [] baseExps]
461−oMathElemToExps (Fraction num denom) =
462− let numExp = TM.EGrouped $ concatMap oMathElemToExps num
463− denExp = TM.EGrouped $ concatMap oMathElemToExps denom
464− in
465− [TM.EFraction TM.NormalFrac numExp denExp]
466−oMathElemToExps (Function fname base) =
467− -- We need a string for the fname, but omml gives it to us as a
468− -- series of oMath elems. We're going to filter out the oMathRuns,
469− -- which should work for us most of the time.
470− let fnameString = concatMap oMathElemToString fname
471− baseExp = baseToExp base
472− in
473− [TM.EMathOperator fnameString, baseExp]
474−oMathElemToExps (Group style base)
475− | Just Top <- groupPos style =
476− let baseExp = baseToExp base
477− chr = case groupChr style of
478− Just c -> c
479− Nothing -> '\65079' -- default to overbrace
480− in
481− [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
482− | otherwise =
483− let baseExp = baseToExp base
484− chr = case groupChr style of
485− Just c -> c
486− Nothing -> '\65080' -- default to underbrace
487− in
488− [TM.EUnder False baseExp (TM.ESymbol TM.Accent [chr])]
489−oMathElemToExps (LowerLimit base limElems) = do
490− let baseExp = baseToExp base
491− lim = TM.EGrouped $ concatMap oMathElemToExps limElems
492− in
493− [TM.EUnder True lim baseExp]
494−oMathElemToExps (UpperLimit base limElems) =
495− let baseExp = baseToExp base
496− lim = TM.EGrouped $ concatMap oMathElemToExps limElems
497− in
498− [TM.EOver True lim baseExp]
499−oMathElemToExps (Matrix bases) =
500− let rows = map (map baseToExp') bases
501− in
502− [TM.EArray [TM.AlignCenter] rows]
503−oMathElemToExps (NAry style sub sup base) =
504− let
505− subExps = concatMap oMathElemToExps sub
506− supExps = concatMap oMathElemToExps sup
507− baseExp = baseToExp base
508− opChar = case nAryChar style of
509− Just c -> c
510− -- default to integral
511− Nothing -> '\8747'
512− in [ TM.ESubsup
513− (TM.ESymbol TM.Op [opChar])
514− (TM.EGrouped subExps)
515− (TM.EGrouped supExps)
516− , baseExp]
517−oMathElemToExps (Phantom base) =
518− [TM.EPhantom $ baseToExp base]
519−oMathElemToExps (Radical degree base) =
520− let degExps = concatMap oMathElemToExps degree
521− baseExp = baseToExp base
522− in
523− case degExps of
524− [] -> [TM.ESqrt baseExp]
525− ds -> [TM.ERoot (TM.EGrouped ds) baseExp]
526−oMathElemToExps (PreSubSuper sub sup base) =
527− let subExps = concatMap oMathElemToExps sub
528− supExps = concatMap oMathElemToExps sup
529− baseExp = baseToExp base
530− in [ TM.ESubsup
531− (TM.EIdentifier "") (TM.EGrouped subExps) (TM.EGrouped supExps)
532− , baseExp]
533−oMathElemToExps (Sub base sub) =
534− let baseExp = baseToExp base
535− subExps = concatMap oMathElemToExps sub
536− in
537− [TM.ESub baseExp (TM.EGrouped subExps)]
538−oMathElemToExps (SubSuper base sub sup) =
539− let baseExp = baseToExp base
540− subExps = concatMap oMathElemToExps sub
541− supExps = concatMap oMathElemToExps sup
542− in
543− [TM.ESubsup baseExp (TM.EGrouped subExps) (TM.EGrouped supExps)]
544−oMathElemToExps (Super base sup) =
545− let baseExp = baseToExp base
546− supExps = concatMap oMathElemToExps sup
547− in
548− [TM.ESuper baseExp (TM.EGrouped supExps)]
549−oMathElemToExps (OMathRun sty elems)
550− | NoStyle <- oMathRunTextStyle sty =
551− [TM.EIdentifier $ oMathRunElemsToString elems]
552− | Nothing <- oMathRunStyleToTextType sty =
553− [TM.EIdentifier $ oMathRunElemsToString elems]
554− | Just textType <- oMathRunStyleToTextType sty =
555− if oMathLit sty
556− then [TM.EText textType (oMathRunElemsToString elems)]
557− else [TM.EStyled textType [TM.EIdentifier $ oMathRunElemsToString elems]]
558−oMathElemToExps (OMathRun _ _) = []
559−
560−oMathRunStyleToTextType :: OMathRunStyle -> Maybe TM.TextType
561−oMathRunStyleToTextType mrPr
562− | Normal <- oMathRunTextStyle mrPr =
563− Just $ TM.TextNormal
564− | Styled scr sty <- oMathRunTextStyle mrPr
565− ,Just OBold <- sty
169+oMathRunTextStyleToTextType :: OMathRunTextStyle -> Maybe TM.TextType
170+oMathRunTextStyleToTextType (Normal) = Just $ TM.TextNormal
171+oMathRunTextStyleToTextType (NoStyle) = Nothing
172+oMathRunTextStyleToTextType (Styled scr sty)
173+ | Just OBold <- sty
566174 , Just OSansSerif <- scr =
567175 Just $ TM.TextSansSerifBold
568− | Styled scr sty <- oMathRunTextStyle mrPr
569− , Just OBoldItalic <- sty
176+ | Just OBoldItalic <- sty
570177 , Just OSansSerif <- scr =
571178 Just $ TM.TextSansSerifBoldItalic
572− | Styled scr sty <- oMathRunTextStyle mrPr
573− , Just OBold <- sty
179+ | Just OBold <- sty
574180 , Just OScript <- scr =
575181 Just $ TM.TextBoldScript
576− | Styled scr sty <- oMathRunTextStyle mrPr
577− , Just OBold <- sty
182+ | Just OBold <- sty
578183 , Just OFraktur <- scr =
579184 Just $ TM.TextBoldFraktur
580− | Styled scr sty <- oMathRunTextStyle mrPr
581− , Just OItalic <- sty
185+ | Just OItalic <- sty
582186 , Just OSansSerif <- scr =
583187 Just $ TM.TextSansSerifItalic
584− | Styled _ sty <- oMathRunTextStyle mrPr
585− , Just OBold <- sty =
188+ | Just OBold <- sty =
586189 Just $ TM.TextBold
587− | Styled _ sty <- oMathRunTextStyle mrPr
588− , Just OItalic <- sty =
190+ | Just OItalic <- sty =
589191 Just $ TM.TextItalic
590− | Styled scr _ <- oMathRunTextStyle mrPr
591− , Just OMonospace <- scr =
192+ | Just OMonospace <- scr =
592193 Just $ TM.TextMonospace
593− | Styled scr _ <- oMathRunTextStyle mrPr
594− , Just OSansSerif <- scr =
194+ | Just OSansSerif <- scr =
595195 Just $ TM.TextSansSerif
596− | Styled scr _ <- oMathRunTextStyle mrPr
597− , Just ODoubleStruck <- scr =
196+ | Just ODoubleStruck <- scr =
598197 Just $ TM.TextDoubleStruck
599− | Styled scr _ <- oMathRunTextStyle mrPr
600− , Just OScript <- scr =
198+ | Just OScript <- scr =
601199 Just $ TM.TextDoubleStruck
602− | Styled scr _ <- oMathRunTextStyle mrPr
603− , Just OFraktur <- scr =
200+ | Just OFraktur <- scr =
604201 Just $ TM.TextFraktur
605− | Styled _ sty <- oMathRunTextStyle mrPr
606− , Just OBoldItalic <- sty =
202+ | Just OBoldItalic <- sty =
607203 Just $ TM.TextBoldItalic
608204 | otherwise = Nothing
609205
610206
611−
612−baseToExp :: Base -> TM.Exp
613−baseToExp b = TM.EGrouped $ baseToExp' b
614−
615−-- an ungrouped version of baseToExp
616−baseToExp' :: Base -> [TM.Exp]
617−baseToExp' (Base mathElems) =
618− concatMap oMathElemToExps mathElems
619−
620−elemToExps :: NameSpaces -> Element -> Maybe [TM.Exp]
621−elemToExps ns element = oMathToExps <$> (elemToMath ns element)
622−
207+elemToExps' :: Element -> Maybe [TM.Exp]
208+elemToExps' element | isElem "m" "acc" element = do
209+ let chr = filterChildName (hasElemName "m" "accPr") element >>=
210+ filterChildName (hasElemName "m" "chr") >>=
211+ findAttrBy (hasElemName "m" "val") >>=
212+ Just . head
213+ chr' = case chr of
214+ Just c -> c
215+ Nothing -> '\180' -- default to acute.
216+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
217+ elemToBase
218+ return $ [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr'])]
219+elemToExps' element | isElem "m" "bar" element = do
220+ pos <- filterChildName (hasElemName "m" "barPr") element >>=
221+ filterChildName (hasElemName "m" "pos") >>=
222+ findAttrBy (hasElemName "m" "val")
223+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
224+ elemToBase
225+ case pos of
226+ "top" -> Just [TM.EOver False baseExp (TM.ESymbol TM.Accent "\175")]
227+ "bot" -> Just [TM.EUnder False baseExp (TM.ESymbol TM.Accent "\818")]
228+ _ -> Nothing
229+elemToExps' element | isElem "m" "box" element = do
230+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
231+ elemToBase
232+ return [baseExp]
233+elemToExps' element | isElem "m" "borderBox" element = do
234+ -- TODO: This needs to be "\\boxed" somehow.
235+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
236+ elemToBase
237+ return [baseExp]
238+elemToExps' element | isElem "m" "d" element =
239+ let baseExps = mapMaybe
240+ elemToBase
241+ (elChildren element)
242+ inDelimExps = map Right baseExps
243+ dPr = filterChildName (hasElemName "m" "dPr") element
244+ begChr = dPr >>=
245+ filterChildName (hasElemName "m" "begChr") >>=
246+ findAttrBy (hasElemName "m" "val") >>=
247+ (\c -> if null c then (Just ' ') else (Just $ head c))
248+ sepChr = dPr >>=
249+ filterChildName (hasElemName "m" "sepChr") >>=
250+ findAttrBy (hasElemName "m" "val") >>=
251+ (\c -> if null c then (Just ' ') else (Just $ head c))
252+ endChr = dPr >>=
253+ filterChildName (hasElemName "m" "endChr") >>=
254+ findAttrBy (hasElemName "m" "val") >>=
255+ (\c -> if null c then (Just ' ') else (Just $ head c))
256+ beg = fromMaybe '(' begChr
257+ end = fromMaybe ')' endChr
258+ sep = fromMaybe '|' sepChr
259+ exps = intersperse (Left [sep]) inDelimExps
260+ in
261+ Just [TM.EDelimited [beg] [end] exps]
262+elemToExps' element | isElem "m" "eqArr" element =
263+ let expLst = mapMaybe elemToBases (elChildren element)
264+ expLst' = map (\es -> [map filterAmpersand es]) expLst
265+ in
266+ return [TM.EArray [] expLst']
267+elemToExps' element | isElem "m" "f" element = do
268+ num <- filterChildName (hasElemName "m" "num") element
269+ den <- filterChildName (hasElemName "m" "den") element
270+ let numExp = TM.EGrouped $ concat $ mapMaybe (elemToExps') (elChildren num)
271+ denExp = TM.EGrouped $ concat $ mapMaybe (elemToExps') (elChildren den)
272+ return $ [TM.EFraction TM.NormalFrac numExp denExp]
273+elemToExps' element | isElem "m" "func" element = do
274+ fName <- filterChildName (hasElemName "m" "fName") element
275+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
276+ elemToBase
277+ -- We need a string for the fname, but omml gives it to us as a
278+ -- series of oMath elems. We're going to filter out the oMathRuns,
279+ -- which should work for us most of the time.
280+ let fnameString = concatMap expToString $
281+ concat $ mapMaybe (elemToExps') (elChildren fName)
282+ return [TM.EMathOperator fnameString, baseExp]
283+elemToExps' element | isElem "m" "groupChr" element = do
284+ let gPr = filterChildName (hasElemName "m" "groupChrPr") element
285+ chr = gPr >>=
286+ filterChildName (hasElemName "m" "chr") >>=
287+ findAttrBy (hasElemName "m" "val")
288+ pos = gPr >>=
289+ filterChildName (hasElemName "m" "pos") >>=
290+ findAttrBy (hasElemName "m" "val")
291+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
292+ elemToBase
293+ case pos of
294+ Just "top" ->
295+ let chr' = case chr of
296+ Just (c:_) -> c
297+ _ -> '\65079' -- default to overbrace
298+ in
299+ return [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr'])]
300+ Just "bot" ->
301+ let chr' = case chr of
302+ Just (c:_) -> c
303+ _ -> '\65080' -- default to underbrace
304+ in
305+ return [TM.EUnder False baseExp (TM.ESymbol TM.Accent [chr'])]
306+ _ -> Nothing
307+elemToExps' element | isElem "m" "limLow" element = do
308+ baseExp <- filterChildName (hasElemName "m" "e") element
309+ >>= elemToBase
310+ limExp <- filterChildName (hasElemName "m" "lim") element
311+ >>= (\e -> Just $ concat $ mapMaybe (elemToExps') (elChildren e))
312+ >>= (return . TM.EGrouped)
313+ return [TM.EUnder True limExp baseExp]
314+elemToExps' element | isElem "m" "limUpp" element = do
315+ baseExp <- filterChildName (hasElemName "m" "e") element
316+ >>= elemToBase
317+ limExp <- filterChildName (hasElemName "m" "lim") element
318+ >>= (\e -> Just $ concat $ mapMaybe (elemToExps') (elChildren e))
319+ >>= (return . TM.EGrouped)
320+ return [TM.EOver True limExp baseExp]
321+elemToExps' element | isElem "m" "m" element =
322+ let rows = filterChildrenName (hasElemName "m" "mr") element
323+ rowExps = map
324+ (\mr -> mapMaybe
325+ elemToBases
326+ (elChildren mr))
327+ rows
328+ in
329+ return [TM.EArray [TM.AlignCenter] rowExps]
330+elemToExps' element | isElem "m" "nary" element = do
331+ let naryPr = filterChildName (hasElemName "m" "naryPr") element
332+ naryChr = naryPr >>=
333+ filterChildName (hasElemName "m" "chr") >>=
334+ findAttrBy (hasElemName "m" "val")
335+ opChr = case naryChr of
336+ Just (c:_) -> c
337+ _ -> '\8747' -- default to integral
338+ limLoc = naryPr >>=
339+ filterChildName (hasElemName "m" "limLoc") >>=
340+ findAttrBy (hasElemName "m" "val")
341+ subExps <- filterChildName (hasElemName "m" "sub") element >>=
342+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
343+ supExps <- filterChildName (hasElemName "m" "sup") element >>=
344+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
345+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
346+ elemToBase
347+ case limLoc of
348+ Just "undOvr" -> return [TM.EUnderover True
349+ (TM.ESymbol TM.Op [opChr])
350+ (TM.EGrouped subExps)
351+ (TM.EGrouped supExps)
352+ , baseExp]
353+ _ -> return [TM.ESubsup
354+ (TM.ESymbol TM.Op [opChr])
355+ (TM.EGrouped subExps)
356+ (TM.EGrouped supExps)
357+ , baseExp]
358+
359+elemToExps' element | isElem "m" "phant" element = do
360+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
361+ elemToBase
362+ return [TM.EPhantom baseExp]
363+elemToExps' element | isElem "m" "rad" element = do
364+ degExps <- filterChildName (hasElemName "m" "deg") element >>=
365+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
366+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
367+ elemToBase
368+ return $ case degExps of
369+ [] -> [TM.ESqrt baseExp]
370+ ds -> [TM.ERoot (TM.EGrouped ds) baseExp]
371+elemToExps' element | isElem "m" "sPre" element = do
372+ subExps <- filterChildName (hasElemName "m" "sub") element >>=
373+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
374+ supExps <- filterChildName (hasElemName "m" "sup") element >>=
375+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
376+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
377+ elemToBase
378+ return [TM.ESubsup
379+ (TM.EIdentifier "")
380+ (TM.EGrouped subExps)
381+ (TM.EGrouped supExps)
382+ , baseExp]
383+elemToExps' element | isElem "m" "sSub" element = do
384+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
385+ elemToBase
386+ subExps <- filterChildName (hasElemName "m" "sub") element >>=
387+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
388+ return [TM.ESub baseExp (TM.EGrouped subExps)]
389+elemToExps' element | isElem "m" "sSubSup" element = do
390+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
391+ elemToBase
392+ subExps <- filterChildName (hasElemName "m" "sub") element >>=
393+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
394+ supExps <- filterChildName (hasElemName "m" "sup") element >>=
395+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
396+ return [TM.ESubsup baseExp (TM.EGrouped subExps) (TM.EGrouped supExps)]
397+elemToExps' element | isElem "m" "sSup" element = do
398+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
399+ elemToBase
400+ supExps <- filterChildName (hasElemName "m" "sup") element >>=
401+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
402+ return [TM.ESuper baseExp (TM.EGrouped supExps)]
403+elemToExps' element | isElem "m" "r" element = do
404+ let mrPr = filterChildName (hasElemName "m" "rPr") element
405+ lit = mrPr >>=
406+ filterChildName (hasElemName "m" "lit") >>=
407+ findAttrBy (hasElemName "m" "val")
408+ txtSty = elemToOMathRunTextStyle element
409+ mrElems <- elemToOMathRunElems element
410+ return $ case oMathRunTextStyleToTextType txtSty of
411+ Nothing -> [TM.EIdentifier $ oMathRunElemsToString mrElems]
412+ Just textType ->
413+ case lit of
414+ Just "on" ->
415+ [TM.EText textType (oMathRunElemsToString mrElems)]
416+ _ ->
417+ [TM.EStyled textType [TM.EIdentifier $ oMathRunElemsToString mrElems]]
418+elemToExps' _ = Nothing
419+
420+
421+expToString :: TM.Exp -> String
422+expToString (TM.ENumber s) = s
423+expToString (TM.EIdentifier s) = s
424+expToString (TM.EMathOperator s) = s
425+expToString (TM.ESymbol _ s) = s
426+expToString (TM.EText _ s) = s
427+expToString (TM.EGrouped exps) = concatMap expToString exps
428+expToString (TM.EStyled _ exps) = concatMap expToString exps
429+expToString _ = ""