@@ -1,438 +0,0 @@
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 (readOMML
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−
41−readOMML :: String -> Either String [TM.Exp]
42−readOMML s | Just e <- parseXMLDoc s =
43− case elemToOMML e of
44− Just exs -> Right exs
45− Nothing -> Left "xml file was not an <m:oMathPara> or <m:oMath> element."
46−readOMML _ = Left "Couldn't parse OMML file"
47−
48−elemToOMML :: Element -> Maybe [TM.Exp]
49−elemToOMML element | isElem "m" "oMathPara" element = do
50− let expList = mapMaybe elemToOMML (elChildren element)
51− return $ map (\l -> if length l == 1 then (head l) else TM.EGrouped l) expList
52−elemToOMML element | isElem "m" "oMath" element =
53− Just $ concat $ mapMaybe (elemToExps') (elChildren element)
54−elemToOMML _ = Nothing
55−
56−isElem :: String -> String -> Element -> Bool
57−isElem prefix name element =
58− let qp = fromMaybe "" (qPrefix (elName element))
59− in
60− qName (elName element) == name &&
61− qp == prefix
62−
63−hasElemName:: String -> String -> QName -> Bool
64−hasElemName prefix name qn =
65− let qp = fromMaybe "" (qPrefix qn)
66− in
67− qName qn == name &&
68− qp == prefix
69−
70−data OMathRunElem = TextRun String
71− | LnBrk
72− | Tab
73− deriving Show
74−
75−data OMathRunTextStyle = NoStyle
76− | Normal
77− | Styled { oMathScript :: Maybe OMathTextScript
78− , oMathStyle :: Maybe OMathTextStyle }
79− deriving Show
80−
81−data OMathTextScript = ORoman
82− | OScript
83− | OFraktur
84− | ODoubleStruck
85− | OSansSerif
86− | OMonospace
87− deriving (Show, Eq)
88−
89−data OMathTextStyle = OPlain
90− | OBold
91− | OItalic
92− | OBoldItalic
93− deriving (Show, Eq)
94−
95−elemToBase :: Element -> Maybe TM.Exp
96−elemToBase element | isElem "m" "e" element = do
97− bs <- elemToBases element
98− return $ case bs of
99− (e : []) -> e
100− exps -> TM.EGrouped exps
101−elemToBase _ = Nothing
102−
103−elemToBases :: Element -> Maybe [TM.Exp]
104−elemToBases element | isElem "m" "e" element =
105− return $ concat $ mapMaybe elemToExps' (elChildren element)
106−elemToBases _ = Nothing
107−
108−
109−-- TODO: The right way to do this is to use the ampersand to break the
110−-- text lines into multiple columns. That's tricky, though, and this
111−-- will get us most of the way for the time being.
112−filterAmpersand :: TM.Exp -> TM.Exp
113−filterAmpersand (TM.EIdentifier s) = TM.EIdentifier (filter ('&' /=) s)
114−filterAmpersand (TM.EText tt s) = TM.EText tt (filter ('&' /=) s)
115−filterAmpersand (TM.EStyled tt exps) = TM.EStyled tt (map filterAmpersand exps)
116−filterAmpersand (TM.EGrouped exps) = TM.EGrouped (map filterAmpersand exps)
117−filterAmpersand e = e
118−
119−elemToOMathRunTextStyle :: Element -> OMathRunTextStyle
120−elemToOMathRunTextStyle element
121− | Just mrPr <- filterChildName (hasElemName"m" "rPr") element
122− , Just _ <- filterChildName (hasElemName"m" "nor") mrPr =
123− Normal
124− | Just mrPr <- filterChildName (hasElemName"m" "rPr") element =
125− let scr =
126− case
127− filterChildName (hasElemName"m" "scr") mrPr >>=
128− findAttrBy (hasElemName"m" "val")
129− of
130− Just "roman" -> Just ORoman
131− Just "script" -> Just OScript
132− Just "fraktur" -> Just OFraktur
133− Just "double-struck" -> Just ODoubleStruck
134− Just "sans-serif" -> Just OSansSerif
135− Just "monospace" -> Just OMonospace
136− _ -> Nothing
137−
138− sty =
139− case
140− filterChildName (hasElemName"m" "sty") mrPr >>=
141− findAttrBy (hasElemName"m" "val")
142− of
143− Just "p" -> Just OPlain
144− Just "b" -> Just OBold
145− Just "i" -> Just OItalic
146− Just "bi" -> Just OBoldItalic
147− _ -> Nothing
148− in
149− Styled { oMathScript = scr, oMathStyle = sty }
150− | otherwise = NoStyle
151−
152−elemToOMathRunElem :: Element -> Maybe OMathRunElem
153−elemToOMathRunElem element
154− | isElem "w" "t" element
155− || isElem "m" "t" element
156− || isElem "w" "delText" element = Just $ TextRun $ strContent element
157− | isElem "w" "br" element = Just LnBrk
158− | isElem "w" "tab" element = Just Tab
159− | otherwise = Nothing
160−
161−elemToOMathRunElems :: Element -> Maybe [OMathRunElem]
162−elemToOMathRunElems element
163− | isElem "w" "r" element
164− || isElem "m" "r" element =
165− Just $ mapMaybe (elemToOMathRunElem) (elChildren element)
166−elemToOMathRunElems _ = Nothing
167−
168−----- And now the TeXMath Creation
169−
170−oMathRunElemToString :: OMathRunElem -> String
171−oMathRunElemToString (TextRun s) = s
172−oMathRunElemToString (LnBrk) = ['\n']
173−oMathRunElemToString (Tab) = ['\t']
174−
175−oMathRunElemsToString :: [OMathRunElem] -> String
176−oMathRunElemsToString = concatMap oMathRunElemToString
177−
178−oMathRunTextStyleToTextType :: OMathRunTextStyle -> Maybe TM.TextType
179−oMathRunTextStyleToTextType (Normal) = Just $ TM.TextNormal
180−oMathRunTextStyleToTextType (NoStyle) = Nothing
181−oMathRunTextStyleToTextType (Styled scr sty)
182− | Just OBold <- sty
183− , Just OSansSerif <- scr =
184− Just $ TM.TextSansSerifBold
185− | Just OBoldItalic <- sty
186− , Just OSansSerif <- scr =
187− Just $ TM.TextSansSerifBoldItalic
188− | Just OBold <- sty
189− , Just OScript <- scr =
190− Just $ TM.TextBoldScript
191− | Just OBold <- sty
192− , Just OFraktur <- scr =
193− Just $ TM.TextBoldFraktur
194− | Just OItalic <- sty
195− , Just OSansSerif <- scr =
196− Just $ TM.TextSansSerifItalic
197− | Just OBold <- sty =
198− Just $ TM.TextBold
199− | Just OItalic <- sty =
200− Just $ TM.TextItalic
201− | Just OMonospace <- scr =
202− Just $ TM.TextMonospace
203− | Just OSansSerif <- scr =
204− Just $ TM.TextSansSerif
205− | Just ODoubleStruck <- scr =
206− Just $ TM.TextDoubleStruck
207− | Just OScript <- scr =
208− Just $ TM.TextDoubleStruck
209− | Just OFraktur <- scr =
210− Just $ TM.TextFraktur
211− | Just OBoldItalic <- sty =
212− Just $ TM.TextBoldItalic
213− | otherwise = Nothing
214−
215−
216−elemToExps' :: Element -> Maybe [TM.Exp]
217−elemToExps' element | isElem "m" "acc" element = do
218− let chr = filterChildName (hasElemName "m" "accPr") element >>=
219− filterChildName (hasElemName "m" "chr") >>=
220− findAttrBy (hasElemName "m" "val") >>=
221− Just . head
222− chr' = case chr of
223− Just c -> c
224− Nothing -> '\180' -- default to acute.
225− baseExp <- filterChildName (hasElemName "m" "e") element >>=
226− elemToBase
227− return $ [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr'])]
228−elemToExps' element | isElem "m" "bar" element = do
229− pos <- filterChildName (hasElemName "m" "barPr") element >>=
230− filterChildName (hasElemName "m" "pos") >>=
231− findAttrBy (hasElemName "m" "val")
232− baseExp <- filterChildName (hasElemName "m" "e") element >>=
233− elemToBase
234− case pos of
235− "top" -> Just [TM.EOver False baseExp (TM.ESymbol TM.Accent "\175")]
236− "bot" -> Just [TM.EUnder False baseExp (TM.ESymbol TM.Accent "\818")]
237− _ -> Nothing
238−elemToExps' element | isElem "m" "box" element = do
239− baseExp <- filterChildName (hasElemName "m" "e") element >>=
240− elemToBase
241− return [baseExp]
242−elemToExps' element | isElem "m" "borderBox" element = do
243− -- TODO: This needs to be "\\boxed" somehow.
244− baseExp <- filterChildName (hasElemName "m" "e") element >>=
245− elemToBase
246− return [baseExp]
247−elemToExps' element | isElem "m" "d" element =
248− let baseExps = mapMaybe
249− elemToBase
250− (elChildren element)
251− inDelimExps = map Right baseExps
252− dPr = filterChildName (hasElemName "m" "dPr") element
253− begChr = dPr >>=
254− filterChildName (hasElemName "m" "begChr") >>=
255− findAttrBy (hasElemName "m" "val") >>=
256− (\c -> if null c then (Just ' ') else (Just $ head c))
257− sepChr = dPr >>=
258− filterChildName (hasElemName "m" "sepChr") >>=
259− findAttrBy (hasElemName "m" "val") >>=
260− (\c -> if null c then (Just ' ') else (Just $ head c))
261− endChr = dPr >>=
262− filterChildName (hasElemName "m" "endChr") >>=
263− findAttrBy (hasElemName "m" "val") >>=
264− (\c -> if null c then (Just ' ') else (Just $ head c))
265− beg = fromMaybe '(' begChr
266− end = fromMaybe ')' endChr
267− sep = fromMaybe '|' sepChr
268− exps = intersperse (Left [sep]) inDelimExps
269− in
270− Just [TM.EDelimited [beg] [end] exps]
271−elemToExps' element | isElem "m" "eqArr" element =
272− let expLst = mapMaybe elemToBases (elChildren element)
273− expLst' = map (\es -> [map filterAmpersand es]) expLst
274− in
275− return [TM.EArray [] expLst']
276−elemToExps' element | isElem "m" "f" element = do
277− num <- filterChildName (hasElemName "m" "num") element
278− den <- filterChildName (hasElemName "m" "den") element
279− let numExp = TM.EGrouped $ concat $ mapMaybe (elemToExps') (elChildren num)
280− denExp = TM.EGrouped $ concat $ mapMaybe (elemToExps') (elChildren den)
281− return $ [TM.EFraction TM.NormalFrac numExp denExp]
282−elemToExps' element | isElem "m" "func" element = do
283− fName <- filterChildName (hasElemName "m" "fName") element
284− baseExp <- filterChildName (hasElemName "m" "e") element >>=
285− elemToBase
286− -- We need a string for the fname, but omml gives it to us as a
287− -- series of oMath elems. We're going to filter out the oMathRuns,
288− -- which should work for us most of the time.
289− let fnameString = concatMap expToString $
290− concat $ mapMaybe (elemToExps') (elChildren fName)
291− return [TM.EMathOperator fnameString, baseExp]
292−elemToExps' element | isElem "m" "groupChr" element = do
293− let gPr = filterChildName (hasElemName "m" "groupChrPr") element
294− chr = gPr >>=
295− filterChildName (hasElemName "m" "chr") >>=
296− findAttrBy (hasElemName "m" "val")
297− pos = gPr >>=
298− filterChildName (hasElemName "m" "pos") >>=
299− findAttrBy (hasElemName "m" "val")
300− baseExp <- filterChildName (hasElemName "m" "e") element >>=
301− elemToBase
302− case pos of
303− Just "top" ->
304− let chr' = case chr of
305− Just (c:_) -> c
306− _ -> '\65079' -- default to overbrace
307− in
308− return [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr'])]
309− Just "bot" ->
310− let chr' = case chr of
311− Just (c:_) -> c
312− _ -> '\65080' -- default to underbrace
313− in
314− return [TM.EUnder False baseExp (TM.ESymbol TM.Accent [chr'])]
315− _ -> Nothing
316−elemToExps' element | isElem "m" "limLow" element = do
317− baseExp <- filterChildName (hasElemName "m" "e") element
318− >>= elemToBase
319− limExp <- filterChildName (hasElemName "m" "lim") element
320− >>= (\e -> Just $ concat $ mapMaybe (elemToExps') (elChildren e))
321− >>= (return . TM.EGrouped)
322− return [TM.EUnder True limExp baseExp]
323−elemToExps' element | isElem "m" "limUpp" element = do
324− baseExp <- filterChildName (hasElemName "m" "e") element
325− >>= elemToBase
326− limExp <- filterChildName (hasElemName "m" "lim") element
327− >>= (\e -> Just $ concat $ mapMaybe (elemToExps') (elChildren e))
328− >>= (return . TM.EGrouped)
329− return [TM.EOver True limExp baseExp]
330−elemToExps' element | isElem "m" "m" element =
331− let rows = filterChildrenName (hasElemName "m" "mr") element
332− rowExps = map
333− (\mr -> mapMaybe
334− elemToBases
335− (elChildren mr))
336− rows
337− in
338− return [TM.EArray [TM.AlignCenter] rowExps]
339−elemToExps' element | isElem "m" "nary" element = do
340− let naryPr = filterChildName (hasElemName "m" "naryPr") element
341− naryChr = naryPr >>=
342− filterChildName (hasElemName "m" "chr") >>=
343− findAttrBy (hasElemName "m" "val")
344− opChr = case naryChr of
345− Just (c:_) -> c
346− _ -> '\8747' -- default to integral
347− limLoc = naryPr >>=
348− filterChildName (hasElemName "m" "limLoc") >>=
349− findAttrBy (hasElemName "m" "val")
350− subExps <- filterChildName (hasElemName "m" "sub") element >>=
351− (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
352− supExps <- filterChildName (hasElemName "m" "sup") element >>=
353− (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
354− baseExp <- filterChildName (hasElemName "m" "e") element >>=
355− elemToBase
356− case limLoc of
357− Just "undOvr" -> return [TM.EUnderover True
358− (TM.ESymbol TM.Op [opChr])
359− (TM.EGrouped subExps)
360− (TM.EGrouped supExps)
361− , baseExp]
362− _ -> return [TM.ESubsup
363− (TM.ESymbol TM.Op [opChr])
364− (TM.EGrouped subExps)
365− (TM.EGrouped supExps)
366− , baseExp]
367−
368−elemToExps' element | isElem "m" "phant" element = do
369− baseExp <- filterChildName (hasElemName "m" "e") element >>=
370− elemToBase
371− return [TM.EPhantom baseExp]
372−elemToExps' element | isElem "m" "rad" element = do
373− degExps <- filterChildName (hasElemName "m" "deg") element >>=
374− (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
375− baseExp <- filterChildName (hasElemName "m" "e") element >>=
376− elemToBase
377− return $ case degExps of
378− [] -> [TM.ESqrt baseExp]
379− ds -> [TM.ERoot (TM.EGrouped ds) baseExp]
380−elemToExps' element | isElem "m" "sPre" element = do
381− subExps <- filterChildName (hasElemName "m" "sub") element >>=
382− (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
383− supExps <- filterChildName (hasElemName "m" "sup") element >>=
384− (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
385− baseExp <- filterChildName (hasElemName "m" "e") element >>=
386− elemToBase
387− return [TM.ESubsup
388− (TM.EIdentifier "")
389− (TM.EGrouped subExps)
390− (TM.EGrouped supExps)
391− , baseExp]
392−elemToExps' element | isElem "m" "sSub" element = do
393− baseExp <- filterChildName (hasElemName "m" "e") element >>=
394− elemToBase
395− subExps <- filterChildName (hasElemName "m" "sub") element >>=
396− (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
397− return [TM.ESub baseExp (TM.EGrouped subExps)]
398−elemToExps' element | isElem "m" "sSubSup" element = do
399− baseExp <- filterChildName (hasElemName "m" "e") element >>=
400− elemToBase
401− subExps <- filterChildName (hasElemName "m" "sub") element >>=
402− (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
403− supExps <- filterChildName (hasElemName "m" "sup") element >>=
404− (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
405− return [TM.ESubsup baseExp (TM.EGrouped subExps) (TM.EGrouped supExps)]
406−elemToExps' element | isElem "m" "sSup" element = do
407− baseExp <- filterChildName (hasElemName "m" "e") element >>=
408− elemToBase
409− supExps <- filterChildName (hasElemName "m" "sup") element >>=
410− (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
411− return [TM.ESuper baseExp (TM.EGrouped supExps)]
412−elemToExps' element | isElem "m" "r" element = do
413− let mrPr = filterChildName (hasElemName "m" "rPr") element
414− lit = mrPr >>=
415− filterChildName (hasElemName "m" "lit") >>=
416− findAttrBy (hasElemName "m" "val")
417− txtSty = elemToOMathRunTextStyle element
418− mrElems <- elemToOMathRunElems element
419− return $ case oMathRunTextStyleToTextType txtSty of
420− Nothing -> [TM.EIdentifier $ oMathRunElemsToString mrElems]
421− Just textType ->
422− case lit of
423− Just "on" ->
424− [TM.EText textType (oMathRunElemsToString mrElems)]
425− _ ->
426− [TM.EStyled textType [TM.EIdentifier $ oMathRunElemsToString mrElems]]
427−elemToExps' _ = Nothing
428−
429−
430−expToString :: TM.Exp -> String
431−expToString (TM.ENumber s) = s
432−expToString (TM.EIdentifier s) = s
433−expToString (TM.EMathOperator s) = s
434−expToString (TM.ESymbol _ s) = s
435−expToString (TM.EText _ s) = s
436−expToString (TM.EGrouped exps) = concatMap expToString exps
437−expToString (TM.EStyled _ exps) = concatMap expToString exps
438−expToString _ = ""