texmath 0.4 → 0.5
raw patch · 9 files changed
+280/−254 lines, 9 files
Files
- Text/TeXMath.hs +2/−5
- Text/TeXMath/Macros.hs +21/−4
- Text/TeXMath/MathML.hs +177/−0
- Text/TeXMath/MathMLWriter.hs +0/−177
- Text/TeXMath/Parser.hs +8/−36
- Text/TeXMath/Types.hs +58/−0
- cgi/texmath-cgi.hs +7/−17
- texmath.cabal +3/−2
- texmath.hs +4/−13
Text/TeXMath.hs view
@@ -22,12 +22,9 @@ module Text.TeXMath ( texMathToMathML, DisplayType(..) ) where import Text.TeXMath.Parser-import Text.TeXMath.MathMLWriter+import Text.TeXMath.MathML import Text.XML.Light-import Text.ParserCombinators.Parsec (parse) texMathToMathML :: DisplayType -> String -> Either String Element texMathToMathML dt inp = inp `seq`- case parse formula "TeX math input" inp of- Left err -> Left (show err)- Right v -> Right $ toMathML dt v+ either Left (Right . toMathML dt) $ parseFormula inp
Text/TeXMath/Macros.hs view
@@ -21,9 +21,8 @@ to LateX expressions. -} -module Text.TeXMath.Macros ( Macro(..)- , pMacroDefinition- , pSkipSpaceComments+module Text.TeXMath.Macros ( Macro+ , parseMacroDefinitions , applyMacros ) where@@ -33,10 +32,28 @@ import Text.ParserCombinators.Parsec data Macro = Macro { macroDefinition :: String- , macroParser :: forall st . GenParser Char st String }+ , macroParser :: forall st . GenParser Char st String } instance Show Macro where show m = "Macro " ++ show (macroDefinition m)++-- | Parses a string for a list of macro definitions, optionally+-- separated and ended by spaces and TeX comments. Returns+-- the list of macros (which may be empty) and the unparsed+-- portion of the input string.+parseMacroDefinitions :: String -> ([Macro], String)+parseMacroDefinitions s =+ case parse pMacroDefinitions "input" s of+ Left _ -> ([], s)+ Right res -> res++-- | Parses one or more macro definitions separated by comments & space.+-- Return list of macros parsed + remainder of string.+pMacroDefinitions :: GenParser Char st ([Macro], String)+pMacroDefinitions = do+ defs <- sepEndBy pMacroDefinition pSkipSpaceComments+ rest <- getInput+ return (reverse defs, rest) -- reversed so later macros shadow earlier -- | Parses a @\\newcommand@ or @\\renewcommand@ macro definition and -- returns a 'Macro'.
+ Text/TeXMath/MathML.hs view
@@ -0,0 +1,177 @@+{-+Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++{- | Functions for writing a parsed formula as MathML.+-}++module Text.TeXMath.MathML (toMathML, DisplayType(..), showExp)+where++import qualified Data.Map as M+import Text.XML.Light+import Text.TeXMath.Types+import Data.Generics (everywhere, mkT)++data DisplayType = DisplayBlock+ | DisplayInline+ deriving Show++toMathML :: DisplayType -> [Exp] -> Element+toMathML dt exprs =+ add_attr dtattr $ math $ map showExp $ everywhere (mkT $ handleDownup dt) exprs+ where dtattr = Attr (unqual "display") dt'+ dt' = case dt of+ DisplayBlock -> "block"+ DisplayInline -> "inline"++math :: [Element] -> Element+math = add_attr (Attr (unqual "xmlns") "http://www.w3.org/1998/Math/MathML") . unode "math" . unode "mrow"++mrow :: [Element] -> Element+mrow = unode "mrow"++{- Firefox seems to set spacing based on its own dictionary,+- so I believe this is unnecessary.+ +setSpacing :: String -> String -> Bool -> Element -> Element+setSpacing left right stretchy elt =+ add_attr (Attr (unqual "lspace") left) $+ add_attr (Attr (unqual "rspace") right) $+ if stretchy+ then add_attr (Attr (unqual "stretchy") "true") elt+ else elt++showSymbol (ESymbol s x) =+ case s of+ Ord x -> unode "mo" x+ Op x -> setSpacing "0" "0.167em" True $ unode "mo" x+ Bin x -> setSpacing "0.222em" "0.222em" False $ unode "mo" x+ Rel x -> setSpacing "0.278em" "0.278em" False $ unode "mo" x+ Open x -> setSpacing "0" "0" True $ unode "mo" x+ Close x -> setSpacing "0" "0" True $ unode "mo" x+ Pun x -> setSpacing "0" "0.167em" False $ unode "mo" x+-}++unaryOps :: M.Map String String+unaryOps = M.fromList+ [ ("\\sqrt", "msqrt")+ , ("\\surd", "msqrt")+ ]++showUnary :: String -> Exp -> Element+showUnary c x =+ case M.lookup c unaryOps of+ Just c' -> unode c' (showExp x)+ Nothing -> error $ "Unknown unary op: " ++ c++binaryOps :: M.Map String ([Element] -> Element)+binaryOps = M.fromList+ [ ("\\frac", unode "mfrac")+ , ("\\tfrac", withAttribute "displaystyle" "false" .+ unode "mstyle" . unode "mfrac")+ , ("\\dfrac", withAttribute "displaystyle" "true" .+ unode "mstyle" . unode "mfrac")+ , ("\\sqrt", unode "mroot")+ , ("\\stackrel", unode "mover")+ , ("\\overset", unode "mover")+ , ("\\underset", unode "munder")+ , ("\\binom", showBinom)+ ]++showBinom :: [Element] -> Element+showBinom lst = unode "mfenced" $ withAttribute "linethickness" "0" $ unode "mfrac" lst++showBinary :: String -> Exp -> Exp -> Element+showBinary c x y =+ case M.lookup c binaryOps of+ Just f -> f [showExp x, showExp y]+ Nothing -> error $ "Unknown binary op: " ++ c++spaceWidth :: String -> Element+spaceWidth w = withAttribute "width" w $ unode "mspace" ()++makeStretchy :: Element -> Element+makeStretchy = withAttribute "stretchy" "true"++makeScaled :: String -> Element -> Element+makeScaled s = withAttribute "minsize" s . withAttribute "maxsize" s++makeText :: String -> String -> Element+makeText a s = if trailingSp+ then mrow [s', sp]+ else s'+ where sp = spaceWidth "0.333em"+ s' = withAttribute "mathvariant" a $ unode "mtext" s+ trailingSp = not (null s) && last s `elem` " \t"++makeArray :: [Alignment] -> [ArrayLine] -> Element+makeArray as ls = unode "mtable" $+ map (unode "mtr" .+ zipWith (\a -> setAlignment a . unode "mtd". map showExp) as') ls+ where setAlignment AlignLeft = withAttribute "columnalign" "left"+ setAlignment AlignRight = withAttribute "columnalign" "right"+ setAlignment AlignCenter = withAttribute "columnalign" "center"+ setAlignment AlignDefault = id + as' = as ++ cycle [AlignDefault]++withAttribute :: String -> String -> Element -> Element+withAttribute a = add_attr . Attr (unqual a)++accent :: String -> Element+accent = add_attr (Attr (unqual "accent") "true") .+ unode "mo"++handleDownup :: DisplayType -> Exp -> Exp+handleDownup DisplayInline (EDown x y) = ESub x y+handleDownup DisplayBlock (EDown x y) = EUnder x y+handleDownup DisplayInline (EUp x y) = ESuper x y+handleDownup DisplayBlock (EUp x y) = EOver x y+handleDownup DisplayInline (EDownup x y z) = ESubsup x y z+handleDownup DisplayBlock (EDownup x y z) = EUnderover x y z+handleDownup _ x = x++showExp :: Exp -> Element+showExp e =+ case e of+ ENumber x -> unode "mn" x+ EGrouped [x] -> showExp x+ EGrouped xs -> mrow $ map showExp xs+ EIdentifier x -> unode "mi" x+ EMathOperator x -> unode "mi" x+ ESymbol Accent x -> accent x+ EStretchy (ESymbol Open x) -> makeStretchy $ unode "mo" x+ EStretchy (ESymbol Close x) -> makeStretchy $ unode "mo" x+ ESymbol Open x -> withAttribute "stretchy" "false" $ unode "mo" x+ ESymbol Close x -> withAttribute "stretchy" "false" $ unode "mo" x+ ESymbol _ x -> unode "mo" x+ ESpace x -> spaceWidth x+ EBinary c x y -> showBinary c x y+ ESub x y -> unode "msub" $ map showExp [x, y]+ ESuper x y -> unode "msup" $ map showExp [x, y]+ ESubsup x y z -> unode "msubsup" $ map showExp [x, y, z]+ EUnder x y -> unode "munder" $ map showExp [x, y]+ EOver x y -> unode "mover" $ map showExp [x, y]+ EUnderover x y z -> unode "munderover" $ map showExp [x, y, z]+ EUnary c x -> showUnary c x+ EStretchy x -> makeStretchy $ showExp x+ EScaled s x -> makeScaled s $ showExp x+ EArray as ls -> makeArray as ls+ EText a s -> makeText a s+ x -> error $ "showExp encountered " ++ show x+ -- note: EUp, EDown, EDownup should be removed by handleDownup+
− Text/TeXMath/MathMLWriter.hs
@@ -1,177 +0,0 @@-{--Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>--This program is free software; you can redistribute it and/or modify-it under the terms of the GNU General Public License as published by-the Free Software Foundation; either version 2 of the License, or-(at your option) any later version.--This program is distributed in the hope that it will be useful,-but WITHOUT ANY WARRANTY; without even the implied warranty of-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the-GNU General Public License for more details.--You should have received a copy of the GNU General Public License-along with this program; if not, write to the Free Software-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA--}--{- | Functions for writing a parsed formula as MathML.--}--module Text.TeXMath.MathMLWriter (toMathML, DisplayType(..), showExp)-where--import qualified Data.Map as M-import Text.XML.Light-import Text.TeXMath.Parser-import Data.Generics (everywhere, mkT)--data DisplayType = DisplayBlock- | DisplayInline- deriving Show--toMathML :: DisplayType -> [Exp] -> Element-toMathML dt exprs =- add_attr dtattr $ math $ map showExp $ everywhere (mkT $ handleDownup dt) exprs- where dtattr = Attr (unqual "display") dt'- dt' = case dt of- DisplayBlock -> "block"- DisplayInline -> "inline"--math :: [Element] -> Element-math = add_attr (Attr (unqual "xmlns") "http://www.w3.org/1998/Math/MathML") . unode "math" . unode "mrow"--mrow :: [Element] -> Element-mrow = unode "mrow"--{- Firefox seems to set spacing based on its own dictionary,-- so I believe this is unnecessary.- -setSpacing :: String -> String -> Bool -> Element -> Element-setSpacing left right stretchy elt =- add_attr (Attr (unqual "lspace") left) $- add_attr (Attr (unqual "rspace") right) $- if stretchy- then add_attr (Attr (unqual "stretchy") "true") elt- else elt--showSymbol (ESymbol s x) =- case s of- Ord x -> unode "mo" x- Op x -> setSpacing "0" "0.167em" True $ unode "mo" x- Bin x -> setSpacing "0.222em" "0.222em" False $ unode "mo" x- Rel x -> setSpacing "0.278em" "0.278em" False $ unode "mo" x- Open x -> setSpacing "0" "0" True $ unode "mo" x- Close x -> setSpacing "0" "0" True $ unode "mo" x- Pun x -> setSpacing "0" "0.167em" False $ unode "mo" x--}--unaryOps :: M.Map String String-unaryOps = M.fromList- [ ("\\sqrt", "msqrt")- , ("\\surd", "msqrt")- ]--showUnary :: String -> Exp -> Element-showUnary c x =- case M.lookup c unaryOps of- Just c' -> unode c' (showExp x)- Nothing -> error $ "Unknown unary op: " ++ c--binaryOps :: M.Map String ([Element] -> Element)-binaryOps = M.fromList- [ ("\\frac", unode "mfrac")- , ("\\tfrac", withAttribute "displaystyle" "false" .- unode "mstyle" . unode "mfrac")- , ("\\dfrac", withAttribute "displaystyle" "true" .- unode "mstyle" . unode "mfrac")- , ("\\sqrt", unode "mroot")- , ("\\stackrel", unode "mover")- , ("\\overset", unode "mover")- , ("\\underset", unode "munder")- , ("\\binom", showBinom)- ]--showBinom :: [Element] -> Element-showBinom lst = unode "mfenced" $ withAttribute "linethickness" "0" $ unode "mfrac" lst--showBinary :: String -> Exp -> Exp -> Element-showBinary c x y =- case M.lookup c binaryOps of- Just f -> f [showExp x, showExp y]- Nothing -> error $ "Unknown binary op: " ++ c--spaceWidth :: String -> Element-spaceWidth w = withAttribute "width" w $ unode "mspace" ()--makeStretchy :: Element -> Element-makeStretchy = withAttribute "stretchy" "true"--makeScaled :: String -> Element -> Element-makeScaled s = withAttribute "minsize" s . withAttribute "maxsize" s--makeText :: String -> String -> Element-makeText a s = if trailingSp- then mrow [s', sp]- else s'- where sp = spaceWidth "0.333em"- s' = withAttribute "mathvariant" a $ unode "mtext" s- trailingSp = not (null s) && last s `elem` " \t"--makeArray :: [Alignment] -> [ArrayLine] -> Element-makeArray as ls = unode "mtable" $- map (unode "mtr" .- zipWith (\a -> setAlignment a . unode "mtd". map showExp) as') ls- where setAlignment AlignLeft = withAttribute "columnalign" "left"- setAlignment AlignRight = withAttribute "columnalign" "right"- setAlignment AlignCenter = withAttribute "columnalign" "center"- setAlignment AlignDefault = id - as' = as ++ cycle [AlignDefault]--withAttribute :: String -> String -> Element -> Element-withAttribute a = add_attr . Attr (unqual a)--accent :: String -> Element-accent = add_attr (Attr (unqual "accent") "true") .- unode "mo"--handleDownup :: DisplayType -> Exp -> Exp-handleDownup DisplayInline (EDown x y) = ESub x y-handleDownup DisplayBlock (EDown x y) = EUnder x y-handleDownup DisplayInline (EUp x y) = ESuper x y-handleDownup DisplayBlock (EUp x y) = EOver x y-handleDownup DisplayInline (EDownup x y z) = ESubsup x y z-handleDownup DisplayBlock (EDownup x y z) = EUnderover x y z-handleDownup _ x = x--showExp :: Exp -> Element-showExp e =- case e of- ENumber x -> unode "mn" x- EGrouped [x] -> showExp x- EGrouped xs -> mrow $ map showExp xs- EIdentifier x -> unode "mi" x- EMathOperator x -> unode "mi" x- ESymbol Accent x -> accent x- EStretchy (ESymbol Open x) -> makeStretchy $ unode "mo" x- EStretchy (ESymbol Close x) -> makeStretchy $ unode "mo" x- ESymbol Open x -> withAttribute "stretchy" "false" $ unode "mo" x- ESymbol Close x -> withAttribute "stretchy" "false" $ unode "mo" x- ESymbol _ x -> unode "mo" x- ESpace x -> spaceWidth x- EBinary c x y -> showBinary c x y- ESub x y -> unode "msub" $ map showExp [x, y]- ESuper x y -> unode "msup" $ map showExp [x, y]- ESubsup x y z -> unode "msubsup" $ map showExp [x, y, z]- EUnder x y -> unode "munder" $ map showExp [x, y]- EOver x y -> unode "mover" $ map showExp [x, y]- EUnderover x y z -> unode "munderover" $ map showExp [x, y, z]- EUnary c x -> showUnary c x- EStretchy x -> makeStretchy $ showExp x- EScaled s x -> makeScaled s $ showExp x- EArray as ls -> makeArray as ls- EText a s -> makeText a s- x -> error $ "showExp encountered " ++ show x- -- note: EUp, EDown, EDownup should be removed by handleDownup-
Text/TeXMath/Parser.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveDataTypeable #-} {- Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu> @@ -20,7 +19,7 @@ {- | Functions for parsing a LaTeX formula to a Haskell representation. -} -module Text.TeXMath.Parser (expr, formula, Exp(..), TeXSymbolType(..), ArrayLine, Alignment(..))+module Text.TeXMath.Parser (parseFormula) where import Control.Monad@@ -29,39 +28,7 @@ import Text.ParserCombinators.Parsec import qualified Text.ParserCombinators.Parsec.Token as P import Text.ParserCombinators.Parsec.Language-import Data.Generics--data TeXSymbolType = Ord | Op | Bin | Rel | Open | Close | Pun | Accent- deriving (Show, Read, Eq, Data, Typeable)--data Alignment = AlignLeft | AlignCenter | AlignRight | AlignDefault- deriving (Show, Read, Eq, Data, Typeable)--type ArrayLine = [[Exp]]--data Exp =- ENumber String- | EGrouped [Exp]- | EIdentifier String- | EMathOperator String- | ESymbol TeXSymbolType String- | ESpace String- | EBinary String Exp Exp- | ESub Exp Exp- | ESuper Exp Exp- | ESubsup Exp Exp Exp- | EOver Exp Exp- | EUnder Exp Exp- | EUnderover Exp Exp Exp- | EUp Exp Exp- | EDown Exp Exp- | EDownup Exp Exp Exp- | EUnary String Exp- | EScaled String Exp- | EStretchy Exp- | EArray [Alignment] [ArrayLine]- | EText String String- deriving (Show, Read, Eq, Data, Typeable)+import Text.TeXMath.Types texMathDef :: LanguageDef st texMathDef = LanguageDef @@ -98,6 +65,11 @@ , ensuremath ] +-- | Parse a formula, returning a list of 'Exp'.+parseFormula :: String -> Either String [Exp]+parseFormula inp =+ either (Left . show) (Right . id) $ parse formula "formula" inp+ formula :: GenParser Char st [Exp] formula = do whiteSpace@@ -452,7 +424,7 @@ , ("\\rbrack", ESymbol Close "]") , ("\\rbrace", ESymbol Close "}") , ("\\llbracket", ESymbol Open "\x27E6")- , ("\\rrbracket", ESymbol Close "\x230B")+ , ("\\rrbracket", ESymbol Close "\x27E7") , ("\\langle", ESymbol Open "\x27E8") , ("\\rangle", ESymbol Close "\x27E9") , ("\\lfloor", ESymbol Open "\x230A")
+ Text/TeXMath/Types.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-+Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++{- | Types for representing a structured formula.+-}++module Text.TeXMath.Types (Exp(..), TeXSymbolType(..), ArrayLine, Alignment(..))+where++import Data.Generics++data TeXSymbolType = Ord | Op | Bin | Rel | Open | Close | Pun | Accent+ deriving (Show, Read, Eq, Data, Typeable)++data Alignment = AlignLeft | AlignCenter | AlignRight | AlignDefault+ deriving (Show, Read, Eq, Data, Typeable)++type ArrayLine = [[Exp]]++data Exp =+ ENumber String+ | EGrouped [Exp]+ | EIdentifier String+ | EMathOperator String+ | ESymbol TeXSymbolType String+ | ESpace String+ | EBinary String Exp Exp+ | ESub Exp Exp+ | ESuper Exp Exp+ | ESubsup Exp Exp Exp+ | EOver Exp Exp+ | EUnder Exp Exp+ | EUnderover Exp Exp Exp+ | EUp Exp Exp+ | EDown Exp Exp+ | EDownup Exp Exp Exp+ | EUnary String Exp+ | EScaled String Exp+ | EStretchy Exp+ | EArray [Alignment] [ArrayLine]+ | EText String String+ deriving (Show, Read, Eq, Data, Typeable)
cgi/texmath-cgi.hs view
@@ -7,30 +7,20 @@ import Control.Monad import Text.JSON import Codec.Binary.UTF8.String (decodeString)-import Text.ParserCombinators.Parsec (Parser, parse, many, try, eof) -pMacros :: Parser [Macro]-pMacros = do- macros <- many (try $ pSkipSpaceComments >> pMacroDefinition)- pSkipSpaceComments >> eof- return macros- cgiMain :: CGI CGIResult cgiMain = do setHeader "Content-type" "text/xhtml; charset=UTF-8" latexFormula <- liftM (decodeString . fromMaybe "") $ getInput "latexFormula" rawMacros <- liftM (decodeString . fromMaybe "") $ getInput "macros"+ let (ms, _) = parseMacroDefinitions rawMacros output . encodeStrict $- case parse pMacros "macros" (rawMacros ++ "\n") of- Left err -> toJSObject [("success", JSBool False)- ,("error", JSString $ toJSString (show err))]- Right ms -> case texMathToMathML DisplayBlock- (applyMacros (reverse ms) latexFormula) of- Left e -> toJSObject [("success", JSBool False)- , ("error", JSString $ toJSString e)]- Right v -> toJSObject [("success", JSBool True)- , ("mathml", JSString $ toJSString $- ppElement v)]+ case texMathToMathML DisplayBlock (applyMacros (reverse ms) latexFormula) of+ Left e -> toJSObject [("success", JSBool False)+ , ("error", JSString $ toJSString e)]+ Right v -> toJSObject [("success", JSBool True)+ , ("mathml", JSString $ toJSString $+ ppElement v)] main :: IO () main = runCGI $ handleErrors cgiMain
texmath.cabal view
@@ -1,5 +1,5 @@ Name: texmath-Version: 0.4+Version: 0.5 Cabal-version: >= 1.2 Build-type: Custom Synopsis: Conversion of LaTeX math formulas to MathML.@@ -73,8 +73,9 @@ else Build-depends: base >= 3 && < 4 Exposed-modules: Text.TeXMath+ Text.TeXMath.Types Text.TeXMath.Parser- Text.TeXMath.MathMLWriter+ Text.TeXMath.MathML Text.TeXMath.Macros if impl(ghc >= 6.12)
texmath.hs view
@@ -3,7 +3,6 @@ import Text.TeXMath import Text.XML.Light import Text.TeXMath.Macros-import Text.ParserCombinators.Parsec import System.IO inHtml :: Element -> Element@@ -16,18 +15,10 @@ unode "meta" () , unode "body" x ] -stripMacroDefs :: Parser ([Macro], String)-stripMacroDefs = do- macros <- many (try $ pSkipSpaceComments >> pMacroDefinition)- rest <- getInput- return (reverse macros, rest) -- reversed so later ones will shadow earlier- main :: IO () main = do inp <- getContents- case parse stripMacroDefs "stdin" inp of- Left err -> error $ show err- Right (ms, rest)->- case (texMathToMathML DisplayBlock $! applyMacros ms rest) of- Left err -> hPutStrLn stderr err- Right v -> putStr . ppTopElement . inHtml $ v+ let (ms, rest) = parseMacroDefinitions inp+ case (texMathToMathML DisplayBlock $! applyMacros ms rest) of+ Left err -> hPutStrLn stderr err+ Right v -> putStr . ppTopElement . inHtml $ v