Merge pull request #1502 from jkr/streamlineMath

Streamline OMML parser
This commit is contained in:
John MacFarlane 2014-08-08 11:26:26 -07:00
commit e5fb97ff4f
2 changed files with 297 additions and 500 deletions

View file

@ -30,76 +30,39 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Types and functions for conversion of OMML into TeXMath. Types and functions for conversion of OMML into TeXMath.
-} -}
module Text.Pandoc.Readers.Docx.OMath ( elemToExps module Text.Pandoc.Readers.Docx.OMath (readOMML
) where ) where
import Text.XML.Light import Text.XML.Light
import Data.Maybe (mapMaybe, fromMaybe) import Data.Maybe (mapMaybe, fromMaybe)
import Data.List (intersperse) import Data.List (intersperse)
import qualified Text.TeXMath.Types as TM import qualified Text.TeXMath.Types as TM
import Control.Applicative ((<$>))
type NameSpaces = [(String, String)] readOMML :: Element -> Maybe [TM.Exp]
readOMML element | isElem "m" "oMath" element =
Just $ concat $ mapMaybe (elemToExps') (elChildren element)
readOMML _ = Nothing
elemName :: NameSpaces -> String -> String -> QName
elemName ns prefix name = (QName name (lookup prefix ns) (Just prefix))
isElem :: NameSpaces -> String -> String -> Element -> Bool isElem :: String -> String -> Element -> Bool
isElem ns prefix name element = isElem prefix name element =
let qp = fromMaybe "" (qPrefix (elName element))
in
qName (elName element) == name && qName (elName element) == name &&
qURI (elName element) == (lookup prefix ns) qp == prefix
hasElemName:: String -> String -> QName -> Bool
data OMath = OMath [OMathElem] hasElemName prefix name qn =
deriving Show let qp = fromMaybe "" (qPrefix qn)
in
data OMathElem = Accent AccentStyle Base qName qn == name &&
| Bar BarStyle Base qp == prefix
| 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 data OMathRunElem = TextRun String
| LnBrk | LnBrk
| Tab | Tab
deriving Show 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 data OMathRunTextStyle = NoStyle
| Normal | Normal
| Styled { oMathScript :: Maybe OMathTextScript | Styled { oMathScript :: Maybe OMathTextScript
@ -120,82 +83,40 @@ data OMathTextStyle = OPlain
| OBoldItalic | OBoldItalic
deriving (Show, Eq) deriving (Show, Eq)
defaultNAryStyle :: NAryStyle elemToBase :: Element -> Maybe TM.Exp
defaultNAryStyle = NAryStyle { nAryChar = Nothing -- integral, in practice elemToBase element | isElem "m" "e" element = do
, nAryLimLoc = SubSup } bs <- elemToBases element
return $ case bs of
(e : []) -> e
exps -> TM.EGrouped exps
elemToBase _ = Nothing
data LimLoc = SubSup | UnderOver deriving Show elemToBases :: Element -> Maybe [TM.Exp]
elemToBases element | isElem "m" "e" element =
return $ concat $ mapMaybe elemToExps' (elChildren element)
elemToBases _ = Nothing
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 -- 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 -- text lines into multiple columns. That's tricky, though, and this
-- will get us most of the way for the time being. -- will get us most of the way for the time being.
filterAmpersand :: OMathElem -> OMathElem filterAmpersand :: TM.Exp -> TM.Exp
filterAmpersand (OMathRun mrPr elems) = filterAmpersand (TM.EIdentifier s) = TM.EIdentifier (filter ('&' /=) s)
let f (TextRun s) = TextRun $ filter ('&' /=) s filterAmpersand (TM.EText tt s) = TM.EText tt (filter ('&' /=) s)
f re = re filterAmpersand (TM.EStyled tt exps) = TM.EStyled tt (map filterAmpersand exps)
in filterAmpersand (TM.EGrouped exps) = TM.EGrouped (map filterAmpersand exps)
OMathRun mrPr (map f elems)
filterAmpersand e = e filterAmpersand e = e
elemToBaseNoAmpersand :: NameSpaces -> Element -> Maybe Base elemToOMathRunTextStyle :: Element -> OMathRunTextStyle
elemToBaseNoAmpersand ns element | isElem ns "m" "e" element = elemToOMathRunTextStyle element
return $ Base $ | Just mrPr <- filterChildName (hasElemName"m" "rPr") element
mapMaybe , Just _ <- filterChildName (hasElemName"m" "nor") mrPr =
(\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 Normal
| Just mrPr <- findChild (elemName ns "m" "rPr") element = | Just mrPr <- filterChildName (hasElemName"m" "rPr") element =
let scr = let scr =
case case
findChild (elemName ns "m" "scr") mrPr >>= filterChildName (hasElemName"m" "scr") mrPr >>=
findAttr (elemName ns "m" "val") findAttrBy (hasElemName"m" "val")
of of
Just "roman" -> Just ORoman Just "roman" -> Just ORoman
Just "script" -> Just OScript Just "script" -> Just OScript
@ -207,8 +128,8 @@ elemToOMathRunTextStyle ns element
sty = sty =
case case
findChild (elemName ns "m" "sty") mrPr >>= filterChildName (hasElemName"m" "sty") mrPr >>=
findAttr (elemName ns "m" "val") findAttrBy (hasElemName"m" "val")
of of
Just "p" -> Just OPlain Just "p" -> Just OPlain
Just "b" -> Just OBold Just "b" -> Just OBold
@ -219,194 +140,21 @@ elemToOMathRunTextStyle ns element
Styled { oMathScript = scr, oMathStyle = sty } Styled { oMathScript = scr, oMathStyle = sty }
| otherwise = NoStyle | otherwise = NoStyle
elemToOMathRunElem :: Element -> Maybe OMathRunElem
elemToOMathRunElem element
elemToNAryStyle :: NameSpaces -> Element -> NAryStyle | isElem "w" "t" element
elemToNAryStyle ns element || isElem "m" "t" element
| Just narypr <- findChild (QName "naryPr" (lookup "m" ns) (Just "m")) element = || isElem "w" "delText" element = Just $ TextRun $ strContent element
let | isElem "w" "br" element = Just LnBrk
chr = findChild (QName "chr" (lookup "m" ns) (Just "m")) narypr >>= | isElem "w" "tab" element = Just Tab
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 | otherwise = Nothing
elemToOMathRunElems :: NameSpaces -> Element -> Maybe [OMathRunElem] elemToOMathRunElems :: Element -> Maybe [OMathRunElem]
elemToOMathRunElems ns element elemToOMathRunElems element
| isElem ns "w" "r" element | isElem "w" "r" element
|| isElem ns "m" "r" element = || isElem "m" "r" element =
Just $ mapMaybe (elemToOMathRunElem ns) (elChildren element) Just $ mapMaybe (elemToOMathRunElem) (elChildren element)
elemToOMathRunElems _ _ = Nothing elemToOMathRunElems _ = Nothing
----- And now the TeXMath Creation ----- And now the TeXMath Creation
@ -418,205 +166,264 @@ oMathRunElemToString (Tab) = ['\t']
oMathRunElemsToString :: [OMathRunElem] -> String oMathRunElemsToString :: [OMathRunElem] -> String
oMathRunElemsToString = concatMap oMathRunElemToString oMathRunElemsToString = concatMap oMathRunElemToString
oMathElemToString :: OMathElem -> String oMathRunTextStyleToTextType :: OMathRunTextStyle -> Maybe TM.TextType
oMathElemToString (OMathRun _ oMathRunElems) = oMathRunTextStyleToTextType (Normal) = Just $ TM.TextNormal
oMathRunElemsToString oMathRunElems oMathRunTextStyleToTextType (NoStyle) = Nothing
oMathElemToString _ = "" oMathRunTextStyleToTextType (Styled scr sty)
| Just OBold <- sty
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 OSansSerif <- scr =
Just $ TM.TextSansSerifBold Just $ TM.TextSansSerifBold
| Styled scr sty <- oMathRunTextStyle mrPr | Just OBoldItalic <- sty
, Just OBoldItalic <- sty
, Just OSansSerif <- scr = , Just OSansSerif <- scr =
Just $ TM.TextSansSerifBoldItalic Just $ TM.TextSansSerifBoldItalic
| Styled scr sty <- oMathRunTextStyle mrPr | Just OBold <- sty
, Just OBold <- sty
, Just OScript <- scr = , Just OScript <- scr =
Just $ TM.TextBoldScript Just $ TM.TextBoldScript
| Styled scr sty <- oMathRunTextStyle mrPr | Just OBold <- sty
, Just OBold <- sty
, Just OFraktur <- scr = , Just OFraktur <- scr =
Just $ TM.TextBoldFraktur Just $ TM.TextBoldFraktur
| Styled scr sty <- oMathRunTextStyle mrPr | Just OItalic <- sty
, Just OItalic <- sty
, Just OSansSerif <- scr = , Just OSansSerif <- scr =
Just $ TM.TextSansSerifItalic Just $ TM.TextSansSerifItalic
| Styled _ sty <- oMathRunTextStyle mrPr | Just OBold <- sty =
, Just OBold <- sty =
Just $ TM.TextBold Just $ TM.TextBold
| Styled _ sty <- oMathRunTextStyle mrPr | Just OItalic <- sty =
, Just OItalic <- sty =
Just $ TM.TextItalic Just $ TM.TextItalic
| Styled scr _ <- oMathRunTextStyle mrPr | Just OMonospace <- scr =
, Just OMonospace <- scr =
Just $ TM.TextMonospace Just $ TM.TextMonospace
| Styled scr _ <- oMathRunTextStyle mrPr | Just OSansSerif <- scr =
, Just OSansSerif <- scr =
Just $ TM.TextSansSerif Just $ TM.TextSansSerif
| Styled scr _ <- oMathRunTextStyle mrPr | Just ODoubleStruck <- scr =
, Just ODoubleStruck <- scr =
Just $ TM.TextDoubleStruck Just $ TM.TextDoubleStruck
| Styled scr _ <- oMathRunTextStyle mrPr | Just OScript <- scr =
, Just OScript <- scr =
Just $ TM.TextDoubleStruck Just $ TM.TextDoubleStruck
| Styled scr _ <- oMathRunTextStyle mrPr | Just OFraktur <- scr =
, Just OFraktur <- scr =
Just $ TM.TextFraktur Just $ TM.TextFraktur
| Styled _ sty <- oMathRunTextStyle mrPr | Just OBoldItalic <- sty =
, Just OBoldItalic <- sty =
Just $ TM.TextBoldItalic Just $ TM.TextBoldItalic
| otherwise = Nothing | otherwise = Nothing
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]
baseToExp :: Base -> TM.Exp elemToExps' element | isElem "m" "phant" element = do
baseToExp b = TM.EGrouped $ baseToExp' b 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
-- 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)
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 _ = ""

View file

@ -61,7 +61,7 @@ import qualified Text.Pandoc.UTF8 as UTF8
import Control.Monad.Reader import Control.Monad.Reader
import qualified Data.Map as M import qualified Data.Map as M
import Text.Pandoc.Compat.Except import Text.Pandoc.Compat.Except
import Text.Pandoc.Readers.Docx.OMath (elemToExps) import Text.Pandoc.Readers.Docx.OMath (readOMML)
import Text.TeXMath (Exp) import Text.TeXMath (Exp)
data ReaderEnv = ReaderEnv { envNotes :: Notes data ReaderEnv = ReaderEnv { envNotes :: Notes
@ -475,7 +475,7 @@ elemToBodyPart ns element
| isElem ns "w" "p" element | isElem ns "w" "p" element
, (c:_) <- findChildren (elemName ns "m" "oMathPara") element = , (c:_) <- findChildren (elemName ns "m" "oMathPara") element =
do do
expsLst <- mapD (\e -> (maybeToD $ elemToExps ns e)) (elChildren c) expsLst <- mapD (\e -> (maybeToD $ readOMML e)) (elChildren c)
return $ OMathPara expsLst return $ OMathPara expsLst
elemToBodyPart ns element elemToBodyPart ns element
| isElem ns "w" "p" element | isElem ns "w" "p" element
@ -575,7 +575,7 @@ elemToParPart ns element
Nothing -> ExternalHyperLink "" runs Nothing -> ExternalHyperLink "" runs
elemToParPart ns element elemToParPart ns element
| isElem ns "m" "oMath" element = | isElem ns "m" "oMath" element =
(maybeToD $ elemToExps ns element) >>= (return . PlainOMath) (maybeToD $ readOMML element) >>= (return . PlainOMath)
elemToParPart _ _ = throwError WrongElem elemToParPart _ _ = throwError WrongElem
lookupFootnote :: String -> Notes -> Maybe Element lookupFootnote :: String -> Notes -> Maybe Element
@ -677,13 +677,3 @@ elemToRunElems ns element
|| isElem ns "m" "r" element = || isElem ns "m" "r" element =
mapD (elemToRunElem ns) (elChildren element) mapD (elemToRunElem ns) (elChildren element)
elemToRunElems _ _ = throwError WrongElem elemToRunElems _ _ = throwError WrongElem