git.iko.soy/typeable/pandoc
on master help sign in
Merge pull request #1502 from jkr/streamlineMath
e5fb97fJohn MacFarlane
src/Text/Pandoc/Readers/Docx/OMath.hs+301−494
compare with master
unifiedsplit
@@ -30,75 +30,38 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
30Types and functions for conversion of OMML into TeXMath.
30Types and functions for conversion of OMML into TeXMath.
31-}
31-}
32
32
33−module Text.Pandoc.Readers.Docx.OMath ( elemToExps
33+module Text.Pandoc.Readers.Docx.OMath (readOMML
34 ) where
34 ) where
35
35
36import Text.XML.Light
36import Text.XML.Light
37import Data.Maybe (mapMaybe, fromMaybe)
37import Data.Maybe (mapMaybe, fromMaybe)
38import Data.List (intersperse)
38import Data.List (intersperse)
39import qualified Text.TeXMath.Types as TM
39import 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
40
78−data OMathRunElem = TextRun String
41+readOMML :: Element -> Maybe [TM.Exp]
79− | LnBrk
42+readOMML element | isElem "m" "oMath" element =
80− | Tab
43+ Just $ concat $ mapMaybe (elemToExps') (elChildren element)
81− deriving Show
44+readOMML _ = Nothing
82−
83−data Base = Base [OMathElem]
84− deriving Show
85
45
86−data TopBottom = Top | Bottom
87− deriving Show
88
46
89−data AccentStyle = AccentStyle { accentChar :: Maybe Char }
47+isElem :: String -> String -> Element -> Bool
90− deriving Show
48+isElem prefix name element =
91−
49+ let qp = fromMaybe "" (qPrefix (elName element))
92−data BarStyle = BarStyle { barPos :: TopBottom}
50+ in
93− deriving Show
51+ qName (elName element) == name &&
52+ qp == prefix
94
53
95−data NAryStyle = NAryStyle { nAryChar :: Maybe Char
54+hasElemName:: String -> String -> QName -> Bool
96− , nAryLimLoc :: LimLoc}
55+hasElemName prefix name qn =
97− deriving Show
56+ let qp = fromMaybe "" (qPrefix qn)
57+ in
58+ qName qn == name &&
59+ qp == prefix
98
60
99−data OMathRunStyle = OMathRunStyle { oMathLit :: Bool
61+data OMathRunElem = TextRun String
100− , oMathRunTextStyle :: OMathRunTextStyle }
62+ | LnBrk
63+ | Tab
101− deriving Show
64+ deriving Show
102
65
103data OMathRunTextStyle = NoStyle
66data OMathRunTextStyle = NoStyle
104 | Normal
67 | Normal
@@ -120,82 +83,40 @@ data OMathTextStyle = OPlain
120 | OBoldItalic
83 | OBoldItalic
121 deriving (Show, Eq)
84 deriving (Show, Eq)
122
85
123−defaultNAryStyle :: NAryStyle
86+elemToBase :: Element -> Maybe TM.Exp
124−defaultNAryStyle = NAryStyle { nAryChar = Nothing -- integral, in practice
87+elemToBase element | isElem "m" "e" element = do
125− , nAryLimLoc = SubSup }
88+ bs <- elemToBases element
126−
89+ return $ case bs of
127−data LimLoc = SubSup | UnderOver deriving Show
90+ (e : []) -> e
128−
91+ exps -> TM.EGrouped exps
129−data DelimStyle = DelimStyle { delimBegChar :: Maybe Char
92+elemToBase _ = Nothing
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
93
146−elemToMath :: NameSpaces -> Element -> Maybe OMath
94+elemToBases :: Element -> Maybe [TM.Exp]
147−elemToMath ns element | isElem ns "m" "oMath" element =
95+elemToBases element | isElem "m" "e" element =
148− Just $ OMath $ mapMaybe (elemToMathElem ns) (elChildren element)
96+ return $ concat $ mapMaybe elemToExps' (elChildren element)
149−elemToMath _ _ = Nothing
97+elemToBases _ = Nothing
150
98
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
99
156-- TODO: The right way to do this is to use the ampersand to break the
100-- 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
101-- text lines into multiple columns. That's tricky, though, and this
158-- will get us most of the way for the time being.
102-- will get us most of the way for the time being.
159−filterAmpersand :: OMathElem -> OMathElem
103+filterAmpersand :: TM.Exp -> TM.Exp
160−filterAmpersand (OMathRun mrPr elems) =
104+filterAmpersand (TM.EIdentifier s) = TM.EIdentifier (filter ('&' /=) s)
161− let f (TextRun s) = TextRun $ filter ('&' /=) s
105+filterAmpersand (TM.EText tt s) = TM.EText tt (filter ('&' /=) s)
162− f re = re
106+filterAmpersand (TM.EStyled tt exps) = TM.EStyled tt (map filterAmpersand exps)
163− in
107+filterAmpersand (TM.EGrouped exps) = TM.EGrouped (map filterAmpersand exps)
164− OMathRun mrPr (map f elems)
108+filterAmpersand e = e
165−filterAmpersand e = e
109+
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
110+elemToOMathRunTextStyle :: Element -> OMathRunTextStyle
190−elemToOMathRunTextStyle ns element
111+elemToOMathRunTextStyle element
191− | Just mrPr <- findChild (elemName ns "m" "rPr") element
112+ | Just mrPr <- filterChildName (hasElemName"m" "rPr") element
192− , Just _ <- findChild (elemName ns "m" "nor") mrPr =
113+ , Just _ <- filterChildName (hasElemName"m" "nor") mrPr =
193 Normal
114 Normal
194− | Just mrPr <- findChild (elemName ns "m" "rPr") element =
115+ | Just mrPr <- filterChildName (hasElemName"m" "rPr") element =
195 let scr =
116 let scr =
196 case
117 case
197− findChild (elemName ns "m" "scr") mrPr >>=
118+ filterChildName (hasElemName"m" "scr") mrPr >>=
198− findAttr (elemName ns "m" "val")
119+ findAttrBy (hasElemName"m" "val")
199 of
120 of
200 Just "roman" -> Just ORoman
121 Just "roman" -> Just ORoman
201 Just "script" -> Just OScript
122 Just "script" -> Just OScript
@@ -207,8 +128,8 @@ elemToOMathRunTextStyle ns element
207
128
208 sty =
129 sty =
209 case
130 case
210− findChild (elemName ns "m" "sty") mrPr >>=
131+ filterChildName (hasElemName"m" "sty") mrPr >>=
211− findAttr (elemName ns "m" "val")
132+ findAttrBy (hasElemName"m" "val")
212 of
133 of
213 Just "p" -> Just OPlain
134 Just "p" -> Just OPlain
214 Just "b" -> Just OBold
135 Just "b" -> Just OBold
@@ -219,194 +140,21 @@ elemToOMathRunTextStyle ns element
219 Styled { oMathScript = scr, oMathStyle = sty }
140 Styled { oMathScript = scr, oMathStyle = sty }
220 | otherwise = NoStyle
141 | otherwise = NoStyle
221
142
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
143+elemToOMathRunElem :: Element -> Maybe OMathRunElem
396−elemToOMathRunElem ns element
144+elemToOMathRunElem element
397− | isElem ns "w" "t" element
145+ | isElem "w" "t" element
398− || isElem ns "m" "t" element
146+ || isElem "m" "t" element
399− || isElem ns "w" "delText" element = Just $ TextRun $ strContent element
147+ || isElem "w" "delText" element = Just $ TextRun $ strContent element
400− | isElem ns "w" "br" element = Just LnBrk
148+ | isElem "w" "br" element = Just LnBrk
401− | isElem ns "w" "tab" element = Just Tab
149+ | isElem "w" "tab" element = Just Tab
402 | otherwise = Nothing
150 | otherwise = Nothing
403
151
404−elemToOMathRunElems :: NameSpaces -> Element -> Maybe [OMathRunElem]
152+elemToOMathRunElems :: Element -> Maybe [OMathRunElem]
405−elemToOMathRunElems ns element
153+elemToOMathRunElems element
406− | isElem ns "w" "r" element
154+ | isElem "w" "r" element
407− || isElem ns "m" "r" element =
155+ || isElem "m" "r" element =
408− Just $ mapMaybe (elemToOMathRunElem ns) (elChildren element)
156+ Just $ mapMaybe (elemToOMathRunElem) (elChildren element)
409−elemToOMathRunElems _ _ = Nothing
157+elemToOMathRunElems _ = Nothing
410
158
411----- And now the TeXMath Creation
159----- And now the TeXMath Creation
412
160
@@ -418,205 +166,264 @@ oMathRunElemToString (Tab) = ['\t']
418oMathRunElemsToString :: [OMathRunElem] -> String
166oMathRunElemsToString :: [OMathRunElem] -> String
419oMathRunElemsToString = concatMap oMathRunElemToString
167oMathRunElemsToString = concatMap oMathRunElemToString
420
168
421−oMathElemToString :: OMathElem -> String
169+oMathRunTextStyleToTextType :: OMathRunTextStyle -> Maybe TM.TextType
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
170+oMathRunTextStyleToTextType (Normal) = Just $ TM.TextNormal
564− | Styled scr sty <- oMathRunTextStyle mrPr
171+oMathRunTextStyleToTextType (NoStyle) = Nothing
172+oMathRunTextStyleToTextType (Styled scr sty)
565− ,Just OBold <- sty
173+ | Just OBold <- sty
566 , Just OSansSerif <- scr =
174 , Just OSansSerif <- scr =
567 Just $ TM.TextSansSerifBold
175 Just $ TM.TextSansSerifBold
568− | Styled scr sty <- oMathRunTextStyle mrPr
569− , Just OBoldItalic <- sty
176+ | Just OBoldItalic <- sty
570 , Just OSansSerif <- scr =
177 , Just OSansSerif <- scr =
571 Just $ TM.TextSansSerifBoldItalic
178 Just $ TM.TextSansSerifBoldItalic
572− | Styled scr sty <- oMathRunTextStyle mrPr
573− , Just OBold <- sty
179+ | Just OBold <- sty
574 , Just OScript <- scr =
180 , Just OScript <- scr =
575 Just $ TM.TextBoldScript
181 Just $ TM.TextBoldScript
576− | Styled scr sty <- oMathRunTextStyle mrPr
577− , Just OBold <- sty
182+ | Just OBold <- sty
578 , Just OFraktur <- scr =
183 , Just OFraktur <- scr =
579 Just $ TM.TextBoldFraktur
184 Just $ TM.TextBoldFraktur
580− | Styled scr sty <- oMathRunTextStyle mrPr
581− , Just OItalic <- sty
185+ | Just OItalic <- sty
582 , Just OSansSerif <- scr =
186 , Just OSansSerif <- scr =
583 Just $ TM.TextSansSerifItalic
187 Just $ TM.TextSansSerifItalic
584− | Styled _ sty <- oMathRunTextStyle mrPr
585− , Just OBold <- sty =
188+ | Just OBold <- sty =
586 Just $ TM.TextBold
189 Just $ TM.TextBold
587− | Styled _ sty <- oMathRunTextStyle mrPr
588− , Just OItalic <- sty =
190+ | Just OItalic <- sty =
589 Just $ TM.TextItalic
191 Just $ TM.TextItalic
590− | Styled scr _ <- oMathRunTextStyle mrPr
591− , Just OMonospace <- scr =
192+ | Just OMonospace <- scr =
592 Just $ TM.TextMonospace
193 Just $ TM.TextMonospace
593− | Styled scr _ <- oMathRunTextStyle mrPr
594− , Just OSansSerif <- scr =
194+ | Just OSansSerif <- scr =
595 Just $ TM.TextSansSerif
195 Just $ TM.TextSansSerif
596− | Styled scr _ <- oMathRunTextStyle mrPr
597− , Just ODoubleStruck <- scr =
196+ | Just ODoubleStruck <- scr =
598 Just $ TM.TextDoubleStruck
197 Just $ TM.TextDoubleStruck
599− | Styled scr _ <- oMathRunTextStyle mrPr
600− , Just OScript <- scr =
198+ | Just OScript <- scr =
601 Just $ TM.TextDoubleStruck
199 Just $ TM.TextDoubleStruck
602− | Styled scr _ <- oMathRunTextStyle mrPr
603− , Just OFraktur <- scr =
200+ | Just OFraktur <- scr =
604 Just $ TM.TextFraktur
201 Just $ TM.TextFraktur
605− | Styled _ sty <- oMathRunTextStyle mrPr
606− , Just OBoldItalic <- sty =
202+ | Just OBoldItalic <- sty =
607 Just $ TM.TextBoldItalic
203 Just $ TM.TextBoldItalic
608 | otherwise = Nothing
204 | otherwise = Nothing
609
205
610
206
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]
207+elemToExps' :: Element -> Maybe [TM.Exp]
621−elemToExps ns element = oMathToExps <$> (elemToMath ns element)
208+elemToExps' element | isElem "m" "acc" element = do
622−
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 _ = ""
src/Text/Pandoc/Readers/Docx/Parse.hs+4−14
@@ -61,7 +61,7 @@ import qualified Text.Pandoc.UTF8 as UTF8
61import Control.Monad.Reader
61import Control.Monad.Reader
62import qualified Data.Map as M
62import qualified Data.Map as M
63import Text.Pandoc.Compat.Except
63import Text.Pandoc.Compat.Except
64−import Text.Pandoc.Readers.Docx.OMath (elemToExps)
64+import Text.Pandoc.Readers.Docx.OMath (readOMML)
65import Text.TeXMath (Exp)
65import Text.TeXMath (Exp)
66
66
67data ReaderEnv = ReaderEnv { envNotes :: Notes
67data ReaderEnv = ReaderEnv { envNotes :: Notes
@@ -475,7 +475,7 @@ elemToBodyPart ns element
475 | isElem ns "w" "p" element
475 | isElem ns "w" "p" element
476 , (c:_) <- findChildren (elemName ns "m" "oMathPara") element =
476 , (c:_) <- findChildren (elemName ns "m" "oMathPara") element =
477 do
477 do
478− expsLst <- mapD (\e -> (maybeToD $ elemToExps ns e)) (elChildren c)
478+ expsLst <- mapD (\e -> (maybeToD $ readOMML e)) (elChildren c)
479 return $ OMathPara expsLst
479 return $ OMathPara expsLst
480elemToBodyPart ns element
480elemToBodyPart ns element
481 | isElem ns "w" "p" element
481 | isElem ns "w" "p" element
@@ -574,8 +574,8 @@ elemToParPart ns element
574 Just target -> ExternalHyperLink target runs
574 Just target -> ExternalHyperLink target runs
575 Nothing -> ExternalHyperLink "" runs
575 Nothing -> ExternalHyperLink "" runs
576elemToParPart ns element
576elemToParPart ns element
577− | isElem ns "m" "oMath" element =
577+ | isElem ns "m" "oMath" element =
578− (maybeToD $ elemToExps ns element) >>= (return . PlainOMath)
578+ (maybeToD $ readOMML element) >>= (return . PlainOMath)
579elemToParPart _ _ = throwError WrongElem
579elemToParPart _ _ = throwError WrongElem
580
580
581lookupFootnote :: String -> Notes -> Maybe Element
581lookupFootnote :: String -> Notes -> Maybe Element
@@ -677,13 +677,3 @@ elemToRunElems ns element
677 || isElem ns "m" "r" element =
677 || isElem ns "m" "r" element =
678 mapD (elemToRunElem ns) (elChildren element)
678 mapD (elemToRunElem ns) (elChildren element)
679elemToRunElems _ _ = throwError WrongElem
679elemToRunElems _ _ = throwError WrongElem
680−
681−
682−
683−
684−
685−
686−
687−
688−
689−