aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Readers/Docx.hs246
-rw-r--r--src/Text/Pandoc/Readers/Docx/OMath.hs622
-rw-r--r--src/Text/Pandoc/Readers/Docx/Parse.hs373
3 files changed, 656 insertions, 585 deletions
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
index f19570aec..6dc3f11c2 100644
--- a/src/Text/Pandoc/Readers/Docx.hs
+++ b/src/Text/Pandoc/Readers/Docx.hs
@@ -84,15 +84,16 @@ import Text.Pandoc.Readers.Docx.Lists
import Text.Pandoc.Readers.Docx.Reducible
import Text.Pandoc.Shared
import Text.Pandoc.MediaBag (insertMedia, MediaBag)
-import Data.Maybe (mapMaybe, fromMaybe)
-import Data.List (delete, stripPrefix, (\\), intersperse, intersect)
+import Data.Maybe (mapMaybe)
+import Data.List (delete, stripPrefix, (\\), intersect)
import Data.Monoid
import Text.TeXMath (writeTeX)
-import qualified Text.TeXMath.Types as TM
+import Data.Default (Default)
import qualified Data.ByteString.Lazy as B
import qualified Data.Map as M
import Control.Monad.Reader
import Control.Monad.State
+import Control.Applicative ((<$>))
readDocx :: ReaderOptions
-> B.ByteString
@@ -104,25 +105,19 @@ readDocx opts bytes =
Left _ -> error $ "couldn't parse docx file"
data DState = DState { docxAnchorMap :: M.Map String String
- , docxMediaBag :: MediaBag
- , docxInHeaderBlock :: Bool}
+ , docxMediaBag :: MediaBag }
-defaultDState :: DState
-defaultDState = DState { docxAnchorMap = M.empty
- , docxMediaBag = mempty
- , docxInHeaderBlock = False}
+instance Default DState where
+ def = DState { docxAnchorMap = M.empty
+ , docxMediaBag = mempty }
-data DEnv = DEnv { docxOptions :: ReaderOptions}
+data DEnv = DEnv { docxOptions :: ReaderOptions
+ , docxInHeaderBlock :: Bool }
-type DocxContext = ReaderT DEnv (State DState)
+instance Default DEnv where
+ def = DEnv def False
-withDState :: (DState -> DState) -> DocxContext a -> DocxContext a
-withDState f dctx = do
- ds <- get
- modify f
- ctx' <- dctx
- put ds
- return ctx'
+type DocxContext = ReaderT DEnv (State DState)
evalDocxContext :: DocxContext a -> DEnv -> DState -> a
evalDocxContext ctx env st = evalState (runReaderT ctx env) st
@@ -161,7 +156,7 @@ isEmptyPar (Paragraph _ parParts) =
isEmptyElem (TextRun s) = trim s == ""
isEmptyElem _ = True
isEmptyPar _ = False
-
+
bodyPartsToMeta' :: [BodyPart] -> DocxContext (M.Map String MetaValue)
bodyPartsToMeta' [] = return M.empty
bodyPartsToMeta' (bp : bps)
@@ -170,7 +165,7 @@ bodyPartsToMeta' (bp : bps)
, (Just metaField) <- M.lookup c metaStyles = do
inlines <- parPartsToInlines parParts
remaining <- bodyPartsToMeta' bps
- let
+ let
f (MetaInlines ils) (MetaInlines ils') = MetaBlocks [Para ils, Para ils']
f (MetaInlines ils) (MetaBlocks blks) = MetaBlocks ((Para ils) : blks)
f m (MetaList mv) = MetaList (m : mv)
@@ -357,7 +352,7 @@ parPartToInlines (BookMark _ anchor) =
-- user-defined anchor links with header auto ids.
do
-- get whether we're in a header.
- inHdrBool <- gets docxInHeaderBlock
+ inHdrBool <- asks docxInHeaderBlock
-- Get the anchor map.
anchorMap <- gets docxAnchorMap
-- We don't want to rewrite if we're in a header, since we'll take
@@ -372,7 +367,8 @@ parPartToInlines (BookMark _ anchor) =
if not inHdrBool && anchor `elem` (M.elems anchorMap)
then uniqueIdent [Str anchor] (M.elems anchorMap)
else anchor
- modify $ \s -> s { docxAnchorMap = M.insert anchor newAnchor anchorMap}
+ unless inHdrBool
+ (modify $ \s -> s { docxAnchorMap = M.insert anchor newAnchor anchorMap})
return [Span (newAnchor, ["anchor"], []) []]
parPartToInlines (Drawing fp bs) = do
mediaBag <- gets docxMediaBag
@@ -384,193 +380,8 @@ parPartToInlines (InternalHyperLink anchor runs) = do
parPartToInlines (ExternalHyperLink target runs) = do
ils <- concatMapM runToInlines runs
return [Link ils (target, "")]
-parPartToInlines (PlainOMath omath) = do
- e <- oMathToExps omath
- return [Math InlineMath (writeTeX e)]
-
-oMathToExps :: OMath -> DocxContext [TM.Exp]
-oMathToExps (OMath oMathElems) = concatMapM oMathElemToExps oMathElems
-
-oMathElemToExps :: OMathElem -> DocxContext [TM.Exp]
-oMathElemToExps (Accent style base) = do
- baseExp <- baseToExp base
- let chr = case accentChar style of
- Just c -> c
- Nothing -> '\180' -- default to acute.
- return [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
-oMathElemToExps(Bar style base) = do
- baseExp <- baseToExp base
- return $ case barPos style of
- Top -> [TM.EOver False baseExp (TM.ESymbol TM.Accent "\175")]
- Bottom -> [TM.EUnder False baseExp (TM.ESymbol TM.Accent "\818")]
-oMathElemToExps (Box base) =
- (\e -> return [e]) =<< baseToExp base
-oMathElemToExps (BorderBox base) =
- -- TODO: This should be "\\boxed" somehow
- (\e -> return [e]) =<< baseToExp base
-oMathElemToExps (Delimiter dPr bases) = do
- baseExps <- mapM baseToExp bases
- let inDelimExps = map Right baseExps
- beg = fromMaybe '(' (delimBegChar dPr)
- end = fromMaybe ')' (delimEndChar dPr)
- sep = fromMaybe '|' (delimSepChar dPr)
- exps = intersperse (Left [sep]) inDelimExps
- return [TM.EDelimited [beg] [end] exps]
-oMathElemToExps (EquationArray bases) = do
- let f b = do bs <- baseToExp' b
- return [bs]
- baseExps <- mapM f bases
- return [TM.EArray [] baseExps]
-oMathElemToExps (Fraction num denom) = do
- numExp <- concatMapM oMathElemToExps num >>= (return . TM.EGrouped)
- denExp <- concatMapM oMathElemToExps denom >>= (return . TM.EGrouped)
- return [TM.EFraction TM.NormalFrac numExp denExp]
-oMathElemToExps (Function fname base) = do
- -- We need a string for the fname, but omml gives it to us as a
- -- series of oMath elems. We're going to filter out the oMathRuns,
- -- which should work for us most of the time.
- let f :: OMathElem -> String
- f (OMathRun _ run) = runToString run
- f _ = ""
- fnameString = concatMap f fname
- baseExp <- baseToExp base
- return [TM.EMathOperator fnameString, baseExp]
-oMathElemToExps (Group style base)
- | Just Top <- groupPos style = do
- baseExp <- baseToExp base
- let chr = case groupChr style of
- Just c -> c
- Nothing -> '\65079' -- default to overbrace
- return [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
- | otherwise = do
- baseExp <- baseToExp base
- let chr = case groupChr style of
- Just c -> c
- Nothing -> '\65080' -- default to underbrace
- return [TM.EUnder False baseExp (TM.ESymbol TM.Accent [chr])]
-oMathElemToExps (LowerLimit base limElems) = do
- baseExp <- baseToExp base
- lim <- concatMapM oMathElemToExps limElems >>= (return . TM.EGrouped)
- return [TM.EUnder True lim baseExp]
-oMathElemToExps (UpperLimit base limElems) = do
- baseExp <- baseToExp base
- lim <- concatMapM oMathElemToExps limElems >>= (return . TM.EGrouped)
- return [TM.EOver True lim baseExp]
-oMathElemToExps (Matrix bases) = do
- rows <- mapM (mapM (\b -> baseToExp' b)) bases
- return [TM.EArray [TM.AlignCenter] rows]
-oMathElemToExps (NAry style sub sup base) = do
- subExps <- concatMapM oMathElemToExps sub
- supExps <- concatMapM oMathElemToExps sup
- baseExp <- baseToExp base
- let opChar = case nAryChar style of
- Just c -> c
- -- default to integral
- Nothing -> '\8747'
- return [ TM.ESubsup
- (TM.ESymbol TM.Op [opChar])
- (TM.EGrouped subExps)
- (TM.EGrouped supExps)
- , baseExp]
-oMathElemToExps (Phantom base) =
- (\e -> return [TM.EPhantom e]) =<< baseToExp base
-oMathElemToExps (Radical degree base) = do
- degExps <- concatMapM oMathElemToExps degree
- baseExp <- baseToExp base
- return $ case degExps of
- [] -> [TM.ESqrt baseExp]
- ds -> [TM.ERoot (TM.EGrouped ds) baseExp]
-oMathElemToExps (PreSubSuper sub sup base) = do
- subExps <- concatMapM oMathElemToExps sub
- supExps <- concatMapM oMathElemToExps sup
- baseExp <- baseToExp base
- return [ TM.ESubsup
- (TM.EIdentifier "") (TM.EGrouped subExps) (TM.EGrouped supExps)
- , baseExp]
-oMathElemToExps (Sub base sub) = do
- baseExp <- baseToExp base
- subExps <- concatMapM oMathElemToExps sub
- return [TM.ESub baseExp (TM.EGrouped subExps)]
-oMathElemToExps (SubSuper base sub sup) = do
- baseExp <- baseToExp base
- subExps <- concatMapM oMathElemToExps sub
- supExps <- concatMapM oMathElemToExps sup
- return [TM.ESubsup baseExp (TM.EGrouped subExps) (TM.EGrouped supExps)]
-oMathElemToExps (Super base sup) = do
- baseExp <- baseToExp base
- supExps <- concatMapM oMathElemToExps sup
- return [TM.ESuper baseExp (TM.EGrouped supExps)]
-oMathElemToExps (OMathRun sty run@(Run _ _))
- | NoStyle <- oMathRunTextStyle sty =
- return $ [TM.EIdentifier $ runToString run]
- | Nothing <- oMathRunStyleToTextType sty =
- return $ [TM.EIdentifier $ runToString run]
- | Just textType <- oMathRunStyleToTextType sty =
- return $ if oMathLit sty
- then [TM.EText textType (runToString run)]
- else [TM.EStyled textType [TM.EIdentifier $ runToString run]]
-oMathElemToExps (OMathRun _ _) = return []
-
-oMathRunStyleToTextType :: OMathRunStyle -> Maybe TM.TextType
-oMathRunStyleToTextType mrPr
- | Normal <- oMathRunTextStyle mrPr =
- Just $ TM.TextNormal
- | Styled scr sty <- oMathRunTextStyle mrPr
- ,Just OBold <- sty
- , Just OSansSerif <- scr =
- Just $ TM.TextSansSerifBold
- | Styled scr sty <- oMathRunTextStyle mrPr
- , Just OBoldItalic <- sty
- , Just OSansSerif <- scr =
- Just $ TM.TextSansSerifBoldItalic
- | Styled scr sty <- oMathRunTextStyle mrPr
- , Just OBold <- sty
- , Just OScript <- scr =
- Just $ TM.TextBoldScript
- | Styled scr sty <- oMathRunTextStyle mrPr
- , Just OBold <- sty
- , Just OFraktur <- scr =
- Just $ TM.TextBoldFraktur
- | Styled scr sty <- oMathRunTextStyle mrPr
- , Just OItalic <- sty
- , Just OSansSerif <- scr =
- Just $ TM.TextSansSerifItalic
- | Styled _ sty <- oMathRunTextStyle mrPr
- , Just OBold <- sty =
- Just $ TM.TextBold
- | Styled _ sty <- oMathRunTextStyle mrPr
- , Just OItalic <- sty =
- Just $ TM.TextItalic
- | Styled scr _ <- oMathRunTextStyle mrPr
- , Just OMonospace <- scr =
- Just $ TM.TextMonospace
- | Styled scr _ <- oMathRunTextStyle mrPr
- , Just OSansSerif <- scr =
- Just $ TM.TextSansSerif
- | Styled scr _ <- oMathRunTextStyle mrPr
- , Just ODoubleStruck <- scr =
- Just $ TM.TextDoubleStruck
- | Styled scr _ <- oMathRunTextStyle mrPr
- , Just OScript <- scr =
- Just $ TM.TextDoubleStruck
- | Styled scr _ <- oMathRunTextStyle mrPr
- , Just OFraktur <- scr =
- Just $ TM.TextFraktur
- | Styled _ sty <- oMathRunTextStyle mrPr
- , Just OBoldItalic <- sty =
- Just $ TM.TextBoldItalic
- | otherwise = Nothing
-
-
-
-baseToExp :: Base -> DocxContext TM.Exp
-baseToExp (Base mathElems) =
- concatMapM oMathElemToExps mathElems >>= (return . TM.EGrouped)
-
--- an ungrouped version of baseToExp
-baseToExp' :: Base -> DocxContext [TM.Exp]
-baseToExp' (Base mathElems) =
- concatMapM oMathElemToExps mathElems
+parPartToInlines (PlainOMath exps) = do
+ return [Math InlineMath (writeTeX exps)]
isAnchorSpan :: Inline -> Bool
@@ -638,8 +449,8 @@ bodyPartToBlocks (Paragraph pPr parparts)
[CodeBlock ("", [], []) (concatMap parPartToString parparts)]
bodyPartToBlocks (Paragraph pPr parparts)
| any isHeaderContainer (parStyleToContainers pPr) = do
- ils <-withDState (\s -> s{docxInHeaderBlock = True}) $
- parPartsToInlines parparts >>= (return . normalizeSpaces)
+ ils <- normalizeSpaces <$> local (\s -> s{docxInHeaderBlock = True})
+ (parPartsToInlines parparts)
let (Container hdrFun) = head $ filter isHeaderContainer (parStyleToContainers pPr)
Header n attr _ = hdrFun []
hdr <- makeHeaderAnchor $ Header n attr ils
@@ -696,11 +507,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 oMathToExps maths
+bodyPartToBlocks (OMathPara exps) = do
return [Para $
- map (\m -> Math DisplayMath (writeTeX m))
- omaths]
+ map (\e -> Math DisplayMath (writeTeX e))
+ exps]
-- replace targets with generated anchors.
rewriteLink :: Inline -> DocxContext Inline
@@ -724,10 +534,8 @@ bodyToOutput (Body bps) = do
docxToOutput :: ReaderOptions -> Docx -> (Meta, [Block], MediaBag)
docxToOutput opts (Docx (Document _ body)) =
- let dState = defaultDState
- dEnv = DEnv { docxOptions = opts }
- in
- evalDocxContext (bodyToOutput body) dEnv dState
+ let dEnv = def { docxOptions = opts} in
+ evalDocxContext (bodyToOutput body) dEnv def
ilToCode :: Inline -> String
diff --git a/src/Text/Pandoc/Readers/Docx/OMath.hs b/src/Text/Pandoc/Readers/Docx/OMath.hs
new file mode 100644
index 000000000..309aaefe8
--- /dev/null
+++ b/src/Text/Pandoc/Readers/Docx/OMath.hs
@@ -0,0 +1,622 @@
+{-# LANGUAGE PatternGuards #-}
+
+{-
+Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+
+{- |
+ Module : Text.Pandoc.Readers.Docx.Math
+ Copyright : Copyright (C) 2014 Jesse Rosenthal
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>
+ Stability : alpha
+ Portability : portable
+
+Types and functions for conversion of OMML into TeXMath.
+-}
+
+module Text.Pandoc.Readers.Docx.OMath ( elemToExps
+ ) where
+
+import Text.XML.Light
+import Data.Maybe (mapMaybe, fromMaybe)
+import Data.List (intersperse)
+import qualified Text.TeXMath.Types as TM
+import Control.Applicative ((<$>))
+
+type NameSpaces = [(String, String)]
+
+elemName :: NameSpaces -> String -> String -> QName
+elemName ns prefix name = (QName name (lookup prefix ns) (Just prefix))
+
+isElem :: NameSpaces -> String -> String -> Element -> Bool
+isElem ns prefix name element =
+ qName (elName element) == name &&
+ qURI (elName element) == (lookup prefix ns)
+
+
+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 [OMathRunElem]
+ deriving Show
+
+data OMathRunElem = TextRun String
+ | LnBrk
+ | Tab
+ deriving Show
+
+data Base = Base [OMathElem]
+ deriving Show
+
+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
+
+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 }
+
+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}
+
+elemToMath :: NameSpaces -> Element -> Maybe OMath
+elemToMath ns element | isElem ns "m" "oMath" element =
+ Just $ OMath $ mapMaybe (elemToMathElem ns) (elChildren element)
+elemToMath _ _ = Nothing
+
+elemToBase :: NameSpaces -> Element -> Maybe Base
+elemToBase ns element | isElem ns "m" "e" element =
+ Just $ Base $ mapMaybe (elemToMathElem ns) (elChildren element)
+elemToBase _ _ = Nothing
+
+-- 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 elems) =
+ let f (TextRun s) = TextRun $ filter ('&' /=) s
+ f re = re
+ in
+ OMathRun mrPr (map f elems)
+filterAmpersand e = e
+
+elemToBaseNoAmpersand :: NameSpaces -> Element -> Maybe Base
+elemToBaseNoAmpersand ns element | isElem ns "m" "e" element =
+ return $ Base $
+ mapMaybe
+ (\e -> (elemToMathElem ns e >>= (return . filterAmpersand)))
+ (elChildren element)
+elemToBaseNoAmpersand _ _ = Nothing
+
+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 =
+ 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 (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 (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 (Just ' ') 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 | isElem ns "m" "acc" element = do
+ let accChar =
+ findChild (elemName ns "m" "accPr") element >>=
+ findChild (elemName ns "m" "chr") >>=
+ findAttr (elemName ns "m" "val") >>=
+ Just . head
+ accPr = AccentStyle { accentChar = accChar}
+ base <- findChild (elemName ns "m" "e") element >>=
+ elemToBase ns
+ return $ Accent accPr base
+elemToMathElem ns element | isElem ns "m" "bar" element = 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 | isElem ns "m" "box" element =
+ findChild (elemName ns "m" "e") element >>=
+ elemToBase ns >>=
+ (\b -> return $ Box b)
+elemToMathElem ns element | isElem ns "m" "borderBox" element =
+ findChild (elemName ns "m" "e") element >>=
+ elemToBase ns >>=
+ (\b -> return $ BorderBox b)
+elemToMathElem ns element | isElem ns "m" "d" element =
+ let style = elemToDelimStyle ns element
+ in
+ return $ Delimiter style $ mapMaybe (elemToBase ns) (elChildren element)
+elemToMathElem ns element | isElem ns "m" "eqArr" element =
+ return $ EquationArray $ mapMaybe (elemToBaseNoAmpersand ns) (elChildren element)
+elemToMathElem ns element | isElem ns "m" "f" element = do
+ num <- findChild (elemName ns "m" "num") element
+ den <- findChild (elemName ns "m" "den") element
+ let numElems = mapMaybe (elemToMathElem ns) (elChildren num)
+ denElems = mapMaybe (elemToMathElem ns) (elChildren den)
+ return $ Fraction numElems denElems
+elemToMathElem ns element | isElem ns "m" "func" element = do
+ fName <- findChild (elemName ns "m" "fName") element
+ base <- findChild (elemName ns "m" "e") element >>=
+ elemToBase ns
+ let fnElems = mapMaybe (elemToMathElem ns) (elChildren fName)
+ return $ Function fnElems base
+elemToMathElem ns element | isElem ns "m" "groupChr" element =
+ let style = elemToGroupStyle ns element
+ in
+ findChild (elemName ns "m" "e") element >>=
+ elemToBase ns >>=
+ (\b -> return $ Group style b)
+elemToMathElem ns element | isElem ns "m" "limLow" element = do
+ base <- findChild (elemName ns "m" "e") element
+ >>= elemToBase ns
+ lim <- findChild (elemName ns "m" "lim") element
+ let limElems = mapMaybe (elemToMathElem ns) (elChildren lim)
+ return $ LowerLimit base limElems
+elemToMathElem ns element | isElem ns "m" "limUpp" element = do
+ base <- findChild (elemName ns "m" "e") element
+ >>= elemToBase ns
+ lim <- findChild (elemName ns "m" "lim") element
+ let limElems = mapMaybe (elemToMathElem ns) (elChildren lim)
+ return $ UpperLimit base limElems
+elemToMathElem ns element | isElem ns "m" "m" element = do
+ let rows = findChildren (elemName ns "m" "mr") element
+ let bases = mapMaybe (\mr -> mapM (elemToBase ns) (elChildren mr)) rows
+ return $ Matrix bases
+elemToMathElem ns element | isElem ns "m" "nary" element = do
+ let style = elemToNAryStyle ns element
+ sub <- findChild (elemName ns "m" "sub") element >>=
+ (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
+ sup <- findChild (elemName ns "m" "sup") element >>=
+ (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
+ base <- findChild (elemName ns "m" "e") element >>=
+ elemToBase ns
+ return $ NAry style sub sup base
+elemToMathElem ns element | isElem ns "m" "rad" element = do
+ deg <- findChild (elemName ns "m" "deg") element >>=
+ (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
+ base <- findChild (elemName ns "m" "e") element >>=
+ elemToBase ns
+ return $ Radical deg base
+elemToMathElem ns element | isElem ns "m" "phant" element = do
+ base <- findChild (elemName ns "m" "e") element >>=
+ elemToBase ns
+ return $ Phantom base
+elemToMathElem ns element | isElem ns "m" "sPre" element = do
+ sub <- findChild (elemName ns "m" "sub") element >>=
+ (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
+ sup <- findChild (elemName ns "m" "sup") element >>=
+ (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
+ base <- findChild (elemName ns "m" "e") element >>=
+ elemToBase ns
+ return $ PreSubSuper sub sup base
+elemToMathElem ns element | isElem ns "m" "sSub" element = do
+ base <- findChild (elemName ns "m" "e") element >>=
+ elemToBase ns
+ sub <- findChild (elemName ns "m" "sub") element >>=
+ (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
+ return $ Sub base sub
+elemToMathElem ns element | isElem ns "m" "sSubSup" element = do
+ base <- findChild (elemName ns "m" "e") element >>=
+ elemToBase ns
+ sub <- findChild (elemName ns "m" "sub") element >>=
+ (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
+ sup <- findChild (elemName ns "m" "sup") element >>=
+ (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
+ return $ SubSuper base sub sup
+elemToMathElem ns element | isElem ns "m" "sSup" element = do
+ base <- findChild (elemName ns "m" "e") element >>=
+ elemToBase ns
+ sup <- findChild (elemName ns "m" "sup") element >>=
+ (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
+ return $ Super base sup
+elemToMathElem ns element | isElem ns "m" "r" element = do
+ let mrPr = elemToOMathRunStyle ns element
+ mrElems <- elemToOMathRunElems ns element
+ return $ OMathRun mrPr mrElems
+elemToMathElem _ _ = Nothing
+
+elemToOMathRunElem :: NameSpaces -> Element -> Maybe OMathRunElem
+elemToOMathRunElem ns element
+ | isElem ns "w" "t" element
+ || isElem ns "m" "t" element
+ || isElem ns "w" "delText" element = Just $ TextRun $ strContent element
+ | isElem ns "w" "br" element = Just LnBrk
+ | isElem ns "w" "tab" element = Just Tab
+ | otherwise = Nothing
+
+elemToOMathRunElems :: NameSpaces -> Element -> Maybe [OMathRunElem]
+elemToOMathRunElems ns element
+ | isElem ns "w" "r" element
+ || isElem ns "m" "r" element =
+ Just $ mapMaybe (elemToOMathRunElem ns) (elChildren element)
+elemToOMathRunElems _ _ = Nothing
+
+----- And now the TeXMath Creation
+
+oMathRunElemToString :: OMathRunElem -> String
+oMathRunElemToString (TextRun s) = s
+oMathRunElemToString (LnBrk) = ['\n']
+oMathRunElemToString (Tab) = ['\t']
+
+oMathRunElemsToString :: [OMathRunElem] -> String
+oMathRunElemsToString = concatMap oMathRunElemToString
+
+oMathElemToString :: OMathElem -> String
+oMathElemToString (OMathRun _ oMathRunElems) =
+ oMathRunElemsToString oMathRunElems
+oMathElemToString _ = ""
+
+
+oMathToExps :: OMath -> [TM.Exp]
+oMathToExps (OMath oMathElems) = concatMap oMathElemToExps oMathElems
+
+oMathElemToExps :: OMathElem -> [TM.Exp]
+oMathElemToExps (Accent style base) =
+ let baseExp = baseToExp base
+ chr = case accentChar style of
+ Just c -> c
+ Nothing -> '\180' -- default to acute.
+ in
+ [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
+oMathElemToExps(Bar style base) =
+ let baseExp = baseToExp base
+ in
+ case barPos style of
+ Top -> [TM.EOver False baseExp (TM.ESymbol TM.Accent "\175")]
+ Bottom -> [TM.EUnder False baseExp (TM.ESymbol TM.Accent "\818")]
+oMathElemToExps (Box base) = [baseToExp base]
+oMathElemToExps (BorderBox base) =
+ -- TODO: This should be "\\boxed" somehow
+ [baseToExp base]
+oMathElemToExps (Delimiter dPr bases) =
+ let baseExps = map baseToExp bases
+ inDelimExps = map Right baseExps
+ beg = fromMaybe '(' (delimBegChar dPr)
+ end = fromMaybe ')' (delimEndChar dPr)
+ sep = fromMaybe '|' (delimSepChar dPr)
+ exps = intersperse (Left [sep]) inDelimExps
+ in
+ [TM.EDelimited [beg] [end] exps]
+oMathElemToExps (EquationArray bases) =
+ let baseExps = map (\b -> [baseToExp' b]) bases
+ in
+ [TM.EArray [] baseExps]
+oMathElemToExps (Fraction num denom) =
+ let numExp = TM.EGrouped $ concatMap oMathElemToExps num
+ denExp = TM.EGrouped $ concatMap oMathElemToExps denom
+ in
+ [TM.EFraction TM.NormalFrac numExp denExp]
+oMathElemToExps (Function fname base) =
+ -- We need a string for the fname, but omml gives it to us as a
+ -- series of oMath elems. We're going to filter out the oMathRuns,
+ -- which should work for us most of the time.
+ let fnameString = concatMap oMathElemToString fname
+ baseExp = baseToExp base
+ in
+ [TM.EMathOperator fnameString, baseExp]
+oMathElemToExps (Group style base)
+ | Just Top <- groupPos style =
+ let baseExp = baseToExp base
+ chr = case groupChr style of
+ Just c -> c
+ Nothing -> '\65079' -- default to overbrace
+ in
+ [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
+ | otherwise =
+ let baseExp = baseToExp base
+ chr = case groupChr style of
+ Just c -> c
+ Nothing -> '\65080' -- default to underbrace
+ in
+ [TM.EUnder False baseExp (TM.ESymbol TM.Accent [chr])]
+oMathElemToExps (LowerLimit base limElems) = do
+ let baseExp = baseToExp base
+ lim = TM.EGrouped $ concatMap oMathElemToExps limElems
+ in
+ [TM.EUnder True lim baseExp]
+oMathElemToExps (UpperLimit base limElems) =
+ let baseExp = baseToExp base
+ lim = TM.EGrouped $ concatMap oMathElemToExps limElems
+ in
+ [TM.EOver True lim baseExp]
+oMathElemToExps (Matrix bases) =
+ let rows = map (map baseToExp') bases
+ in
+ [TM.EArray [TM.AlignCenter] rows]
+oMathElemToExps (NAry style sub sup base) =
+ let
+ subExps = concatMap oMathElemToExps sub
+ supExps = concatMap oMathElemToExps sup
+ baseExp = baseToExp base
+ opChar = case nAryChar style of
+ Just c -> c
+ -- default to integral
+ Nothing -> '\8747'
+ in [ TM.ESubsup
+ (TM.ESymbol TM.Op [opChar])
+ (TM.EGrouped subExps)
+ (TM.EGrouped supExps)
+ , baseExp]
+oMathElemToExps (Phantom base) =
+ [TM.EPhantom $ baseToExp base]
+oMathElemToExps (Radical degree base) =
+ let degExps = concatMap oMathElemToExps degree
+ baseExp = baseToExp base
+ in
+ case degExps of
+ [] -> [TM.ESqrt baseExp]
+ ds -> [TM.ERoot (TM.EGrouped ds) baseExp]
+oMathElemToExps (PreSubSuper sub sup base) =
+ let subExps = concatMap oMathElemToExps sub
+ supExps = concatMap oMathElemToExps sup
+ baseExp = baseToExp base
+ in [ TM.ESubsup
+ (TM.EIdentifier "") (TM.EGrouped subExps) (TM.EGrouped supExps)
+ , baseExp]
+oMathElemToExps (Sub base sub) =
+ let baseExp = baseToExp base
+ subExps = concatMap oMathElemToExps sub
+ in
+ [TM.ESub baseExp (TM.EGrouped subExps)]
+oMathElemToExps (SubSuper base sub sup) =
+ let baseExp = baseToExp base
+ subExps = concatMap oMathElemToExps sub
+ supExps = concatMap oMathElemToExps sup
+ in
+ [TM.ESubsup baseExp (TM.EGrouped subExps) (TM.EGrouped supExps)]
+oMathElemToExps (Super base sup) =
+ let baseExp = baseToExp base
+ supExps = concatMap oMathElemToExps sup
+ in
+ [TM.ESuper baseExp (TM.EGrouped supExps)]
+oMathElemToExps (OMathRun sty elems)
+ | NoStyle <- oMathRunTextStyle sty =
+ [TM.EIdentifier $ oMathRunElemsToString elems]
+ | Nothing <- oMathRunStyleToTextType sty =
+ [TM.EIdentifier $ oMathRunElemsToString elems]
+ | Just textType <- oMathRunStyleToTextType sty =
+ if oMathLit sty
+ then [TM.EText textType (oMathRunElemsToString elems)]
+ else [TM.EStyled textType [TM.EIdentifier $ oMathRunElemsToString elems]]
+oMathElemToExps (OMathRun _ _) = []
+
+oMathRunStyleToTextType :: OMathRunStyle -> Maybe TM.TextType
+oMathRunStyleToTextType mrPr
+ | Normal <- oMathRunTextStyle mrPr =
+ Just $ TM.TextNormal
+ | Styled scr sty <- oMathRunTextStyle mrPr
+ ,Just OBold <- sty
+ , Just OSansSerif <- scr =
+ Just $ TM.TextSansSerifBold
+ | Styled scr sty <- oMathRunTextStyle mrPr
+ , Just OBoldItalic <- sty
+ , Just OSansSerif <- scr =
+ Just $ TM.TextSansSerifBoldItalic
+ | Styled scr sty <- oMathRunTextStyle mrPr
+ , Just OBold <- sty
+ , Just OScript <- scr =
+ Just $ TM.TextBoldScript
+ | Styled scr sty <- oMathRunTextStyle mrPr
+ , Just OBold <- sty
+ , Just OFraktur <- scr =
+ Just $ TM.TextBoldFraktur
+ | Styled scr sty <- oMathRunTextStyle mrPr
+ , Just OItalic <- sty
+ , Just OSansSerif <- scr =
+ Just $ TM.TextSansSerifItalic
+ | Styled _ sty <- oMathRunTextStyle mrPr
+ , Just OBold <- sty =
+ Just $ TM.TextBold
+ | Styled _ sty <- oMathRunTextStyle mrPr
+ , Just OItalic <- sty =
+ Just $ TM.TextItalic
+ | Styled scr _ <- oMathRunTextStyle mrPr
+ , Just OMonospace <- scr =
+ Just $ TM.TextMonospace
+ | Styled scr _ <- oMathRunTextStyle mrPr
+ , Just OSansSerif <- scr =
+ Just $ TM.TextSansSerif
+ | Styled scr _ <- oMathRunTextStyle mrPr
+ , Just ODoubleStruck <- scr =
+ Just $ TM.TextDoubleStruck
+ | Styled scr _ <- oMathRunTextStyle mrPr
+ , Just OScript <- scr =
+ Just $ TM.TextDoubleStruck
+ | Styled scr _ <- oMathRunTextStyle mrPr
+ , Just OFraktur <- scr =
+ Just $ TM.TextFraktur
+ | Styled _ sty <- oMathRunTextStyle mrPr
+ , Just OBoldItalic <- sty =
+ Just $ TM.TextBoldItalic
+ | otherwise = Nothing
+
+
+
+baseToExp :: Base -> TM.Exp
+baseToExp b = TM.EGrouped $ baseToExp' b
+
+-- an ungrouped version of baseToExp
+baseToExp' :: Base -> [TM.Exp]
+baseToExp' (Base mathElems) =
+ concatMap oMathElemToExps mathElems
+
+elemToExps :: NameSpaces -> Element -> Maybe [TM.Exp]
+elemToExps ns element = oMathToExps <$> (elemToMath ns element)
+
diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs
index bc4e6ea06..3b2e7c5ca 100644
--- a/src/Text/Pandoc/Readers/Docx/Parse.hs
+++ b/src/Text/Pandoc/Readers/Docx/Parse.hs
@@ -36,19 +36,6 @@ module Text.Pandoc.Readers.Docx.Parse ( Docx(..)
, BodyPart(..)
, TblLook(..)
, ParPart(..)
- , OMath(..)
- , OMathElem(..)
- , Base(..)
- , TopBottom(..)
- , AccentStyle(..)
- , BarStyle(..)
- , NAryStyle(..)
- , DelimStyle(..)
- , GroupStyle(..)
- , OMathRunStyle(..)
- , OMathRunTextStyle(..)
- , OMathTextScript(..)
- , OMathTextStyle(..)
, Run(..)
, RunElem(..)
, Notes
@@ -74,6 +61,8 @@ import qualified Text.Pandoc.UTF8 as UTF8
import Control.Monad.Reader
import qualified Data.Map as M
import Text.Pandoc.Compat.Except
+import Text.Pandoc.Readers.Docx.OMath (elemToExps)
+import Text.TeXMath (Exp)
data ReaderEnv = ReaderEnv { envNotes :: Notes
, envNumbering :: Numbering
@@ -161,7 +150,7 @@ defaultParagraphStyle = ParagraphStyle { pStyle = []
data BodyPart = Paragraph ParagraphStyle [ParPart]
| ListItem ParagraphStyle String String Level [ParPart]
| Tbl String TblGrid TblLook [Row]
- | OMathPara OMathParaStyle [OMath]
+ | OMathPara [[Exp]]
deriving Show
type TblGrid = [Integer]
@@ -185,100 +174,9 @@ data ParPart = PlainRun Run
| InternalHyperLink Anchor [Run]
| ExternalHyperLink URL [Run]
| Drawing FilePath B.ByteString
- | PlainOMath OMath
+ | PlainOMath [Exp]
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
-
-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 }
-
-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}
-
data Run = Run RunStyle [RunElem]
| Footnote [BodyPart]
| Endnote [BodyPart]
@@ -577,9 +475,8 @@ elemToBodyPart ns element
| isElem ns "w" "p" element
, (c:_) <- findChildren (elemName ns "m" "oMathPara") element =
do
- let style = [] -- placeholder
- maths <- mapD (elemToMath ns) (elChildren c)
- return $ OMathPara style maths
+ expsLst <- mapD (\e -> (maybeToD $ elemToExps ns e)) (elChildren c)
+ return $ OMathPara expsLst
elemToBodyPart ns element
| isElem ns "w" "p" element
, Just (numId, lvl) <- elemToNumInfo ns element = do
@@ -615,262 +512,6 @@ elemToBodyPart ns element
return $ Tbl caption grid tblLook rows
elemToBodyPart _ _ = throwError WrongElem
-elemToMath :: NameSpaces -> Element -> D OMath
-elemToMath ns element | isElem ns "m" "oMath" element =
- mapD (elemToMathElem ns) (elChildren element) >>=
- (\es -> return $ OMath es)
-elemToMath _ _ = throwError WrongElem
-
-elemToBase :: NameSpaces -> Element -> D Base
-elemToBase ns element | isElem ns "m" "e" element =
- mapD (elemToMathElem ns) (elChildren 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 =
- 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 (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 (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 (Just ' ') 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 -> D OMathElem
-elemToMathElem ns element | isElem ns "m" "acc" element = do
- let accChar =
- 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) >>=
- elemToBase ns
- return $ Accent accPr base
-elemToMathElem ns element | isElem ns "m" "bar" element = do
- barPr <- maybeToD $
- 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 <-maybeToD (findChild (QName "e" (lookup "m" ns) (Just "m")) element) >>=
- elemToBase ns
- return $ Bar barPr base
-elemToMathElem ns element | isElem ns "m" "box" element =
- maybeToD (findChild (elemName ns "m" "e") element) >>=
- elemToBase ns >>=
- (\b -> return $ Box b)
-elemToMathElem ns element | isElem ns "m" "borderBox" element =
- maybeToD (findChild (elemName ns "m" "e") element) >>=
- elemToBase ns >>=
- (\b -> return $ BorderBox b)
-elemToMathElem ns element | isElem ns "m" "d" element =
- let style = elemToDelimStyle ns element
- in
- mapD (elemToBase ns) (elChildren element) >>=
- (\es -> return $ Delimiter style es)
-elemToMathElem ns element | isElem ns "m" "eqArr" 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
- den <- maybeToD $ findChild (elemName ns "m" "den") element
- numElems <- mapD (elemToMathElem ns) (elChildren num)
- denElems <- mapD (elemToMathElem ns) (elChildren den)
- return $ Fraction numElems denElems
-elemToMathElem ns element | isElem ns "m" "func" element = do
- fName <- maybeToD $ findChild (elemName ns "m" "fName") element
- base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
- elemToBase ns
- fnElems <- mapD (elemToMathElem ns) (elChildren fName)
- return $ Function fnElems base
-elemToMathElem ns element | isElem ns "m" "groupChr" element =
- let style = elemToGroupStyle ns element
- in
- maybeToD (findChild (elemName ns "m" "e") element) >>=
- elemToBase ns >>=
- (\b -> return $ Group style b)
-elemToMathElem ns element | isElem ns "m" "limLow" element = do
- base <- maybeToD (findChild (elemName ns "m" "e") element)
- >>= elemToBase ns
- lim <- maybeToD $ findChild (elemName ns "m" "lim") element
- limElems <- mapD (elemToMathElem ns) (elChildren lim)
- return $ LowerLimit base limElems
-elemToMathElem ns element | isElem ns "m" "limUpp" element = do
- base <- maybeToD (findChild (elemName ns "m" "e") element)
- >>= elemToBase ns
- lim <- maybeToD $ findChild (elemName ns "m" "lim") element
- limElems <- mapD (elemToMathElem ns) (elChildren lim)
- return $ UpperLimit base limElems
-elemToMathElem ns element | isElem ns "m" "m" element = do
- let rows = findChildren (elemName ns "m" "mr") element
- bases <- mapD (\mr -> mapD (elemToBase ns) (elChildren mr)) rows
- return $ Matrix bases
-elemToMathElem ns element | isElem ns "m" "nary" element = do
- let style = elemToNAryStyle ns element
- sub <- maybeToD (findChild (elemName ns "m" "sub") element) >>=
- (\e -> mapD (elemToMathElem ns) (elChildren e))
- sup <- maybeToD (findChild (elemName ns "m" "sup") element) >>=
- (\e -> mapD (elemToMathElem ns) (elChildren e))
- base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
- elemToBase ns
- return $ NAry style sub sup base
-elemToMathElem ns element | isElem ns "m" "rad" element = do
- deg <- maybeToD (findChild (elemName ns "m" "deg") element) >>=
- (\e -> mapD (elemToMathElem ns) (elChildren e))
- base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
- elemToBase ns
- return $ Radical deg base
-elemToMathElem ns element | isElem ns "m" "phant" element = do
- base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
- elemToBase ns
- return $ Phantom base
-elemToMathElem ns element | isElem ns "m" "sPre" element = do
- sub <- maybeToD (findChild (elemName ns "m" "sub") element) >>=
- (\e -> mapD (elemToMathElem ns) (elChildren e))
- sup <- maybeToD (findChild (elemName ns "m" "sup") element) >>=
- (\e -> mapD (elemToMathElem ns) (elChildren e))
- base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
- elemToBase ns
- return $ PreSubSuper sub sup base
-elemToMathElem ns element | isElem ns "m" "sSub" element = do
- base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
- elemToBase ns
- sub <- maybeToD (findChild (elemName ns "m" "sub") element) >>=
- (\e -> mapD (elemToMathElem ns) (elChildren e))
- return $ Sub base sub
-elemToMathElem ns element | isElem ns "m" "sSubSup" element = do
- base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
- elemToBase ns
- sub <- maybeToD (findChild (elemName ns "m" "sub") element) >>=
- (\e -> mapD (elemToMathElem ns) (elChildren e))
- sup <- maybeToD (findChild (elemName ns "m" "sup") element) >>=
- (\e -> mapD (elemToMathElem ns) (elChildren e))
- return $ SubSuper base sub sup
-elemToMathElem ns element | isElem ns "m" "sSup" element = do
- base <- maybeToD (findChild (elemName ns "m" "e") element) >>=
- elemToBase ns
- sup <- maybeToD (findChild (elemName ns "m" "sup") element) >>=
- (\e -> mapD (elemToMathElem ns) (elChildren e))
- return $ Super base sup
-elemToMathElem ns element | isElem ns "m" "r" element = do
- let mrPr = elemToOMathRunStyle ns element
- wrPr = elemToRunStyle ns element
- relems <- elemToRunElems ns element
- return $ OMathRun mrPr $ Run wrPr relems
-elemToMathElem _ _ = throwError WrongElem
-
lookupRelationship :: RelId -> [Relationship] -> Maybe Target
lookupRelationship relid rels =
lookup relid (map (\(Relationship pair) -> pair) rels)
@@ -934,7 +575,7 @@ elemToParPart ns element
Nothing -> ExternalHyperLink "" runs
elemToParPart ns element
| isElem ns "m" "oMath" element =
- elemToMath ns element >>= (return . PlainOMath)
+ (maybeToD $ elemToExps ns element) >>= (return . PlainOMath)
elemToParPart _ _ = throwError WrongElem
lookupFootnote :: String -> Notes -> Maybe Element
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-08 15:00:33 +0000