Merge pull request #1502 from jkr/streamlineMath

Streamline OMML parser

src/Text/Pandoc/Readers/Docx/OMath.hs

@@ -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 =
-elemName :: NameSpaces -> String -> String -> QName
+  Just $ concat $ mapMaybe (elemToExps') (elChildren element)
-elemName ns prefix name = (QName name (lookup prefix ns) (Just prefix))
+readOMML _ = Nothing
-
-isElem :: NameSpaces -> String -> String -> Element -> Bool
-isElem ns prefix name element =
-  qName (elName element) == name &&
-  qURI (elName element) == (lookup prefix ns)
 
 
-data OMath = OMath [OMathElem]
+isElem :: String -> String -> Element -> Bool
-          deriving Show
+isElem prefix name element =
+  let qp = fromMaybe "" (qPrefix (elName element))
+  in
+   qName (elName element) == name &&
+   qp == prefix
 
-data OMathElem = Accent AccentStyle Base
+hasElemName:: String -> String -> QName -> Bool
-              | Bar BarStyle Base
+hasElemName prefix name qn =
-              | Box Base
+  let qp = fromMaybe "" (qPrefix qn)
-              | BorderBox Base
+  in
-              | Delimiter DelimStyle [Base]
+   qName qn == name &&
-              | EquationArray [Base]
+   qp       == prefix
-              | 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
@@ -120,82 +83,40 @@ data OMathTextStyle = OPlain
                     | OBoldItalic
                     deriving (Show, Eq)
 
-defaultNAryStyle :: NAryStyle
+elemToBase :: Element -> Maybe TM.Exp
-defaultNAryStyle = NAryStyle { nAryChar = Nothing -- integral, in practice
+elemToBase element | isElem "m" "e" element = do
-                             , nAryLimLoc = SubSup }
+  bs <- elemToBases element
+  return $ case bs of
+    (e : []) -> e
+    exps     -> TM.EGrouped exps
+elemToBase _ = Nothing
 
-data LimLoc = SubSup | UnderOver deriving Show
+elemToBases :: Element -> Maybe [TM.Exp]
+elemToBases element | isElem "m" "e" element =
+  return $ concat $ mapMaybe elemToExps' (elChildren element)
+elemToBases _ = Nothing
 
-data DelimStyle = DelimStyle { delimBegChar :: Maybe Char
-                             , delimSepChar :: Maybe Char
-                             , delimEndChar :: Maybe Char}
-                  deriving Show
-
-defaultDelimStyle :: DelimStyle
-defaultDelimStyle = DelimStyle { delimBegChar = Nothing
-                               , delimSepChar = Nothing
-                               , delimEndChar = Nothing }
-
-data GroupStyle = GroupStyle { groupChr :: Maybe Char
-                             , groupPos :: Maybe TopBottom }
-                  deriving Show
-
-defaultGroupStyle :: GroupStyle
-defaultGroupStyle = GroupStyle {groupChr = Nothing, groupPos = Nothing}
-
-elemToMath :: NameSpaces -> Element -> Maybe OMath
-elemToMath ns element  | isElem ns "m" "oMath" element =
-  Just $ OMath $ mapMaybe (elemToMathElem ns) (elChildren element)
-elemToMath _ _ = Nothing
-
-elemToBase :: NameSpaces -> Element -> Maybe Base
-elemToBase ns element | isElem ns "m" "e" element =
-  Just $ Base $ mapMaybe (elemToMathElem ns) (elChildren element)
-elemToBase _ _ = Nothing
 
 -- TODO: The right way to do this is to use the ampersand to break the
 -- 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 :: TM.Exp -> TM.Exp
-filterAmpersand (OMathRun mrPr elems) =
+filterAmpersand (TM.EIdentifier s)   = TM.EIdentifier (filter ('&' /=) s)
-  let f (TextRun s) = TextRun $ filter ('&' /=) s
+filterAmpersand (TM.EText tt s)      = TM.EText tt (filter ('&' /=) s)
-      f re          = re
+filterAmpersand (TM.EStyled tt exps) = TM.EStyled tt (map filterAmpersand exps)
-  in
+filterAmpersand (TM.EGrouped exps)   = TM.EGrouped (map filterAmpersand exps)
-   OMathRun mrPr (map f elems)
+filterAmpersand e                    = e
-filterAmpersand e = e
 
-elemToBaseNoAmpersand :: NameSpaces -> Element -> Maybe Base
+elemToOMathRunTextStyle :: Element -> OMathRunTextStyle
-elemToBaseNoAmpersand ns element | isElem ns "m" "e" element =
+elemToOMathRunTextStyle element
-  return $ Base $ 
+  | Just mrPr <- filterChildName (hasElemName"m" "rPr") element
-  mapMaybe
+  , Just _    <- filterChildName (hasElemName"m" "nor") mrPr =
-  (\e -> (elemToMathElem ns e >>= (return . filterAmpersand)))
-  (elChildren element)
-elemToBaseNoAmpersand _ _ = Nothing
-
-elemToOMathRunStyle :: NameSpaces -> Element -> OMathRunStyle
-elemToOMathRunStyle ns element =
-  let lit =
-        case
-          findChild (elemName ns "m" "lit") element >>=
-          findAttr (elemName ns "m" "val")
-        of
-          Just "on" -> True
-          _         -> False
-  in
-   OMathRunStyle { oMathLit = lit
-                 , oMathRunTextStyle = (elemToOMathRunTextStyle ns element)
-                 }
-
-elemToOMathRunTextStyle :: NameSpaces -> Element -> OMathRunTextStyle
-elemToOMathRunTextStyle ns element
-  | Just mrPr <- findChild (elemName ns "m" "rPr") element
-  , Just _    <- findChild (elemName ns "m" "nor") mrPr =
     Normal
-  | Just mrPr <- findChild (elemName ns "m" "rPr") element =
+  | Just mrPr <- filterChildName (hasElemName"m" "rPr") element =
     let scr =
           case
-            findChild (elemName ns "m" "scr") mrPr >>=
+            filterChildName (hasElemName"m" "scr") mrPr >>=
-            findAttr (elemName ns "m" "val") 
+            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 >>=
+            filterChildName (hasElemName"m" "sty") mrPr >>=
-            findAttr (elemName ns "m" "val")
+            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
 
-
+elemToOMathRunElem :: Element -> Maybe OMathRunElem
-
+elemToOMathRunElem element
-elemToNAryStyle :: NameSpaces -> Element -> NAryStyle
+  | isElem "w" "t" element
-elemToNAryStyle ns element
+    || isElem "m" "t" element
-  | Just narypr <- findChild (QName "naryPr" (lookup "m" ns) (Just "m")) element =
+    || isElem "w" "delText" element = Just $ TextRun $ strContent element
-  let
+  | isElem "w" "br" element = Just LnBrk
-    chr = findChild (QName "chr" (lookup "m" ns) (Just "m")) narypr >>=
+  | isElem "w" "tab" element = Just Tab
-          findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
-          Just . head
-    limLoc = findChild (QName "limLoc" (lookup "m" ns) (Just "m")) narypr >>=
-             findAttr (QName "val" (lookup "m" ns) (Just "m"))
-    limLoc' = case limLoc of
-      Just "undOver" -> UnderOver
-      Just "subSup"  -> SubSup
-      _              -> SubSup
-  in
-   NAryStyle { nAryChar = chr, nAryLimLoc = limLoc'}
-elemToNAryStyle _ _ = defaultNAryStyle
-
-elemToDelimStyle :: NameSpaces -> Element -> DelimStyle
-elemToDelimStyle ns element
-  | Just dPr <- findChild (QName "dPr" (lookup "m" ns) (Just "m")) element =
-    let begChr = findChild (QName "begChr" (lookup "m" ns) (Just "m")) dPr >>=
-                 findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
-                 (\c -> if null c then (Just ' ') else (Just $ head c))
-        sepChr = findChild (QName "sepChr" (lookup "m" ns) (Just "m")) dPr >>=
-                 findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
-                 (\c -> if null c then (Just ' ') else (Just $ head c))
-        endChr = findChild (QName "endChr" (lookup "m" ns) (Just "m")) dPr >>=
-                 findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
-                 (\c -> if null c then (Just ' ') else (Just $ head c))
-    in
-     DelimStyle { delimBegChar = begChr
-                , delimSepChar = sepChr
-                , delimEndChar = endChr}
-elemToDelimStyle _ _ = defaultDelimStyle
-
-elemToGroupStyle :: NameSpaces -> Element -> GroupStyle
-elemToGroupStyle ns element
-  | Just gPr <- findChild (QName "groupChrPr" (lookup "m" ns) (Just "m")) element =
-    let chr = findChild (QName "chr" (lookup "m" ns) (Just "m")) gPr >>=
-              findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
-              Just . head
-        pos = findChild (QName "pos" (lookup "m" ns) (Just "m")) gPr >>=
-              findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
-              (\s -> Just $ if s == "top" then Top else Bottom)
-    in
-     GroupStyle { groupChr = chr, groupPos = pos }
-elemToGroupStyle _ _ = defaultGroupStyle
-
-elemToMathElem :: NameSpaces -> Element -> Maybe OMathElem
-elemToMathElem ns element | isElem ns "m" "acc" element = do
-  let accChar =
-        findChild (elemName ns "m" "accPr") element >>=
-        findChild (elemName ns "m" "chr") >>=
-        findAttr (elemName ns "m" "val") >>=
-        Just . head
-      accPr = AccentStyle { accentChar = accChar}
-  base <- findChild (elemName ns "m" "e") element >>=
-         elemToBase ns
-  return $ Accent accPr base
-elemToMathElem ns element | isElem ns "m" "bar" element = do
-  barPr <- findChild (QName "barPr" (lookup "m" ns) (Just "m")) element >>=
-           findChild (QName "pos" (lookup "m" ns) (Just "m")) >>=
-           findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
-           (\s ->
-             Just $ BarStyle {
-               barPos = (if s == "bot" then Bottom else Top)
-               })
-  base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=
-          elemToBase ns
-  return $ Bar barPr base
-elemToMathElem ns element | isElem ns "m" "box" element =
-  findChild (elemName ns "m" "e") element >>=
-  elemToBase ns >>=
-  (\b -> return $ Box b)
-elemToMathElem ns element | isElem ns "m" "borderBox" element =
-  findChild (elemName ns "m" "e") element >>=
-  elemToBase ns >>=
-  (\b -> return $ BorderBox b)
-elemToMathElem ns element | isElem ns "m" "d" element =
-  let style = elemToDelimStyle ns element
-  in
-   return $ Delimiter style $ mapMaybe (elemToBase ns) (elChildren element)
-elemToMathElem ns element | isElem ns "m" "eqArr" element =
-  return $ EquationArray $ mapMaybe (elemToBaseNoAmpersand ns) (elChildren element) 
-elemToMathElem ns element | isElem ns "m" "f" element = do
-  num <- findChild (elemName ns "m" "num") element
-  den <- findChild (elemName ns "m" "den") element
-  let numElems = mapMaybe (elemToMathElem ns) (elChildren num)
-      denElems = mapMaybe (elemToMathElem ns) (elChildren den)
-  return $ Fraction numElems denElems
-elemToMathElem ns element | isElem ns "m" "func" element = do
-  fName <- findChild (elemName ns "m" "fName") element
-  base <- findChild (elemName ns "m" "e") element >>=
-          elemToBase ns
-  let fnElems = mapMaybe (elemToMathElem ns) (elChildren fName)
-  return $ Function fnElems base
-elemToMathElem ns element | isElem ns "m" "groupChr" element =
-  let style = elemToGroupStyle ns element
-  in
-   findChild (elemName ns "m" "e") element >>=
-   elemToBase ns >>=
-   (\b -> return $ Group style b)
-elemToMathElem ns element | isElem ns "m" "limLow" element = do
-  base <- findChild (elemName ns "m" "e") element
-          >>= elemToBase ns
-  lim <- findChild (elemName ns "m" "lim") element
-  let limElems = mapMaybe (elemToMathElem ns) (elChildren lim)
-  return $ LowerLimit base limElems
-elemToMathElem ns element | isElem ns "m" "limUpp" element = do
-  base <- findChild (elemName ns "m" "e") element
-          >>= elemToBase ns
-  lim <- findChild (elemName ns "m" "lim") element
-  let limElems = mapMaybe (elemToMathElem ns) (elChildren lim)
-  return $ UpperLimit base limElems
-elemToMathElem ns element | isElem ns "m" "m" element = do
-  let rows = findChildren (elemName ns "m" "mr") element
-  let bases = mapMaybe (\mr -> mapM (elemToBase ns) (elChildren mr)) rows
-  return $ Matrix bases
-elemToMathElem ns element | isElem ns "m" "nary" element = do
-  let style = elemToNAryStyle ns element
-  sub <- findChild (elemName ns "m" "sub") element >>=
-         (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
-  sup <- findChild (elemName ns "m" "sup") element >>=
-         (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
-  base <- findChild (elemName ns "m" "e") element >>=
-          elemToBase ns
-  return $ NAry style sub sup base
-elemToMathElem ns element | isElem ns "m" "rad" element = do
-  deg <- findChild (elemName ns "m" "deg") element >>=
-         (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
-  base <- findChild (elemName ns "m" "e") element >>=
-          elemToBase ns
-  return $ Radical deg base
-elemToMathElem ns element | isElem ns "m" "phant" element = do
-  base <- findChild (elemName ns "m" "e") element >>=
-          elemToBase ns
-  return $ Phantom base
-elemToMathElem ns element | isElem ns "m" "sPre" element = do
-  sub <- findChild (elemName ns "m" "sub") element >>=
-         (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
-  sup <- findChild (elemName ns "m" "sup") element >>=
-         (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
-  base <- findChild (elemName ns "m" "e") element >>=
-          elemToBase ns
-  return $ PreSubSuper sub sup base
-elemToMathElem ns element | isElem ns "m" "sSub" element = do
-  base <- findChild (elemName ns "m" "e") element >>=
-          elemToBase ns
-  sub <- findChild (elemName ns "m" "sub") element >>=
-         (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
-  return $ Sub base sub
-elemToMathElem ns element | isElem ns "m" "sSubSup" element = do
-  base <- findChild (elemName ns "m" "e") element >>=
-          elemToBase ns
-  sub <- findChild (elemName ns "m" "sub") element >>=
-         (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
-  sup <- findChild (elemName ns "m" "sup") element >>=
-         (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
-  return $ SubSuper base sub sup
-elemToMathElem ns element | isElem ns "m" "sSup" element = do
-  base <- findChild (elemName ns "m" "e") element >>=
-          elemToBase ns
-  sup <- findChild (elemName ns "m" "sup") element >>=
-         (\e -> return $ mapMaybe (elemToMathElem ns) (elChildren e))
-  return $ Super base sup
-elemToMathElem ns element | isElem ns "m" "r" element = do
-  let mrPr = elemToOMathRunStyle ns element
-  mrElems <- elemToOMathRunElems ns element
-  return $ OMathRun mrPr mrElems
-elemToMathElem _ _ = Nothing
-
-elemToOMathRunElem :: NameSpaces -> Element -> Maybe OMathRunElem
-elemToOMathRunElem ns element
-  | isElem ns "w" "t" element
-    || isElem ns "m" "t" element 
-    || isElem ns "w" "delText" element = Just $ TextRun $ strContent element
-  | isElem ns "w" "br" element = Just LnBrk
-  | isElem ns "w" "tab" element = Just Tab
   | otherwise = Nothing
 
-elemToOMathRunElems :: NameSpaces -> Element -> Maybe [OMathRunElem]
+elemToOMathRunElems :: Element -> Maybe [OMathRunElem]
-elemToOMathRunElems ns element
+elemToOMathRunElems element
-  | isElem ns "w" "r" element
+  | isElem "w" "r" element
-    || isElem ns "m" "r" element =
+    || isElem "m" "r" element =
-      Just $ mapMaybe (elemToOMathRunElem ns) (elChildren element)
+      Just $ mapMaybe (elemToOMathRunElem) (elChildren element)
-elemToOMathRunElems _ _ = Nothing
+elemToOMathRunElems _ = Nothing
 
 ----- And now the TeXMath Creation
 
@@ -418,205 +166,264 @@ oMathRunElemToString (Tab) = ['\t']
 oMathRunElemsToString :: [OMathRunElem] -> String
 oMathRunElemsToString = concatMap oMathRunElemToString
 
-oMathElemToString :: OMathElem -> String
+oMathRunTextStyleToTextType :: OMathRunTextStyle -> Maybe TM.TextType
-oMathElemToString (OMathRun _ oMathRunElems) =
+oMathRunTextStyleToTextType (Normal) = Just $ TM.TextNormal
-  oMathRunElemsToString oMathRunElems
+oMathRunTextStyleToTextType (NoStyle) = Nothing
-oMathElemToString _ = ""
+oMathRunTextStyleToTextType (Styled scr sty)
-
+  | Just OBold <- sty
-
-oMathToExps :: OMath -> [TM.Exp]
-oMathToExps (OMath oMathElems) = concatMap oMathElemToExps oMathElems
-
-oMathElemToExps :: OMathElem -> [TM.Exp]
-oMathElemToExps (Accent style base) = 
-  let baseExp = baseToExp base
-      chr = case accentChar style of
-        Just c -> c
-        Nothing -> '\180'       -- default to acute.
-  in
-   [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
-oMathElemToExps(Bar style base) =
-  let baseExp = baseToExp base
-  in
-   case barPos style of
-     Top    -> [TM.EOver False baseExp (TM.ESymbol TM.Accent "\175")]
-     Bottom -> [TM.EUnder False baseExp (TM.ESymbol TM.Accent "\818")]
-oMathElemToExps (Box base) = [baseToExp base]
-oMathElemToExps (BorderBox base) =
-  -- TODO: This should be "\\boxed" somehow
-  [baseToExp base]
-oMathElemToExps (Delimiter dPr bases) =
-  let baseExps = map baseToExp bases
-      inDelimExps = map Right baseExps
-      beg = fromMaybe '(' (delimBegChar dPr)
-      end = fromMaybe ')' (delimEndChar dPr)
-      sep = fromMaybe '|' (delimSepChar dPr)
-      exps = intersperse (Left [sep]) inDelimExps
-  in
-   [TM.EDelimited [beg] [end] exps]
-oMathElemToExps (EquationArray bases) =
-  let baseExps = map (\b -> [baseToExp' b]) bases
-  in
-   [TM.EArray [] baseExps]
-oMathElemToExps (Fraction num denom) =
-  let numExp = TM.EGrouped $ concatMap oMathElemToExps num
-      denExp = TM.EGrouped $ concatMap oMathElemToExps denom
-  in
-   [TM.EFraction TM.NormalFrac numExp denExp]
-oMathElemToExps (Function fname base) =
-  -- We need a string for the fname, but omml gives it to us as a
-  -- series of oMath elems. We're going to filter out the oMathRuns,
-  -- which should work for us most of the time.
-  let fnameString = concatMap oMathElemToString fname
-      baseExp  = baseToExp base
-  in
-   [TM.EMathOperator fnameString, baseExp]
-oMathElemToExps (Group style base)
-  | Just Top <- groupPos style =
-    let baseExp = baseToExp base
-        chr = case groupChr style of
-          Just c -> c
-          Nothing -> '\65079'   -- default to overbrace
-    in
-     [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
-  | otherwise = 
-    let baseExp = baseToExp base 
-        chr = case groupChr style of
-          Just c -> c
-          Nothing -> '\65080'   -- default to underbrace
-    in
-     [TM.EUnder False baseExp (TM.ESymbol TM.Accent [chr])]
-oMathElemToExps (LowerLimit base limElems) = do
-  let baseExp = baseToExp base
-      lim = TM.EGrouped $ concatMap oMathElemToExps limElems
-   in
-    [TM.EUnder True lim baseExp]
-oMathElemToExps (UpperLimit base limElems) =
-  let baseExp = baseToExp base
-      lim = TM.EGrouped $ concatMap oMathElemToExps limElems
-  in
-   [TM.EOver True lim baseExp]
-oMathElemToExps (Matrix bases) =
-  let rows = map (map baseToExp') bases
-  in
-   [TM.EArray [TM.AlignCenter] rows]
-oMathElemToExps (NAry style sub sup base) =
-  let 
-    subExps = concatMap oMathElemToExps sub
-    supExps = concatMap oMathElemToExps sup
-    baseExp =  baseToExp base
-    opChar = case nAryChar style of
-      Just c -> c
-      -- default to integral
-      Nothing -> '\8747'
-  in [ TM.ESubsup
-       (TM.ESymbol TM.Op [opChar])
-       (TM.EGrouped subExps)
-       (TM.EGrouped supExps)
-     , baseExp]
-oMathElemToExps (Phantom base) =
-  [TM.EPhantom $ baseToExp base]
-oMathElemToExps (Radical degree base) =
-  let degExps = concatMap oMathElemToExps degree
-      baseExp = baseToExp base
-  in
-   case degExps of
-     [] -> [TM.ESqrt baseExp]
-     ds -> [TM.ERoot (TM.EGrouped ds) baseExp]
-oMathElemToExps (PreSubSuper sub sup base) =
-  let subExps = concatMap oMathElemToExps sub
-      supExps = concatMap oMathElemToExps sup
-      baseExp = baseToExp base
-  in [ TM.ESubsup
-       (TM.EIdentifier "") (TM.EGrouped subExps) (TM.EGrouped supExps)
-     , baseExp]
-oMathElemToExps (Sub base sub) =
-  let baseExp = baseToExp base 
-      subExps = concatMap oMathElemToExps sub
-  in
-   [TM.ESub baseExp (TM.EGrouped subExps)]
-oMathElemToExps (SubSuper base sub sup) =
-  let baseExp = baseToExp base 
-      subExps = concatMap oMathElemToExps sub
-      supExps = concatMap oMathElemToExps sup
-  in
-   [TM.ESubsup baseExp (TM.EGrouped subExps) (TM.EGrouped supExps)]
-oMathElemToExps (Super base sup) =
-  let baseExp = baseToExp base
-      supExps = concatMap oMathElemToExps sup
-  in
-   [TM.ESuper baseExp (TM.EGrouped supExps)]
-oMathElemToExps (OMathRun sty elems)
-  | NoStyle <- oMathRunTextStyle sty =
-    [TM.EIdentifier $ oMathRunElemsToString elems]
-  | Nothing <- oMathRunStyleToTextType sty =
-    [TM.EIdentifier $ oMathRunElemsToString elems]
-  | Just textType <-  oMathRunStyleToTextType sty =
-      if oMathLit sty
-      then [TM.EText textType (oMathRunElemsToString elems)]
-      else [TM.EStyled textType [TM.EIdentifier $ oMathRunElemsToString elems]]
-oMathElemToExps (OMathRun _ _) = []
-
-oMathRunStyleToTextType :: OMathRunStyle -> Maybe TM.TextType
-oMathRunStyleToTextType mrPr
-  | Normal <- oMathRunTextStyle mrPr =
-    Just $ TM.TextNormal
-  | Styled scr sty  <- oMathRunTextStyle mrPr
-    ,Just OBold <- sty
   , Just OSansSerif <- scr =
     Just $ 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
+elemToExps' element | isElem "m" "phant" element = do
-baseToExp b = TM.EGrouped $ baseToExp' b
+  baseExp <- filterChildName (hasElemName "m" "e") element >>=
+             elemToBase
+  return [TM.EPhantom baseExp]
+elemToExps' element | isElem "m" "rad" element = do
+  degExps <- filterChildName (hasElemName "m" "deg") element >>=
+              (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
+  baseExp <- filterChildName (hasElemName "m" "e") element >>=
+             elemToBase
+  return $ case degExps of
+    [] -> [TM.ESqrt baseExp]
+    ds -> [TM.ERoot (TM.EGrouped ds) baseExp]
+elemToExps' element | isElem "m" "sPre" element = do
+  subExps <- filterChildName (hasElemName "m" "sub") element >>=
+            (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
+  supExps <- filterChildName (hasElemName "m" "sup") element >>=
+            (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
+  baseExp <- filterChildName (hasElemName "m" "e") element >>=
+             elemToBase
+  return [TM.ESubsup
+          (TM.EIdentifier "")
+          (TM.EGrouped subExps)
+          (TM.EGrouped supExps)
+         , baseExp]
+elemToExps' element | isElem "m" "sSub" element = do
+  baseExp <- filterChildName (hasElemName "m" "e") element >>=
+             elemToBase
+  subExps <- filterChildName (hasElemName "m" "sub") element >>=
+            (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
+  return [TM.ESub baseExp (TM.EGrouped subExps)]
+elemToExps' element | isElem "m" "sSubSup" element = do
+  baseExp <- filterChildName (hasElemName "m" "e") element >>=
+             elemToBase
+  subExps <- filterChildName (hasElemName "m" "sub") element >>=
+             (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
+  supExps <- filterChildName (hasElemName "m" "sup") element >>=
+             (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
+  return [TM.ESubsup baseExp (TM.EGrouped subExps) (TM.EGrouped supExps)]
+elemToExps' element | isElem "m" "sSup" element = do
+  baseExp <- filterChildName (hasElemName "m" "e") element >>=
+             elemToBase
+  supExps <- filterChildName (hasElemName "m" "sup") element >>=
+            (\e -> return $ concat $ mapMaybe (elemToExps') (elChildren e))
+  return [TM.ESuper baseExp (TM.EGrouped supExps)]
+elemToExps' element | isElem "m" "r" element = do
+  let mrPr = filterChildName (hasElemName "m" "rPr") element
+      lit = mrPr >>=
+            filterChildName (hasElemName "m" "lit") >>=
+            findAttrBy (hasElemName "m" "val")
+      txtSty = elemToOMathRunTextStyle element
+  mrElems <- elemToOMathRunElems element
+  return $ case oMathRunTextStyleToTextType txtSty of
+    Nothing -> [TM.EIdentifier $ oMathRunElemsToString mrElems]
+    Just textType ->
+      case lit of
+        Just "on" ->
+          [TM.EText textType (oMathRunElemsToString mrElems)]
+        _         ->
+          [TM.EStyled textType [TM.EIdentifier $ oMathRunElemsToString mrElems]]
+elemToExps' _ = Nothing
 
--- an ungrouped version of baseToExp
-baseToExp' :: Base -> [TM.Exp]
-baseToExp' (Base mathElems) =
-  concatMap oMathElemToExps mathElems
-
-elemToExps :: NameSpaces -> Element -> Maybe [TM.Exp]
-elemToExps ns element = oMathToExps <$> (elemToMath ns element)
 
+expToString :: TM.Exp -> String
+expToString (TM.ENumber s) = s
+expToString (TM.EIdentifier s) = s
+expToString (TM.EMathOperator s) = s
+expToString (TM.ESymbol _ s) = s
+expToString (TM.EText _ s) = s
+expToString (TM.EGrouped exps) = concatMap expToString exps
+expToString (TM.EStyled _ exps) = concatMap expToString exps
+expToString _ = ""

src/Text/Pandoc/Readers/Docx/Parse.hs

@@ -61,7 +61,7 @@ import qualified Text.Pandoc.UTF8 as UTF8
 import Control.Monad.Reader
 import qualified Data.Map as M
 import Text.Pandoc.Compat.Except
-import Text.Pandoc.Readers.Docx.OMath (elemToExps)
+import Text.Pandoc.Readers.Docx.OMath (readOMML)
 import Text.TeXMath (Exp)
 
 data ReaderEnv = ReaderEnv { envNotes         :: Notes
@@ -475,7 +475,7 @@ elemToBodyPart ns element
   | isElem ns "w" "p" element
   , (c:_) <- findChildren (elemName ns "m" "oMathPara") element =
       do
-        expsLst <- mapD (\e -> (maybeToD $ elemToExps ns e)) (elChildren c)
+        expsLst <- mapD (\e -> (maybeToD $ readOMML e)) (elChildren c)
         return $ OMathPara expsLst
 elemToBodyPart ns element
   | isElem ns "w" "p" element
@@ -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
-
-
-
-
-
-
-
-
-
-