git.iko.soy/typeable/pandoc
on master help sign in
OMath module: Add new file.
d293dd5Jesse Rosenthal
src/Text/Pandoc/Readers/Docx/OMath.hsnew file+622
compare with master
unifiedsplit
@@ -0,0 +1,622 @@
1+{-# LANGUAGE PatternGuards #-}
2+
3+{-
4+Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu>
5+
6+This program is free software; you can redistribute it and/or modify
7+it under the terms of the GNU General Public License as published by
8+the Free Software Foundation; either version 2 of the License, or
9+(at your option) any later version.
10+
11+This program is distributed in the hope that it will be useful,
12+but WITHOUT ANY WARRANTY; without even the implied warranty of
13+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14+GNU General Public License for more details.
15+
16+You should have received a copy of the GNU General Public License
17+along with this program; if not, write to the Free Software
18+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19+-}
20+
21+{- |
22+ Module : Text.Pandoc.Readers.Docx.Math
23+ Copyright : Copyright (C) 2014 Jesse Rosenthal
24+ License : GNU GPL, version 2 or above
25+
26+ Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>
27+ Stability : alpha
28+ Portability : portable
29+
30+Types and functions for conversion of OMML into TeXMath.
31+-}
32+
33+module Text.Pandoc.Readers.Docx.OMath ( elemToExps
34+ ) where
35+
36+import Text.XML.Light
37+import Data.Maybe (mapMaybe, fromMaybe)
38+import Data.List (intersperse)
39+import 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
77+
78+data OMathRunElem = TextRun String
79+ | LnBrk
80+ | Tab
81+ deriving Show
82+
83+data Base = Base [OMathElem]
84+ deriving Show
85+
86+data TopBottom = Top | Bottom
87+ deriving Show
88+
89+data AccentStyle = AccentStyle { accentChar :: Maybe Char }
90+ deriving Show
91+
92+data BarStyle = BarStyle { barPos :: TopBottom}
93+ deriving Show
94+
95+data NAryStyle = NAryStyle { nAryChar :: Maybe Char
96+ , nAryLimLoc :: LimLoc}
97+ deriving Show
98+
99+data OMathRunStyle = OMathRunStyle { oMathLit :: Bool
100+ , oMathRunTextStyle :: OMathRunTextStyle }
101+ deriving Show
102+
103+data OMathRunTextStyle = NoStyle
104+ | Normal
105+ | Styled { oMathScript :: Maybe OMathTextScript
106+ , oMathStyle :: Maybe OMathTextStyle }
107+ deriving Show
108+
109+data OMathTextScript = ORoman
110+ | OScript
111+ | OFraktur
112+ | ODoubleStruck
113+ | OSansSerif
114+ | OMonospace
115+ deriving (Show, Eq)
116+
117+data OMathTextStyle = OPlain
118+ | OBold
119+ | OItalic
120+ | OBoldItalic
121+ deriving (Show, Eq)
122+
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}
145+
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
150+
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
155+
156+-- TODO: The right way to do this is to use the ampersand to break the
157+-- text lines into multiple columns. That's tricky, though, and this
158+-- 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 =
193+ Normal
194+ | Just mrPr <- findChild (elemName ns "m" "rPr") element =
195+ let scr =
196+ case
197+ findChild (elemName ns "m" "scr") mrPr >>=
198+ findAttr (elemName ns "m" "val")
199+ of
200+ Just "roman" -> Just ORoman
201+ Just "script" -> Just OScript
202+ Just "fraktur" -> Just OFraktur
203+ Just "double-struck" -> Just ODoubleStruck
204+ Just "sans-serif" -> Just OSansSerif
205+ Just "monospace" -> Just OMonospace
206+ _ -> Nothing
207+
208+ sty =
209+ case
210+ findChild (elemName ns "m" "sty") mrPr >>=
211+ findAttr (elemName ns "m" "val")
212+ of
213+ Just "p" -> Just OPlain
214+ Just "b" -> Just OBold
215+ Just "i" -> Just OItalic
216+ Just "bi" -> Just OBoldItalic
217+ _ -> Nothing
218+ in
219+ Styled { oMathScript = scr, oMathStyle = sty }
220+ | otherwise = NoStyle
221+
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
402+ | otherwise = Nothing
403+
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
410+
411+----- And now the TeXMath Creation
412+
413+oMathRunElemToString :: OMathRunElem -> String
414+oMathRunElemToString (TextRun s) = s
415+oMathRunElemToString (LnBrk) = ['\n']
416+oMathRunElemToString (Tab) = ['\t']
417+
418+oMathRunElemsToString :: [OMathRunElem] -> String
419+oMathRunElemsToString = concatMap oMathRunElemToString
420+
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
566+ , Just OSansSerif <- scr =
567+ Just $ TM.TextSansSerifBold
568+ | Styled scr sty <- oMathRunTextStyle mrPr
569+ , Just OBoldItalic <- sty
570+ , Just OSansSerif <- scr =
571+ Just $ TM.TextSansSerifBoldItalic
572+ | Styled scr sty <- oMathRunTextStyle mrPr
573+ , Just OBold <- sty
574+ , Just OScript <- scr =
575+ Just $ TM.TextBoldScript
576+ | Styled scr sty <- oMathRunTextStyle mrPr
577+ , Just OBold <- sty
578+ , Just OFraktur <- scr =
579+ Just $ TM.TextBoldFraktur
580+ | Styled scr sty <- oMathRunTextStyle mrPr
581+ , Just OItalic <- sty
582+ , Just OSansSerif <- scr =
583+ Just $ TM.TextSansSerifItalic
584+ | Styled _ sty <- oMathRunTextStyle mrPr
585+ , Just OBold <- sty =
586+ Just $ TM.TextBold
587+ | Styled _ sty <- oMathRunTextStyle mrPr
588+ , Just OItalic <- sty =
589+ Just $ TM.TextItalic
590+ | Styled scr _ <- oMathRunTextStyle mrPr
591+ , Just OMonospace <- scr =
592+ Just $ TM.TextMonospace
593+ | Styled scr _ <- oMathRunTextStyle mrPr
594+ , Just OSansSerif <- scr =
595+ Just $ TM.TextSansSerif
596+ | Styled scr _ <- oMathRunTextStyle mrPr
597+ , Just ODoubleStruck <- scr =
598+ Just $ TM.TextDoubleStruck
599+ | Styled scr _ <- oMathRunTextStyle mrPr
600+ , Just OScript <- scr =
601+ Just $ TM.TextDoubleStruck
602+ | Styled scr _ <- oMathRunTextStyle mrPr
603+ , Just OFraktur <- scr =
604+ Just $ TM.TextFraktur
605+ | Styled _ sty <- oMathRunTextStyle mrPr
606+ , Just OBoldItalic <- sty =
607+ Just $ TM.TextBoldItalic
608+ | otherwise = Nothing
609+
610+
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+