From cf849443cba46952ec8b3c5c59b70cadc040ef3f Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Thu, 7 Aug 2014 22:55:03 -0400 Subject: OMath parser: don't group expressions if there's only one. --- src/Text/Pandoc/Readers/Docx/OMath.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'src/Text/Pandoc/Readers') diff --git a/src/Text/Pandoc/Readers/Docx/OMath.hs b/src/Text/Pandoc/Readers/Docx/OMath.hs index 309aaefe8..8dd39c613 100644 --- a/src/Text/Pandoc/Readers/Docx/OMath.hs +++ b/src/Text/Pandoc/Readers/Docx/OMath.hs @@ -607,10 +607,10 @@ oMathRunStyleToTextType mrPr Just $ TM.TextBoldItalic | otherwise = Nothing - - baseToExp :: Base -> TM.Exp -baseToExp b = TM.EGrouped $ baseToExp' b +baseToExp b = case baseToExp' b of + (e : []) -> e + exps -> TM.EGrouped exps -- an ungrouped version of baseToExp baseToExp' :: Base -> [TM.Exp] -- cgit v1.2.3 From 0acd139fb19d01f8f110c15125f1b4385939ff88 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Thu, 7 Aug 2014 22:49:47 -0400 Subject: OMath: Start phasing out internal OMath type. This is the first step in removing the intermediate OMath type, which we no longer need since we're writing straight to TeXMath Exp. --- src/Text/Pandoc/Readers/Docx/OMath.hs | 276 ++++++++++++++++++++++++++++++++++ 1 file changed, 276 insertions(+) (limited to 'src/Text/Pandoc/Readers') diff --git a/src/Text/Pandoc/Readers/Docx/OMath.hs b/src/Text/Pandoc/Readers/Docx/OMath.hs index 8dd39c613..c057ba754 100644 --- a/src/Text/Pandoc/Readers/Docx/OMath.hs +++ b/src/Text/Pandoc/Readers/Docx/OMath.hs @@ -557,6 +557,44 @@ oMathElemToExps (OMathRun sty elems) else [TM.EStyled textType [TM.EIdentifier $ oMathRunElemsToString elems]] oMathElemToExps (OMathRun _ _) = [] +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 + | Just OBoldItalic <- sty + , Just OSansSerif <- scr = + Just $ TM.TextSansSerifBoldItalic + | Just OBold <- sty + , Just OScript <- scr = + Just $ TM.TextBoldScript + | Just OBold <- sty + , Just OFraktur <- scr = + Just $ TM.TextBoldFraktur + | Just OItalic <- sty + , Just OSansSerif <- scr = + Just $ TM.TextSansSerifItalic + | Just OBold <- sty = + Just $ TM.TextBold + | Just OItalic <- sty = + Just $ TM.TextItalic + | Just OMonospace <- scr = + Just $ TM.TextMonospace + | Just OSansSerif <- scr = + Just $ TM.TextSansSerif + | Just ODoubleStruck <- scr = + Just $ TM.TextDoubleStruck + | Just OScript <- scr = + Just $ TM.TextDoubleStruck + | Just OFraktur <- scr = + Just $ TM.TextFraktur + | Just OBoldItalic <- sty = + Just $ TM.TextBoldItalic + | otherwise = Nothing + + oMathRunStyleToTextType :: OMathRunStyle -> Maybe TM.TextType oMathRunStyleToTextType mrPr | Normal <- oMathRunTextStyle mrPr = @@ -620,3 +658,241 @@ baseToExp' (Base mathElems) = elemToExps :: NameSpaces -> Element -> Maybe [TM.Exp] elemToExps ns element = oMathToExps <$> (elemToMath ns element) + +elemToExps' :: NameSpaces -> Element -> Maybe [TM.Exp] +elemToExps' ns element | isElem ns "m" "acc" element = do + let chr = findChild (elemName ns "m" "accPr") element >>= + findChild (elemName ns "m" "chr") >>= + findAttr (elemName ns "m" "val") >>= + Just . head + chr' = case chr of + Just c -> c + Nothing -> '\180' -- default to acute. + baseExp <- findChild (elemName ns "m" "e") element >>= + elemToBase ns >>= + (return . baseToExp) + return $ [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr'])] +elemToExps' ns element | isElem ns "m" "bar" element = do + pos <- findChild (elemName ns "m" "barPr") element >>= + findChild (elemName ns "m" "pos") >>= + findAttr (elemName ns "m" "val") + baseExp <- findChild (elemName ns "m" "e") element >>= + elemToBase ns >>= + (return . baseToExp) + 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' ns element | isElem ns "m" "box" element = do + baseExp <- findChild (elemName ns "m" "e") element >>= + elemToBase ns >>= + (return . baseToExp) + return [baseExp] +elemToExps' ns element | isElem ns "m" "borderBox" element = do + -- TODO: This needs to be "\\boxed" somehow. + baseExp <- findChild (elemName ns "m" "e") element >>= + elemToBase ns >>= + (return . baseToExp) + return [baseExp] +elemToExps' ns element | isElem ns "m" "d" element = + let baseExps = mapMaybe + (\e -> (elemToBase ns e >>= (return . baseToExp))) + (elChildren element) + inDelimExps = map Right baseExps + dPr = findChild (elemName ns "m" "dPr") element + begChr = dPr >>= + findChild (elemName ns "m" "begChr") >>= + findAttr (elemName ns "m" "val") >>= + (\c -> if null c then (Just ' ') else (Just $ head c)) + sepChr = dPr >>= + findChild (elemName ns "m" "sepChr") >>= + findAttr (elemName ns "m" "val") >>= + (\c -> if null c then (Just ' ') else (Just $ head c)) + endChr = dPr >>= + findChild (elemName ns "m" "endChr") >>= + findAttr (elemName ns "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' ns element | isElem ns "m" "eqArr" element = + let bases = mapMaybe (elemToBaseNoAmpersand ns) (elChildren element) + baseExps = map (\b -> [baseToExp' b]) bases + in + return [TM.EArray [] baseExps] +elemToExps' ns element | isElem ns "m" "f" element = do + num <- findChild (elemName ns "m" "num") element + den <- findChild (elemName ns "m" "den") element + let numExp = TM.EGrouped $ concat $ mapMaybe (elemToExps' ns) (elChildren num) + denExp = TM.EGrouped $ concat $ mapMaybe (elemToExps' ns) (elChildren den) + return $ [TM.EFraction TM.NormalFrac numExp denExp] +elemToExps' ns element | isElem ns "m" "func" element = do + fName <- findChild (elemName ns "m" "fName") element + baseExp <- findChild (elemName ns "m" "e") element >>= + elemToBase ns >>= + (return . baseToExp) + -- 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' ns) (elChildren fName) + return [TM.EMathOperator fnameString, baseExp] +elemToExps' ns element | isElem ns "m" "groupChr" element = do + let gPr = findChild (elemName ns "m" "groupChrPr") element + chr = gPr >>= + findChild (elemName ns "m" "chr") >>= + findAttr (elemName ns "m" "val") + pos = gPr >>= + findChild (elemName ns "m" "pos") >>= + findAttr (elemName ns "m" "val") + baseExp <- findChild (elemName ns "m" "e") element >>= + elemToBase ns >>= + (return . baseToExp) + 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' ns element | isElem ns "m" "limLow" element = do + baseExp <- findChild (elemName ns "m" "e") element + >>= elemToBase ns + >>= (return . baseToExp) + limExp <- findChild (elemName ns "m" "lim") element + >>= (\e -> Just $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) + >>= (return . TM.EGrouped) + return [TM.EUnder True limExp baseExp] +elemToExps' ns element | isElem ns "m" "limUpp" element = do + baseExp <- findChild (elemName ns "m" "e") element + >>= elemToBase ns + >>= (return . baseToExp) + limExp <- findChild (elemName ns "m" "lim") element + >>= (\e -> Just $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) + >>= (return . TM.EGrouped) + return [TM.EOver True limExp baseExp] +elemToExps' ns element | isElem ns "m" "m" element = + let rows = findChildren (elemName ns "m" "mr") element + rowExps = map + (\mr -> mapMaybe + (\e -> (elemToBase ns e >>= return . baseToExp')) + (elChildren mr)) + rows + in + return [TM.EArray [TM.AlignCenter] rowExps] +elemToExps' ns element | isElem ns "m" "nary" element = do + let naryPr = findChild (elemName ns "m" "naryPr") element + naryChr = naryPr >>= + findChild (elemName ns "m" "chr") >>= + findAttr (elemName ns "m" "val") + opChr = case naryChr of + Just (c:_) -> c + _ -> '\8747' -- default to integral + limLoc = naryPr >>= + findChild (elemName ns "m" "limLoc") >>= + findAttr (elemName ns "m" "val") + subExps <- findChild (elemName ns "m" "sub") element >>= + (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) + supExps <- findChild (elemName ns "m" "sup") element >>= + (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) + baseExp <- findChild (elemName ns "m" "e") element >>= + elemToBase ns >>= + (return . baseToExp) + 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' ns element | isElem ns "m" "phant" element = do + baseExp <- findChild (elemName ns "m" "e") element >>= + elemToBase ns >>= + (return . baseToExp) + return [TM.EPhantom baseExp] +elemToExps' ns element | isElem ns "m" "rad" element = do + degExps <- findChild (elemName ns "m" "deg") element >>= + (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) + baseExp <- findChild (elemName ns "m" "e") element >>= + elemToBase ns >>= + (return . baseToExp) + return $ case degExps of + [] -> [TM.ESqrt baseExp] + ds -> [TM.ERoot (TM.EGrouped ds) baseExp] +elemToExps' ns element | isElem ns "m" "sPre" element = do + subExps <- findChild (elemName ns "m" "sub") element >>= + (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) + supExps <- findChild (elemName ns "m" "sup") element >>= + (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) + baseExp <- findChild (elemName ns "m" "e") element >>= + elemToBase ns >>= + (return . baseToExp) + return [TM.ESubsup + (TM.EIdentifier "") + (TM.EGrouped subExps) + (TM.EGrouped supExps) + , baseExp] +elemToExps' ns element | isElem ns "m" "sSub" element = do + baseExp <- findChild (elemName ns "m" "e") element >>= + elemToBase ns >>= + (return . baseToExp) + subExps <- findChild (elemName ns "m" "sub") element >>= + (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) + return [TM.ESub baseExp (TM.EGrouped subExps)] +elemToExps' ns element | isElem ns "m" "sSubSup" element = do + baseExp <- findChild (elemName ns "m" "e") element >>= + elemToBase ns >>= + (return . baseToExp) + subExps <- findChild (elemName ns "m" "sub") element >>= + (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) + supExps <- findChild (elemName ns "m" "sup") element >>= + (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) + return [TM.ESubsup baseExp (TM.EGrouped subExps) (TM.EGrouped supExps)] +elemToExps' ns element | isElem ns "m" "sSup" element = do + baseExp <- findChild (elemName ns "m" "e") element >>= + elemToBase ns >>= + (return . baseToExp) + supExps <- findChild (elemName ns "m" "sup") element >>= + (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) + return [TM.ESuper baseExp (TM.EGrouped supExps)] +elemToExps' ns element | isElem ns "m" "r" element = do + let mrPr = findChild (elemName ns "m" "rPr") element + lit = mrPr >>= + findChild (elemName ns "m" "lit") >>= + findAttr (elemName ns "m" "val") + txtSty = elemToOMathRunTextStyle ns element + mrElems <- elemToOMathRunElems ns 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 _ = "" -- cgit v1.2.3 From ba5804f9ec8c14f818eda2285395aaba98b304ac Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Fri, 8 Aug 2014 11:34:10 -0400 Subject: OMath: Remove Namespaces We still need to test against prefixes, but this is only going to look at oMath fragments, so we're not going to be worried about looking up the real namespace. --- src/Text/Pandoc/Readers/Docx/OMath.hs | 573 +++++++++++++++++----------------- src/Text/Pandoc/Readers/Docx/Parse.hs | 4 +- 2 files changed, 290 insertions(+), 287 deletions(-) (limited to 'src/Text/Pandoc/Readers') diff --git a/src/Text/Pandoc/Readers/Docx/OMath.hs b/src/Text/Pandoc/Readers/Docx/OMath.hs index c057ba754..210f715f9 100644 --- a/src/Text/Pandoc/Readers/Docx/OMath.hs +++ b/src/Text/Pandoc/Readers/Docx/OMath.hs @@ -30,7 +30,7 @@ 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 ( elemToExps ) where import Text.XML.Light @@ -39,16 +39,19 @@ 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) +isElem :: String -> String -> Element -> Bool +isElem prefix name element = + let qp = fromMaybe "" (qPrefix (elName element)) + in + qName (elName element) == name && + qp == prefix +hasElemName:: String -> String -> QName -> Bool +hasElemName prefix name qn = + let qp = fromMaybe "" (qPrefix qn) + in + qName qn == name && + qp == prefix data OMath = OMath [OMathElem] deriving Show @@ -143,15 +146,15 @@ data GroupStyle = GroupStyle { groupChr :: Maybe Char 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 +elemToMath :: Element -> Maybe OMath +elemToMath element | isElem "m" "oMath" element = + Just $ OMath $ mapMaybe (elemToMathElem) (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 +elemToBase :: Element -> Maybe Base +elemToBase element | isElem "m" "e" element = + Just $ Base $ mapMaybe (elemToMathElem) (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 @@ -164,38 +167,38 @@ filterAmpersand (OMathRun mrPr elems) = OMathRun mrPr (map f elems) filterAmpersand e = e -elemToBaseNoAmpersand :: NameSpaces -> Element -> Maybe Base -elemToBaseNoAmpersand ns element | isElem ns "m" "e" element = +elemToBaseNoAmpersand :: Element -> Maybe Base +elemToBaseNoAmpersand element | isElem "m" "e" element = return $ Base $ mapMaybe - (\e -> (elemToMathElem ns e >>= (return . filterAmpersand))) + (\e -> (elemToMathElem e >>= (return . filterAmpersand))) (elChildren element) -elemToBaseNoAmpersand _ _ = Nothing +elemToBaseNoAmpersand _ = Nothing -elemToOMathRunStyle :: NameSpaces -> Element -> OMathRunStyle -elemToOMathRunStyle ns element = +elemToOMathRunStyle :: Element -> OMathRunStyle +elemToOMathRunStyle element = let lit = case - findChild (elemName ns "m" "lit") element >>= - findAttr (elemName ns "m" "val") + filterChildName (hasElemName"m" "lit") element >>= + findAttrBy (hasElemName"m" "val") of Just "on" -> True _ -> False in OMathRunStyle { oMathLit = lit - , oMathRunTextStyle = (elemToOMathRunTextStyle ns element) + , oMathRunTextStyle = (elemToOMathRunTextStyle 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 +210,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 @@ -221,192 +224,192 @@ elemToOMathRunTextStyle ns element -elemToNAryStyle :: NameSpaces -> Element -> NAryStyle -elemToNAryStyle ns element - | Just narypr <- findChild (QName "naryPr" (lookup "m" ns) (Just "m")) element = +elemToNAryStyle :: Element -> NAryStyle +elemToNAryStyle element + | Just narypr <- filterChildName (hasElemName"m" "naryPr") element = let - chr = findChild (QName "chr" (lookup "m" ns) (Just "m")) narypr >>= - findAttr (QName "val" (lookup "m" ns) (Just "m")) >>= + chr = filterChildName (hasElemName"m" "chr") narypr >>= + findAttrBy (hasElemName"m" "val") >>= Just . head - limLoc = findChild (QName "limLoc" (lookup "m" ns) (Just "m")) narypr >>= - findAttr (QName "val" (lookup "m" ns) (Just "m")) + limLoc = filterChildName (hasElemName"m" "limLoc") narypr >>= + findAttrBy (hasElemName"m" "val") limLoc' = case limLoc of Just "undOver" -> UnderOver Just "subSup" -> SubSup _ -> SubSup in NAryStyle { nAryChar = chr, nAryLimLoc = limLoc'} -elemToNAryStyle _ _ = defaultNAryStyle +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")) >>= +elemToDelimStyle :: Element -> DelimStyle +elemToDelimStyle element + | Just dPr <- filterChildName (hasElemName"m" "dPr") element = + let begChr = filterChildName (hasElemName"m" "begChr") dPr >>= + findAttrBy (hasElemName"m" "val") >>= (\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")) >>= + sepChr = filterChildName (hasElemName"m" "sepChr") dPr >>= + findAttrBy (hasElemName"m" "val") >>= (\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")) >>= + endChr = filterChildName (hasElemName"m" "endChr") dPr >>= + findAttrBy (hasElemName"m" "val") >>= (\c -> if null c then (Just ' ') else (Just $ head c)) in DelimStyle { delimBegChar = begChr , delimSepChar = sepChr , delimEndChar = endChr} -elemToDelimStyle _ _ = defaultDelimStyle +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")) >>= +elemToGroupStyle :: Element -> GroupStyle +elemToGroupStyle element + | Just gPr <- filterChildName (hasElemName"m" "groupChrPr") element = + let chr = filterChildName (hasElemName"m" "chr") gPr >>= + findAttrBy (hasElemName"m" "val") >>= Just . head - pos = findChild (QName "pos" (lookup "m" ns) (Just "m")) gPr >>= - findAttr (QName "val" (lookup "m" ns) (Just "m")) >>= + pos = filterChildName (hasElemName"m" "pos") gPr >>= + findAttrBy (hasElemName"m" "val") >>= (\s -> Just $ if s == "top" then Top else Bottom) in GroupStyle { groupChr = chr, groupPos = pos } -elemToGroupStyle _ _ = defaultGroupStyle +elemToGroupStyle _ = defaultGroupStyle -elemToMathElem :: NameSpaces -> Element -> Maybe OMathElem -elemToMathElem ns element | isElem ns "m" "acc" element = do +elemToMathElem :: Element -> Maybe OMathElem +elemToMathElem element | isElem "m" "acc" element = do let accChar = - findChild (elemName ns "m" "accPr") element >>= - findChild (elemName ns "m" "chr") >>= - findAttr (elemName ns "m" "val") >>= + filterChildName (hasElemName"m" "accPr") element >>= + filterChildName (hasElemName"m" "chr") >>= + findAttrBy (hasElemName"m" "val") >>= Just . head accPr = AccentStyle { accentChar = accChar} - base <- findChild (elemName ns "m" "e") element >>= - elemToBase ns + base <- filterChildName (hasElemName"m" "e") element >>= + elemToBase 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")) >>= +elemToMathElem element | isElem "m" "bar" element = do + barPr <- filterChildName (hasElemName"m" "barPr") element >>= + filterChildName (hasElemName"m" "pos") >>= + findAttrBy (hasElemName"m" "val") >>= (\s -> Just $ BarStyle { barPos = (if s == "bot" then Bottom else Top) }) - base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>= - elemToBase ns + base <- filterChildName (hasElemName"m" "e") element >>= + elemToBase return $ Bar barPr base -elemToMathElem ns element | isElem ns "m" "box" element = - findChild (elemName ns "m" "e") element >>= - elemToBase ns >>= +elemToMathElem element | isElem "m" "box" element = + filterChildName (hasElemName"m" "e") element >>= + elemToBase >>= (\b -> return $ Box b) -elemToMathElem ns element | isElem ns "m" "borderBox" element = - findChild (elemName ns "m" "e") element >>= - elemToBase ns >>= +elemToMathElem element | isElem "m" "borderBox" element = + filterChildName (hasElemName"m" "e") element >>= + elemToBase >>= (\b -> return $ BorderBox b) -elemToMathElem ns element | isElem ns "m" "d" element = - let style = elemToDelimStyle ns element +elemToMathElem element | isElem "m" "d" element = + let style = elemToDelimStyle 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 $ Delimiter style $ mapMaybe (elemToBase) (elChildren element) +elemToMathElem element | isElem "m" "eqArr" element = + return $ EquationArray $ mapMaybe (elemToBaseNoAmpersand) (elChildren element) +elemToMathElem element | isElem "m" "f" element = do + num <- filterChildName (hasElemName"m" "num") element + den <- filterChildName (hasElemName"m" "den") element + let numElems = mapMaybe (elemToMathElem) (elChildren num) + denElems = mapMaybe (elemToMathElem) (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) +elemToMathElem element | isElem "m" "func" element = do + fName <- filterChildName (hasElemName"m" "fName") element + base <- filterChildName (hasElemName"m" "e") element >>= + elemToBase + let fnElems = mapMaybe (elemToMathElem) (elChildren fName) return $ Function fnElems base -elemToMathElem ns element | isElem ns "m" "groupChr" element = - let style = elemToGroupStyle ns element +elemToMathElem element | isElem "m" "groupChr" element = + let style = elemToGroupStyle element in - findChild (elemName ns "m" "e") element >>= - elemToBase ns >>= + filterChildName (hasElemName"m" "e") element >>= + elemToBase >>= (\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) +elemToMathElem element | isElem "m" "limLow" element = do + base <- filterChildName (hasElemName"m" "e") element + >>= elemToBase + lim <- filterChildName (hasElemName"m" "lim") element + let limElems = mapMaybe (elemToMathElem) (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) +elemToMathElem element | isElem "m" "limUpp" element = do + base <- filterChildName (hasElemName"m" "e") element + >>= elemToBase + lim <- filterChildName (hasElemName"m" "lim") element + let limElems = mapMaybe (elemToMathElem) (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 +elemToMathElem element | isElem "m" "m" element = do + let rows = filterChildrenName (hasElemName"m" "mr") element + let bases = mapMaybe (\mr -> mapM (elemToBase) (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 +elemToMathElem element | isElem "m" "nary" element = do + let style = elemToNAryStyle element + sub <- filterChildName (hasElemName"m" "sub") element >>= + (\e -> return $ mapMaybe (elemToMathElem) (elChildren e)) + sup <- filterChildName (hasElemName"m" "sup") element >>= + (\e -> return $ mapMaybe (elemToMathElem) (elChildren e)) + base <- filterChildName (hasElemName"m" "e") element >>= + elemToBase 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 +elemToMathElem element | isElem "m" "rad" element = do + deg <- filterChildName (hasElemName"m" "deg") element >>= + (\e -> return $ mapMaybe (elemToMathElem) (elChildren e)) + base <- filterChildName (hasElemName"m" "e") element >>= + elemToBase return $ Radical deg base -elemToMathElem ns element | isElem ns "m" "phant" element = do - base <- findChild (elemName ns "m" "e") element >>= - elemToBase ns +elemToMathElem element | isElem "m" "phant" element = do + base <- filterChildName (hasElemName"m" "e") element >>= + elemToBase 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 +elemToMathElem element | isElem "m" "sPre" element = do + sub <- filterChildName (hasElemName"m" "sub") element >>= + (\e -> return $ mapMaybe (elemToMathElem) (elChildren e)) + sup <- filterChildName (hasElemName"m" "sup") element >>= + (\e -> return $ mapMaybe (elemToMathElem) (elChildren e)) + base <- filterChildName (hasElemName"m" "e") element >>= + elemToBase 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)) +elemToMathElem element | isElem "m" "sSub" element = do + base <- filterChildName (hasElemName"m" "e") element >>= + elemToBase + sub <- filterChildName (hasElemName"m" "sub") element >>= + (\e -> return $ mapMaybe (elemToMathElem) (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)) +elemToMathElem element | isElem "m" "sSubSup" element = do + base <- filterChildName (hasElemName"m" "e") element >>= + elemToBase + sub <- filterChildName (hasElemName"m" "sub") element >>= + (\e -> return $ mapMaybe (elemToMathElem) (elChildren e)) + sup <- filterChildName (hasElemName"m" "sup") element >>= + (\e -> return $ mapMaybe (elemToMathElem) (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)) +elemToMathElem element | isElem "m" "sSup" element = do + base <- filterChildName (hasElemName"m" "e") element >>= + elemToBase + sup <- filterChildName (hasElemName"m" "sup") element >>= + (\e -> return $ mapMaybe (elemToMathElem) (elChildren e)) return $ Super base sup -elemToMathElem ns element | isElem ns "m" "r" element = do - let mrPr = elemToOMathRunStyle ns element - mrElems <- elemToOMathRunElems ns element +elemToMathElem element | isElem "m" "r" element = do + let mrPr = elemToOMathRunStyle element + mrElems <- elemToOMathRunElems 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 +elemToMathElem _ = Nothing + +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 @@ -655,62 +658,62 @@ 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 = oMathToExps <$> (elemToMath element) -elemToExps' :: NameSpaces -> Element -> Maybe [TM.Exp] -elemToExps' ns element | isElem ns "m" "acc" element = do - let chr = findChild (elemName ns "m" "accPr") element >>= - findChild (elemName ns "m" "chr") >>= - findAttr (elemName ns "m" "val") >>= +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 <- findChild (elemName ns "m" "e") element >>= - elemToBase ns >>= + baseExp <- filterChildName (hasElemName "m" "e") element >>= + elemToBase >>= (return . baseToExp) return $ [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr'])] -elemToExps' ns element | isElem ns "m" "bar" element = do - pos <- findChild (elemName ns "m" "barPr") element >>= - findChild (elemName ns "m" "pos") >>= - findAttr (elemName ns "m" "val") - baseExp <- findChild (elemName ns "m" "e") element >>= - elemToBase ns >>= +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 >>= (return . baseToExp) 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' ns element | isElem ns "m" "box" element = do - baseExp <- findChild (elemName ns "m" "e") element >>= - elemToBase ns >>= +elemToExps' element | isElem "m" "box" element = do + baseExp <- filterChildName (hasElemName "m" "e") element >>= + elemToBase >>= (return . baseToExp) return [baseExp] -elemToExps' ns element | isElem ns "m" "borderBox" element = do +elemToExps' element | isElem "m" "borderBox" element = do -- TODO: This needs to be "\\boxed" somehow. - baseExp <- findChild (elemName ns "m" "e") element >>= - elemToBase ns >>= + baseExp <- filterChildName (hasElemName "m" "e") element >>= + elemToBase >>= (return . baseToExp) return [baseExp] -elemToExps' ns element | isElem ns "m" "d" element = +elemToExps' element | isElem "m" "d" element = let baseExps = mapMaybe - (\e -> (elemToBase ns e >>= (return . baseToExp))) + (\e -> (elemToBase e >>= (return . baseToExp))) (elChildren element) inDelimExps = map Right baseExps - dPr = findChild (elemName ns "m" "dPr") element + dPr = filterChildName (hasElemName "m" "dPr") element begChr = dPr >>= - findChild (elemName ns "m" "begChr") >>= - findAttr (elemName ns "m" "val") >>= + filterChildName (hasElemName "m" "begChr") >>= + findAttrBy (hasElemName "m" "val") >>= (\c -> if null c then (Just ' ') else (Just $ head c)) sepChr = dPr >>= - findChild (elemName ns "m" "sepChr") >>= - findAttr (elemName ns "m" "val") >>= + filterChildName (hasElemName "m" "sepChr") >>= + findAttrBy (hasElemName "m" "val") >>= (\c -> if null c then (Just ' ') else (Just $ head c)) endChr = dPr >>= - findChild (elemName ns "m" "endChr") >>= - findAttr (elemName ns "m" "val") >>= + filterChildName (hasElemName "m" "endChr") >>= + findAttrBy (hasElemName "m" "val") >>= (\c -> if null c then (Just ' ') else (Just $ head c)) beg = fromMaybe '(' begChr end = fromMaybe ')' endChr @@ -718,38 +721,38 @@ elemToExps' ns element | isElem ns "m" "d" element = exps = intersperse (Left [sep]) inDelimExps in Just [TM.EDelimited [beg] [end] exps] -elemToExps' ns element | isElem ns "m" "eqArr" element = - let bases = mapMaybe (elemToBaseNoAmpersand ns) (elChildren element) +elemToExps' element | isElem "m" "eqArr" element = + let bases = mapMaybe (elemToBaseNoAmpersand) (elChildren element) baseExps = map (\b -> [baseToExp' b]) bases in return [TM.EArray [] baseExps] -elemToExps' ns element | isElem ns "m" "f" element = do - num <- findChild (elemName ns "m" "num") element - den <- findChild (elemName ns "m" "den") element - let numExp = TM.EGrouped $ concat $ mapMaybe (elemToExps' ns) (elChildren num) - denExp = TM.EGrouped $ concat $ mapMaybe (elemToExps' ns) (elChildren den) +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' ns element | isElem ns "m" "func" element = do - fName <- findChild (elemName ns "m" "fName") element - baseExp <- findChild (elemName ns "m" "e") element >>= - elemToBase ns >>= +elemToExps' element | isElem "m" "func" element = do + fName <- filterChildName (hasElemName "m" "fName") element + baseExp <- filterChildName (hasElemName "m" "e") element >>= + elemToBase >>= (return . baseToExp) -- 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' ns) (elChildren fName) + concat $ mapMaybe (elemToExps') (elChildren fName) return [TM.EMathOperator fnameString, baseExp] -elemToExps' ns element | isElem ns "m" "groupChr" element = do - let gPr = findChild (elemName ns "m" "groupChrPr") element +elemToExps' element | isElem "m" "groupChr" element = do + let gPr = filterChildName (hasElemName "m" "groupChrPr") element chr = gPr >>= - findChild (elemName ns "m" "chr") >>= - findAttr (elemName ns "m" "val") + filterChildName (hasElemName "m" "chr") >>= + findAttrBy (hasElemName "m" "val") pos = gPr >>= - findChild (elemName ns "m" "pos") >>= - findAttr (elemName ns "m" "val") - baseExp <- findChild (elemName ns "m" "e") element >>= - elemToBase ns >>= + filterChildName (hasElemName "m" "pos") >>= + findAttrBy (hasElemName "m" "val") + baseExp <- filterChildName (hasElemName "m" "e") element >>= + elemToBase >>= (return . baseToExp) case pos of Just "top" -> @@ -765,48 +768,48 @@ elemToExps' ns element | isElem ns "m" "groupChr" element = do in return [TM.EUnder False baseExp (TM.ESymbol TM.Accent [chr'])] _ -> Nothing -elemToExps' ns element | isElem ns "m" "limLow" element = do - baseExp <- findChild (elemName ns "m" "e") element - >>= elemToBase ns +elemToExps' element | isElem "m" "limLow" element = do + baseExp <- filterChildName (hasElemName "m" "e") element + >>= elemToBase >>= (return . baseToExp) - limExp <- findChild (elemName ns "m" "lim") element - >>= (\e -> Just $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) + limExp <- filterChildName (hasElemName "m" "lim") element + >>= (\e -> Just $ concat $ mapMaybe (elemToExps') (elChildren e)) >>= (return . TM.EGrouped) return [TM.EUnder True limExp baseExp] -elemToExps' ns element | isElem ns "m" "limUpp" element = do - baseExp <- findChild (elemName ns "m" "e") element - >>= elemToBase ns +elemToExps' element | isElem "m" "limUpp" element = do + baseExp <- filterChildName (hasElemName "m" "e") element + >>= elemToBase >>= (return . baseToExp) - limExp <- findChild (elemName ns "m" "lim") element - >>= (\e -> Just $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) + limExp <- filterChildName (hasElemName "m" "lim") element + >>= (\e -> Just $ concat $ mapMaybe (elemToExps') (elChildren e)) >>= (return . TM.EGrouped) return [TM.EOver True limExp baseExp] -elemToExps' ns element | isElem ns "m" "m" element = - let rows = findChildren (elemName ns "m" "mr") element +elemToExps' element | isElem "m" "m" element = + let rows = filterChildrenName (hasElemName "m" "mr") element rowExps = map (\mr -> mapMaybe - (\e -> (elemToBase ns e >>= return . baseToExp')) + (\e -> (elemToBase e >>= return . baseToExp')) (elChildren mr)) rows in return [TM.EArray [TM.AlignCenter] rowExps] -elemToExps' ns element | isElem ns "m" "nary" element = do - let naryPr = findChild (elemName ns "m" "naryPr") element +elemToExps' element | isElem "m" "nary" element = do + let naryPr = filterChildName (hasElemName "m" "naryPr") element naryChr = naryPr >>= - findChild (elemName ns "m" "chr") >>= - findAttr (elemName ns "m" "val") + filterChildName (hasElemName "m" "chr") >>= + findAttrBy (hasElemName "m" "val") opChr = case naryChr of Just (c:_) -> c _ -> '\8747' -- default to integral limLoc = naryPr >>= - findChild (elemName ns "m" "limLoc") >>= - findAttr (elemName ns "m" "val") - subExps <- findChild (elemName ns "m" "sub") element >>= - (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) - supExps <- findChild (elemName ns "m" "sup") element >>= - (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) - baseExp <- findChild (elemName ns "m" "e") element >>= - elemToBase ns >>= + 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 >>= (return . baseToExp) case limLoc of Just "undOvr" -> return [TM.EUnderover True @@ -820,63 +823,63 @@ elemToExps' ns element | isElem ns "m" "nary" element = do (TM.EGrouped supExps) , baseExp] -elemToExps' ns element | isElem ns "m" "phant" element = do - baseExp <- findChild (elemName ns "m" "e") element >>= - elemToBase ns >>= +elemToExps' element | isElem "m" "phant" element = do + baseExp <- filterChildName (hasElemName "m" "e") element >>= + elemToBase >>= (return . baseToExp) return [TM.EPhantom baseExp] -elemToExps' ns element | isElem ns "m" "rad" element = do - degExps <- findChild (elemName ns "m" "deg") element >>= - (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) - baseExp <- findChild (elemName ns "m" "e") element >>= - elemToBase ns >>= +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 . baseToExp) return $ case degExps of [] -> [TM.ESqrt baseExp] ds -> [TM.ERoot (TM.EGrouped ds) baseExp] -elemToExps' ns element | isElem ns "m" "sPre" element = do - subExps <- findChild (elemName ns "m" "sub") element >>= - (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) - supExps <- findChild (elemName ns "m" "sup") element >>= - (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) - baseExp <- findChild (elemName ns "m" "e") element >>= - elemToBase ns >>= +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 . baseToExp) return [TM.ESubsup (TM.EIdentifier "") (TM.EGrouped subExps) (TM.EGrouped supExps) , baseExp] -elemToExps' ns element | isElem ns "m" "sSub" element = do - baseExp <- findChild (elemName ns "m" "e") element >>= - elemToBase ns >>= +elemToExps' element | isElem "m" "sSub" element = do + baseExp <- filterChildName (hasElemName "m" "e") element >>= + elemToBase >>= (return . baseToExp) - subExps <- findChild (elemName ns "m" "sub") element >>= - (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) + subExps <- filterChildName (hasElemName "m" "sub") element >>= + (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e)) return [TM.ESub baseExp (TM.EGrouped subExps)] -elemToExps' ns element | isElem ns "m" "sSubSup" element = do - baseExp <- findChild (elemName ns "m" "e") element >>= - elemToBase ns >>= +elemToExps' element | isElem "m" "sSubSup" element = do + baseExp <- filterChildName (hasElemName "m" "e") element >>= + elemToBase >>= (return . baseToExp) - subExps <- findChild (elemName ns "m" "sub") element >>= - (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) - supExps <- findChild (elemName ns "m" "sup") element >>= - (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) + 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' ns element | isElem ns "m" "sSup" element = do - baseExp <- findChild (elemName ns "m" "e") element >>= - elemToBase ns >>= +elemToExps' element | isElem "m" "sSup" element = do + baseExp <- filterChildName (hasElemName "m" "e") element >>= + elemToBase >>= (return . baseToExp) - supExps <- findChild (elemName ns "m" "sup") element >>= - (\e -> return $ concat $ mapMaybe (elemToExps' ns) (elChildren e)) + supExps <- filterChildName (hasElemName "m" "sup") element >>= + (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e)) return [TM.ESuper baseExp (TM.EGrouped supExps)] -elemToExps' ns element | isElem ns "m" "r" element = do - let mrPr = findChild (elemName ns "m" "rPr") element +elemToExps' element | isElem "m" "r" element = do + let mrPr = filterChildName (hasElemName "m" "rPr") element lit = mrPr >>= - findChild (elemName ns "m" "lit") >>= - findAttr (elemName ns "m" "val") - txtSty = elemToOMathRunTextStyle ns element - mrElems <- elemToOMathRunElems ns element + 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 -> @@ -885,7 +888,7 @@ elemToExps' ns element | isElem ns "m" "r" element = do [TM.EText textType (oMathRunElemsToString mrElems)] _ -> [TM.EStyled textType [TM.EIdentifier $ oMathRunElemsToString mrElems]] -elemToExps' _ _ = Nothing +elemToExps' _ = Nothing expToString :: TM.Exp -> String expToString (TM.ENumber s) = s diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index 3b2e7c5ca..56dd2c96d 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -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 $ elemToExps 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 $ elemToExps element) >>= (return . PlainOMath) elemToParPart _ _ = throwError WrongElem lookupFootnote :: String -> Notes -> Maybe Element -- cgit v1.2.3 From 2f7a627f6dc9f7ee805af4d2a01746c6ab3d45e5 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Fri, 8 Aug 2014 13:58:10 -0400 Subject: OMath: Finish initial cleanup. This gets rid of commented-out functions, cleans up whitespace errors, and exports and imports the correct functions. --- src/Text/Pandoc/Readers/Docx/OMath.hs | 572 +++------------------------------- src/Text/Pandoc/Readers/Docx/Parse.hs | 18 +- 2 files changed, 54 insertions(+), 536 deletions(-) (limited to 'src/Text/Pandoc/Readers') diff --git a/src/Text/Pandoc/Readers/Docx/OMath.hs b/src/Text/Pandoc/Readers/Docx/OMath.hs index 210f715f9..62fc6286c 100644 --- a/src/Text/Pandoc/Readers/Docx/OMath.hs +++ b/src/Text/Pandoc/Readers/Docx/OMath.hs @@ -30,14 +30,19 @@ 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 ((<$>)) + +readOMML :: Element -> Maybe [TM.Exp] +readOMML element | isElem "m" "oMath" element = + Just $ concat $ mapMaybe (elemToExps') (elChildren element) +readOMML _ = Nothing + isElem :: String -> String -> Element -> Bool isElem prefix name element = @@ -53,56 +58,11 @@ hasElemName prefix name qn = qName qn == name && 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 - 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 @@ -123,71 +83,29 @@ 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 :: Element -> Maybe OMath -elemToMath element | isElem "m" "oMath" element = - Just $ OMath $ mapMaybe (elemToMathElem) (elChildren element) -elemToMath _ = Nothing +elemToBases :: Element -> Maybe [TM.Exp] +elemToBases element | isElem "m" "e" element = + return $ concat $ mapMaybe elemToExps' (elChildren element) +elemToBases _ = Nothing -elemToBase :: Element -> Maybe Base -elemToBase element | isElem "m" "e" element = - Just $ Base $ mapMaybe (elemToMathElem) (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 :: Element -> Maybe Base -elemToBaseNoAmpersand element | isElem "m" "e" element = - return $ Base $ - mapMaybe - (\e -> (elemToMathElem e >>= (return . filterAmpersand))) - (elChildren element) -elemToBaseNoAmpersand _ = Nothing - -elemToOMathRunStyle :: Element -> OMathRunStyle -elemToOMathRunStyle element = - let lit = - case - filterChildName (hasElemName"m" "lit") element >>= - findAttrBy (hasElemName"m" "val") - of - Just "on" -> True - _ -> False - in - OMathRunStyle { oMathLit = lit - , oMathRunTextStyle = (elemToOMathRunTextStyle element) - } +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 @@ -198,7 +116,7 @@ elemToOMathRunTextStyle element let scr = case filterChildName (hasElemName"m" "scr") mrPr >>= - findAttrBy (hasElemName"m" "val") + findAttrBy (hasElemName"m" "val") of Just "roman" -> Just ORoman Just "script" -> Just OScript @@ -222,183 +140,10 @@ elemToOMathRunTextStyle element Styled { oMathScript = scr, oMathStyle = sty } | otherwise = NoStyle - - -elemToNAryStyle :: Element -> NAryStyle -elemToNAryStyle element - | Just narypr <- filterChildName (hasElemName"m" "naryPr") element = - let - chr = filterChildName (hasElemName"m" "chr") narypr >>= - findAttrBy (hasElemName"m" "val") >>= - Just . head - limLoc = filterChildName (hasElemName"m" "limLoc") narypr >>= - findAttrBy (hasElemName"m" "val") - limLoc' = case limLoc of - Just "undOver" -> UnderOver - Just "subSup" -> SubSup - _ -> SubSup - in - NAryStyle { nAryChar = chr, nAryLimLoc = limLoc'} -elemToNAryStyle _ = defaultNAryStyle - -elemToDelimStyle :: Element -> DelimStyle -elemToDelimStyle element - | Just dPr <- filterChildName (hasElemName"m" "dPr") element = - let begChr = filterChildName (hasElemName"m" "begChr") dPr >>= - findAttrBy (hasElemName"m" "val") >>= - (\c -> if null c then (Just ' ') else (Just $ head c)) - sepChr = filterChildName (hasElemName"m" "sepChr") dPr >>= - findAttrBy (hasElemName"m" "val") >>= - (\c -> if null c then (Just ' ') else (Just $ head c)) - endChr = filterChildName (hasElemName"m" "endChr") dPr >>= - findAttrBy (hasElemName"m" "val") >>= - (\c -> if null c then (Just ' ') else (Just $ head c)) - in - DelimStyle { delimBegChar = begChr - , delimSepChar = sepChr - , delimEndChar = endChr} -elemToDelimStyle _ = defaultDelimStyle - -elemToGroupStyle :: Element -> GroupStyle -elemToGroupStyle element - | Just gPr <- filterChildName (hasElemName"m" "groupChrPr") element = - let chr = filterChildName (hasElemName"m" "chr") gPr >>= - findAttrBy (hasElemName"m" "val") >>= - Just . head - pos = filterChildName (hasElemName"m" "pos") gPr >>= - findAttrBy (hasElemName"m" "val") >>= - (\s -> Just $ if s == "top" then Top else Bottom) - in - GroupStyle { groupChr = chr, groupPos = pos } -elemToGroupStyle _ = defaultGroupStyle - -elemToMathElem :: Element -> Maybe OMathElem -elemToMathElem element | isElem "m" "acc" element = do - let accChar = - filterChildName (hasElemName"m" "accPr") element >>= - filterChildName (hasElemName"m" "chr") >>= - findAttrBy (hasElemName"m" "val") >>= - Just . head - accPr = AccentStyle { accentChar = accChar} - base <- filterChildName (hasElemName"m" "e") element >>= - elemToBase - return $ Accent accPr base -elemToMathElem element | isElem "m" "bar" element = do - barPr <- filterChildName (hasElemName"m" "barPr") element >>= - filterChildName (hasElemName"m" "pos") >>= - findAttrBy (hasElemName"m" "val") >>= - (\s -> - Just $ BarStyle { - barPos = (if s == "bot" then Bottom else Top) - }) - base <- filterChildName (hasElemName"m" "e") element >>= - elemToBase - return $ Bar barPr base -elemToMathElem element | isElem "m" "box" element = - filterChildName (hasElemName"m" "e") element >>= - elemToBase >>= - (\b -> return $ Box b) -elemToMathElem element | isElem "m" "borderBox" element = - filterChildName (hasElemName"m" "e") element >>= - elemToBase >>= - (\b -> return $ BorderBox b) -elemToMathElem element | isElem "m" "d" element = - let style = elemToDelimStyle element - in - return $ Delimiter style $ mapMaybe (elemToBase) (elChildren element) -elemToMathElem element | isElem "m" "eqArr" element = - return $ EquationArray $ mapMaybe (elemToBaseNoAmpersand) (elChildren element) -elemToMathElem element | isElem "m" "f" element = do - num <- filterChildName (hasElemName"m" "num") element - den <- filterChildName (hasElemName"m" "den") element - let numElems = mapMaybe (elemToMathElem) (elChildren num) - denElems = mapMaybe (elemToMathElem) (elChildren den) - return $ Fraction numElems denElems -elemToMathElem element | isElem "m" "func" element = do - fName <- filterChildName (hasElemName"m" "fName") element - base <- filterChildName (hasElemName"m" "e") element >>= - elemToBase - let fnElems = mapMaybe (elemToMathElem) (elChildren fName) - return $ Function fnElems base -elemToMathElem element | isElem "m" "groupChr" element = - let style = elemToGroupStyle element - in - filterChildName (hasElemName"m" "e") element >>= - elemToBase >>= - (\b -> return $ Group style b) -elemToMathElem element | isElem "m" "limLow" element = do - base <- filterChildName (hasElemName"m" "e") element - >>= elemToBase - lim <- filterChildName (hasElemName"m" "lim") element - let limElems = mapMaybe (elemToMathElem) (elChildren lim) - return $ LowerLimit base limElems -elemToMathElem element | isElem "m" "limUpp" element = do - base <- filterChildName (hasElemName"m" "e") element - >>= elemToBase - lim <- filterChildName (hasElemName"m" "lim") element - let limElems = mapMaybe (elemToMathElem) (elChildren lim) - return $ UpperLimit base limElems -elemToMathElem element | isElem "m" "m" element = do - let rows = filterChildrenName (hasElemName"m" "mr") element - let bases = mapMaybe (\mr -> mapM (elemToBase) (elChildren mr)) rows - return $ Matrix bases -elemToMathElem element | isElem "m" "nary" element = do - let style = elemToNAryStyle element - sub <- filterChildName (hasElemName"m" "sub") element >>= - (\e -> return $ mapMaybe (elemToMathElem) (elChildren e)) - sup <- filterChildName (hasElemName"m" "sup") element >>= - (\e -> return $ mapMaybe (elemToMathElem) (elChildren e)) - base <- filterChildName (hasElemName"m" "e") element >>= - elemToBase - return $ NAry style sub sup base -elemToMathElem element | isElem "m" "rad" element = do - deg <- filterChildName (hasElemName"m" "deg") element >>= - (\e -> return $ mapMaybe (elemToMathElem) (elChildren e)) - base <- filterChildName (hasElemName"m" "e") element >>= - elemToBase - return $ Radical deg base -elemToMathElem element | isElem "m" "phant" element = do - base <- filterChildName (hasElemName"m" "e") element >>= - elemToBase - return $ Phantom base -elemToMathElem element | isElem "m" "sPre" element = do - sub <- filterChildName (hasElemName"m" "sub") element >>= - (\e -> return $ mapMaybe (elemToMathElem) (elChildren e)) - sup <- filterChildName (hasElemName"m" "sup") element >>= - (\e -> return $ mapMaybe (elemToMathElem) (elChildren e)) - base <- filterChildName (hasElemName"m" "e") element >>= - elemToBase - return $ PreSubSuper sub sup base -elemToMathElem element | isElem "m" "sSub" element = do - base <- filterChildName (hasElemName"m" "e") element >>= - elemToBase - sub <- filterChildName (hasElemName"m" "sub") element >>= - (\e -> return $ mapMaybe (elemToMathElem) (elChildren e)) - return $ Sub base sub -elemToMathElem element | isElem "m" "sSubSup" element = do - base <- filterChildName (hasElemName"m" "e") element >>= - elemToBase - sub <- filterChildName (hasElemName"m" "sub") element >>= - (\e -> return $ mapMaybe (elemToMathElem) (elChildren e)) - sup <- filterChildName (hasElemName"m" "sup") element >>= - (\e -> return $ mapMaybe (elemToMathElem) (elChildren e)) - return $ SubSuper base sub sup -elemToMathElem element | isElem "m" "sSup" element = do - base <- filterChildName (hasElemName"m" "e") element >>= - elemToBase - sup <- filterChildName (hasElemName"m" "sup") element >>= - (\e -> return $ mapMaybe (elemToMathElem) (elChildren e)) - return $ Super base sup -elemToMathElem element | isElem "m" "r" element = do - let mrPr = elemToOMathRunStyle element - mrElems <- elemToOMathRunElems element - return $ OMathRun mrPr mrElems -elemToMathElem _ = Nothing - elemToOMathRunElem :: Element -> Maybe OMathRunElem elemToOMathRunElem element | isElem "w" "t" element - || isElem "m" "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 @@ -421,149 +166,10 @@ 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 _ _) = [] - oMathRunTextStyleToTextType :: OMathRunTextStyle -> Maybe TM.TextType oMathRunTextStyleToTextType (Normal) = Just $ TM.TextNormal oMathRunTextStyleToTextType (NoStyle) = Nothing -oMathRunTextStyleToTextType (Styled scr sty) +oMathRunTextStyleToTextType (Styled scr sty) | Just OBold <- sty , Just OSansSerif <- scr = Just $ TM.TextSansSerifBold @@ -598,70 +204,6 @@ oMathRunTextStyleToTextType (Styled scr sty) | otherwise = Nothing -oMathRunStyleToTextType :: OMathRunStyle -> Maybe TM.TextType -oMathRunStyleToTextType mrPr - | Normal <- oMathRunTextStyle mrPr = - Just $ TM.TextNormal - | Styled scr sty <- oMathRunTextStyle mrPr - ,Just OBold <- sty - , Just OSansSerif <- scr = - Just $ TM.TextSansSerifBold - | Styled scr sty <- oMathRunTextStyle mrPr - , Just OBoldItalic <- sty - , Just OSansSerif <- scr = - Just $ TM.TextSansSerifBoldItalic - | Styled scr sty <- oMathRunTextStyle mrPr - , Just OBold <- sty - , Just OScript <- scr = - Just $ TM.TextBoldScript - | Styled scr sty <- oMathRunTextStyle mrPr - , Just OBold <- sty - , Just OFraktur <- scr = - Just $ TM.TextBoldFraktur - | Styled scr sty <- oMathRunTextStyle mrPr - , Just OItalic <- sty - , Just OSansSerif <- scr = - Just $ TM.TextSansSerifItalic - | Styled _ sty <- oMathRunTextStyle mrPr - , Just OBold <- sty = - Just $ TM.TextBold - | Styled _ sty <- oMathRunTextStyle mrPr - , Just OItalic <- sty = - Just $ TM.TextItalic - | Styled scr _ <- oMathRunTextStyle mrPr - , Just OMonospace <- scr = - Just $ TM.TextMonospace - | Styled scr _ <- oMathRunTextStyle mrPr - , Just OSansSerif <- scr = - Just $ TM.TextSansSerif - | Styled scr _ <- oMathRunTextStyle mrPr - , Just ODoubleStruck <- scr = - Just $ TM.TextDoubleStruck - | Styled scr _ <- oMathRunTextStyle mrPr - , Just OScript <- scr = - Just $ TM.TextDoubleStruck - | Styled scr _ <- oMathRunTextStyle mrPr - , Just OFraktur <- scr = - Just $ TM.TextFraktur - | Styled _ sty <- oMathRunTextStyle mrPr - , Just OBoldItalic <- sty = - Just $ TM.TextBoldItalic - | otherwise = Nothing - -baseToExp :: Base -> TM.Exp -baseToExp b = case baseToExp' b of - (e : []) -> e - exps -> TM.EGrouped exps - --- an ungrouped version of baseToExp -baseToExp' :: Base -> [TM.Exp] -baseToExp' (Base mathElems) = - concatMap oMathElemToExps mathElems - -elemToExps :: Element -> Maybe [TM.Exp] -elemToExps element = oMathToExps <$> (elemToMath element) - - elemToExps' :: Element -> Maybe [TM.Exp] elemToExps' element | isElem "m" "acc" element = do let chr = filterChildName (hasElemName "m" "accPr") element >>= @@ -672,35 +214,31 @@ elemToExps' element | isElem "m" "acc" element = do Just c -> c Nothing -> '\180' -- default to acute. baseExp <- filterChildName (hasElemName "m" "e") element >>= - elemToBase >>= - (return . baseToExp) + 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") + findAttrBy (hasElemName "m" "val") baseExp <- filterChildName (hasElemName "m" "e") element >>= - elemToBase >>= - (return . baseToExp) + 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 . baseToExp) + 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 . baseToExp) + elemToBase return [baseExp] -elemToExps' element | isElem "m" "d" element = +elemToExps' element | isElem "m" "d" element = let baseExps = mapMaybe - (\e -> (elemToBase e >>= (return . baseToExp))) - (elChildren element) + elemToBase + (elChildren element) inDelimExps = map Right baseExps dPr = filterChildName (hasElemName "m" "dPr") element begChr = dPr >>= @@ -722,10 +260,10 @@ elemToExps' element | isElem "m" "d" element = in Just [TM.EDelimited [beg] [end] exps] elemToExps' element | isElem "m" "eqArr" element = - let bases = mapMaybe (elemToBaseNoAmpersand) (elChildren element) - baseExps = map (\b -> [baseToExp' b]) bases + let expLst = mapMaybe elemToBases (elChildren element) + expLst' = map (\es -> [map filterAmpersand es]) expLst in - return [TM.EArray [] baseExps] + return [TM.EArray [] expLst'] elemToExps' element | isElem "m" "f" element = do num <- filterChildName (hasElemName "m" "num") element den <- filterChildName (hasElemName "m" "den") element @@ -735,8 +273,7 @@ elemToExps' element | isElem "m" "f" element = do elemToExps' element | isElem "m" "func" element = do fName <- filterChildName (hasElemName "m" "fName") element baseExp <- filterChildName (hasElemName "m" "e") element >>= - elemToBase >>= - (return . baseToExp) + 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. @@ -752,8 +289,7 @@ elemToExps' element | isElem "m" "groupChr" element = do filterChildName (hasElemName "m" "pos") >>= findAttrBy (hasElemName "m" "val") baseExp <- filterChildName (hasElemName "m" "e") element >>= - elemToBase >>= - (return . baseToExp) + elemToBase case pos of Just "top" -> let chr' = case chr of @@ -771,7 +307,6 @@ elemToExps' element | isElem "m" "groupChr" element = do elemToExps' element | isElem "m" "limLow" element = do baseExp <- filterChildName (hasElemName "m" "e") element >>= elemToBase - >>= (return . baseToExp) limExp <- filterChildName (hasElemName "m" "lim") element >>= (\e -> Just $ concat $ mapMaybe (elemToExps') (elChildren e)) >>= (return . TM.EGrouped) @@ -779,16 +314,15 @@ elemToExps' element | isElem "m" "limLow" element = do elemToExps' element | isElem "m" "limUpp" element = do baseExp <- filterChildName (hasElemName "m" "e") element >>= elemToBase - >>= (return . baseToExp) 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 = +elemToExps' element | isElem "m" "m" element = let rows = filterChildrenName (hasElemName "m" "mr") element rowExps = map (\mr -> mapMaybe - (\e -> (elemToBase e >>= return . baseToExp')) + elemToBases (elChildren mr)) rows in @@ -809,8 +343,7 @@ elemToExps' element | isElem "m" "nary" element = do supExps <- filterChildName (hasElemName "m" "sup") element >>= (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e)) baseExp <- filterChildName (hasElemName "m" "e") element >>= - elemToBase >>= - (return . baseToExp) + elemToBase case limLoc of Just "undOvr" -> return [TM.EUnderover True (TM.ESymbol TM.Op [opChr]) @@ -825,15 +358,13 @@ elemToExps' element | isElem "m" "nary" element = do elemToExps' element | isElem "m" "phant" element = do baseExp <- filterChildName (hasElemName "m" "e") element >>= - elemToBase >>= - (return . baseToExp) + 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 . baseToExp) + elemToBase return $ case degExps of [] -> [TM.ESqrt baseExp] ds -> [TM.ERoot (TM.EGrouped ds) baseExp] @@ -843,8 +374,7 @@ elemToExps' element | isElem "m" "sPre" element = do supExps <- filterChildName (hasElemName "m" "sup") element >>= (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e)) baseExp <- filterChildName (hasElemName "m" "e") element >>= - elemToBase >>= - (return . baseToExp) + elemToBase return [TM.ESubsup (TM.EIdentifier "") (TM.EGrouped subExps) @@ -852,15 +382,13 @@ elemToExps' element | isElem "m" "sPre" element = do , baseExp] elemToExps' element | isElem "m" "sSub" element = do baseExp <- filterChildName (hasElemName "m" "e") element >>= - elemToBase >>= - (return . baseToExp) + 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 >>= - (return . baseToExp) + elemToBase subExps <- filterChildName (hasElemName "m" "sub") element >>= (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e)) supExps <- filterChildName (hasElemName "m" "sup") element >>= @@ -868,8 +396,7 @@ elemToExps' element | isElem "m" "sSubSup" element = do return [TM.ESubsup baseExp (TM.EGrouped subExps) (TM.EGrouped supExps)] elemToExps' element | isElem "m" "sSup" element = do baseExp <- filterChildName (hasElemName "m" "e") element >>= - elemToBase >>= - (return . baseToExp) + elemToBase supExps <- filterChildName (hasElemName "m" "sup") element >>= (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e)) return [TM.ESuper baseExp (TM.EGrouped supExps)] @@ -890,6 +417,7 @@ elemToExps' element | isElem "m" "r" element = do [TM.EStyled textType [TM.EIdentifier $ oMathRunElemsToString mrElems]] elemToExps' _ = Nothing + expToString :: TM.Exp -> String expToString (TM.ENumber s) = s expToString (TM.EIdentifier s) = s diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index 56dd2c96d..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 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 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 - - - - - - - - - - -- cgit v1.2.3