aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Readers/Docx/OMath.hs795
-rw-r--r--src/Text/Pandoc/Readers/Docx/Parse.hs18
2 files changed, 305 insertions, 508 deletions
diff --git a/src/Text/Pandoc/Readers/Docx/OMath.hs b/src/Text/Pandoc/Readers/Docx/OMath.hs
index 309aaefe8..62fc6286c 100644
--- a/src/Text/Pandoc/Readers/Docx/OMath.hs
+++ b/src/Text/Pandoc/Readers/Docx/OMath.hs
@@ -30,75 +30,38 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Types and functions for conversion of OMML into TeXMath.
-}
-module Text.Pandoc.Readers.Docx.OMath ( elemToExps
+module Text.Pandoc.Readers.Docx.OMath (readOMML
) 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
+readOMML :: Element -> Maybe [TM.Exp]
+readOMML element | isElem "m" "oMath" element =
+ Just $ concat $ mapMaybe (elemToExps') (elChildren element)
+readOMML _ = Nothing
-data TopBottom = Top | Bottom
- deriving Show
-data AccentStyle = AccentStyle { accentChar :: Maybe Char }
- deriving Show
-
-data BarStyle = BarStyle { barPos :: TopBottom}
- deriving Show
+isElem :: String -> String -> Element -> Bool
+isElem prefix name element =
+ let qp = fromMaybe "" (qPrefix (elName element))
+ in
+ qName (elName element) == name &&
+ qp == prefix
-data NAryStyle = NAryStyle { nAryChar :: Maybe Char
- , nAryLimLoc :: LimLoc}
- deriving Show
+hasElemName:: String -> String -> QName -> Bool
+hasElemName prefix name qn =
+ let qp = fromMaybe "" (qPrefix qn)
+ in
+ qName qn == name &&
+ qp == prefix
-data OMathRunStyle = OMathRunStyle { oMathLit :: Bool
- , oMathRunTextStyle :: OMathRunTextStyle }
- deriving Show
+data OMathRunElem = TextRun String
+ | LnBrk
+ | Tab
+ deriving Show
data OMathRunTextStyle = NoStyle
| Normal
@@ -120,82 +83,40 @@ data OMathTextStyle = OPlain
| 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}
+elemToBase :: Element -> Maybe TM.Exp
+elemToBase element | isElem "m" "e" element = do
+ bs <- elemToBases element
+ return $ case bs of
+ (e : []) -> e
+ exps -> TM.EGrouped exps
+elemToBase _ = Nothing
-elemToMath :: NameSpaces -> Element -> Maybe OMath
-elemToMath ns element | isElem ns "m" "oMath" element =
- Just $ OMath $ mapMaybe (elemToMathElem ns) (elChildren element)
-elemToMath _ _ = Nothing
+elemToBases :: Element -> Maybe [TM.Exp]
+elemToBases element | isElem "m" "e" element =
+ return $ concat $ mapMaybe elemToExps' (elChildren element)
+elemToBases _ = 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 =
+filterAmpersand :: TM.Exp -> TM.Exp
+filterAmpersand (TM.EIdentifier s) = TM.EIdentifier (filter ('&' /=) s)
+filterAmpersand (TM.EText tt s) = TM.EText tt (filter ('&' /=) s)
+filterAmpersand (TM.EStyled tt exps) = TM.EStyled tt (map filterAmpersand exps)
+filterAmpersand (TM.EGrouped exps) = TM.EGrouped (map filterAmpersand exps)
+filterAmpersand e = e
+
+elemToOMathRunTextStyle :: Element -> OMathRunTextStyle
+elemToOMathRunTextStyle element
+ | Just mrPr <- filterChildName (hasElemName"m" "rPr") element
+ , Just _ <- filterChildName (hasElemName"m" "nor") mrPr =
Normal
- | Just mrPr <- findChild (elemName ns "m" "rPr") element =
+ | Just mrPr <- filterChildName (hasElemName"m" "rPr") element =
let scr =
case
- findChild (elemName ns "m" "scr") mrPr >>=
- findAttr (elemName ns "m" "val")
+ filterChildName (hasElemName"m" "scr") mrPr >>=
+ findAttrBy (hasElemName"m" "val")
of
Just "roman" -> Just ORoman
Just "script" -> Just OScript
@@ -207,8 +128,8 @@ elemToOMathRunTextStyle ns element
sty =
case
- findChild (elemName ns "m" "sty") mrPr >>=
- findAttr (elemName ns "m" "val")
+ filterChildName (hasElemName"m" "sty") mrPr >>=
+ findAttrBy (hasElemName"m" "val")
of
Just "p" -> Just OPlain
Just "b" -> Just OBold
@@ -219,194 +140,21 @@ elemToOMathRunTextStyle ns element
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
+elemToOMathRunElem :: Element -> Maybe OMathRunElem
+elemToOMathRunElem element
+ | isElem "w" "t" element
+ || isElem "m" "t" element
+ || isElem "w" "delText" element = Just $ TextRun $ strContent element
+ | isElem "w" "br" element = Just LnBrk
+ | isElem "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
+elemToOMathRunElems :: Element -> Maybe [OMathRunElem]
+elemToOMathRunElems element
+ | isElem "w" "r" element
+ || isElem "m" "r" element =
+ Just $ mapMaybe (elemToOMathRunElem) (elChildren element)
+elemToOMathRunElems _ = Nothing
----- And now the TeXMath Creation
@@ -418,205 +166,264 @@ 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
+oMathRunTextStyleToTextType :: OMathRunTextStyle -> Maybe TM.TextType
+oMathRunTextStyleToTextType (Normal) = Just $ TM.TextNormal
+oMathRunTextStyleToTextType (NoStyle) = Nothing
+oMathRunTextStyleToTextType (Styled scr sty)
+ | Just OBold <- sty
, Just OSansSerif <- scr =
Just $ TM.TextSansSerifBold
- | Styled scr sty <- oMathRunTextStyle mrPr
- , Just OBoldItalic <- sty
+ | Just OBoldItalic <- sty
, Just OSansSerif <- scr =
Just $ TM.TextSansSerifBoldItalic
- | Styled scr sty <- oMathRunTextStyle mrPr
- , Just OBold <- sty
+ | Just OBold <- sty
, Just OScript <- scr =
Just $ TM.TextBoldScript
- | Styled scr sty <- oMathRunTextStyle mrPr
- , Just OBold <- sty
+ | Just OBold <- sty
, Just OFraktur <- scr =
Just $ TM.TextBoldFraktur
- | Styled scr sty <- oMathRunTextStyle mrPr
- , Just OItalic <- sty
+ | Just OItalic <- sty
, Just OSansSerif <- scr =
Just $ TM.TextSansSerifItalic
- | Styled _ sty <- oMathRunTextStyle mrPr
- , Just OBold <- sty =
+ | Just OBold <- sty =
Just $ TM.TextBold
- | Styled _ sty <- oMathRunTextStyle mrPr
- , Just OItalic <- sty =
+ | Just OItalic <- sty =
Just $ TM.TextItalic
- | Styled scr _ <- oMathRunTextStyle mrPr
- , Just OMonospace <- scr =
+ | Just OMonospace <- scr =
Just $ TM.TextMonospace
- | Styled scr _ <- oMathRunTextStyle mrPr
- , Just OSansSerif <- scr =
+ | Just OSansSerif <- scr =
Just $ TM.TextSansSerif
- | Styled scr _ <- oMathRunTextStyle mrPr
- , Just ODoubleStruck <- scr =
+ | Just ODoubleStruck <- scr =
Just $ TM.TextDoubleStruck
- | Styled scr _ <- oMathRunTextStyle mrPr
- , Just OScript <- scr =
+ | Just OScript <- scr =
Just $ TM.TextDoubleStruck
- | Styled scr _ <- oMathRunTextStyle mrPr
- , Just OFraktur <- scr =
+ | Just OFraktur <- scr =
Just $ TM.TextFraktur
- | Styled _ sty <- oMathRunTextStyle mrPr
- , Just OBoldItalic <- sty =
+ | 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)
-
+elemToExps' :: Element -> Maybe [TM.Exp]
+elemToExps' element | isElem "m" "acc" element = do
+ let chr = filterChildName (hasElemName "m" "accPr") element >>=
+ filterChildName (hasElemName "m" "chr") >>=
+ findAttrBy (hasElemName "m" "val") >>=
+ Just . head
+ chr' = case chr of
+ Just c -> c
+ Nothing -> '\180' -- default to acute.
+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
+ elemToBase
+ return $ [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr'])]
+elemToExps' element | isElem "m" "bar" element = do
+ pos <- filterChildName (hasElemName "m" "barPr") element >>=
+ filterChildName (hasElemName "m" "pos") >>=
+ findAttrBy (hasElemName "m" "val")
+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
+ elemToBase
+ case pos of
+ "top" -> Just [TM.EOver False baseExp (TM.ESymbol TM.Accent "\175")]
+ "bot" -> Just [TM.EUnder False baseExp (TM.ESymbol TM.Accent "\818")]
+ _ -> Nothing
+elemToExps' element | isElem "m" "box" element = do
+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
+ elemToBase
+ return [baseExp]
+elemToExps' element | isElem "m" "borderBox" element = do
+ -- TODO: This needs to be "\\boxed" somehow.
+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
+ elemToBase
+ return [baseExp]
+elemToExps' element | isElem "m" "d" element =
+ let baseExps = mapMaybe
+ elemToBase
+ (elChildren element)
+ inDelimExps = map Right baseExps
+ dPr = filterChildName (hasElemName "m" "dPr") element
+ begChr = dPr >>=
+ filterChildName (hasElemName "m" "begChr") >>=
+ findAttrBy (hasElemName "m" "val") >>=
+ (\c -> if null c then (Just ' ') else (Just $ head c))
+ sepChr = dPr >>=
+ filterChildName (hasElemName "m" "sepChr") >>=
+ findAttrBy (hasElemName "m" "val") >>=
+ (\c -> if null c then (Just ' ') else (Just $ head c))
+ endChr = dPr >>=
+ filterChildName (hasElemName "m" "endChr") >>=
+ findAttrBy (hasElemName "m" "val") >>=
+ (\c -> if null c then (Just ' ') else (Just $ head c))
+ beg = fromMaybe '(' begChr
+ end = fromMaybe ')' endChr
+ sep = fromMaybe '|' sepChr
+ exps = intersperse (Left [sep]) inDelimExps
+ in
+ Just [TM.EDelimited [beg] [end] exps]
+elemToExps' element | isElem "m" "eqArr" element =
+ let expLst = mapMaybe elemToBases (elChildren element)
+ expLst' = map (\es -> [map filterAmpersand es]) expLst
+ in
+ return [TM.EArray [] expLst']
+elemToExps' element | isElem "m" "f" element = do
+ num <- filterChildName (hasElemName "m" "num") element
+ den <- filterChildName (hasElemName "m" "den") element
+ let numExp = TM.EGrouped $ concat $ mapMaybe (elemToExps') (elChildren num)
+ denExp = TM.EGrouped $ concat $ mapMaybe (elemToExps') (elChildren den)
+ return $ [TM.EFraction TM.NormalFrac numExp denExp]
+elemToExps' element | isElem "m" "func" element = do
+ fName <- filterChildName (hasElemName "m" "fName") element
+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
+ elemToBase
+ -- 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 expToString $
+ concat $ mapMaybe (elemToExps') (elChildren fName)
+ return [TM.EMathOperator fnameString, baseExp]
+elemToExps' element | isElem "m" "groupChr" element = do
+ let gPr = filterChildName (hasElemName "m" "groupChrPr") element
+ chr = gPr >>=
+ filterChildName (hasElemName "m" "chr") >>=
+ findAttrBy (hasElemName "m" "val")
+ pos = gPr >>=
+ filterChildName (hasElemName "m" "pos") >>=
+ findAttrBy (hasElemName "m" "val")
+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
+ elemToBase
+ case pos of
+ Just "top" ->
+ let chr' = case chr of
+ Just (c:_) -> c
+ _ -> '\65079' -- default to overbrace
+ in
+ return [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr'])]
+ Just "bot" ->
+ let chr' = case chr of
+ Just (c:_) -> c
+ _ -> '\65080' -- default to underbrace
+ in
+ return [TM.EUnder False baseExp (TM.ESymbol TM.Accent [chr'])]
+ _ -> Nothing
+elemToExps' element | isElem "m" "limLow" element = do
+ baseExp <- filterChildName (hasElemName "m" "e") element
+ >>= elemToBase
+ limExp <- filterChildName (hasElemName "m" "lim") element
+ >>= (\e -> Just $ concat $ mapMaybe (elemToExps') (elChildren e))
+ >>= (return . TM.EGrouped)
+ return [TM.EUnder True limExp baseExp]
+elemToExps' element | isElem "m" "limUpp" element = do
+ baseExp <- filterChildName (hasElemName "m" "e") element
+ >>= elemToBase
+ limExp <- filterChildName (hasElemName "m" "lim") element
+ >>= (\e -> Just $ concat $ mapMaybe (elemToExps') (elChildren e))
+ >>= (return . TM.EGrouped)
+ return [TM.EOver True limExp baseExp]
+elemToExps' element | isElem "m" "m" element =
+ let rows = filterChildrenName (hasElemName "m" "mr") element
+ rowExps = map
+ (\mr -> mapMaybe
+ elemToBases
+ (elChildren mr))
+ rows
+ in
+ return [TM.EArray [TM.AlignCenter] rowExps]
+elemToExps' element | isElem "m" "nary" element = do
+ let naryPr = filterChildName (hasElemName "m" "naryPr") element
+ naryChr = naryPr >>=
+ filterChildName (hasElemName "m" "chr") >>=
+ findAttrBy (hasElemName "m" "val")
+ opChr = case naryChr of
+ Just (c:_) -> c
+ _ -> '\8747' -- default to integral
+ limLoc = naryPr >>=
+ filterChildName (hasElemName "m" "limLoc") >>=
+ findAttrBy (hasElemName "m" "val")
+ subExps <- filterChildName (hasElemName "m" "sub") element >>=
+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
+ supExps <- filterChildName (hasElemName "m" "sup") element >>=
+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
+ elemToBase
+ case limLoc of
+ Just "undOvr" -> return [TM.EUnderover True
+ (TM.ESymbol TM.Op [opChr])
+ (TM.EGrouped subExps)
+ (TM.EGrouped supExps)
+ , baseExp]
+ _ -> return [TM.ESubsup
+ (TM.ESymbol TM.Op [opChr])
+ (TM.EGrouped subExps)
+ (TM.EGrouped supExps)
+ , baseExp]
+
+elemToExps' element | isElem "m" "phant" element = do
+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
+ elemToBase
+ return [TM.EPhantom baseExp]
+elemToExps' element | isElem "m" "rad" element = do
+ degExps <- filterChildName (hasElemName "m" "deg") element >>=
+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
+ elemToBase
+ return $ case degExps of
+ [] -> [TM.ESqrt baseExp]
+ ds -> [TM.ERoot (TM.EGrouped ds) baseExp]
+elemToExps' element | isElem "m" "sPre" element = do
+ subExps <- filterChildName (hasElemName "m" "sub") element >>=
+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
+ supExps <- filterChildName (hasElemName "m" "sup") element >>=
+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
+ elemToBase
+ return [TM.ESubsup
+ (TM.EIdentifier "")
+ (TM.EGrouped subExps)
+ (TM.EGrouped supExps)
+ , baseExp]
+elemToExps' element | isElem "m" "sSub" element = do
+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
+ elemToBase
+ subExps <- filterChildName (hasElemName "m" "sub") element >>=
+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
+ return [TM.ESub baseExp (TM.EGrouped subExps)]
+elemToExps' element | isElem "m" "sSubSup" element = do
+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
+ elemToBase
+ subExps <- filterChildName (hasElemName "m" "sub") element >>=
+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
+ supExps <- filterChildName (hasElemName "m" "sup") element >>=
+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
+ return [TM.ESubsup baseExp (TM.EGrouped subExps) (TM.EGrouped supExps)]
+elemToExps' element | isElem "m" "sSup" element = do
+ baseExp <- filterChildName (hasElemName "m" "e") element >>=
+ elemToBase
+ supExps <- filterChildName (hasElemName "m" "sup") element >>=
+ (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
+ return [TM.ESuper baseExp (TM.EGrouped supExps)]
+elemToExps' element | isElem "m" "r" element = do
+ let mrPr = filterChildName (hasElemName "m" "rPr") element
+ lit = mrPr >>=
+ filterChildName (hasElemName "m" "lit") >>=
+ findAttrBy (hasElemName "m" "val")
+ txtSty = elemToOMathRunTextStyle element
+ mrElems <- elemToOMathRunElems element
+ return $ case oMathRunTextStyleToTextType txtSty of
+ Nothing -> [TM.EIdentifier $ oMathRunElemsToString mrElems]
+ Just textType ->
+ case lit of
+ Just "on" ->
+ [TM.EText textType (oMathRunElemsToString mrElems)]
+ _ ->
+ [TM.EStyled textType [TM.EIdentifier $ oMathRunElemsToString mrElems]]
+elemToExps' _ = Nothing
+
+
+expToString :: TM.Exp -> String
+expToString (TM.ENumber s) = s
+expToString (TM.EIdentifier s) = s
+expToString (TM.EMathOperator s) = s
+expToString (TM.ESymbol _ s) = s
+expToString (TM.EText _ s) = s
+expToString (TM.EGrouped exps) = concatMap expToString exps
+expToString (TM.EStyled _ exps) = concatMap expToString exps
+expToString _ = ""
diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs
index 3b2e7c5ca..8c9b4d672 100644
--- a/src/Text/Pandoc/Readers/Docx/Parse.hs
+++ b/src/Text/Pandoc/Readers/Docx/Parse.hs
@@ -61,7 +61,7 @@ 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.Pandoc.Readers.Docx.OMath (readOMML)
import Text.TeXMath (Exp)
data ReaderEnv = ReaderEnv { envNotes :: Notes
@@ -475,7 +475,7 @@ elemToBodyPart ns element
| isElem ns "w" "p" element
, (c:_) <- findChildren (elemName ns "m" "oMathPara") element =
do
- expsLst <- mapD (\e -> (maybeToD $ elemToExps ns e)) (elChildren c)
+ expsLst <- mapD (\e -> (maybeToD $ readOMML e)) (elChildren c)
return $ OMathPara expsLst
elemToBodyPart ns element
| isElem ns "w" "p" element
@@ -574,8 +574,8 @@ elemToParPart ns element
Just target -> ExternalHyperLink target runs
Nothing -> ExternalHyperLink "" runs
elemToParPart ns element
- | isElem ns "m" "oMath" element =
- (maybeToD $ elemToExps ns element) >>= (return . PlainOMath)
+ | isElem ns "m" "oMath" element =
+ (maybeToD $ readOMML element) >>= (return . PlainOMath)
elemToParPart _ _ = throwError WrongElem
lookupFootnote :: String -> Notes -> Maybe Element
@@ -677,13 +677,3 @@ elemToRunElems ns 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 2024-12-12 05:28:53 +0000