@@ -1,3 +1,5 @@
1+{-# LANGUAGE PatternGuards #-}
2+
13{-
24Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu>
35
@@ -35,6 +37,15 @@ module Text.Pandoc.Readers.Docx.Parse ( Docx(..)
3537 , BodyPart(..)
3638 , TblLook(..)
3739 , ParPart(..)
40+ , OMath(..)
41+ , OMathElem(..)
42+ , Base(..)
43+ , TopBottom(..)
44+ , AccentStyle(..)
45+ , BarStyle(..)
46+ , NAryStyle(..)
47+ , DelimStyle(..)
48+ , GroupStyle(..)
3849 , Run(..)
3950 , RunElem(..)
4051 , Notes
@@ -288,15 +299,30 @@ elemToNumInfo _ _ = Nothing
288299
289300elemToBodyPart :: NameSpaces -> Element -> Maybe BodyPart
290301elemToBodyPart ns element
302+ | qName (elName element) == "p" &&
303+ qURI (elName element) == (lookup "w" ns)
304+ , (c:_) <- findChildren (QName "oMathPara" (lookup "m" ns) (Just "m")) element =
305+ let style = [] -- placeholder
306+ maths = mapMaybe (elemToMath ns)
307+ $ findChildren
308+ (QName "oMath" (lookup "m" ns) (Just "m")) c
309+ in
310+ Just $ OMathPara style maths
311+ | qName (elName element) == "p" &&
312+ qURI (elName element) == (lookup "w" ns)
313+ , Just (numId, lvl) <- elemToNumInfo ns element =
314+ let parstyle = elemToParagraphStyle ns element
315+ parparts = mapMaybe (elemToParPart ns)
316+ $ elChildren element
317+ in
318+ Just $ ListItem parstyle numId lvl parparts
291319 | qName (elName element) == "p" &&
292320 qURI (elName element) == (lookup "w" ns) =
293321 let parstyle = elemToParagraphStyle ns element
294322 parparts = mapMaybe (elemToParPart ns)
295323 $ elChildren element
296324 in
297− case elemToNumInfo ns element of
298− Just (numId, lvl) -> Just $ ListItem parstyle numId lvl parparts
299− Nothing -> Just $ Paragraph parstyle parparts
325+ Just $ Paragraph parstyle parparts
300326 | qName (elName element) == "tbl" &&
301327 qURI (elName element) == (lookup "w" ns) =
302328 let
@@ -392,7 +418,7 @@ elemToParagraphStyle ns element =
392418data BodyPart = Paragraph ParagraphStyle [ParPart]
393419 | ListItem ParagraphStyle String String [ParPart]
394420 | Tbl String TblGrid TblLook [Row]
395−
421+ | OMathPara OMathParaStyle [OMath]
396422 deriving Show
397423
398424type TblGrid = [Integer]
@@ -451,6 +477,7 @@ data ParPart = PlainRun Run
451477 | InternalHyperLink Anchor [Run]
452478 | ExternalHyperLink RelId [Run]
453479 | Drawing String
480+ | PlainOMath OMath
454481 deriving Show
455482
456483data Run = Run RunStyle [RunElem]
@@ -458,6 +485,75 @@ data Run = Run RunStyle [RunElem]
458485 | Endnote String
459486 deriving Show
460487
488+data OMath = OMath [OMathElem]
489+ deriving Show
490+
491+data OMathElem = Accent AccentStyle Base
492+ | Bar BarStyle Base
493+ | Box Base
494+ | BorderBox Base
495+ | Delimiter DelimStyle [Base]
496+ | EquationArray [Base]
497+ | Fraction [OMathElem] [OMathElem]
498+ | Function [OMathElem] Base
499+ | Group GroupStyle Base
500+ | LowerLimit Base [OMathElem]
501+ | UpperLimit Base [OMathElem]
502+ | Matrix [[Base]]
503+ | NAry NAryStyle [OMathElem] [OMathElem] Base
504+ | Phantom Base
505+ | Radical [OMathElem] Base
506+ | PreSubSuper [OMathElem] [OMathElem] Base
507+ | Sub Base [OMathElem]
508+ | SubSuper Base [OMathElem] [OMathElem]
509+ | Super Base [OMathElem]
510+ | OMathRun OMathRunStyle Run
511+ deriving Show
512+
513+data Base = Base [OMathElem]
514+ deriving Show
515+
516+-- placeholders
517+type OMathParaStyle = [String]
518+
519+data TopBottom = Top | Bottom
520+ deriving Show
521+
522+data AccentStyle = AccentStyle { accentChar :: Maybe Char }
523+ deriving Show
524+
525+data BarStyle = BarStyle { barPos :: TopBottom}
526+ deriving Show
527+
528+data NAryStyle = NAryStyle { nAryChar :: Maybe Char
529+ , nAryLimLoc :: LimLoc}
530+ deriving Show
531+
532+defaultNAryStyle :: NAryStyle
533+defaultNAryStyle = NAryStyle { nAryChar = Nothing -- integral, in practice
534+ , nAryLimLoc = SubSup }
535+
536+data LimLoc = SubSup | UnderOver deriving Show
537+
538+data DelimStyle = DelimStyle { delimBegChar :: Maybe Char
539+ , delimSepChar :: Maybe Char
540+ , delimEndChar :: Maybe Char}
541+ deriving Show
542+
543+defaultDelimStyle :: DelimStyle
544+defaultDelimStyle = DelimStyle { delimBegChar = Nothing
545+ , delimSepChar = Nothing
546+ , delimEndChar = Nothing }
547+
548+data GroupStyle = GroupStyle { groupChr :: Maybe Char
549+ , groupPos :: Maybe TopBottom }
550+ deriving Show
551+
552+defaultGroupStyle :: GroupStyle
553+defaultGroupStyle = GroupStyle {groupChr = Nothing, groupPos = Nothing}
554+
555+type OMathRunStyle = [String]
556+
461557data RunElem = TextRun String | LnBrk | Tab
462558 deriving Show
463559
@@ -532,13 +628,13 @@ elemToRun _ _ = Nothing
532628elemToRunElem :: NameSpaces -> Element -> Maybe RunElem
533629elemToRunElem ns element
534630 | (qName (elName element) == "t" || qName (elName element) == "delText") &&
535− qURI (elName element) == (lookup "w" ns) =
631+ qURI (elName element) `elem` [(lookup "w" ns), (lookup "m" ns)] =
536632 Just $ TextRun (strContent element)
537633 | qName (elName element) == "br" &&
538− qURI (elName element) == (lookup "w" ns) =
634+ qURI (elName element) `elem` [(lookup "w" ns), (lookup "m" ns)] =
539635 Just $ LnBrk
540636 | qName (elName element) == "tab" &&
541− qURI (elName element) == (lookup "w" ns) =
637+ qURI (elName element) `elem` [(lookup "w" ns), (lookup "m" ns)] =
542638 Just $ Tab
543639 | otherwise = Nothing
544640
@@ -546,7 +642,7 @@ elemToRunElem ns element
546642elemToRunElems :: NameSpaces -> Element -> [RunElem]
547643elemToRunElems ns element
548644 | qName (elName element) == "r" &&
549− qURI (elName element) == (lookup "w" ns) =
645+ qURI (elName element) `elem` [(lookup "w" ns), (lookup "m" ns)] =
550646 mapMaybe (elemToRunElem ns) (elChildren element)
551647 | otherwise = []
552648
@@ -561,7 +657,233 @@ elemToDrawing ns element
561657 >>= (\s -> Just $ Drawing s)
562658elemToDrawing _ _ = Nothing
563659
660+elemToMath :: NameSpaces -> Element -> Maybe OMath
661+elemToMath ns element
662+ | qName (elName element) == "oMath" &&
663+ qURI (elName element) == (lookup "m" ns) =
664+ Just $ OMath $ mapMaybe (elemToMathElem ns) (elChildren element)
665+elemToMath _ _ = Nothing
666+
667+
668+
669+elemToBase :: NameSpaces -> Element -> Maybe Base
670+elemToBase ns element
671+ | qName (elName element) == "e" &&
672+ qURI (elName element) == (lookup "m" ns) =
673+ Just $ Base $ mapMaybe (elemToMathElem ns) (elChildren element)
674+elemToBase _ _ = Nothing
675+
676+elemToNAryStyle :: NameSpaces -> Element -> NAryStyle
677+elemToNAryStyle ns element
678+ | Just narypr <- findChild (QName "naryPr" (lookup "m" ns) (Just "m")) element =
679+ let
680+ chr = findChild (QName "chr" (lookup "m" ns) (Just "m")) narypr >>=
681+ findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
682+ Just . head
683+ limLoc = findChild (QName "limLoc" (lookup "m" ns) (Just "m")) narypr >>=
684+ findAttr (QName "val" (lookup "m" ns) (Just "m"))
685+ limLoc' = case limLoc of
686+ Just "undOver" -> UnderOver
687+ Just "subSup" -> SubSup
688+ _ -> SubSup
689+ in
690+ NAryStyle { nAryChar = chr, nAryLimLoc = limLoc'}
691+elemToNAryStyle _ _ = defaultNAryStyle
692+
693+elemToDelimStyle :: NameSpaces -> Element -> DelimStyle
694+elemToDelimStyle ns element
695+ | Just dPr <- findChild (QName "dPr" (lookup "m" ns) (Just "m")) element =
696+ let begChr = findChild (QName "begChr" (lookup "m" ns) (Just "m")) dPr >>=
697+ findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
698+ (\c -> if null c then Nothing else (Just $ head c))
699+ sepChr = findChild (QName "sepChr" (lookup "m" ns) (Just "m")) dPr >>=
700+ findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
701+ (\c -> if null c then Nothing else (Just $ head c))
702+ endChr = findChild (QName "endChr" (lookup "m" ns) (Just "m")) dPr >>=
703+ findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
704+ (\c -> if null c then Nothing else (Just $ head c))
705+ in
706+ DelimStyle { delimBegChar = begChr
707+ , delimSepChar = sepChr
708+ , delimEndChar = endChr}
709+elemToDelimStyle _ _ = defaultDelimStyle
710+
711+elemToGroupStyle :: NameSpaces -> Element -> GroupStyle
712+elemToGroupStyle ns element
713+ | Just gPr <- findChild (QName "groupChrPr" (lookup "m" ns) (Just "m")) element =
714+ let chr = findChild (QName "chr" (lookup "m" ns) (Just "m")) gPr >>=
715+ findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
716+ Just . head
717+ pos = findChild (QName "pos" (lookup "m" ns) (Just "m")) gPr >>=
718+ findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
719+ (\s -> Just $ if s == "top" then Top else Bottom)
720+ in
721+ GroupStyle { groupChr = chr, groupPos = pos }
722+elemToGroupStyle _ _ = defaultGroupStyle
723+
724+elemToMathElem :: NameSpaces -> Element -> Maybe OMathElem
725+elemToMathElem ns element
726+ | qName (elName element) == "acc" &&
727+ qURI (elName element) == (lookup "m" ns) = do
728+ let accChar =
729+ findChild (QName "accPr" (lookup "m" ns) (Just "m")) element >>=
730+ findChild (QName "chr" (lookup "m" ns) (Just "m")) >>=
731+ findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
732+ Just . head
733+ accPr = AccentStyle { accentChar = accChar}
734+ base <-findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
735+ elemToBase ns
736+ return $ Accent accPr base
737+elemToMathElem ns element
738+ | qName (elName element) == "bar" &&
739+ qURI (elName element) == (lookup "m" ns) = do
740+ barPr <- findChild (QName "barPr" (lookup "m" ns) (Just "m")) element >>=
741+ findChild (QName "pos" (lookup "m" ns) (Just "m")) >>=
742+ findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
743+ (\s ->
744+ Just $ BarStyle {
745+ barPos = (if s == "bot" then Bottom else Top)
746+ })
747+ base <-findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
748+ elemToBase ns
749+ return $ Bar barPr base
750+elemToMathElem ns element
751+ | qName (elName element) == "box" &&
752+ qURI (elName element) == (lookup "m" ns) =
753+ findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
754+ elemToBase ns >>=
755+ (\b -> Just $ Box b)
756+elemToMathElem ns element
757+ | qName (elName element) == "borderBox" &&
758+ qURI (elName element) == (lookup "m" ns) =
759+ findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
760+ elemToBase ns >>=
761+ (\b -> Just $ BorderBox b)
762+elemToMathElem ns element
763+ | qName (elName element) == "d" &&
764+ qURI (elName element) == (lookup "m" ns) =
765+ let style = elemToDelimStyle ns element
766+ in
767+ Just $ Delimiter style $ mapMaybe (elemToBase ns) (elChildren element)
768+elemToMathElem ns element
769+ | qName (elName element) == "eqArr" &&
770+ qURI (elName element) == (lookup "m" ns) =
771+ Just $ EquationArray
772+ $ mapMaybe (elemToBase ns) (elChildren element)
773+elemToMathElem ns element
774+ | qName (elName element) == "f" &&
775+ qURI (elName element) == (lookup "m" ns) = do
776+ num <- findChild (QName "num" (lookup "m" ns) (Just "m")) element
777+ den <- findChild (QName "den" (lookup "m" ns) (Just "m")) element
778+ let numElems = mapMaybe (elemToMathElem ns) (elChildren num)
779+ denElems = mapMaybe (elemToMathElem ns) (elChildren den)
780+ return $ Fraction numElems denElems
781+elemToMathElem ns element
782+ | qName (elName element) == "func" &&
783+ qURI (elName element) == (lookup "m" ns) = do
784+ fName <- findChild (QName "fName" (lookup "m" ns) (Just "m")) element
785+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
786+ elemToBase ns
787+ let fnElems = mapMaybe (elemToMathElem ns) (elChildren fName)
788+ return $ Function fnElems base
789+elemToMathElem ns element
790+ | qName (elName element) == "groupChr" &&
791+ qURI (elName element) == (lookup "m" ns) =
792+ let style = elemToGroupStyle ns element
793+ in
794+ findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
795+ elemToBase ns >>=
796+ (\b -> Just $ Group style b)
797+elemToMathElem ns element
798+ | qName (elName element) == "limLow" &&
799+ qURI (elName element) == (lookup "m" ns) = do
800+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element
801+ >>= elemToBase ns
802+ lim <- findChild (QName "lim" (lookup "m" ns) (Just "m")) element
803+ return $ LowerLimit base (mapMaybe (elemToMathElem ns) (elChildren lim))
804+elemToMathElem ns element
805+ | qName (elName element) == "limUpp" &&
806+ qURI (elName element) == (lookup "m" ns) = do
807+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element
808+ >>= elemToBase ns
809+ lim <- findChild (QName "lim" (lookup "m" ns) (Just "m")) element
810+ return $ UpperLimit base (mapMaybe (elemToMathElem ns) (elChildren lim))
811+elemToMathElem ns element
812+ | qName (elName element) == "m" &&
813+ qURI (elName element) == (lookup "m" ns) =
814+ let rows = findChildren (QName "mr" (lookup "m" ns) (Just "m")) element
815+ bases = map (\mr -> mapMaybe (elemToBase ns) (elChildren mr)) rows
816+ in
817+ Just $ Matrix bases
818+elemToMathElem ns element
819+ | qName (elName element) == "nary" &&
820+ qURI (elName element) == (lookup "m" ns) = do
821+ let style = elemToNAryStyle ns element
822+ sub <- findChild (QName "sub" (lookup "m" ns) (Just "m")) element >>=
823+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
824+ sup <- findChild (QName "sup" (lookup "m" ns) (Just "m")) element >>=
825+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
826+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
827+ elemToBase ns
828+ return $ NAry style sub sup base
829+elemToMathElem ns element
830+ | qName (elName element) == "rad" &&
831+ qURI (elName element) == (lookup "m" ns) = do
832+ deg <- findChild (QName "deg" (lookup "m" ns) (Just "m")) element >>=
833+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
834+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
835+ elemToBase ns
836+ return $ Radical deg base
837+-- skipping for now:
838+-- phant
839+elemToMathElem ns element
840+ | qName (elName element) == "sPre" &&
841+ qURI (elName element) == (lookup "m" ns) = do
842+ sub <- findChild (QName "sub" (lookup "m" ns) (Just "m")) element >>=
843+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
844+ sup <- findChild (QName "sup" (lookup "m" ns) (Just "m")) element >>=
845+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
846+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
847+ elemToBase ns
848+ return $ PreSubSuper sub sup base
849+elemToMathElem ns element
850+ | qName (elName element) == "sSub" &&
851+ qURI (elName element) == (lookup "m" ns) = do
852+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
853+ elemToBase ns
854+ sub <- findChild (QName "sub" (lookup "m" ns) (Just "m")) element >>=
855+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
856+ return $ Sub base sub
857+elemToMathElem ns element
858+ | qName (elName element) == "sSubSup" &&
859+ qURI (elName element) == (lookup "m" ns) = do
860+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
861+ elemToBase ns
862+ sub <- findChild (QName "sub" (lookup "m" ns) (Just "m")) element >>=
863+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
864+ sup <- findChild (QName "sup" (lookup "m" ns) (Just "m")) element >>=
865+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
866+ return $ SubSuper base sub sup
867+elemToMathElem ns element
868+ | qName (elName element) == "sSup" &&
869+ qURI (elName element) == (lookup "m" ns) = do
870+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
871+ elemToBase ns
872+ sup <- findChild (QName "sup" (lookup "m" ns) (Just "m")) element >>=
873+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
874+ return $ Super base sup
875+elemToMathElem ns element
876+ | qName (elName element) == "r" &&
877+ qURI (elName element) == (lookup "m" ns) =
878+ let style = [] -- placeholder
879+ rstyle = elemToRunStyle ns element
880+ relems = elemToRunElems ns element
881+ in
882+ Just $ OMathRun style $ Run rstyle relems
883+elemToMathElem _ _ = Nothing
884+
564885
886+
565887elemToParPart :: NameSpaces -> Element -> Maybe ParPart
566888elemToParPart ns element
567889 | qName (elName element) == "r" &&
@@ -606,8 +928,14 @@ elemToParPart ns element
606928 case findAttr (QName "id" (lookup "r" ns) (Just "r")) element of
607929 Just relId -> Just $ ExternalHyperLink relId runs
608930 Nothing -> Nothing
931+elemToParPart ns element
932+ | qName (elName element) == "oMath" &&
933+ qURI (elName element) == (lookup "m" ns) =
934+ elemToMath ns element >>=
935+ (\m -> Just $ PlainOMath m)
609936elemToParPart _ _ = Nothing
610937
938+
611939type Target = String
612940type Anchor = String
613941type BookMarkId = String