aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Readers/Docx
diff options
context:
space:
mode:
authorJesse Rosenthal <jrosenthal@jhu.edu>2014-07-20 21:40:36 -0400
committerJesse Rosenthal <jrosenthal@jhu.edu>2014-08-06 11:20:27 -0400
commit3bc2ea4cf753997738f0247be854b04ca91456e3 (patch)
tree86d464a11005bb827128dc3540a0939f5080d9d8 /src/Text/Pandoc/Readers/Docx
parent1819bdfaed91670fef11b47d09e1de4d19034997 (diff)
downloadpandoc-3bc2ea4cf753997738f0247be854b04ca91456e3.tar.gz
Docx reader: Use TeXMath to write math
The new version of TeXMath can translate from its type system into LaTeX. So instead of writing the LaTeX ourself, we write to the TeXMath `Exp` type, and let TeXMath do the rest.
Diffstat (limited to 'src/Text/Pandoc/Readers/Docx')
-rw-r--r--src/Text/Pandoc/Readers/Docx/Parse.hs147
1 files changed, 125 insertions, 22 deletions
diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs
index cc93bc9ed..5cfe50c5c 100644
--- a/src/Text/Pandoc/Readers/Docx/Parse.hs
+++ b/src/Text/Pandoc/Readers/Docx/Parse.hs
@@ -45,6 +45,10 @@ module Text.Pandoc.Readers.Docx.Parse ( Docx(..)
, NAryStyle(..)
, DelimStyle(..)
, GroupStyle(..)
+ , OMathRunStyle(..)
+ , OMathRunTextStyle(..)
+ , OMathTextScript(..)
+ , OMathTextStyle(..)
, Run(..)
, RunElem(..)
, Notes
@@ -93,13 +97,14 @@ maybeToD :: Maybe a -> D a
maybeToD (Just a) = return a
maybeToD Nothing = throwError DocxError
-mapD :: (a -> D b) -> [a] -> D [b]
-mapD _ [] = return []
-mapD f (x:xs) = do
- y <- (f x >>= (\z -> return [z])) `catchError` (\_ -> return [])
- ys <- mapD f xs
- return $ y ++ ys
+concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
+concatMapM f xs = liftM concat (mapM f xs)
+mapD :: (a -> D b) -> [a] -> D [b]
+mapD f xs =
+ let handler x = (f x >>= (\y-> return [y])) `catchError` (\_ -> return [])
+ in
+ concatMapM handler xs
type NameSpaces = [(String, String)]
@@ -128,6 +133,7 @@ type Level = (String, String, String, Maybe Integer)
data Relationship = Relationship (RelId, Target)
deriving Show
+
data Notes = Notes NameSpaces
(Maybe (M.Map String Element))
(Maybe (M.Map String Element))
@@ -223,6 +229,30 @@ data NAryStyle = NAryStyle { nAryChar :: Maybe Char
, nAryLimLoc :: LimLoc}
deriving Show
+data OMathRunStyle = OMathRunStyle { oMathLit :: Bool
+ , oMathRunTextStyle :: OMathRunTextStyle }
+ deriving Show
+
+data OMathRunTextStyle = NoStyle
+ | Normal
+ | Styled { oMathScript :: Maybe OMathTextScript
+ , oMathStyle :: Maybe OMathTextStyle }
+ deriving Show
+
+data OMathTextScript = ORoman
+ | OScript
+ | OFraktur
+ | ODoubleStruck
+ | OSansSerif
+ | OMonospace
+ deriving (Show, Eq)
+
+data OMathTextStyle = OPlain
+ | OBold
+ | OItalic
+ | OBoldItalic
+ deriving (Show, Eq)
+
defaultNAryStyle :: NAryStyle
defaultNAryStyle = NAryStyle { nAryChar = Nothing -- integral, in practice
, nAryLimLoc = SubSup }
@@ -246,9 +276,6 @@ data GroupStyle = GroupStyle { groupChr :: Maybe Char
defaultGroupStyle :: GroupStyle
defaultGroupStyle = GroupStyle {groupChr = Nothing, groupPos = Nothing}
-type OMathRunStyle = [String]
-
-
data Run = Run RunStyle [RunElem]
| Footnote [BodyPart]
| Endnote [BodyPart]
@@ -596,6 +623,75 @@ elemToBase ns element | isElem ns "m" "e" element =
(\es -> return $ Base es)
elemToBase _ _ = throwError WrongElem
+-- TODO: The right way to do this is to use the ampersand to break the
+-- text lines into multiple columns. That's tricky, though, and this
+-- will get us most of the way for the time being.
+filterAmpersand :: OMathElem -> OMathElem
+filterAmpersand (OMathRun mrPr (Run wrPr elems)) =
+ let f (TextRun s) = TextRun $ filter ('&' /=) s
+ f re = re
+ in
+ OMathRun mrPr $ Run wrPr (map f elems)
+filterAmpersand e = e
+
+elemToBaseNoAmpersand :: NameSpaces -> Element -> D Base
+elemToBaseNoAmpersand ns element | isElem ns "m" "e" element =
+ mapD
+ (\e -> (elemToMathElem ns e >>= (return . filterAmpersand)))
+ (elChildren element) >>=
+ (\es -> return $ Base es)
+elemToBaseNoAmpersand _ _ = throwError WrongElem
+
+
+elemToOMathRunStyle :: NameSpaces -> Element -> OMathRunStyle
+elemToOMathRunStyle ns element =
+ let lit =
+ case
+ findChild (elemName ns "m" "lit") element >>=
+ findAttr (elemName ns "m" "val")
+ of
+ Just "on" -> True
+ _ -> False
+ in
+ OMathRunStyle { oMathLit = lit
+ , oMathRunTextStyle = (elemToOMathRunTextStyle ns element)
+ }
+
+elemToOMathRunTextStyle :: NameSpaces -> Element -> OMathRunTextStyle
+elemToOMathRunTextStyle ns element
+ | Just mrPr <- findChild (elemName ns "m" "rPr") element
+ , Just _ <- findChild (elemName ns "m" "nor") mrPr =
+ Normal
+ | Just mrPr <- findChild (elemName ns "m" "rPr") element =
+ let scr =
+ case
+ findChild (elemName ns "m" "scr") mrPr >>=
+ findAttr (elemName ns "m" "val")
+ of
+ Just "roman" -> Just ORoman
+ Just "script" -> Just OScript
+ Just "fraktur" -> Just OFraktur
+ Just "double-struck" -> Just ODoubleStruck
+ Just "sans-serif" -> Just OSansSerif
+ Just "monospace" -> Just OMonospace
+ _ -> Nothing
+
+ sty =
+ case
+ findChild (elemName ns "m" "sty") mrPr >>=
+ findAttr (elemName ns "m" "val")
+ of
+ Just "p" -> Just OPlain
+ Just "b" -> Just OBold
+ Just "i" -> Just OItalic
+ Just "bi" -> Just OBoldItalic
+ _ -> Nothing
+ in
+ Styled { oMathScript = scr, oMathStyle = sty }
+ | otherwise = NoStyle
+
+
+
elemToNAryStyle :: NameSpaces -> Element -> NAryStyle
elemToNAryStyle ns element
| Just narypr <- findChild (QName "naryPr" (lookup "m" ns) (Just "m")) element =
@@ -618,13 +714,13 @@ elemToDelimStyle ns element
| Just dPr <- findChild (QName "dPr" (lookup "m" ns) (Just "m")) element =
let begChr = findChild (QName "begChr" (lookup "m" ns) (Just "m")) dPr >>=
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
- (\c -> if null c then Nothing else (Just $ head c))
+ (\c -> if null c then (Just ' ') else (Just $ head c))
sepChr = findChild (QName "sepChr" (lookup "m" ns) (Just "m")) dPr >>=
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
- (\c -> if null c then Nothing else (Just $ head c))
+ (\c -> if null c then (Just ' ') else (Just $ head c))
endChr = findChild (QName "endChr" (lookup "m" ns) (Just "m")) dPr >>=
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
- (\c -> if null c then Nothing else (Just $ head c))
+ (\c -> if null c then (Just ' ') else (Just $ head c))
in
DelimStyle { delimBegChar = begChr
, delimSepChar = sepChr
@@ -647,9 +743,9 @@ elemToGroupStyle _ _ = defaultGroupStyle
elemToMathElem :: NameSpaces -> Element -> D OMathElem
elemToMathElem ns element | isElem ns "m" "acc" element = do
let accChar =
- findChild (QName "accPr" (lookup "m" ns) (Just "m")) element >>=
- findChild (QName "chr" (lookup "m" ns) (Just "m")) >>=
- findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
+ findChild (elemName ns "m" "accPr") element >>=
+ findChild (elemName ns "m" "chr") >>=
+ findAttr (elemName ns "m" "val") >>=
Just . head
accPr = AccentStyle { accentChar = accChar}
base <-(maybeToD $ findChild (elemName ns "m" "e") element) >>=
@@ -681,7 +777,7 @@ elemToMathElem ns element | isElem ns "m" "d" element =
mapD (elemToBase ns) (elChildren element) >>=
(\es -> return $ Delimiter style es)
elemToMathElem ns element | isElem ns "m" "eqArr" element =
- mapD (elemToBase ns) (elChildren element) >>=
+ mapD (elemToBaseNoAmpersand ns) (elChildren element) >>=
(\es -> return $ EquationArray es)
elemToMathElem ns element | isElem ns "m" "f" element = do
num <- maybeToD $ findChild (elemName ns "m" "num") element
@@ -763,12 +859,12 @@ elemToMathElem ns element | isElem ns "m" "sSup" element = do
elemToBase ns
sup <- maybeToD (findChild (elemName ns "m" "sup") element) >>=
(\e -> mapD (elemToMathElem ns) (elChildren e))
- return $ Sub base sup
+ return $ Super base sup
elemToMathElem ns element | isElem ns "m" "r" element = do
- let style = [] -- placeholder
- rstyle = elemToRunStyle ns element
+ let mrPr = elemToOMathRunStyle ns element
+ wrPr = elemToRunStyle ns element
relems <- elemToRunElems ns element
- return $ OMathRun style $ Run rstyle relems
+ return $ OMathRun mrPr $ Run wrPr relems
elemToMathElem _ _ = throwError WrongElem
lookupRelationship :: RelId -> [Relationship] -> Maybe Target
@@ -832,6 +928,9 @@ elemToParPart ns element
return $ case lookupRelationship relId rels of
Just target -> ExternalHyperLink target runs
Nothing -> ExternalHyperLink "" runs
+elemToParPart ns element
+ | isElem ns "m" "oMath" element =
+ elemToMath ns element >>= (return . PlainOMath)
elemToParPart _ _ = throwError WrongElem
lookupFootnote :: String -> Notes -> Maybe Element
@@ -908,7 +1007,9 @@ elemToRunStyle _ _ = defaultRunStyle
elemToRunElem :: NameSpaces -> Element -> D RunElem
elemToRunElem ns element
- | isElem ns "w" "t" element || isElem ns "w" "delText" element =
+ | isElem ns "w" "t" element
+ || isElem ns "w" "delText" element
+ || isElem ns "m" "t" element =
return $ TextRun $ strContent element
| isElem ns "w" "br" element = return LnBrk
| isElem ns "w" "tab" element = return Tab
@@ -916,7 +1017,9 @@ elemToRunElem ns element
elemToRunElems :: NameSpaces -> Element -> D [RunElem]
elemToRunElems ns element
- | isElem ns "w" "r" element = mapD (elemToRunElem ns) (elChildren element)
+ | isElem ns "w" "r" element
+ || isElem ns "m" "r" element =
+ mapD (elemToRunElem ns) (elChildren element)
elemToRunElems _ _ = throwError WrongElem
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-30 09:40:49 +0000