git.iko.soy/typeable/pandoc
on master help sign in
Merge pull request #1494 from jkr/math-module

Math module

commit17e48ba81e4bb339b7bc08aed9b42c592bdbcd01 authorJohn MacFarlane <jgm@berkeley.edu> dateThu 7 Aug 2014, 13:44 (12 years ago) parent44dad52d293dd5
4 files changed+657−585
compare with master
unifiedsplit
pandoc.cabal+1 src/Text/Pandoc/Readers/Docx.hs+27−219 src/Text/Pandoc/Readers/Docx/OMath.hs+622 src/Text/Pandoc/Readers/Docx/Parse.hs+7−366
pandoc.cabal+1
@@ -324,6 +324,7 @@ Library
324324 Other-Modules: Text.Pandoc.Readers.Docx.Lists,
325325 Text.Pandoc.Readers.Docx.Reducible,
326326 Text.Pandoc.Readers.Docx.Parse,
327+ Text.Pandoc.Readers.Docx.OMath,
327328 Text.Pandoc.Writers.Shared,
328329 Text.Pandoc.Asciify,
329330 Text.Pandoc.MIME,
src/Text/Pandoc/Readers/Docx.hs+27−219
@@ -84,15 +84,16 @@ import Text.Pandoc.Readers.Docx.Lists
8484import Text.Pandoc.Readers.Docx.Reducible
8585import Text.Pandoc.Shared
8686import Text.Pandoc.MediaBag (insertMedia, MediaBag)
87−import Data.Maybe (mapMaybe, fromMaybe)
88−import Data.List (delete, stripPrefix, (\\), intersperse, intersect)
87+import Data.Maybe (mapMaybe)
88+import Data.List (delete, stripPrefix, (\\), intersect)
8989import Data.Monoid
9090import Text.TeXMath (writeTeX)
91−import qualified Text.TeXMath.Types as TM
91+import Data.Default (Default)
9292import qualified Data.ByteString.Lazy as B
9393import qualified Data.Map as M
9494import Control.Monad.Reader
9595import Control.Monad.State
96+import Control.Applicative ((<$>))
9697
9798readDocx :: ReaderOptions
9899 -> B.ByteString
@@ -104,25 +105,19 @@ readDocx opts bytes =
104105 Left _ -> error $ "couldn't parse docx file"
105106
106107data DState = DState { docxAnchorMap :: M.Map String String
107− , docxMediaBag :: MediaBag
108− , docxInHeaderBlock :: Bool}
108+ , docxMediaBag :: MediaBag }
109109
110−defaultDState :: DState
111−defaultDState = DState { docxAnchorMap = M.empty
112− , docxMediaBag = mempty
113− , docxInHeaderBlock = False}
110+instance Default DState where
111+ def = DState { docxAnchorMap = M.empty
112+ , docxMediaBag = mempty }
114113
115−data DEnv = DEnv { docxOptions :: ReaderOptions}
114+data DEnv = DEnv { docxOptions :: ReaderOptions
115+ , docxInHeaderBlock :: Bool }
116116
117−type DocxContext = ReaderT DEnv (State DState)
117+instance Default DEnv where
118+ def = DEnv def False
118119
119−withDState :: (DState -> DState) -> DocxContext a -> DocxContext a
120−withDState f dctx = do
121− ds <- get
122− modify f
123− ctx' <- dctx
124− put ds
125− return ctx'
120+type DocxContext = ReaderT DEnv (State DState)
126121
127122evalDocxContext :: DocxContext a -> DEnv -> DState -> a
128123evalDocxContext ctx env st = evalState (runReaderT ctx env) st
@@ -161,7 +156,7 @@ isEmptyPar (Paragraph _ parParts) =
161156 isEmptyElem (TextRun s) = trim s == ""
162157 isEmptyElem _ = True
163158isEmptyPar _ = False
164−
159+
165160bodyPartsToMeta' :: [BodyPart] -> DocxContext (M.Map String MetaValue)
166161bodyPartsToMeta' [] = return M.empty
167162bodyPartsToMeta' (bp : bps)
@@ -170,7 +165,7 @@ bodyPartsToMeta' (bp : bps)
170165 , (Just metaField) <- M.lookup c metaStyles = do
171166 inlines <- parPartsToInlines parParts
172167 remaining <- bodyPartsToMeta' bps
173− let
168+ let
174169 f (MetaInlines ils) (MetaInlines ils') = MetaBlocks [Para ils, Para ils']
175170 f (MetaInlines ils) (MetaBlocks blks) = MetaBlocks ((Para ils) : blks)
176171 f m (MetaList mv) = MetaList (m : mv)
@@ -357,7 +352,7 @@ parPartToInlines (BookMark _ anchor) =
357352 -- user-defined anchor links with header auto ids.
358353 do
359354 -- get whether we're in a header.
360− inHdrBool <- gets docxInHeaderBlock
355+ inHdrBool <- asks docxInHeaderBlock
361356 -- Get the anchor map.
362357 anchorMap <- gets docxAnchorMap
363358 -- We don't want to rewrite if we're in a header, since we'll take
@@ -372,7 +367,8 @@ parPartToInlines (BookMark _ anchor) =
372367 if not inHdrBool && anchor `elem` (M.elems anchorMap)
373368 then uniqueIdent [Str anchor] (M.elems anchorMap)
374369 else anchor
375− modify $ \s -> s { docxAnchorMap = M.insert anchor newAnchor anchorMap}
370+ unless inHdrBool
371+ (modify $ \s -> s { docxAnchorMap = M.insert anchor newAnchor anchorMap})
376372 return [Span (newAnchor, ["anchor"], []) []]
377373parPartToInlines (Drawing fp bs) = do
378374 mediaBag <- gets docxMediaBag
@@ -384,193 +380,8 @@ parPartToInlines (InternalHyperLink anchor runs) = do
384380parPartToInlines (ExternalHyperLink target runs) = do
385381 ils <- concatMapM runToInlines runs
386382 return [Link ils (target, "")]
387−parPartToInlines (PlainOMath omath) = do
388− e <- oMathToExps omath
389− return [Math InlineMath (writeTeX e)]
390−
391−oMathToExps :: OMath -> DocxContext [TM.Exp]
392−oMathToExps (OMath oMathElems) = concatMapM oMathElemToExps oMathElems
393−
394−oMathElemToExps :: OMathElem -> DocxContext [TM.Exp]
395−oMathElemToExps (Accent style base) = do
396− baseExp <- baseToExp base
397− let chr = case accentChar style of
398− Just c -> c
399− Nothing -> '\180' -- default to acute.
400− return [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
401−oMathElemToExps(Bar style base) = do
402− baseExp <- baseToExp base
403− return $ case barPos style of
404− Top -> [TM.EOver False baseExp (TM.ESymbol TM.Accent "\175")]
405− Bottom -> [TM.EUnder False baseExp (TM.ESymbol TM.Accent "\818")]
406−oMathElemToExps (Box base) =
407− (\e -> return [e]) =<< baseToExp base
408−oMathElemToExps (BorderBox base) =
409− -- TODO: This should be "\\boxed" somehow
410− (\e -> return [e]) =<< baseToExp base
411−oMathElemToExps (Delimiter dPr bases) = do
412− baseExps <- mapM baseToExp bases
413− let inDelimExps = map Right baseExps
414− beg = fromMaybe '(' (delimBegChar dPr)
415− end = fromMaybe ')' (delimEndChar dPr)
416− sep = fromMaybe '|' (delimSepChar dPr)
417− exps = intersperse (Left [sep]) inDelimExps
418− return [TM.EDelimited [beg] [end] exps]
419−oMathElemToExps (EquationArray bases) = do
420− let f b = do bs <- baseToExp' b
421− return [bs]
422− baseExps <- mapM f bases
423− return [TM.EArray [] baseExps]
424−oMathElemToExps (Fraction num denom) = do
425− numExp <- concatMapM oMathElemToExps num >>= (return . TM.EGrouped)
426− denExp <- concatMapM oMathElemToExps denom >>= (return . TM.EGrouped)
427− return [TM.EFraction TM.NormalFrac numExp denExp]
428−oMathElemToExps (Function fname base) = do
429− -- We need a string for the fname, but omml gives it to us as a
430− -- series of oMath elems. We're going to filter out the oMathRuns,
431− -- which should work for us most of the time.
432− let f :: OMathElem -> String
433− f (OMathRun _ run) = runToString run
434− f _ = ""
435− fnameString = concatMap f fname
436− baseExp <- baseToExp base
437− return [TM.EMathOperator fnameString, baseExp]
438−oMathElemToExps (Group style base)
439− | Just Top <- groupPos style = do
440− baseExp <- baseToExp base
441− let chr = case groupChr style of
442− Just c -> c
443− Nothing -> '\65079' -- default to overbrace
444− return [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
445− | otherwise = do
446− baseExp <- baseToExp base
447− let chr = case groupChr style of
448− Just c -> c
449− Nothing -> '\65080' -- default to underbrace
450− return [TM.EUnder False baseExp (TM.ESymbol TM.Accent [chr])]
451−oMathElemToExps (LowerLimit base limElems) = do
452− baseExp <- baseToExp base
453− lim <- concatMapM oMathElemToExps limElems >>= (return . TM.EGrouped)
454− return [TM.EUnder True lim baseExp]
455−oMathElemToExps (UpperLimit base limElems) = do
456− baseExp <- baseToExp base
457− lim <- concatMapM oMathElemToExps limElems >>= (return . TM.EGrouped)
458− return [TM.EOver True lim baseExp]
459−oMathElemToExps (Matrix bases) = do
460− rows <- mapM (mapM (\b -> baseToExp' b)) bases
461− return [TM.EArray [TM.AlignCenter] rows]
462−oMathElemToExps (NAry style sub sup base) = do
463− subExps <- concatMapM oMathElemToExps sub
464− supExps <- concatMapM oMathElemToExps sup
465− baseExp <- baseToExp base
466− let opChar = case nAryChar style of
467− Just c -> c
468− -- default to integral
469− Nothing -> '\8747'
470− return [ TM.ESubsup
471− (TM.ESymbol TM.Op [opChar])
472− (TM.EGrouped subExps)
473− (TM.EGrouped supExps)
474− , baseExp]
475−oMathElemToExps (Phantom base) =
476− (\e -> return [TM.EPhantom e]) =<< baseToExp base
477−oMathElemToExps (Radical degree base) = do
478− degExps <- concatMapM oMathElemToExps degree
479− baseExp <- baseToExp base
480− return $ case degExps of
481− [] -> [TM.ESqrt baseExp]
482− ds -> [TM.ERoot (TM.EGrouped ds) baseExp]
483−oMathElemToExps (PreSubSuper sub sup base) = do
484− subExps <- concatMapM oMathElemToExps sub
485− supExps <- concatMapM oMathElemToExps sup
486− baseExp <- baseToExp base
487− return [ TM.ESubsup
488− (TM.EIdentifier "") (TM.EGrouped subExps) (TM.EGrouped supExps)
489− , baseExp]
490−oMathElemToExps (Sub base sub) = do
491− baseExp <- baseToExp base
492− subExps <- concatMapM oMathElemToExps sub
493− return [TM.ESub baseExp (TM.EGrouped subExps)]
494−oMathElemToExps (SubSuper base sub sup) = do
495− baseExp <- baseToExp base
496− subExps <- concatMapM oMathElemToExps sub
497− supExps <- concatMapM oMathElemToExps sup
498− return [TM.ESubsup baseExp (TM.EGrouped subExps) (TM.EGrouped supExps)]
499−oMathElemToExps (Super base sup) = do
500− baseExp <- baseToExp base
501− supExps <- concatMapM oMathElemToExps sup
502− return [TM.ESuper baseExp (TM.EGrouped supExps)]
503−oMathElemToExps (OMathRun sty run@(Run _ _))
504− | NoStyle <- oMathRunTextStyle sty =
505− return $ [TM.EIdentifier $ runToString run]
506− | Nothing <- oMathRunStyleToTextType sty =
507− return $ [TM.EIdentifier $ runToString run]
508− | Just textType <- oMathRunStyleToTextType sty =
509− return $ if oMathLit sty
510− then [TM.EText textType (runToString run)]
511− else [TM.EStyled textType [TM.EIdentifier $ runToString run]]
512−oMathElemToExps (OMathRun _ _) = return []
513−
514−oMathRunStyleToTextType :: OMathRunStyle -> Maybe TM.TextType
515−oMathRunStyleToTextType mrPr
516− | Normal <- oMathRunTextStyle mrPr =
517− Just $ TM.TextNormal
518− | Styled scr sty <- oMathRunTextStyle mrPr
519− ,Just OBold <- sty
520− , Just OSansSerif <- scr =
521− Just $ TM.TextSansSerifBold
522− | Styled scr sty <- oMathRunTextStyle mrPr
523− , Just OBoldItalic <- sty
524− , Just OSansSerif <- scr =
525− Just $ TM.TextSansSerifBoldItalic
526− | Styled scr sty <- oMathRunTextStyle mrPr
527− , Just OBold <- sty
528− , Just OScript <- scr =
529− Just $ TM.TextBoldScript
530− | Styled scr sty <- oMathRunTextStyle mrPr
531− , Just OBold <- sty
532− , Just OFraktur <- scr =
533− Just $ TM.TextBoldFraktur
534− | Styled scr sty <- oMathRunTextStyle mrPr
535− , Just OItalic <- sty
536− , Just OSansSerif <- scr =
537− Just $ TM.TextSansSerifItalic
538− | Styled _ sty <- oMathRunTextStyle mrPr
539− , Just OBold <- sty =
540− Just $ TM.TextBold
541− | Styled _ sty <- oMathRunTextStyle mrPr
542− , Just OItalic <- sty =
543− Just $ TM.TextItalic
544− | Styled scr _ <- oMathRunTextStyle mrPr
545− , Just OMonospace <- scr =
546− Just $ TM.TextMonospace
547− | Styled scr _ <- oMathRunTextStyle mrPr
548− , Just OSansSerif <- scr =
549− Just $ TM.TextSansSerif
550− | Styled scr _ <- oMathRunTextStyle mrPr
551− , Just ODoubleStruck <- scr =
552− Just $ TM.TextDoubleStruck
553− | Styled scr _ <- oMathRunTextStyle mrPr
554− , Just OScript <- scr =
555− Just $ TM.TextDoubleStruck
556− | Styled scr _ <- oMathRunTextStyle mrPr
557− , Just OFraktur <- scr =
558− Just $ TM.TextFraktur
559− | Styled _ sty <- oMathRunTextStyle mrPr
560− , Just OBoldItalic <- sty =
561− Just $ TM.TextBoldItalic
562− | otherwise = Nothing
563−
564−
565−
566−baseToExp :: Base -> DocxContext TM.Exp
567−baseToExp (Base mathElems) =
568− concatMapM oMathElemToExps mathElems >>= (return . TM.EGrouped)
569−
570−-- an ungrouped version of baseToExp
571−baseToExp' :: Base -> DocxContext [TM.Exp]
572−baseToExp' (Base mathElems) =
573− concatMapM oMathElemToExps mathElems
383+parPartToInlines (PlainOMath exps) = do
384+ return [Math InlineMath (writeTeX exps)]
574385
575386
576387isAnchorSpan :: Inline -> Bool
@@ -638,8 +449,8 @@ bodyPartToBlocks (Paragraph pPr parparts)
638449 [CodeBlock ("", [], []) (concatMap parPartToString parparts)]
639450bodyPartToBlocks (Paragraph pPr parparts)
640451 | any isHeaderContainer (parStyleToContainers pPr) = do
641− ils <-withDState (\s -> s{docxInHeaderBlock = True}) $
642− parPartsToInlines parparts >>= (return . normalizeSpaces)
452+ ils <- normalizeSpaces <$> local (\s -> s{docxInHeaderBlock = True})
453+ (parPartsToInlines parparts)
643454 let (Container hdrFun) = head $ filter isHeaderContainer (parStyleToContainers pPr)
644455 Header n attr _ = hdrFun []
645456 hdr <- makeHeaderAnchor $ Header n attr ils
@@ -696,11 +507,10 @@ bodyPartToBlocks (Tbl cap _ look (r:rs)) = do
696507 widths = replicate size 0 :: [Double]
697508
698509 return [Table caption alignments widths hdrCells cells]
699−bodyPartToBlocks (OMathPara _ maths) = do
700− omaths <- mapM oMathToExps maths
510+bodyPartToBlocks (OMathPara exps) = do
701511 return [Para $
702− map (\m -> Math DisplayMath (writeTeX m))
703− omaths]
512+ map (\e -> Math DisplayMath (writeTeX e))
513+ exps]
704514
705515-- replace targets with generated anchors.
706516rewriteLink :: Inline -> DocxContext Inline
@@ -724,10 +534,8 @@ bodyToOutput (Body bps) = do
724534
725535docxToOutput :: ReaderOptions -> Docx -> (Meta, [Block], MediaBag)
726536docxToOutput opts (Docx (Document _ body)) =
727− let dState = defaultDState
728− dEnv = DEnv { docxOptions = opts }
729− in
730− evalDocxContext (bodyToOutput body) dEnv dState
537+ let dEnv = def { docxOptions = opts} in
538+ evalDocxContext (bodyToOutput body) dEnv def
731539
732540
733541ilToCode :: Inline -> String
src/Text/Pandoc/Readers/Docx/OMath.hsnew file+622
@@ -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+
src/Text/Pandoc/Readers/Docx/Parse.hs+7−366
@@ -36,19 +36,6 @@ module Text.Pandoc.Readers.Docx.Parse ( Docx(..)
3636 , BodyPart(..)
3737 , TblLook(..)
3838 , ParPart(..)
39− , OMath(..)
40− , OMathElem(..)
41− , Base(..)
42− , TopBottom(..)
43− , AccentStyle(..)
44− , BarStyle(..)
45− , NAryStyle(..)
46− , DelimStyle(..)
47− , GroupStyle(..)
48− , OMathRunStyle(..)
49− , OMathRunTextStyle(..)
50− , OMathTextScript(..)
51− , OMathTextStyle(..)
5239 , Run(..)
5340 , RunElem(..)
5441 , Notes
@@ -74,6 +61,8 @@ import qualified Text.Pandoc.UTF8 as UTF8
7461import Control.Monad.Reader
7562import qualified Data.Map as M
7663import Text.Pandoc.Compat.Except
64+import Text.Pandoc.Readers.Docx.OMath (elemToExps)
65+import Text.TeXMath (Exp)
7766
7867data ReaderEnv = ReaderEnv { envNotes :: Notes
7968 , envNumbering :: Numbering
@@ -161,7 +150,7 @@ defaultParagraphStyle = ParagraphStyle { pStyle = []
161150data BodyPart = Paragraph ParagraphStyle [ParPart]
162151 | ListItem ParagraphStyle String String Level [ParPart]
163152 | Tbl String TblGrid TblLook [Row]
164− | OMathPara OMathParaStyle [OMath]
153+ | OMathPara [[Exp]]
165154 deriving Show
166155
167156type TblGrid = [Integer]
@@ -185,100 +174,9 @@ data ParPart = PlainRun Run
185174 | InternalHyperLink Anchor [Run]
186175 | ExternalHyperLink URL [Run]
187176 | Drawing FilePath B.ByteString
188− | PlainOMath OMath
177+ | PlainOMath [Exp]
189178 deriving Show
190179
191−data OMath = OMath [OMathElem]
192− deriving Show
193−
194−data OMathElem = Accent AccentStyle Base
195− | Bar BarStyle Base
196− | Box Base
197− | BorderBox Base
198− | Delimiter DelimStyle [Base]
199− | EquationArray [Base]
200− | Fraction [OMathElem] [OMathElem]
201− | Function [OMathElem] Base
202− | Group GroupStyle Base
203− | LowerLimit Base [OMathElem]
204− | UpperLimit Base [OMathElem]
205− | Matrix [[Base]]
206− | NAry NAryStyle [OMathElem] [OMathElem] Base
207− | Phantom Base
208− | Radical [OMathElem] Base
209− | PreSubSuper [OMathElem] [OMathElem] Base
210− | Sub Base [OMathElem]
211− | SubSuper Base [OMathElem] [OMathElem]
212− | Super Base [OMathElem]
213− | OMathRun OMathRunStyle Run
214− deriving Show
215−
216−data Base = Base [OMathElem]
217− deriving Show
218−
219−-- placeholders
220−type OMathParaStyle = [String]
221−
222−data TopBottom = Top | Bottom
223− deriving Show
224−
225−data AccentStyle = AccentStyle { accentChar :: Maybe Char }
226− deriving Show
227−
228−data BarStyle = BarStyle { barPos :: TopBottom}
229− deriving Show
230−
231−data NAryStyle = NAryStyle { nAryChar :: Maybe Char
232− , nAryLimLoc :: LimLoc}
233− deriving Show
234−
235−data OMathRunStyle = OMathRunStyle { oMathLit :: Bool
236− , oMathRunTextStyle :: OMathRunTextStyle }
237− deriving Show
238−
239−data OMathRunTextStyle = NoStyle
240− | Normal
241− | Styled { oMathScript :: Maybe OMathTextScript
242− , oMathStyle :: Maybe OMathTextStyle }
243− deriving Show
244−
245−data OMathTextScript = ORoman
246− | OScript
247− | OFraktur
248− | ODoubleStruck
249− | OSansSerif
250− | OMonospace
251− deriving (Show, Eq)
252−
253−data OMathTextStyle = OPlain
254− | OBold
255− | OItalic
256− | OBoldItalic
257− deriving (Show, Eq)
258−
259−defaultNAryStyle :: NAryStyle
260−defaultNAryStyle = NAryStyle { nAryChar = Nothing -- integral, in practice
261− , nAryLimLoc = SubSup }
262−
263−data LimLoc = SubSup | UnderOver deriving Show
264−
265−data DelimStyle = DelimStyle { delimBegChar :: Maybe Char
266− , delimSepChar :: Maybe Char
267− , delimEndChar :: Maybe Char}
268− deriving Show
269−
270−defaultDelimStyle :: DelimStyle
271−defaultDelimStyle = DelimStyle { delimBegChar = Nothing
272− , delimSepChar = Nothing
273− , delimEndChar = Nothing }
274−
275−data GroupStyle = GroupStyle { groupChr :: Maybe Char
276− , groupPos :: Maybe TopBottom }
277− deriving Show
278−
279−defaultGroupStyle :: GroupStyle
280−defaultGroupStyle = GroupStyle {groupChr = Nothing, groupPos = Nothing}
281−
282180data Run = Run RunStyle [RunElem]
283181 | Footnote [BodyPart]
284182 | Endnote [BodyPart]
@@ -577,9 +475,8 @@ elemToBodyPart ns element
577475 | isElem ns "w" "p" element
578476 , (c:_) <- findChildren (elemName ns "m" "oMathPara") element =
579477 do
580− let style = [] -- placeholder
581− maths <- mapD (elemToMath ns) (elChildren c)
582− return $ OMathPara style maths
478+ expsLst <- mapD (\e -> (maybeToD $ elemToExps ns e)) (elChildren c)
479+ return $ OMathPara expsLst
583480elemToBodyPart ns element
584481 | isElem ns "w" "p" element
585482 , Just (numId, lvl) <- elemToNumInfo ns element = do
@@ -615,262 +512,6 @@ elemToBodyPart ns element
615512 return $ Tbl caption grid tblLook rows
616513elemToBodyPart _ _ = throwError WrongElem
617514
618−elemToMath :: NameSpaces -> Element -> D OMath
619−elemToMath ns element | isElem ns "m" "oMath" element =
620− mapD (elemToMathElem ns) (elChildren element) >>=
621− (\es -> return $ OMath es)
622−elemToMath _ _ = throwError WrongElem
623−
624−elemToBase :: NameSpaces -> Element -> D Base
625−elemToBase ns element | isElem ns "m" "e" element =
626− mapD (elemToMathElem ns) (elChildren element) >>=
627− (\es -> return $ Base es)
628−elemToBase _ _ = throwError WrongElem
629−
630−-- TODO: The right way to do this is to use the ampersand to break the
631−-- text lines into multiple columns. That's tricky, though, and this
632−-- will get us most of the way for the time being.
633−filterAmpersand :: OMathElem -> OMathElem
634−filterAmpersand (OMathRun mrPr (Run wrPr elems)) =
635− let f (TextRun s) = TextRun $ filter ('&' /=) s
636− f re = re
637− in
638− OMathRun mrPr $ Run wrPr (map f elems)
639−filterAmpersand e = e
640−
641−elemToBaseNoAmpersand :: NameSpaces -> Element -> D Base
642−elemToBaseNoAmpersand ns element | isElem ns "m" "e" element =
643− mapD
644− (\e -> (elemToMathElem ns e >>= (return . filterAmpersand)))
645− (elChildren element) >>=
646− (\es -> return $ Base es)
647−elemToBaseNoAmpersand _ _ = throwError WrongElem
648−
649−
650−elemToOMathRunStyle :: NameSpaces -> Element -> OMathRunStyle
651−elemToOMathRunStyle ns element =
652− let lit =
653− case
654− findChild (elemName ns "m" "lit") element >>=
655− findAttr (elemName ns "m" "val")
656− of
657− Just "on" -> True
658− _ -> False
659− in
660− OMathRunStyle { oMathLit = lit
661− , oMathRunTextStyle = (elemToOMathRunTextStyle ns element)
662− }
663−
664−elemToOMathRunTextStyle :: NameSpaces -> Element -> OMathRunTextStyle
665−elemToOMathRunTextStyle ns element
666− | Just mrPr <- findChild (elemName ns "m" "rPr") element
667− , Just _ <- findChild (elemName ns "m" "nor") mrPr =
668− Normal
669− | Just mrPr <- findChild (elemName ns "m" "rPr") element =
670− let scr =
671− case
672− findChild (elemName ns "m" "scr") mrPr >>=
673− findAttr (elemName ns "m" "val")
674− of
675− Just "roman" -> Just ORoman
676− Just "script" -> Just OScript
677− Just "fraktur" -> Just OFraktur
678− Just "double-struck" -> Just ODoubleStruck
679− Just "sans-serif" -> Just OSansSerif
680− Just "monospace" -> Just OMonospace
681− _ -> Nothing
682−
683− sty =
684− case
685− findChild (elemName ns "m" "sty") mrPr >>=
686− findAttr (elemName ns "m" "val")
687− of
688− Just "p" -> Just OPlain
689− Just "b" -> Just OBold
690− Just "i" -> Just OItalic
691− Just "bi" -> Just OBoldItalic
692− _ -> Nothing
693− in
694− Styled { oMathScript = scr, oMathStyle = sty }
695− | otherwise = NoStyle
696−
697−
698−
699−elemToNAryStyle :: NameSpaces -> Element -> NAryStyle
700−elemToNAryStyle ns element
701− | Just narypr <- findChild (QName "naryPr" (lookup "m" ns) (Just "m")) element =
702− let
703− chr = findChild (QName "chr" (lookup "m" ns) (Just "m")) narypr >>=
704− findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
705− Just . head
706− limLoc = findChild (QName "limLoc" (lookup "m" ns) (Just "m")) narypr >>=
707− findAttr (QName "val" (lookup "m" ns) (Just "m"))
708− limLoc' = case limLoc of
709− Just "undOver" -> UnderOver
710− Just "subSup" -> SubSup
711− _ -> SubSup
712− in
713− NAryStyle { nAryChar = chr, nAryLimLoc = limLoc'}
714−elemToNAryStyle _ _ = defaultNAryStyle
715−
716−elemToDelimStyle :: NameSpaces -> Element -> DelimStyle
717−elemToDelimStyle ns element
718− | Just dPr <- findChild (QName "dPr" (lookup "m" ns) (Just "m")) element =
719− let begChr = findChild (QName "begChr" (lookup "m" ns) (Just "m")) dPr >>=
720− findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
721− (\c -> if null c then (Just ' ') else (Just $ head c))
722− sepChr = findChild (QName "sepChr" (lookup "m" ns) (Just "m")) dPr >>=
723− findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
724− (\c -> if null c then (Just ' ') else (Just $ head c))
725− endChr = findChild (QName "endChr" (lookup "m" ns) (Just "m")) dPr >>=
726− findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
727− (\c -> if null c then (Just ' ') else (Just $ head c))
728− in
729− DelimStyle { delimBegChar = begChr
730− , delimSepChar = sepChr
731− , delimEndChar = endChr}
732−elemToDelimStyle _ _ = defaultDelimStyle
733−
734−elemToGroupStyle :: NameSpaces -> Element -> GroupStyle
735−elemToGroupStyle ns element
736− | Just gPr <- findChild (QName "groupChrPr" (lookup "m" ns) (Just "m")) element =
737− let chr = findChild (QName "chr" (lookup "m" ns) (Just "m")) gPr >>=
738− findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
739− Just . head
740− pos = findChild (QName "pos" (lookup "m" ns) (Just "m")) gPr >>=
741− findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
742− (\s -> Just $ if s == "top" then Top else Bottom)
743− in
744− GroupStyle { groupChr = chr, groupPos = pos }
745−elemToGroupStyle _ _ = defaultGroupStyle
746−
747−elemToMathElem :: NameSpaces -> Element -> D OMathElem
748−elemToMathElem ns element | isElem ns "m" "acc" element = do
749− let accChar =
750− findChild (elemName ns "m" "accPr") element >>=
751− findChild (elemName ns "m" "chr") >>=
752− findAttr (elemName ns "m" "val") >>=
753− Just . head
754− accPr = AccentStyle { accentChar = accChar}
755− base <-(maybeToD $ findChild (elemName ns "m" "e") element) >>=
756− elemToBase ns
757− return $ Accent accPr base
758−elemToMathElem ns element | isElem ns "m" "bar" element = do
759− barPr <- maybeToD $
760− findChild (QName "barPr" (lookup "m" ns) (Just "m")) element >>=
761− findChild (QName "pos" (lookup "m" ns) (Just "m")) >>=
762− findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
763− (\s ->
764− Just $ BarStyle {
765− barPos = (if s == "bot" then Bottom else Top)
766− })
767− base <-maybeToD (findChild (QName "e" (lookup "m" ns) (Just "m")) element) >>=
768− elemToBase ns
769− return $ Bar barPr base
770−elemToMathElem ns element | isElem ns "m" "box" element =
771− maybeToD (findChild (elemName ns "m" "e") element) >>=
772− elemToBase ns >>=
773− (\b -> return $ Box b)
774−elemToMathElem ns element | isElem ns "m" "borderBox" element =
775− maybeToD (findChild (elemName ns "m" "e") element) >>=
776− elemToBase ns >>=
777− (\b -> return $ BorderBox b)
778−elemToMathElem ns element | isElem ns "m" "d" element =
779− let style = elemToDelimStyle ns element
780− in
781− mapD (elemToBase ns) (elChildren element) >>=
782− (\es -> return $ Delimiter style es)
783−elemToMathElem ns element | isElem ns "m" "eqArr" element =
784− mapD (elemToBaseNoAmpersand ns) (elChildren element) >>=
785− (\es -> return $ EquationArray es)
786−elemToMathElem ns element | isElem ns "m" "f" element = do
787− num <- maybeToD $ findChild (elemName ns "m" "num") element
788− den <- maybeToD $ findChild (elemName ns "m" "den") element
789− numElems <- mapD (elemToMathElem ns) (elChildren num)
790− denElems <- mapD (elemToMathElem ns) (elChildren den)
791− return $ Fraction numElems denElems
792−elemToMathElem ns element | isElem ns "m" "func" element = do
793− fName <- maybeToD $ findChild (elemName ns "m" "fName") element
794− base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
795− elemToBase ns
796− fnElems <- mapD (elemToMathElem ns) (elChildren fName)
797− return $ Function fnElems base
798−elemToMathElem ns element | isElem ns "m" "groupChr" element =
799− let style = elemToGroupStyle ns element
800− in
801− maybeToD (findChild (elemName ns "m" "e") element) >>=
802− elemToBase ns >>=
803− (\b -> return $ Group style b)
804−elemToMathElem ns element | isElem ns "m" "limLow" element = do
805− base <- maybeToD (findChild (elemName ns "m" "e") element)
806− >>= elemToBase ns
807− lim <- maybeToD $ findChild (elemName ns "m" "lim") element
808− limElems <- mapD (elemToMathElem ns) (elChildren lim)
809− return $ LowerLimit base limElems
810−elemToMathElem ns element | isElem ns "m" "limUpp" element = do
811− base <- maybeToD (findChild (elemName ns "m" "e") element)
812− >>= elemToBase ns
813− lim <- maybeToD $ findChild (elemName ns "m" "lim") element
814− limElems <- mapD (elemToMathElem ns) (elChildren lim)
815− return $ UpperLimit base limElems
816−elemToMathElem ns element | isElem ns "m" "m" element = do
817− let rows = findChildren (elemName ns "m" "mr") element
818− bases <- mapD (\mr -> mapD (elemToBase ns) (elChildren mr)) rows
819− return $ Matrix bases
820−elemToMathElem ns element | isElem ns "m" "nary" element = do
821− let style = elemToNAryStyle ns element
822− sub <- maybeToD (findChild (elemName ns "m" "sub") element) >>=
823− (\e -> mapD (elemToMathElem ns) (elChildren e))
824− sup <- maybeToD (findChild (elemName ns "m" "sup") element) >>=
825− (\e -> mapD (elemToMathElem ns) (elChildren e))
826− base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
827− elemToBase ns
828− return $ NAry style sub sup base
829−elemToMathElem ns element | isElem ns "m" "rad" element = do
830− deg <- maybeToD (findChild (elemName ns "m" "deg") element) >>=
831− (\e -> mapD (elemToMathElem ns) (elChildren e))
832− base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
833− elemToBase ns
834− return $ Radical deg base
835−elemToMathElem ns element | isElem ns "m" "phant" element = do
836− base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
837− elemToBase ns
838− return $ Phantom base
839−elemToMathElem ns element | isElem ns "m" "sPre" element = do
840− sub <- maybeToD (findChild (elemName ns "m" "sub") element) >>=
841− (\e -> mapD (elemToMathElem ns) (elChildren e))
842− sup <- maybeToD (findChild (elemName ns "m" "sup") element) >>=
843− (\e -> mapD (elemToMathElem ns) (elChildren e))
844− base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
845− elemToBase ns
846− return $ PreSubSuper sub sup base
847−elemToMathElem ns element | isElem ns "m" "sSub" element = do
848− base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
849− elemToBase ns
850− sub <- maybeToD (findChild (elemName ns "m" "sub") element) >>=
851− (\e -> mapD (elemToMathElem ns) (elChildren e))
852− return $ Sub base sub
853−elemToMathElem ns element | isElem ns "m" "sSubSup" element = do
854− base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
855− elemToBase ns
856− sub <- maybeToD (findChild (elemName ns "m" "sub") element) >>=
857− (\e -> mapD (elemToMathElem ns) (elChildren e))
858− sup <- maybeToD (findChild (elemName ns "m" "sup") element) >>=
859− (\e -> mapD (elemToMathElem ns) (elChildren e))
860− return $ SubSuper base sub sup
861−elemToMathElem ns element | isElem ns "m" "sSup" element = do
862− base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
863− elemToBase ns
864− sup <- maybeToD (findChild (elemName ns "m" "sup") element) >>=
865− (\e -> mapD (elemToMathElem ns) (elChildren e))
866− return $ Super base sup
867−elemToMathElem ns element | isElem ns "m" "r" element = do
868− let mrPr = elemToOMathRunStyle ns element
869− wrPr = elemToRunStyle ns element
870− relems <- elemToRunElems ns element
871− return $ OMathRun mrPr $ Run wrPr relems
872−elemToMathElem _ _ = throwError WrongElem
873−
874515lookupRelationship :: RelId -> [Relationship] -> Maybe Target
875516lookupRelationship relid rels =
876517 lookup relid (map (\(Relationship pair) -> pair) rels)
@@ -934,7 +575,7 @@ elemToParPart ns element
934575 Nothing -> ExternalHyperLink "" runs
935576elemToParPart ns element
936577 | isElem ns "m" "oMath" element =
937− elemToMath ns element >>= (return . PlainOMath)
578+ (maybeToD $ elemToExps ns element) >>= (return . PlainOMath)
938579elemToParPart _ _ = throwError WrongElem
939580
940581lookupFootnote :: String -> Notes -> Maybe Element