Docx reader: Use TeXMath to write math

The new version of TeXMath can translate from its type system into
LaTeX. So instead of writing the LaTeX ourself, we write to the TeXMath
`Exp` type, and let TeXMath do the rest.

2 files changed, 315 insertions, 177 deletions

diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
index be486c83f..513283005 100644
--- a/src/Text/Pandoc/Readers/Docx.hs
+++ b/src/Text/Pandoc/Readers/Docx.hs
@@ -82,17 +82,17 @@ import Text.Pandoc.Walk
 import Text.Pandoc.Readers.Docx.Parse
 import Text.Pandoc.Readers.Docx.Lists
 import Text.Pandoc.Readers.Docx.Reducible
-import Text.Pandoc.Readers.Docx.TexChar
 import Text.Pandoc.Shared
 import Text.Pandoc.MediaBag (insertMedia, MediaBag)
 import Data.Maybe (mapMaybe, fromMaybe)
-import Data.List (delete, stripPrefix, (\\), intercalate, intersect)
+import Data.List (delete, stripPrefix, (\\), intersperse, intersect)
 import Data.Monoid
+import Text.TeXMath (writeTeX)
+import qualified Text.TeXMath.Types as TM
 import qualified Data.ByteString.Lazy as B
 import qualified Data.Map as M
 import Control.Monad.Reader
 import Control.Monad.State
-import Text.Printf (printf)
 
 readDocx :: ReaderOptions
          -> B.ByteString
@@ -381,158 +381,192 @@ parPartToInlines (ExternalHyperLink target runs) = do
   ils <- concatMapM runToInlines runs
   return [Link ils (target, "")]
 parPartToInlines (PlainOMath omath) = do
-  s <- oMathToTexString omath
-  return [Math InlineMath s]
-
-oMathToTexString :: OMath -> DocxContext String
-oMathToTexString (OMath omathElems) = do
-  ss <- mapM oMathElemToTexString omathElems
-  return $ intercalate " " ss
-oMathElemToTexString :: OMathElem -> DocxContext String
-oMathElemToTexString (Accent style base) | Just c <- accentChar style = do
-  baseString <- baseToTexString base
-  return $ case lookupTexChar c of
-    s@('\\' : _) -> printf "%s{%s}" s baseString
-    _            -> printf "\\acute{%s}" baseString -- we default.
-oMathElemToTexString (Accent _ base) =
-    baseToTexString base >>= (\s -> return $ printf "\\acute{%s}" s)
-oMathElemToTexString (Bar style base) = do
-  baseString <- baseToTexString base
+  e <- oMathToExps omath
+  return [Math InlineMath (writeTeX e)]
+
+oMathToExps :: OMath -> DocxContext [TM.Exp]
+oMathToExps (OMath oMathElems) = concatMapM oMathElemToExps oMathElems
+
+oMathElemToExps :: OMathElem -> DocxContext [TM.Exp]
+oMathElemToExps (Accent style base) = do
+  baseExp <- baseToExp base
+  let chr = case accentChar style of
+        Just c -> c
+        Nothing -> '\180'       -- default to acute.
+  return [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
+oMathElemToExps(Bar style base) = do
+  baseExp <- baseToExp base
   return $ case barPos style of
-    Top    -> printf "\\overline{%s}" baseString
-    Bottom -> printf "\\underline{%s}" baseString
-oMathElemToTexString (Box base) = baseToTexString base
-oMathElemToTexString (BorderBox base) =
-  baseToTexString base >>= (\s -> return $ printf "\\boxed{%s}" s)
-oMathElemToTexString (Delimiter dPr bases) = do
-  let beg = fromMaybe '(' (delimBegChar dPr)
+    Top    -> [TM.EOver False baseExp (TM.ESymbol TM.Accent "\175")]
+    Bottom -> [TM.EUnder False baseExp (TM.ESymbol TM.Accent "\818")]
+oMathElemToExps (Box base) =
+  (\e -> return [e]) =<< baseToExp base
+oMathElemToExps (BorderBox base) =
+  -- TODO: This should be "\\boxed" somehow
+  (\e -> return [e]) =<< baseToExp base
+oMathElemToExps (Delimiter dPr bases) = do
+  baseExps <- mapM baseToExp bases
+  let inDelimExps = map Right baseExps
+      beg = fromMaybe '(' (delimBegChar dPr)
       end = fromMaybe ')' (delimEndChar dPr)
       sep = fromMaybe '|' (delimSepChar dPr)
-      left = "\\left" ++ lookupTexChar beg
-      right = "\\right" ++ lookupTexChar end
-      mid  = "\\middle" ++ lookupTexChar sep
-  baseStrings <- mapM baseToTexString bases
-  return $ printf "%s %s %s"
-    left
-    (intercalate (" " ++ mid ++ " ") baseStrings)
-    right
-oMathElemToTexString (EquationArray bases) = do
-  baseStrings <- mapM baseToTexString bases
-  inSub <- gets docxInTexSubscript
-  return $
-    if inSub
-    then
-      printf "\\substack{%s}" (intercalate "\\\\ " baseStrings)
-    else
-      printf
-      "\\begin{aligned}\n%s\n\\end{aligned}"
-      (intercalate "\\\\\n" baseStrings)
-oMathElemToTexString (Fraction num denom) = do
-  numString  <- concatMapM oMathElemToTexString num
-  denString  <- concatMapM oMathElemToTexString denom
-  return $ printf "\\frac{%s}{%s}" numString denString
-oMathElemToTexString (Function fname base) = do
-  fnameString <- concatMapM oMathElemToTexString fname
-  baseString  <- baseToTexString base
-  return $ printf "%s %s" fnameString baseString
-oMathElemToTexString (Group style base)
-  | Just c <- groupChr style
-  , grouper <- lookupTexChar c
-  , notElem grouper ["\\overbrace", "\\underbrace"]
-    = do
-      baseString <- baseToTexString base
-      return $ case groupPos style of
-        Just Top -> printf "\\overset{%s}{%s}" grouper baseString
-        _        -> printf "\\underset{%s}{%s}" grouper baseString
-oMathElemToTexString (Group style base) = do
-  baseString <- baseToTexString base
-  return $ case groupPos style of
-    Just Top -> printf "\\overbrace{%s}" baseString
-    _        -> printf "\\underbrace{%s}" baseString
-oMathElemToTexString (LowerLimit base limElems) = do
-  baseString <- baseToTexString base
-  lim <- concatMapM oMathElemToTexString limElems
-    --  we want to make sure to replace the `\rightarrow` with `\to`
-  let arrowToTo :: String -> String
-      arrowToTo "" = ""
-      arrowToTo s | Just s' <- stripPrefix "\\rightarrow" s =
-        "\\to" ++ arrowToTo s'
-      arrowToTo (c:cs) = c : arrowToTo cs
-      lim' = arrowToTo lim
-  return $ case baseString of
-    "lim" -> printf "\\lim_{%s}" lim'
-    "max" -> printf "\\max_{%s}" lim'
-    "min" -> printf "\\min_{%s}" lim'
-    _     -> printf "\\operatorname*{%s}_{%s}" baseString lim'
-oMathElemToTexString (UpperLimit base limElems) = do
-  baseString <- baseToTexString base
-  lim <- concatMapM oMathElemToTexString limElems
-    --  we want to make sure to replace the `\rightarrow` with `\to`
-  let arrowToTo :: String -> String
-      arrowToTo "" = ""
-      arrowToTo s | Just s' <- stripPrefix "\\rightarrow" s =
-        "\\to" ++ arrowToTo s'
-      arrowToTo (c:cs) = c : arrowToTo cs
-      lim' = arrowToTo lim
-  return $ case baseString of
-    "lim" -> printf "\\lim^{%s}" lim'
-    "max" -> printf "\\max^{%s}" lim'
-    "min" -> printf "\\min^{%s}" lim'
-    _     -> printf "\\operatorname*{%s}^{%s}" baseString lim'
-oMathElemToTexString (Matrix bases) = do
-  let rowString :: [Base] -> DocxContext String
-      rowString bs = liftM (intercalate " & ") (mapM baseToTexString bs)
-
-  s <- liftM (intercalate " \\\\\n")(mapM rowString bases)
-  return $ printf "\\begin{matrix}\n%s\n\\end{matrix}" s
-oMathElemToTexString (NAry style sub sup base) | Just c <- nAryChar style = do
-  subString  <- withDState (\s -> s{docxInTexSubscript = True}) $
-                concatMapM oMathElemToTexString sub
-  supString  <- concatMapM oMathElemToTexString sup
-  baseString <- baseToTexString base
-  return $ case M.lookup c uniconvMap of
-    Just s@('\\':_) -> printf "%s_{%s}^{%s}{%s}"
-                       s subString supString baseString
-    _               -> printf "\\operatorname*{%s}_{%s}^{%s}{%s}"
-                       [c] subString supString baseString
-oMathElemToTexString (NAry _ sub sup base) = do
-  subString  <- concatMapM oMathElemToTexString sub
-  supString  <- concatMapM oMathElemToTexString sup
-  baseString <- baseToTexString base
-  return $ printf "\\int_{%s}^{%s}{%s}"
-    subString supString baseString
-oMathElemToTexString (Phantom base) = do
-  baseString <- baseToTexString base
-  return $ printf "\\phantom{%s}" baseString
-oMathElemToTexString (Radical degree base) = do
-  degString  <- concatMapM oMathElemToTexString degree
-  baseString <- baseToTexString base
-  return $ case trim degString of
-    "" -> printf "\\sqrt{%s}" baseString
-    _  -> printf "\\sqrt[%s]{%s}" degString baseString
-oMathElemToTexString (PreSubSuper sub sup base) = do
-  subString  <- concatMapM oMathElemToTexString sub
-  supString  <- concatMapM oMathElemToTexString sup
-  baseString <- baseToTexString base
-  return $ printf "_{%s}^{%s}%s" subString supString baseString
-oMathElemToTexString (Sub base sub) = do
-  baseString <- baseToTexString base
-  subString  <- concatMapM oMathElemToTexString sub
-  return $ printf "%s_{%s}" baseString subString
-oMathElemToTexString (SubSuper base sub sup) = do
-  baseString <- baseToTexString base
-  subString  <- concatMapM oMathElemToTexString sub
-  supString  <- concatMapM oMathElemToTexString sup
-  return $ printf "%s_{%s}^{%s}" baseString subString supString
-oMathElemToTexString (Super base sup) = do
-  baseString <- baseToTexString base
-  supString  <- concatMapM oMathElemToTexString sup
-  return $ printf "%s^{%s}" baseString supString
-oMathElemToTexString (OMathRun _ run) = return $ stringToTex $ runToString run
-
-baseToTexString :: Base -> DocxContext String
-baseToTexString (Base mathElems) =
-  concatMapM oMathElemToTexString mathElems
+      exps = intersperse (Left [sep]) inDelimExps
+  return [TM.EDelimited [beg] [end] exps]
+oMathElemToExps (EquationArray bases) = do
+  let f b = do bs <- baseToExp' b
+               return [bs]
+  baseExps <- mapM f bases
+  return [TM.EArray [] baseExps]
+oMathElemToExps (Fraction num denom) = do
+  numExp  <- concatMapM oMathElemToExps num >>= (return . TM.EGrouped)
+  denExp  <- concatMapM oMathElemToExps denom >>= (return . TM.EGrouped)
+  return [TM.EFraction TM.NormalFrac numExp denExp]
+oMathElemToExps (Function fname base) = do
+  -- 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 f :: OMathElem -> String
+      f (OMathRun _ run) = runToString run
+      f _                  = ""
+      fnameString = concatMap f fname
+  baseExp  <- baseToExp base
+  return [TM.EMathOperator fnameString, baseExp]
+oMathElemToExps (Group style base)
+  | Just Top <- groupPos style = do
+    baseExp <- baseToExp base
+    let chr = case groupChr style of
+          Just c -> c
+          Nothing -> '\65079'   -- default to overbrace
+    return [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
+  | otherwise = do
+    baseExp <- baseToExp base
+    let chr = case groupChr style of
+          Just c -> c
+          Nothing -> '\65080'   -- default to underbrace
+    return [TM.EUnder False baseExp (TM.ESymbol TM.Accent [chr])]
+oMathElemToExps (LowerLimit base limElems) = do
+  baseExp <- baseToExp base
+  lim <- concatMapM oMathElemToExps limElems >>= (return . TM.EGrouped)
+  return [TM.EUnder True lim baseExp]
+oMathElemToExps (UpperLimit base limElems) = do
+  baseExp <- baseToExp base
+  lim <- concatMapM oMathElemToExps limElems >>= (return . TM.EGrouped)
+  return [TM.EOver True lim baseExp]
+oMathElemToExps (Matrix bases) = do
+  rows <- mapM (mapM (\b -> baseToExp' b)) bases
+  return [TM.EArray [TM.AlignCenter] rows]
+oMathElemToExps (NAry style sub sup base) = do
+  subExps  <- concatMapM oMathElemToExps sub
+  supExps  <- concatMapM oMathElemToExps sup
+  baseExp <-  baseToExp base
+  let opChar = case nAryChar style of
+        Just c -> c
+        -- default to integral
+        Nothing -> '\8747'
+  return [ TM.ESubsup
+           (TM.ESymbol TM.Op [opChar])
+           (TM.EGrouped subExps)
+           (TM.EGrouped supExps)
+         , baseExp]
+oMathElemToExps (Phantom base) =
+  (\e -> return [TM.EPhantom e]) =<< baseToExp base
+oMathElemToExps (Radical degree base) = do
+  degExps  <- concatMapM oMathElemToExps degree
+  baseExp <- baseToExp base
+  return $ case degExps of
+    [] -> [TM.ESqrt baseExp]
+    ds -> [TM.ERoot (TM.EGrouped ds) baseExp]
+oMathElemToExps (PreSubSuper sub sup base) = do
+  subExps  <- concatMapM oMathElemToExps sub
+  supExps  <- concatMapM oMathElemToExps sup
+  baseExp <- baseToExp base
+  return [ TM.ESubsup
+          (TM.EIdentifier "") (TM.EGrouped subExps) (TM.EGrouped supExps)
+         , baseExp]
+oMathElemToExps (Sub base sub) = do
+  baseExp <- baseToExp base
+  subExps  <- concatMapM oMathElemToExps sub
+  return [TM.ESub baseExp (TM.EGrouped subExps)]
+oMathElemToExps (SubSuper base sub sup) = do
+  baseExp <- baseToExp base
+  subExps  <- concatMapM oMathElemToExps sub
+  supExps  <- concatMapM oMathElemToExps sup
+  return [TM.ESubsup baseExp (TM.EGrouped subExps) (TM.EGrouped supExps)]
+oMathElemToExps (Super base sup) = do
+  baseExp <- baseToExp base
+  supExps  <- concatMapM oMathElemToExps sup
+  return [TM.ESuper baseExp (TM.EGrouped supExps)]
+oMathElemToExps (OMathRun sty run@(Run _ _))
+  | NoStyle <- oMathRunTextStyle sty =
+    return $ [TM.EIdentifier $ runToString run]
+  | Nothing <- oMathRunStyleToTextType sty =
+    return $ [TM.EIdentifier $ runToString run]
+  | Just textType <-  oMathRunStyleToTextType sty =
+      return $ if oMathLit sty
+               then [TM.EText textType  (runToString run)]
+               else [TM.EStyled textType [TM.EIdentifier $ runToString run]]
+oMathElemToExps (OMathRun _ _) = return []
+
+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 -> DocxContext TM.Exp
+baseToExp (Base mathElems) =
+  concatMapM oMathElemToExps mathElems >>= (return . TM.EGrouped)
+
+-- an ungrouped version of baseToExp
+baseToExp' :: Base -> DocxContext [TM.Exp]
+baseToExp' (Base mathElems) =
+  concatMapM oMathElemToExps mathElems 
 
 
 isAnchorSpan :: Inline -> Bool
@@ -659,9 +693,10 @@ bodyPartToBlocks (Tbl cap _ look (r:rs)) = do
 
   return [Table caption alignments widths hdrCells cells]
 bodyPartToBlocks (OMathPara _ maths) = do
-  omaths <- mapM oMathToTexString maths
-  return [Para $ map (\s -> Math DisplayMath s) omaths]
-
+  omaths <- mapM oMathToExps maths
+  return [Para $
+          map (\m -> Math DisplayMath (writeTeX m))
+          omaths]
 
 -- replace targets with generated anchors.
 rewriteLink :: Inline -> DocxContext Inline
diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs
index cc93bc9ed..5cfe50c5c 100644
--- a/src/Text/Pandoc/Readers/Docx/Parse.hs
+++ b/src/Text/Pandoc/Readers/Docx/Parse.hs
@@ -45,6 +45,10 @@ module Text.Pandoc.Readers.Docx.Parse ( Docx(..)
                                       , NAryStyle(..)
                                       , DelimStyle(..)
                                       , GroupStyle(..)
+                                      , OMathRunStyle(..)
+                                      , OMathRunTextStyle(..)
+                                      , OMathTextScript(..)
+                                      , OMathTextStyle(..)
                                       , Run(..)
                                       , RunElem(..)
                                       , Notes
@@ -93,13 +97,14 @@ maybeToD :: Maybe a -> D a
 maybeToD (Just a) = return a
 maybeToD Nothing = throwError DocxError
 
-mapD :: (a -> D b) -> [a] -> D [b]
-mapD _ [] = return []
-mapD f (x:xs) = do
-  y <- (f x >>= (\z -> return [z])) `catchError` (\_ -> return [])
-  ys <- mapD f xs
-  return $ y ++ ys
+concatMapM        :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
+concatMapM f xs   =  liftM concat (mapM f xs)
 
+mapD :: (a -> D b) -> [a] -> D [b]
+mapD f xs =
+  let handler x = (f x >>= (\y-> return [y])) `catchError` (\_ -> return [])
+  in
+   concatMapM handler xs
 
 type NameSpaces = [(String, String)]
 
@@ -128,6 +133,7 @@ type Level = (String, String, String, Maybe Integer)
 
 data Relationship = Relationship (RelId, Target)
                   deriving Show
+
 data Notes = Notes NameSpaces
              (Maybe (M.Map String Element))
              (Maybe (M.Map String Element))
@@ -223,6 +229,30 @@ 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
+                                , oMathStyle  :: Maybe OMathTextStyle }
+                       deriving Show
+
+data OMathTextScript = ORoman
+                     | OScript
+                     | OFraktur
+                     | ODoubleStruck
+                     | OSansSerif
+                     | OMonospace
+                     deriving (Show, Eq)
+
+data OMathTextStyle = OPlain
+                    | OBold
+                    | OItalic
+                    | OBoldItalic
+                    deriving (Show, Eq)
+
 defaultNAryStyle :: NAryStyle
 defaultNAryStyle = NAryStyle { nAryChar = Nothing -- integral, in practice
                              , nAryLimLoc = SubSup }
@@ -246,9 +276,6 @@ data GroupStyle = GroupStyle { groupChr :: Maybe Char
 defaultGroupStyle :: GroupStyle
 defaultGroupStyle = GroupStyle {groupChr = Nothing, groupPos = Nothing}
 
-type OMathRunStyle = [String]
-
-
 data Run = Run RunStyle [RunElem]
          | Footnote [BodyPart]
          | Endnote [BodyPart]
@@ -596,6 +623,75 @@ elemToBase ns element | isElem ns "m" "e" element =
   (\es -> return $ Base es)
 elemToBase _ _ = throwError WrongElem
 
+-- 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 (Run wrPr elems)) =
+  let f (TextRun s) = TextRun $ filter ('&' /=) s
+      f re          = re
+  in
+   OMathRun mrPr $ Run wrPr (map f elems)
+filterAmpersand e = e
+
+elemToBaseNoAmpersand :: NameSpaces -> Element -> D Base
+elemToBaseNoAmpersand ns element | isElem ns "m" "e" element =
+  mapD
+  (\e -> (elemToMathElem ns e >>= (return . filterAmpersand)))
+  (elChildren element) >>=
+  (\es -> return $ Base es)
+elemToBaseNoAmpersand _ _ = throwError WrongElem
+
+
+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 =
+    let scr =
+          case
+            findChild (elemName ns "m" "scr") mrPr >>=
+            findAttr (elemName ns "m" "val") 
+          of
+            Just "roman"         -> Just ORoman
+            Just "script"        -> Just OScript
+            Just "fraktur"       -> Just OFraktur
+            Just "double-struck" -> Just ODoubleStruck
+            Just "sans-serif"    -> Just OSansSerif
+            Just "monospace"     -> Just OMonospace
+            _                    -> Nothing
+
+        sty =
+          case
+            findChild (elemName ns "m" "sty") mrPr >>=
+            findAttr (elemName ns "m" "val")
+          of
+            Just "p"             -> Just OPlain
+            Just "b"             -> Just OBold
+            Just "i"             -> Just OItalic
+            Just "bi"            -> Just OBoldItalic
+            _                    -> Nothing
+    in
+     Styled { oMathScript = scr, oMathStyle = sty }
+  | otherwise = NoStyle
+
+
+
 elemToNAryStyle :: NameSpaces -> Element -> NAryStyle
 elemToNAryStyle ns element
   | Just narypr <- findChild (QName "naryPr" (lookup "m" ns) (Just "m")) element =
@@ -618,13 +714,13 @@ 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 Nothing else (Just $ head c))
+                 (\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 Nothing else (Just $ head c))
+                 (\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 Nothing else (Just $ head c))
+                 (\c -> if null c then (Just ' ') else (Just $ head c))
     in
      DelimStyle { delimBegChar = begChr
                 , delimSepChar = sepChr
@@ -647,9 +743,9 @@ elemToGroupStyle _ _ = defaultGroupStyle
 elemToMathElem :: NameSpaces -> Element -> D OMathElem
 elemToMathElem ns element | isElem ns "m" "acc" element = do
   let accChar =
-        findChild (QName "accPr" (lookup "m" ns) (Just "m")) element >>=
-        findChild (QName "chr" (lookup "m" ns) (Just "m")) >>=
-        findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
+        findChild (elemName ns "m" "accPr") element >>=
+        findChild (elemName ns "m" "chr") >>=
+        findAttr (elemName ns "m" "val") >>=
         Just . head
       accPr = AccentStyle { accentChar = accChar}
   base <-(maybeToD $ findChild (elemName ns "m" "e") element) >>=
@@ -681,7 +777,7 @@ elemToMathElem ns element | isElem ns "m" "d" element =
    mapD (elemToBase ns) (elChildren element) >>=
    (\es -> return $ Delimiter style es)
 elemToMathElem ns element | isElem ns "m" "eqArr" element =
-  mapD (elemToBase ns) (elChildren element) >>=
+  mapD (elemToBaseNoAmpersand ns) (elChildren element) >>=
   (\es -> return $ EquationArray es)
 elemToMathElem ns element | isElem ns "m" "f" element = do
   num <- maybeToD $ findChild (elemName ns "m" "num") element
@@ -763,12 +859,12 @@ elemToMathElem ns element | isElem ns "m" "sSup" element = do
           elemToBase ns
   sup <- maybeToD (findChild (elemName ns "m" "sup") element) >>=
          (\e -> mapD (elemToMathElem ns) (elChildren e))
-  return $ Sub base sup
+  return $ Super base sup
 elemToMathElem ns element | isElem ns "m" "r" element = do
-  let style = []            -- placeholder
-      rstyle = elemToRunStyle ns element
+  let mrPr = elemToOMathRunStyle ns element
+      wrPr = elemToRunStyle ns element
   relems <- elemToRunElems ns element
-  return $ OMathRun style $ Run rstyle relems
+  return $ OMathRun mrPr $ Run wrPr relems
 elemToMathElem _ _ = throwError WrongElem
 
 lookupRelationship :: RelId -> [Relationship] -> Maybe Target
@@ -832,6 +928,9 @@ elemToParPart ns element
     return $ case lookupRelationship relId rels of
       Just target -> ExternalHyperLink target runs
       Nothing     -> ExternalHyperLink "" runs
+elemToParPart ns element
+  | isElem ns "m" "oMath" element = 
+    elemToMath ns element >>= (return . PlainOMath)
 elemToParPart _ _ = throwError WrongElem
 
 lookupFootnote :: String -> Notes -> Maybe Element
@@ -908,7 +1007,9 @@ elemToRunStyle _ _ = defaultRunStyle
 
 elemToRunElem :: NameSpaces -> Element -> D RunElem
 elemToRunElem ns element
-  | isElem ns "w" "t" element || isElem ns "w" "delText" element =
+  | isElem ns "w" "t" element
+    || isElem ns "w" "delText" element
+    || isElem ns "m" "t" element =
     return $ TextRun $ strContent element
   | isElem ns "w" "br" element = return LnBrk
   | isElem ns "w" "tab" element = return Tab
@@ -916,7 +1017,9 @@ elemToRunElem ns element
 
 elemToRunElems :: NameSpaces -> Element -> D [RunElem]
 elemToRunElems ns element
-  |  isElem ns "w" "r" element = mapD (elemToRunElem ns) (elChildren element)
+  |  isElem ns "w" "r" element
+     || isElem ns "m" "r" element =
+       mapD (elemToRunElem ns) (elChildren element)
 elemToRunElems _ _ = throwError WrongElem