Use texmath's parser in TexMath module.

* This replaces a lot of custom parser code, and expands
  the tex -> unicode conversion.
* The behavior has also changed: if the whole formula can't
  be converted, the whole formula is left in raw TeX.
  Previously, pandoc converted parts of the formula to unicode
  and left other parts in raw TeX.
* Added (but not yet exported) readTeXMath', which returns a Maybe.
* Updated tests

1 files changed, 53 insertions, 197 deletions

diff --git a/src/Text/Pandoc/Readers/TeXMath.hs b/src/Text/Pandoc/Readers/TeXMath.hs
index 080354be1..40cf39987 100644
--- a/src/Text/Pandoc/Readers/TeXMath.hs
+++ b/src/Text/Pandoc/Readers/TeXMath.hs
@@ -28,208 +28,64 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 Conversion of TeX math to a list of 'Pandoc' inline elements.
 -}
 module Text.Pandoc.Readers.TeXMath ( 
-                                     readTeXMath 
+                                     readTeXMath
                                    ) where
 
 import Text.ParserCombinators.Parsec
 import Text.Pandoc.Definition
+import Text.TeXMath.Parser
 
--- | Converts a string of raw TeX math to a list of 'Pandoc' inlines. 
+-- | Converts a raw TeX math formula to a list of 'Pandoc' inlines.
+-- Defaults to raw formula between @$@ characters if entire formula
+-- can't be converted.
 readTeXMath :: String    -- ^ String to parse (assumes @'\n'@ line endings)
             -> [Inline]
-readTeXMath inp = case parse teXMath ("formula: " ++ inp) inp of
-   Left _    -> [Str inp]  -- if unparseable, just include original
-   Right res -> res
-
-teXMath :: GenParser Char st [Inline]
-teXMath = manyTill mathPart eof >>= return . concat
-
-mathPart :: GenParser Char st [Inline]
-mathPart = whitespace <|> superscript <|> subscript <|> symbol <|> 
-           argument <|> digits <|> letters <|> misc
-
-whitespace :: GenParser Char st [Inline]
-whitespace = many1 space >> return []
-
-symbol :: GenParser Char st [Inline]
-symbol = try $ do
-  char '\\'
-  res <- many1 letter
-  case lookup res teXsymbols of
-    Just m  -> return [Str m]
-    Nothing -> return [Str $ "\\" ++ res]
-
-argument :: GenParser Char st [Inline]
-argument = try $ do
-  char '{'
-  res <- many mathPart
-  char '}'
-  return $ if null res 
-              then [Str " "]
-              else [Str "{"] ++ concat res ++ [Str "}"]
-
-digits :: GenParser Char st [Inline]
-digits = do
-  res <- many1 digit
-  return [Str res]
-
-letters :: GenParser Char st [Inline]
-letters = do
-  res <- many1 letter
-  return [Emph [Str res]]
-
-misc :: GenParser Char st [Inline]
-misc = do
-  res <- noneOf "}"
-  return [Str [res]] 
-
-scriptArg :: GenParser Char st [Inline]
-scriptArg = try $ do
-  (try (do{char '{'; r <- many mathPart; char '}'; return $ concat r}))
-   <|> symbol
-   <|> (do{c <- (letter <|> digit); return [Str [c]]})
-  
-superscript :: GenParser Char st [Inline]
-superscript = try $ do
-  char '^'
-  arg <- scriptArg
-  return [Superscript arg]
-
-subscript :: GenParser Char st [Inline]
-subscript = try $ do
-  char '_'
-  arg <- scriptArg
-  return [Subscript arg]
- 
-withThinSpace :: String -> String
-withThinSpace str = "\x2009" ++ str ++ "\x2009"
-
-teXsymbols :: [(String, String)]
-teXsymbols = 
- [("alpha","\x3B1")
- ,("beta", "\x3B2")
- ,("chi", "\x3C7")
- ,("delta", "\x3B4")
- ,("Delta", "\x394")
- ,("epsilon", "\x3B5")
- ,("varepsilon", "\x25B")
- ,("eta", "\x3B7")
- ,("gamma", "\x3B3")
- ,("Gamma", "\x393")
- ,("iota", "\x3B9")
- ,("kappa", "\x3BA")
- ,("lambda", "\x3BB")
- ,("Lambda", "\x39B")
- ,("mu", "\x3BC")
- ,("nu", "\x3BD")
- ,("omega", "\x3C9")
- ,("Omega", "\x3A9")
- ,("phi", "\x3C6")
- ,("varphi", "\x3D5")
- ,("Phi", "\x3A6")
- ,("pi", "\x3C0")
- ,("Pi", "\x3A0")
- ,("psi", "\x3C8")
- ,("Psi", "\x3A8")
- ,("rho", "\x3C1")
- ,("sigma", "\x3C3")
- ,("Sigma", "\x3A3")
- ,("tau", "\x3C4")
- ,("theta", "\x3B8")
- ,("vartheta", "\x3D1")
- ,("Theta", "\x398")
- ,("upsilon", "\x3C5")
- ,("xi", "\x3BE")
- ,("Xi", "\x39E")
- ,("zeta", "\x3B6")
- ,("ne", "\x2260")
- ,("lt", withThinSpace "<")
- ,("le", withThinSpace "\x2264")
- ,("leq", withThinSpace "\x2264")
- ,("ge", withThinSpace "\x2265")
- ,("geq", withThinSpace "\x2265")
- ,("prec", withThinSpace "\x227A")
- ,("succ", withThinSpace "\x227B")
- ,("preceq", withThinSpace "\x2AAF")
- ,("succeq", withThinSpace "\x2AB0")
- ,("in", withThinSpace "\x2208")
- ,("notin", withThinSpace "\x2209")
- ,("subset", withThinSpace "\x2282")
- ,("supset", withThinSpace "\x2283")
- ,("subseteq", withThinSpace "\x2286")
- ,("supseteq", withThinSpace "\x2287")
- ,("equiv", withThinSpace "\x2261")
- ,("cong", withThinSpace "\x2245")
- ,("approx", withThinSpace "\x2248")
- ,("propto", withThinSpace "\x221D")
- ,("cdot", withThinSpace "\x22C5")
- ,("star", withThinSpace "\x22C6")
- ,("backslash", "\\")
- ,("times", withThinSpace "\x00D7")
- ,("divide", withThinSpace "\x00F7")
- ,("circ", withThinSpace "\x2218")
- ,("oplus", withThinSpace "\x2295")
- ,("otimes", withThinSpace "\x2297")
- ,("odot", withThinSpace "\x2299")
- ,("sum", "\x2211")
- ,("prod", "\x220F")
- ,("wedge", withThinSpace "\x2227")
- ,("bigwedge", withThinSpace "\x22C0")
- ,("vee", withThinSpace "\x2228")
- ,("bigvee", withThinSpace "\x22C1")
- ,("cap", withThinSpace "\x2229")
- ,("bigcap", withThinSpace "\x22C2")
- ,("cup", withThinSpace "\x222A")
- ,("bigcup", withThinSpace "\x22C3")
- ,("neg", "\x00AC")
- ,("implies", withThinSpace "\x21D2")
- ,("iff", withThinSpace "\x21D4")
- ,("forall", "\x2200")
- ,("exists", "\x2203")
- ,("bot", "\x22A5")
- ,("top", "\x22A4")
- ,("vdash", "\x22A2")
- ,("models", withThinSpace "\x22A8")
- ,("uparrow", "\x2191")
- ,("downarrow", "\x2193")
- ,("rightarrow", withThinSpace "\x2192")
- ,("to", withThinSpace "\x2192")
- ,("rightarrowtail", "\x21A3")
- ,("twoheadrightarrow", withThinSpace "\x21A0")
- ,("twoheadrightarrowtail", withThinSpace "\x2916")
- ,("mapsto", withThinSpace "\x21A6")
- ,("leftarrow", withThinSpace "\x2190")
- ,("leftrightarrow", withThinSpace "\x2194")
- ,("Rightarrow", withThinSpace "\x21D2")
- ,("Leftarrow", withThinSpace "\x21D0")
- ,("Leftrightarrow", withThinSpace "\x21D4")
- ,("partial", "\x2202")
- ,("nabla", "\x2207")
- ,("pm", "\x00B1")
- ,("emptyset", "\x2205")
- ,("infty", "\x221E")
- ,("aleph", "\x2135")
- ,("ldots", "...")
- ,("therefore", "\x2234")
- ,("angle", "\x2220")
- ,("quad", "\x00A0\x00A0")
- ,("cdots", "\x22EF")
- ,("vdots", "\x22EE")
- ,("ddots", "\x22F1")
- ,("diamond", "\x22C4")
- ,("Box", "\x25A1")
- ,("lfloor", "\x230A")
- ,("rfloor", "\x230B")
- ,("lceiling", "\x2308")
- ,("rceiling", "\x2309")
- ,("langle", "\x2329")
- ,("rangle", "\x232A")
- ,("int", "\8747")
- ,("{", "{")
- ,("}", "}")
- ,("[", "[")
- ,("]", "]")
- ,("|", "|")
- ,("||", "||")
- ]
+readTeXMath inp = case readTeXMath' inp of
+                        Nothing  -> [Str ("$" ++ inp ++ "$")]
+                        Just res -> res
+
+-- | Like 'readTeXMath', but without the default.
+readTeXMath' :: String    -- ^ String to parse (assumes @'\n'@ line endings)
+            -> Maybe [Inline]
+readTeXMath' inp = case parse formula "formula" inp of
+   Left _     -> Just [Str inp]
+   Right exps -> expsToInlines exps
+
+expsToInlines :: [Exp] -> Maybe [Inline]
+expsToInlines xs = do
+  res <- mapM expToInlines xs
+  return (concat res)
+
+expToInlines :: Exp -> Maybe [Inline]
+expToInlines (ENumber s) = Just [Str s]
+expToInlines (EIdentifier s) = Just [Emph [Str s]]
+expToInlines (EMathOperator s) = Just [Str s]
+expToInlines (ESymbol t s) = Just $ addSpace t (Str s)
+  where addSpace Op x = [x, thinspace]
+        addSpace Bin x = [medspace, x, medspace]
+        addSpace Rel x = [widespace, x, widespace]
+        addSpace Pun x = [x, thinspace]
+        addSpace _ x = [x]
+        thinspace = Str "\x2006"
+        medspace  = Str "\x2005"
+        widespace = Str "\x2004"
+expToInlines (EStretchy x) = expToInlines x
+expToInlines (EGrouped xs) = expsToInlines xs
+expToInlines (ESpace _) = Just [Str " "]  -- variable widths not supported
+expToInlines (EBinary _ _ _) = Nothing
+expToInlines (ESub x y) = do
+  x' <- expToInlines x
+  y' <- expToInlines y
+  return $ x' ++ [Subscript y']
+expToInlines (ESuper x y) = do
+  x' <- expToInlines x
+  y' <- expToInlines y
+  return $ x' ++ [Superscript y']
+expToInlines (ESubsup x y z) = do
+  x' <- expToInlines x
+  y' <- expToInlines y
+  z' <- expToInlines z
+  return $ x' ++ [Subscript y'] ++ [Superscript z']
+expToInlines (EText _ x) = Just [Emph [Str x]]
+expToInlines _ = Nothing