Merge pull request #1397 from jkr/equations
Docx Reader: Parse Docx OMML math/equations
This commit is contained in:
John MacFarlane
commit
186b8e71e0
4 changed files with 4895 additions and 12 deletions
|
|
@ -329,6 +329,7 @@ Library
|
|||
Other-Modules: Text.Pandoc.Readers.Docx.Lists,
|
||||
Text.Pandoc.Readers.Docx.Reducible,
|
||||
Text.Pandoc.Readers.Docx.Parse,
|
||||
Text.Pandoc.Readers.Docx.TexChar,
|
||||
Text.Pandoc.Writers.Shared,
|
||||
Text.Pandoc.Asciify,
|
||||
Text.Pandoc.MIME,
|
||||
|
|
|
|||
|
|
@ -84,9 +84,10 @@ import Text.Pandoc.Walk
|
|||
import Text.Pandoc.Readers.Docx.Parse
|
||||
import Text.Pandoc.Readers.Docx.Lists
|
||||
import Text.Pandoc.Readers.Docx.Reducible
|
||||
import Text.Pandoc.Readers.Docx.TexChar
|
||||
import Text.Pandoc.Shared
|
||||
import Data.Maybe (mapMaybe)
|
||||
import Data.List (delete, isPrefixOf, (\\))
|
||||
import Data.Maybe (mapMaybe, fromMaybe)
|
||||
import Data.List (delete, isPrefixOf, (\\), intercalate)
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as B
|
||||
import Data.ByteString.Base64 (encode)
|
||||
|
|
@ -94,6 +95,7 @@ import System.FilePath (combine)
|
|||
import qualified Data.Map as M
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.State
|
||||
import Text.Printf (printf)
|
||||
|
||||
readDocx :: ReaderOptions
|
||||
-> B.ByteString
|
||||
|
|
@ -103,7 +105,8 @@ readDocx opts bytes =
|
|||
Just docx -> Pandoc nullMeta (docxToBlocks opts docx)
|
||||
Nothing -> error $ "couldn't parse docx file"
|
||||
|
||||
data DState = DState { docxAnchorMap :: M.Map String String }
|
||||
data DState = DState { docxAnchorMap :: M.Map String String
|
||||
, docxInTexSubscript :: Bool }
|
||||
|
||||
data DEnv = DEnv { docxOptions :: ReaderOptions
|
||||
, docxDocument :: Docx}
|
||||
|
|
@ -115,6 +118,14 @@ updateDState f = do
|
|||
st <- get
|
||||
put $ f st
|
||||
|
||||
withDState :: DState -> DocxContext a -> DocxContext a
|
||||
withDState ds dctx = do
|
||||
ds' <- get
|
||||
updateDState (\_ -> ds)
|
||||
dctx' <- dctx
|
||||
put ds'
|
||||
return dctx'
|
||||
|
||||
evalDocxContext :: DocxContext a -> DEnv -> DState -> a
|
||||
evalDocxContext ctx env st = evalState (runReaderT ctx env) st
|
||||
|
||||
|
|
@ -318,6 +329,158 @@ parPartToInlines (ExternalHyperLink relid runs) = do
|
|||
[Link rs (target, "")]
|
||||
Nothing ->
|
||||
[Link rs ("", "")]
|
||||
parPartToInlines (PlainOMath omath) = do
|
||||
s <- oMathToTexString omath
|
||||
return [Math InlineMath s]
|
||||
|
||||
oMathToTexString :: OMath -> DocxContext String
|
||||
oMathToTexString (OMath omathElems) = do
|
||||
ss <- mapM oMathElemToTexString omathElems
|
||||
return $ intercalate " " ss
|
||||
oMathElemToTexString :: OMathElem -> DocxContext String
|
||||
oMathElemToTexString (Accent style base) | Just c <- accentChar style = do
|
||||
baseString <- baseToTexString base
|
||||
return $ case lookupTexChar c of
|
||||
s@('\\' : _) -> printf "%s{%s}" s baseString
|
||||
_ -> printf "\\acute{%s}" baseString -- we default.
|
||||
oMathElemToTexString (Accent _ base) =
|
||||
baseToTexString base >>= (\s -> return $ printf "\\acute{%s}" s)
|
||||
oMathElemToTexString (Bar style base) = do
|
||||
baseString <- baseToTexString base
|
||||
return $ case barPos style of
|
||||
Top -> printf "\\overline{%s}" baseString
|
||||
Bottom -> printf "\\underline{%s}" baseString
|
||||
oMathElemToTexString (Box base) = baseToTexString base
|
||||
oMathElemToTexString (BorderBox base) =
|
||||
baseToTexString base >>= (\s -> return $ printf "\\boxed{%s}" s)
|
||||
oMathElemToTexString (Delimiter dPr bases) = do
|
||||
let beg = fromMaybe '(' (delimBegChar dPr)
|
||||
end = fromMaybe ')' (delimEndChar dPr)
|
||||
sep = fromMaybe '|' (delimSepChar dPr)
|
||||
left = "\\left" ++ lookupTexChar beg
|
||||
right = "\\right" ++ lookupTexChar end
|
||||
mid = "\\middle" ++ lookupTexChar sep
|
||||
baseStrings <- mapM baseToTexString bases
|
||||
return $ printf "%s %s %s"
|
||||
left
|
||||
(intercalate (" " ++ mid ++ " ") baseStrings)
|
||||
right
|
||||
oMathElemToTexString (EquationArray bases) = do
|
||||
baseStrings <- mapM baseToTexString bases
|
||||
inSub <- gets docxInTexSubscript
|
||||
return $
|
||||
if inSub
|
||||
then
|
||||
printf "\\substack{%s}" (intercalate "\\\\ " baseStrings)
|
||||
else
|
||||
printf
|
||||
"\\begin{aligned}\n%s\n\\end{aligned}"
|
||||
(intercalate "\\\\\n" baseStrings)
|
||||
oMathElemToTexString (Fraction num denom) = do
|
||||
numString <- concatMapM oMathElemToTexString num
|
||||
denString <- concatMapM oMathElemToTexString denom
|
||||
return $ printf "\\frac{%s}{%s}" numString denString
|
||||
oMathElemToTexString (Function fname base) = do
|
||||
fnameString <- concatMapM oMathElemToTexString fname
|
||||
baseString <- baseToTexString base
|
||||
return $ printf "%s %s" fnameString baseString
|
||||
oMathElemToTexString (Group style base)
|
||||
| Just c <- groupChr style
|
||||
, grouper <- lookupTexChar c
|
||||
, notElem grouper ["\\overbrace", "\\underbrace"]
|
||||
= do
|
||||
baseString <- baseToTexString base
|
||||
return $ case groupPos style of
|
||||
Just Top -> printf "\\overset{%s}{%s}" grouper baseString
|
||||
_ -> printf "\\underset{%s}{%s}" grouper baseString
|
||||
oMathElemToTexString (Group style base) = do
|
||||
baseString <- baseToTexString base
|
||||
return $ case groupPos style of
|
||||
Just Top -> printf "\\overbrace{%s}" baseString
|
||||
_ -> printf "\\underbrace{%s}" baseString
|
||||
oMathElemToTexString (LowerLimit base limElems) = do
|
||||
baseString <- baseToTexString base
|
||||
lim <- concatMapM oMathElemToTexString limElems
|
||||
-- we want to make sure to replace the `\rightarrow` with `\to`
|
||||
let arrowToTo :: String -> String
|
||||
arrowToTo "" = ""
|
||||
arrowToTo s | "\\rightarrow" `isPrefixOf` s =
|
||||
"\\to" ++ (arrowToTo $ drop (length "\\rightarrow") s)
|
||||
arrowToTo (c:cs) = c : arrowToTo cs
|
||||
lim' = arrowToTo lim
|
||||
return $ case baseString of
|
||||
"lim" -> printf "\\lim_{%s}" lim'
|
||||
"max" -> printf "\\max_{%s}" lim'
|
||||
"min" -> printf "\\min_{%s}" lim'
|
||||
_ -> printf "\\operatorname*{%s}_{%s}" baseString lim'
|
||||
oMathElemToTexString (UpperLimit base limElems) = do
|
||||
baseString <- baseToTexString base
|
||||
lim <- concatMapM oMathElemToTexString limElems
|
||||
-- we want to make sure to replace the `\rightarrow` with `\to`
|
||||
let arrowToTo :: String -> String
|
||||
arrowToTo "" = ""
|
||||
arrowToTo s | "\\rightarrow" `isPrefixOf` s =
|
||||
"\\to" ++ (arrowToTo $ drop (length "\\rightarrow") s)
|
||||
arrowToTo (c:cs) = c : arrowToTo cs
|
||||
lim' = arrowToTo lim
|
||||
return $ case baseString of
|
||||
"lim" -> printf "\\lim^{%s}" lim'
|
||||
"max" -> printf "\\max^{%s}" lim'
|
||||
"min" -> printf "\\min^{%s}" lim'
|
||||
_ -> printf "\\operatorname*{%s}^{%s}" baseString lim'
|
||||
oMathElemToTexString (Matrix bases) = do
|
||||
let rowString :: [Base] -> DocxContext String
|
||||
rowString bs = liftM (intercalate " & ") (mapM baseToTexString bs)
|
||||
|
||||
s <- liftM (intercalate " \\\\\n")(mapM rowString bases)
|
||||
return $ printf "\\begin{matrix}\n%s\n\\end{matrix}" s
|
||||
oMathElemToTexString (NAry style sub sup base) | Just c <- nAryChar style = do
|
||||
ds <- gets (\s -> s{docxInTexSubscript = True})
|
||||
subString <- withDState ds $ concatMapM oMathElemToTexString sub
|
||||
supString <- concatMapM oMathElemToTexString sup
|
||||
baseString <- baseToTexString base
|
||||
return $ case M.lookup c uniconvMap of
|
||||
Just s@('\\':_) -> printf "%s_{%s}^{%s}{%s}"
|
||||
s subString supString baseString
|
||||
_ -> printf "\\operatorname*{%s}_{%s}^{%s}{%s}"
|
||||
[c] subString supString baseString
|
||||
oMathElemToTexString (NAry _ sub sup base) = do
|
||||
subString <- concatMapM oMathElemToTexString sub
|
||||
supString <- concatMapM oMathElemToTexString sup
|
||||
baseString <- baseToTexString base
|
||||
return $ printf "\\int_{%s}^{%s}{%s}"
|
||||
subString supString baseString
|
||||
oMathElemToTexString (Radical degree base) = do
|
||||
degString <- concatMapM oMathElemToTexString degree
|
||||
baseString <- baseToTexString base
|
||||
return $ case trim degString of
|
||||
"" -> printf "\\sqrt{%s}" baseString
|
||||
_ -> printf "\\sqrt[%s]{%s}" degString baseString
|
||||
oMathElemToTexString (PreSubSuper sub sup base) = do
|
||||
subString <- concatMapM oMathElemToTexString sub
|
||||
supString <- concatMapM oMathElemToTexString sup
|
||||
baseString <- baseToTexString base
|
||||
return $ printf "_{%s}^{%s}%s" subString supString baseString
|
||||
oMathElemToTexString (Sub base sub) = do
|
||||
baseString <- baseToTexString base
|
||||
subString <- concatMapM oMathElemToTexString sub
|
||||
return $ printf "%s_{%s}" baseString subString
|
||||
oMathElemToTexString (SubSuper base sub sup) = do
|
||||
baseString <- baseToTexString base
|
||||
subString <- concatMapM oMathElemToTexString sub
|
||||
supString <- concatMapM oMathElemToTexString sup
|
||||
return $ printf "%s_{%s}^{%s}" baseString subString supString
|
||||
oMathElemToTexString (Super base sup) = do
|
||||
baseString <- baseToTexString base
|
||||
supString <- concatMapM oMathElemToTexString sup
|
||||
return $ printf "%s^{%s}" baseString supString
|
||||
oMathElemToTexString (OMathRun _ run) = return $ stringToTex $ runToString run
|
||||
oMathElemToTexString _ = return "[NOT IMPLEMENTED]"
|
||||
|
||||
baseToTexString :: Base -> DocxContext String
|
||||
baseToTexString (Base mathElems) =
|
||||
concatMapM oMathElemToTexString mathElems
|
||||
|
||||
|
||||
isAnchorSpan :: Inline -> Bool
|
||||
isAnchorSpan (Span (ident, classes, kvs) ils) =
|
||||
|
|
@ -445,6 +608,10 @@ bodyPartToBlocks (Tbl cap _ look (r:rs)) = do
|
|||
widths = replicate size 0 :: [Double]
|
||||
|
||||
return [Table caption alignments widths hdrCells cells]
|
||||
bodyPartToBlocks (OMathPara _ maths) = do
|
||||
omaths <- mapM oMathToTexString maths
|
||||
return [Para $ map (\s -> Math DisplayMath s) omaths]
|
||||
|
||||
|
||||
-- replace targets with generated anchors.
|
||||
rewriteLink :: Inline -> DocxContext Inline
|
||||
|
|
@ -480,7 +647,8 @@ bodyToBlocks (Body bps) = do
|
|||
|
||||
docxToBlocks :: ReaderOptions -> Docx -> [Block]
|
||||
docxToBlocks opts d@(Docx (Document _ body) _ _ _ _) =
|
||||
let dState = DState { docxAnchorMap = M.empty }
|
||||
let dState = DState { docxAnchorMap = M.empty
|
||||
, docxInTexSubscript = False}
|
||||
dEnv = DEnv { docxOptions = opts
|
||||
, docxDocument = d}
|
||||
in
|
||||
|
|
|
|||
|
|
@ -1,3 +1,5 @@
|
|||
{-# LANGUAGE PatternGuards #-}
|
||||
|
||||
{-
|
||||
Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu>
|
||||
|
||||
|
|
@ -35,6 +37,15 @@ module Text.Pandoc.Readers.Docx.Parse ( Docx(..)
|
|||
, BodyPart(..)
|
||||
, TblLook(..)
|
||||
, ParPart(..)
|
||||
, OMath(..)
|
||||
, OMathElem(..)
|
||||
, Base(..)
|
||||
, TopBottom(..)
|
||||
, AccentStyle(..)
|
||||
, BarStyle(..)
|
||||
, NAryStyle(..)
|
||||
, DelimStyle(..)
|
||||
, GroupStyle(..)
|
||||
, Run(..)
|
||||
, RunElem(..)
|
||||
, Notes
|
||||
|
|
@ -288,15 +299,30 @@ elemToNumInfo _ _ = Nothing
|
|||
|
||||
elemToBodyPart :: NameSpaces -> Element -> Maybe BodyPart
|
||||
elemToBodyPart ns element
|
||||
| qName (elName element) == "p" &&
|
||||
qURI (elName element) == (lookup "w" ns)
|
||||
, (c:_) <- findChildren (QName "oMathPara" (lookup "m" ns) (Just "m")) element =
|
||||
let style = [] -- placeholder
|
||||
maths = mapMaybe (elemToMath ns)
|
||||
$ findChildren
|
||||
(QName "oMath" (lookup "m" ns) (Just "m")) c
|
||||
in
|
||||
Just $ OMathPara style maths
|
||||
| qName (elName element) == "p" &&
|
||||
qURI (elName element) == (lookup "w" ns)
|
||||
, Just (numId, lvl) <- elemToNumInfo ns element =
|
||||
let parstyle = elemToParagraphStyle ns element
|
||||
parparts = mapMaybe (elemToParPart ns)
|
||||
$ elChildren element
|
||||
in
|
||||
Just $ ListItem parstyle numId lvl parparts
|
||||
| qName (elName element) == "p" &&
|
||||
qURI (elName element) == (lookup "w" ns) =
|
||||
let parstyle = elemToParagraphStyle ns element
|
||||
parparts = mapMaybe (elemToParPart ns)
|
||||
$ elChildren element
|
||||
in
|
||||
case elemToNumInfo ns element of
|
||||
Just (numId, lvl) -> Just $ ListItem parstyle numId lvl parparts
|
||||
Nothing -> Just $ Paragraph parstyle parparts
|
||||
Just $ Paragraph parstyle parparts
|
||||
| qName (elName element) == "tbl" &&
|
||||
qURI (elName element) == (lookup "w" ns) =
|
||||
let
|
||||
|
|
@ -392,7 +418,7 @@ elemToParagraphStyle ns element =
|
|||
data BodyPart = Paragraph ParagraphStyle [ParPart]
|
||||
| ListItem ParagraphStyle String String [ParPart]
|
||||
| Tbl String TblGrid TblLook [Row]
|
||||
|
||||
| OMathPara OMathParaStyle [OMath]
|
||||
deriving Show
|
||||
|
||||
type TblGrid = [Integer]
|
||||
|
|
@ -451,6 +477,7 @@ data ParPart = PlainRun Run
|
|||
| InternalHyperLink Anchor [Run]
|
||||
| ExternalHyperLink RelId [Run]
|
||||
| Drawing String
|
||||
| PlainOMath OMath
|
||||
deriving Show
|
||||
|
||||
data Run = Run RunStyle [RunElem]
|
||||
|
|
@ -458,6 +485,75 @@ data Run = Run RunStyle [RunElem]
|
|||
| Endnote String
|
||||
deriving Show
|
||||
|
||||
data OMath = OMath [OMathElem]
|
||||
deriving Show
|
||||
|
||||
data OMathElem = Accent AccentStyle Base
|
||||
| Bar BarStyle Base
|
||||
| Box Base
|
||||
| BorderBox Base
|
||||
| Delimiter DelimStyle [Base]
|
||||
| EquationArray [Base]
|
||||
| Fraction [OMathElem] [OMathElem]
|
||||
| Function [OMathElem] Base
|
||||
| Group GroupStyle Base
|
||||
| LowerLimit Base [OMathElem]
|
||||
| UpperLimit Base [OMathElem]
|
||||
| Matrix [[Base]]
|
||||
| NAry NAryStyle [OMathElem] [OMathElem] Base
|
||||
| Phantom Base
|
||||
| Radical [OMathElem] Base
|
||||
| PreSubSuper [OMathElem] [OMathElem] Base
|
||||
| Sub Base [OMathElem]
|
||||
| SubSuper Base [OMathElem] [OMathElem]
|
||||
| Super Base [OMathElem]
|
||||
| OMathRun OMathRunStyle Run
|
||||
deriving Show
|
||||
|
||||
data Base = Base [OMathElem]
|
||||
deriving Show
|
||||
|
||||
-- placeholders
|
||||
type OMathParaStyle = [String]
|
||||
|
||||
data TopBottom = Top | Bottom
|
||||
deriving Show
|
||||
|
||||
data AccentStyle = AccentStyle { accentChar :: Maybe Char }
|
||||
deriving Show
|
||||
|
||||
data BarStyle = BarStyle { barPos :: TopBottom}
|
||||
deriving Show
|
||||
|
||||
data NAryStyle = NAryStyle { nAryChar :: Maybe Char
|
||||
, nAryLimLoc :: LimLoc}
|
||||
deriving Show
|
||||
|
||||
defaultNAryStyle :: NAryStyle
|
||||
defaultNAryStyle = NAryStyle { nAryChar = Nothing -- integral, in practice
|
||||
, nAryLimLoc = SubSup }
|
||||
|
||||
data LimLoc = SubSup | UnderOver deriving Show
|
||||
|
||||
data DelimStyle = DelimStyle { delimBegChar :: Maybe Char
|
||||
, delimSepChar :: Maybe Char
|
||||
, delimEndChar :: Maybe Char}
|
||||
deriving Show
|
||||
|
||||
defaultDelimStyle :: DelimStyle
|
||||
defaultDelimStyle = DelimStyle { delimBegChar = Nothing
|
||||
, delimSepChar = Nothing
|
||||
, delimEndChar = Nothing }
|
||||
|
||||
data GroupStyle = GroupStyle { groupChr :: Maybe Char
|
||||
, groupPos :: Maybe TopBottom }
|
||||
deriving Show
|
||||
|
||||
defaultGroupStyle :: GroupStyle
|
||||
defaultGroupStyle = GroupStyle {groupChr = Nothing, groupPos = Nothing}
|
||||
|
||||
type OMathRunStyle = [String]
|
||||
|
||||
data RunElem = TextRun String | LnBrk | Tab
|
||||
deriving Show
|
||||
|
||||
|
|
@ -532,13 +628,13 @@ elemToRun _ _ = Nothing
|
|||
elemToRunElem :: NameSpaces -> Element -> Maybe RunElem
|
||||
elemToRunElem ns element
|
||||
| (qName (elName element) == "t" || qName (elName element) == "delText") &&
|
||||
qURI (elName element) == (lookup "w" ns) =
|
||||
qURI (elName element) `elem` [(lookup "w" ns), (lookup "m" ns)] =
|
||||
Just $ TextRun (strContent element)
|
||||
| qName (elName element) == "br" &&
|
||||
qURI (elName element) == (lookup "w" ns) =
|
||||
qURI (elName element) `elem` [(lookup "w" ns), (lookup "m" ns)] =
|
||||
Just $ LnBrk
|
||||
| qName (elName element) == "tab" &&
|
||||
qURI (elName element) == (lookup "w" ns) =
|
||||
qURI (elName element) `elem` [(lookup "w" ns), (lookup "m" ns)] =
|
||||
Just $ Tab
|
||||
| otherwise = Nothing
|
||||
|
||||
|
|
@ -546,7 +642,7 @@ elemToRunElem ns element
|
|||
elemToRunElems :: NameSpaces -> Element -> [RunElem]
|
||||
elemToRunElems ns element
|
||||
| qName (elName element) == "r" &&
|
||||
qURI (elName element) == (lookup "w" ns) =
|
||||
qURI (elName element) `elem` [(lookup "w" ns), (lookup "m" ns)] =
|
||||
mapMaybe (elemToRunElem ns) (elChildren element)
|
||||
| otherwise = []
|
||||
|
||||
|
|
@ -561,7 +657,233 @@ elemToDrawing ns element
|
|||
>>= (\s -> Just $ Drawing s)
|
||||
elemToDrawing _ _ = Nothing
|
||||
|
||||
elemToMath :: NameSpaces -> Element -> Maybe OMath
|
||||
elemToMath ns element
|
||||
| qName (elName element) == "oMath" &&
|
||||
qURI (elName element) == (lookup "m" ns) =
|
||||
Just $ OMath $ mapMaybe (elemToMathElem ns) (elChildren element)
|
||||
elemToMath _ _ = Nothing
|
||||
|
||||
|
||||
|
||||
elemToBase :: NameSpaces -> Element -> Maybe Base
|
||||
elemToBase ns element
|
||||
| qName (elName element) == "e" &&
|
||||
qURI (elName element) == (lookup "m" ns) =
|
||||
Just $ Base $ mapMaybe (elemToMathElem ns) (elChildren element)
|
||||
elemToBase _ _ = Nothing
|
||||
|
||||
elemToNAryStyle :: NameSpaces -> Element -> NAryStyle
|
||||
elemToNAryStyle ns element
|
||||
| Just narypr <- findChild (QName "naryPr" (lookup "m" ns) (Just "m")) element =
|
||||
let
|
||||
chr = findChild (QName "chr" (lookup "m" ns) (Just "m")) narypr >>=
|
||||
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
|
||||
Just . head
|
||||
limLoc = findChild (QName "limLoc" (lookup "m" ns) (Just "m")) narypr >>=
|
||||
findAttr (QName "val" (lookup "m" ns) (Just "m"))
|
||||
limLoc' = case limLoc of
|
||||
Just "undOver" -> UnderOver
|
||||
Just "subSup" -> SubSup
|
||||
_ -> SubSup
|
||||
in
|
||||
NAryStyle { nAryChar = chr, nAryLimLoc = limLoc'}
|
||||
elemToNAryStyle _ _ = defaultNAryStyle
|
||||
|
||||
elemToDelimStyle :: NameSpaces -> Element -> DelimStyle
|
||||
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))
|
||||
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))
|
||||
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))
|
||||
in
|
||||
DelimStyle { delimBegChar = begChr
|
||||
, delimSepChar = sepChr
|
||||
, delimEndChar = endChr}
|
||||
elemToDelimStyle _ _ = defaultDelimStyle
|
||||
|
||||
elemToGroupStyle :: NameSpaces -> Element -> GroupStyle
|
||||
elemToGroupStyle ns element
|
||||
| Just gPr <- findChild (QName "groupChrPr" (lookup "m" ns) (Just "m")) element =
|
||||
let chr = findChild (QName "chr" (lookup "m" ns) (Just "m")) gPr >>=
|
||||
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
|
||||
Just . head
|
||||
pos = findChild (QName "pos" (lookup "m" ns) (Just "m")) gPr >>=
|
||||
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
|
||||
(\s -> Just $ if s == "top" then Top else Bottom)
|
||||
in
|
||||
GroupStyle { groupChr = chr, groupPos = pos }
|
||||
elemToGroupStyle _ _ = defaultGroupStyle
|
||||
|
||||
elemToMathElem :: NameSpaces -> Element -> Maybe OMathElem
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "acc" &&
|
||||
qURI (elName element) == (lookup "m" ns) = 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")) >>=
|
||||
Just . head
|
||||
accPr = AccentStyle { accentChar = accChar}
|
||||
base <-findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
|
||||
elemToBase ns
|
||||
return $ Accent accPr base
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "bar" &&
|
||||
qURI (elName element) == (lookup "m" ns) = do
|
||||
barPr <- findChild (QName "barPr" (lookup "m" ns) (Just "m")) element >>=
|
||||
findChild (QName "pos" (lookup "m" ns) (Just "m")) >>=
|
||||
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
|
||||
(\s ->
|
||||
Just $ BarStyle {
|
||||
barPos = (if s == "bot" then Bottom else Top)
|
||||
})
|
||||
base <-findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
|
||||
elemToBase ns
|
||||
return $ Bar barPr base
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "box" &&
|
||||
qURI (elName element) == (lookup "m" ns) =
|
||||
findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
|
||||
elemToBase ns >>=
|
||||
(\b -> Just $ Box b)
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "borderBox" &&
|
||||
qURI (elName element) == (lookup "m" ns) =
|
||||
findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
|
||||
elemToBase ns >>=
|
||||
(\b -> Just $ BorderBox b)
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "d" &&
|
||||
qURI (elName element) == (lookup "m" ns) =
|
||||
let style = elemToDelimStyle ns element
|
||||
in
|
||||
Just $ Delimiter style $ mapMaybe (elemToBase ns) (elChildren element)
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "eqArr" &&
|
||||
qURI (elName element) == (lookup "m" ns) =
|
||||
Just $ EquationArray
|
||||
$ mapMaybe (elemToBase ns) (elChildren element)
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "f" &&
|
||||
qURI (elName element) == (lookup "m" ns) = do
|
||||
num <- findChild (QName "num" (lookup "m" ns) (Just "m")) element
|
||||
den <- findChild (QName "den" (lookup "m" ns) (Just "m")) element
|
||||
let numElems = mapMaybe (elemToMathElem ns) (elChildren num)
|
||||
denElems = mapMaybe (elemToMathElem ns) (elChildren den)
|
||||
return $ Fraction numElems denElems
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "func" &&
|
||||
qURI (elName element) == (lookup "m" ns) = do
|
||||
fName <- findChild (QName "fName" (lookup "m" ns) (Just "m")) element
|
||||
base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
|
||||
elemToBase ns
|
||||
let fnElems = mapMaybe (elemToMathElem ns) (elChildren fName)
|
||||
return $ Function fnElems base
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "groupChr" &&
|
||||
qURI (elName element) == (lookup "m" ns) =
|
||||
let style = elemToGroupStyle ns element
|
||||
in
|
||||
findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
|
||||
elemToBase ns >>=
|
||||
(\b -> Just $ Group style b)
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "limLow" &&
|
||||
qURI (elName element) == (lookup "m" ns) = do
|
||||
base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element
|
||||
>>= elemToBase ns
|
||||
lim <- findChild (QName "lim" (lookup "m" ns) (Just "m")) element
|
||||
return $ LowerLimit base (mapMaybe (elemToMathElem ns) (elChildren lim))
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "limUpp" &&
|
||||
qURI (elName element) == (lookup "m" ns) = do
|
||||
base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element
|
||||
>>= elemToBase ns
|
||||
lim <- findChild (QName "lim" (lookup "m" ns) (Just "m")) element
|
||||
return $ UpperLimit base (mapMaybe (elemToMathElem ns) (elChildren lim))
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "m" &&
|
||||
qURI (elName element) == (lookup "m" ns) =
|
||||
let rows = findChildren (QName "mr" (lookup "m" ns) (Just "m")) element
|
||||
bases = map (\mr -> mapMaybe (elemToBase ns) (elChildren mr)) rows
|
||||
in
|
||||
Just $ Matrix bases
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "nary" &&
|
||||
qURI (elName element) == (lookup "m" ns) = do
|
||||
let style = elemToNAryStyle ns element
|
||||
sub <- findChild (QName "sub" (lookup "m" ns) (Just "m")) element >>=
|
||||
(\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
|
||||
sup <- findChild (QName "sup" (lookup "m" ns) (Just "m")) element >>=
|
||||
(\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
|
||||
base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
|
||||
elemToBase ns
|
||||
return $ NAry style sub sup base
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "rad" &&
|
||||
qURI (elName element) == (lookup "m" ns) = do
|
||||
deg <- findChild (QName "deg" (lookup "m" ns) (Just "m")) element >>=
|
||||
(\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
|
||||
base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
|
||||
elemToBase ns
|
||||
return $ Radical deg base
|
||||
-- skipping for now:
|
||||
-- phant
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "sPre" &&
|
||||
qURI (elName element) == (lookup "m" ns) = do
|
||||
sub <- findChild (QName "sub" (lookup "m" ns) (Just "m")) element >>=
|
||||
(\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
|
||||
sup <- findChild (QName "sup" (lookup "m" ns) (Just "m")) element >>=
|
||||
(\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
|
||||
base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
|
||||
elemToBase ns
|
||||
return $ PreSubSuper sub sup base
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "sSub" &&
|
||||
qURI (elName element) == (lookup "m" ns) = do
|
||||
base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
|
||||
elemToBase ns
|
||||
sub <- findChild (QName "sub" (lookup "m" ns) (Just "m")) element >>=
|
||||
(\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
|
||||
return $ Sub base sub
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "sSubSup" &&
|
||||
qURI (elName element) == (lookup "m" ns) = do
|
||||
base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
|
||||
elemToBase ns
|
||||
sub <- findChild (QName "sub" (lookup "m" ns) (Just "m")) element >>=
|
||||
(\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
|
||||
sup <- findChild (QName "sup" (lookup "m" ns) (Just "m")) element >>=
|
||||
(\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
|
||||
return $ SubSuper base sub sup
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "sSup" &&
|
||||
qURI (elName element) == (lookup "m" ns) = do
|
||||
base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
|
||||
elemToBase ns
|
||||
sup <- findChild (QName "sup" (lookup "m" ns) (Just "m")) element >>=
|
||||
(\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))
|
||||
return $ Super base sup
|
||||
elemToMathElem ns element
|
||||
| qName (elName element) == "r" &&
|
||||
qURI (elName element) == (lookup "m" ns) =
|
||||
let style = [] -- placeholder
|
||||
rstyle = elemToRunStyle ns element
|
||||
relems = elemToRunElems ns element
|
||||
in
|
||||
Just $ OMathRun style $ Run rstyle relems
|
||||
elemToMathElem _ _ = Nothing
|
||||
|
||||
|
||||
|
||||
elemToParPart :: NameSpaces -> Element -> Maybe ParPart
|
||||
elemToParPart ns element
|
||||
| qName (elName element) == "r" &&
|
||||
|
|
@ -606,8 +928,14 @@ elemToParPart ns element
|
|||
case findAttr (QName "id" (lookup "r" ns) (Just "r")) element of
|
||||
Just relId -> Just $ ExternalHyperLink relId runs
|
||||
Nothing -> Nothing
|
||||
elemToParPart ns element
|
||||
| qName (elName element) == "oMath" &&
|
||||
qURI (elName element) == (lookup "m" ns) =
|
||||
elemToMath ns element >>=
|
||||
(\m -> Just $ PlainOMath m)
|
||||
elemToParPart _ _ = Nothing
|
||||
|
||||
|
||||
type Target = String
|
||||
type Anchor = String
|
||||
type BookMarkId = String
|
||||
|
|
|
|||
4386
src/Text/Pandoc/Readers/Docx/TexChar.hs
Normal file
4386
src/Text/Pandoc/Readers/Docx/TexChar.hs
Normal file
File diff suppressed because it is too large
Load diff
Loading…
Add table
Reference in a new issue