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.
-}
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)]
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 ns prefix name element =
isElem :: String -> String -> Element -> Bool
isElem prefix name element =
let qp = fromMaybe "" (qPrefix (elName element))
in
qName (elName element) == name &&
qURI (elName element) == (lookup prefix ns)
qp == prefix
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
hasElemName:: String -> String -> QName -> Bool
hasElemName prefix name qn =
let qp = fromMaybe "" (qPrefix qn)
in
qName qn == name &&
qp == prefix
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
@ -120,82 +83,40 @@ data OMathTextStyle = OPlain
| OBoldItalic
deriving (Show, Eq)
defaultNAryStyle :: NAryStyle
defaultNAryStyle = NAryStyle { nAryChar = Nothing -- integral, in practice
, nAryLimLoc = SubSup }
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
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
-- 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 :: 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
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 =
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
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
baseToExp b = TM.EGrouped $ baseToExp' b
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
-- 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 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
@ -575,7 +575,7 @@ elemToParPart ns element
Nothing -> ExternalHyperLink "" runs
elemToParPart ns element
| isElem ns "m" "oMath" element =
(maybeToD $ elemToExps ns element) >>= (return . PlainOMath)
(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