packages feed

texmath 0.11.3 → 0.12

raw patch · 22 files changed

+638/−535 lines, 22 filesdep −splitdep ~pandoc-types

Dependencies removed: split

Dependency ranges changed: pandoc-types

Files

changelog view
@@ -1,3 +1,11 @@+texmath (0.12)++  * Use Text instead of String in data types and functions+    (Christian Despres) [API change].  Note that there are still a few+    places where we unpack Text to String with a view pattern:+    performance could likely be increased with further rewriting.+  * Avoid use of !! with negative index (jgm/pandoc#5853).+ texmath (0.11.3)    * Use error instead of fail to allow building with ghc 8.8.
extra/texmath.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+ module Main where  import Text.TeXMath@@ -6,20 +8,22 @@ import Text.XML.Light import System.IO import System.Environment-import Control.Applicative import System.Console.GetOpt-import Data.List (intersperse) import System.Exit import Data.Maybe import Text.Pandoc.Definition import Network.URI (unEscapeString)-import Data.List.Split (splitOn) import Data.Aeson (encode, (.=), object)+import Data.Semigroup ((<>)) import qualified Data.ByteString.Lazy as B import qualified Data.Text as T+import qualified Data.Text.IO as T import Data.Version ( showVersion ) import Paths_texmath (version) +tshow :: Show a => a -> T.Text+tshow = T.pack . show+ inHtml :: Element -> Element inHtml e =   add_attr (Attr (unqual "xmlns") "http://www.w3.org/1999/xhtml") $@@ -30,28 +34,28 @@         unode "meta" ()     , unode "body" e ] -type Reader = String -> Either String [Exp]+type Reader = T.Text -> Either T.Text [Exp] data Writer = XMLWriter (DisplayType -> [Exp] -> Element)-            | StringWriter (DisplayType -> [Exp] -> String)+            | StringWriter (DisplayType -> [Exp] -> T.Text)             | PandocWriter (DisplayType -> [Exp] -> Maybe [Inline]) -readers :: [(String, Reader)]+readers :: [(T.Text, Reader)] readers = [     ("tex", readTeX)   , ("mathml", readMathML)   , ("omml", readOMML)   , ("native", readNative)] -readNative :: String -> Either String [Exp]+readNative :: T.Text -> Either T.Text [Exp] readNative s =-  case reads s of+  case reads (T.unpack s) of        ((exps, ws):_) | all isSpace ws -> Right exps        ((_, (_:_)):_) -> Left "Could not read whole input as native Exp"        _ -> Left "Could not read input as native Exp" -writers :: [(String, Writer)]+writers :: [(T.Text, Writer)] writers = [-    ("native", StringWriter (\_ es -> show es) )+    ("native", StringWriter (\_ es -> tshow es) )   , ("tex", StringWriter (\_ -> writeTeX))   , ("eqn", StringWriter writeEqn)   , ("omml",  XMLWriter writeOMML)@@ -61,8 +65,8 @@  data Options = Options {     optDisplay :: DisplayType-  , optIn :: String-  , optOut :: String }+  , optIn :: T.Text+  , optOut :: T.Text }  def :: Options def = Options DisplayBlock "tex" "mathml"@@ -73,48 +77,50 @@       (NoArg (\opts -> return opts {optDisplay = DisplayInline}))       "Use the inline display style"   , Option "f" ["from"]-      (ReqArg (\s opts -> return opts {optIn = s}) "FORMAT")-      ("Input format: " ++ (concat $ intersperse ", " (map fst readers)))+      (ReqArg (\s opts -> return opts {optIn = T.pack s}) "FORMAT")+      ("Input format: " <> T.unpack (T.intercalate ", " (map fst readers)))   , Option "t" ["to"]-      (ReqArg (\s opts -> return opts {optOut = s}) "FORMAT")-      ("Output format: " ++ (concat $ intersperse ", " (map fst writers)))+      (ReqArg (\s opts -> return opts {optOut = T.pack s}) "FORMAT")+      ("Output format: " <> T.unpack (T.intercalate ", " (map fst writers)))    , Option "v" ["version"]       (NoArg (\_ -> do-                      hPutStrLn stderr $ "Version " ++ showVersion version+                      hPutStrLn stderr $ "Version " <> showVersion version                       exitWith ExitSuccess))       "Print version"      , Option "h" ["help"]         (NoArg (\_ -> do                         prg <- getProgName-                        hPutStrLn stderr (usageInfo (prg ++ " [OPTIONS] [FILE*]") options)+                        hPutStrLn stderr (usageInfo (prg <> " [OPTIONS] [FILE*]") options)                         exitWith ExitSuccess))       "Show help"   ] -output :: DisplayType -> Writer -> [Exp] -> String-output dt (XMLWriter w) es    = output dt (StringWriter (\dt' -> ppElement . w dt' )) es+output :: DisplayType -> Writer -> [Exp] -> T.Text+output dt (XMLWriter w) es    = output dt (StringWriter (\dt' -> T.pack . ppElement . w dt' )) es output dt (StringWriter w) es = w dt es-output dt (PandocWriter w) es = show (fromMaybe fallback (w dt es))-  where fallback = [Math mt (writeTeX es)]+output dt (PandocWriter w) es = tshow (fromMaybe fallback (w dt es))+  where fallback = [Math mt $ writeTeX es]         mt = case dt of                   DisplayBlock  -> DisplayMath                   DisplayInline -> InlineMath -err :: Bool -> Int -> String -> IO a+err :: Bool -> Int -> T.Text -> IO a err cgi code msg = do   if cgi      then B.putStr $ encode $ object [T.pack "error" .= msg]-     else hPutStrLn stderr msg+     else T.hPutStrLn stderr msg   exitWith $ ExitFailure code -ensureFinalNewline :: String -> String-ensureFinalNewline "" = ""-ensureFinalNewline xs = if last xs == '\n' then xs else xs ++ "\n"+ensureFinalNewline :: T.Text -> T.Text+ensureFinalNewline xs = case T.unsnoc xs of+  Nothing        -> xs+  Just (_, '\n') -> xs+  _              -> xs <> "\n" -urlUnencode :: String -> String-urlUnencode = unEscapeString . plusToSpace-  where plusToSpace ('+':xs) = "%20" ++ plusToSpace xs+urlUnencode :: T.Text -> T.Text+urlUnencode = T.pack . unEscapeString . plusToSpace . T.unpack+  where plusToSpace ('+':xs) = "%20" <> plusToSpace xs         plusToSpace (x:xs)   = x : plusToSpace xs         plusToSpace []       = [] @@ -132,8 +138,8 @@   let (actions, files, _) = getOpt RequireOrder options args   opts <- foldl (>>=) (return def) actions   inp <- case files of-              [] -> getContents-              _  -> concat <$> mapM readFile files+              [] -> T.getContents+              _  -> T.concat <$> mapM T.readFile files   reader <- case lookup (optIn opts) readers of                   Just r -> return r                   Nothing -> err False 3 "Unrecognised reader"@@ -142,17 +148,18 @@                   Nothing -> err False 5 "Unrecognised writer"   case reader inp of         Left msg -> err False 1 msg-        Right v  -> putStr $ ensureFinalNewline-                           $ output (optDisplay opts) writer v+        Right v  -> T.putStr $ ensureFinalNewline+                             $ output (optDisplay opts) writer v   exitWith ExitSuccess  runCGI :: IO () runCGI = do-  query <- getContents-  let topairs xs = case break (=='=') xs of-                        (ys,('=':zs)) -> (urlUnencode ys, urlUnencode zs)-                        (ys,_)        -> (urlUnencode ys,"")-  let pairs = map topairs $ splitOn "&" query+  query <- T.getContents+  let topairs xs = case T.break (=='=') xs of+                     (ys, zs) -> case T.uncons zs of+                       Just ('=', zs') -> (urlUnencode ys, urlUnencode zs')+                       _               -> (urlUnencode ys, "")+  let pairs = map topairs $ T.split (== '&') query   inp <- case lookup "input" pairs of                  Just x  -> return x                  Nothing -> err True 3 "Query missing 'input'"
src/Text/TeXMath.hs view
@@ -24,9 +24,10 @@ A typical use is to combine together a reader and writer.  > import Control.Applicative ((<$>))+> import Data.Text (Text) > import Text.TeXMath (writeMathML, readTeX) >-> texMathToMathML :: DisplayType -> String -> Either String Element+> texMathToMathML :: DisplayType -> Text -> Either Text Element > texMathToMathML dt s = writeMathML dt <$> readTeX s  It is also possible to manipulate the AST using 'Data.Generics'. For@@ -34,20 +35,24 @@ x in your expression, you do could do so with the following script. -> import Control.Applicative ((<$>))-> import Data.Generics (everywhere, mkT)-> import Text.TeXMath (writeMathML, readTeX)-> import Text.TeXMath.Types-> import Text.XML.Light (Element)->-> changeIdent :: Exp -> Exp-> changeIdent (EIdentifier "x") = EIdentifier "y"-> changeIdent e = e->-> texToMMLWithChangeIdent :: DisplayType -> String -> Either String Element-> texToMMLWithChangeIdent dt s =->   writeMathML dt . everywhere (mkT changeIdent) <$> readTeX s+@+&#x7b;-\# LANGUAGE OverloadedStrings -\#&#x7d; +import Control.Applicative ((\<$\>))+import Data.Text (Text)+import Data.Generics (everywhere, mkT)+import Text.TeXMath (writeMathML, readTeX)+import Text.TeXMath.Types+import Text.XML.Light (Element)++changeIdent :: Exp -> Exp+changeIdent (EIdentifier "x") = EIdentifier "y"+changeIdent e = e++texToMMLWithChangeIdent :: DisplayType -> Text -> Either Text Element+texToMMLWithChangeIdent dt s =+  writeMathML dt . everywhere (mkT changeIdent) \<$\> readTeX s+@ -}  module Text.TeXMath ( readMathML,
src/Text/TeXMath/Readers/MathML.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE OverloadedStrings #-} {- Copyright (C) 2014 Matthew Pickering <matthewtpickering@gmail.com> @@ -50,13 +51,15 @@ import Control.Arrow ((&&&)) import Data.Maybe (fromMaybe, listToMaybe, isJust) import Data.Monoid (mconcat, First(..), getFirst)+import Data.Semigroup ((<>)) import Data.List (transpose)+import qualified Data.Text as T import Control.Monad (filterM, guard) import Control.Monad.Reader (ReaderT, runReaderT, asks, local) import Data.Either (rights)  -- | Parse a MathML expression to a list of 'Exp'.-readMathML :: String -> Either String [Exp]+readMathML :: T.Text -> Either T.Text [Exp] readMathML inp = map fixTree <$>   (runExcept (flip runReaderT defaultState (i >>= parseMathML)))   where@@ -67,11 +70,11 @@                          , inAccent :: Bool                          , curStyle :: TextType } -type MML = ReaderT MMLState (Except String)+type MML = ReaderT MMLState (Except T.Text)  data SupOrSub = Sub | Sup deriving (Show, Eq) -data IR a = Stretchy TeXSymbolType (String -> Exp) String+data IR a = Stretchy TeXSymbolType (T.Text -> Exp) T.Text           | Trailing (Exp -> Exp -> Exp) Exp           | E a @@ -122,7 +125,7 @@     "semantics" -> mkE <$> semantics e     "maligngroup" -> return $ mkE empty     "malignmark" -> return $ mkE empty-    _ -> throwError $ "Unexpected element " ++ err e+    _ -> throwError $ "Unexpected element " <> err e   where     mkE :: Exp -> [IR Exp]     mkE = (:[]) . E@@ -163,11 +166,11 @@   let objectPosition = getPosition $ form opDict   inScript <- asks inAccent   let ts =  [("accent", ESymbol Accent), ("fence", ESymbol objectPosition)]-  let fallback = case opString of-                      [t] -> ESymbol (getSymbolType t)-                      _   -> if isJust opLookup-                                then ESymbol Ord-                                else EMathOperator+  let fallback = case T.unpack opString of+                   [t] -> ESymbol (getSymbolType t)+                   _   -> if isJust opLookup+                          then ESymbol Ord+                          else EMathOperator   let constructor =         fromMaybe fallback           (getFirst . mconcat $ map (First . flip lookup ts) props)@@ -176,7 +179,7 @@     else do       return $ (E . constructor) opString   where-    checkAttr ps v = maybe (v `elem` ps) (=="true") <$> findAttrQ v e+    checkAttr ps v = maybe (v `elem` ps) (=="true") <$> findAttrQ (T.unpack v) e  text :: Element -> MML Exp text e = do@@ -185,7 +188,7 @@   s <- getString e   -- mathml seems to use mtext for spacing often; we get   -- more idiomatic math if we replace these with ESpace:-  return $ case (textStyle, s) of+  return $ case (textStyle, T.unpack s) of        (TextNormal, [c]) ->          case getSpaceWidth c of               Just w  -> ESpace w@@ -199,7 +202,7 @@   textStyle <- maybe TextNormal getTextType                 <$> (findAttrQ "mathvariant" e)   s <- getString e-  return $ EText textStyle (lquote ++ s ++ rquote)+  return $ EText textStyle $ lquote <> s <> rquote  space :: Element -> MML Exp space e = do@@ -267,7 +270,7 @@  -- If at the end of a delimiter we need to apply the script to the whole -- expression. We only insert Trailing when reordering Stretchy-trailingSup :: Maybe (String, String -> Exp)  -> Maybe (String, String -> Exp)  -> [IR InEDelimited] -> Exp+trailingSup :: Maybe (T.Text, T.Text -> Exp)  -> Maybe (T.Text, T.Text -> Exp)  -> [IR InEDelimited] -> Exp trailingSup open close es = go es   where     go [] = case (open, close) of@@ -376,13 +379,13 @@         case sep of           "" -> elChildren e           _  ->-            let seps = map (\x -> unode "mo" [x]) sep+            let seps = map (\x -> unode "mo" [x]) $ T.unpack sep                 sepsList = seps ++ repeat (last seps) in                 fInterleave (elChildren e) (sepsList)   safeExpr $ unode "mrow"-              ([unode "mo" open | not $ null open] +++              ([tunode "mo" open | not $ T.null open] ++                [unode "mrow" expanded] ++-               [unode "mo" close | not $ null close])+               [tunode "mo" close | not $ T.null close])  -- This could approximate the variants enclosed :: Element -> MML Exp@@ -394,7 +397,7 @@  action :: Element -> MML Exp action e = do-  selection <-  maybe 1 read <$> (findAttrQ "selection" e)  -- 1-indexing+  selection <-  maybe 1 (read . T.unpack) <$> (findAttrQ "selection" e)  -- 1-indexing   safeExpr =<< maybeToEither ("Selection out of range")             (listToMaybe $ drop (selection - 1) (elChildren e)) @@ -487,14 +490,14 @@   case name e of     "mtr" -> mapM (tableCell align) (elChildren e)     "mlabeledtr" -> mapM (tableCell align) (tail $ elChildren e)-    _ -> throwError $ "Invalid Element: Only expecting mtr elements " ++ err e+    _ -> throwError $ "Invalid Element: Only expecting mtr elements " <> err e  tableCell :: Alignment -> Element -> MML (Alignment, [Exp]) tableCell a e = do   align <- maybe a toAlignment <$> (findAttrQ "columnalign" e)   case name e of     "mtd" -> (,) align . (:[]) <$> row e-    _ -> throwError $ "Invalid Element: Only expecting mtd elements " ++ err e+    _ -> throwError $ "Invalid Element: Only expecting mtd elements " <> err e  -- Fixup @@ -540,10 +543,10 @@  -- Utility -getString :: Element -> MML String+getString :: Element -> MML T.Text getString e = do   tt <- asks curStyle-  return $ fromUnicode tt $ stripSpaces $ concatMap cdData+  return $ fromUnicode tt $ stripSpaces $ T.pack $ concatMap cdData          $ onlyText $ elContent $ e  -- Finds only text data and replaces entity references with corresponding@@ -551,42 +554,49 @@ onlyText :: [Content] -> [CData] onlyText [] = [] onlyText ((Text c):xs) = c : onlyText xs-onlyText (CRef s : xs)  = (CData CDataText (fromMaybe s $ getUnicode s) Nothing) : onlyText xs+onlyText (CRef s : xs)  = (CData CDataText (fromMaybe s $ getUnicode' s) Nothing) : onlyText xs+  where getUnicode' = fmap T.unpack . getUnicode . T.pack onlyText (_:xs) = onlyText xs  checkArgs2 :: Element -> MML (Element, Element) checkArgs2 e = case elChildren e of   [a, b] -> return (a, b)-  _      -> throwError ("Incorrect number of arguments for " ++ err e)+  _      -> throwError ("Incorrect number of arguments for " <> err e)  checkArgs3 :: Element -> MML (Element, Element, Element) checkArgs3 e = case elChildren e of   [a, b, c] -> return (a, b, c)-  _         -> throwError ("Incorrect number of arguments for " ++ err e)+  _         -> throwError ("Incorrect number of arguments for " <> err e)  mapPairM :: Monad m => (a -> m b) -> (a, a) -> m (b, b) mapPairM f (a, b) = (,) <$> (f a) <*> (f b) -err :: Element -> String-err e = name e ++ maybe "" (\x -> " line " ++ show x) (elLine e)+err :: Element -> T.Text+err e = name e <> maybe "" (\x -> " line " <> T.pack (show x)) (elLine e) -findAttrQ :: String -> Element -> MML (Maybe String)+-- Kept as String for Text.XML.Light+findAttrQ :: String -> Element -> MML (Maybe T.Text) findAttrQ s e = do   inherit <- asks (lookupAttrQ s . attrs)-  return $+  return $ fmap T.pack $     findAttr (QName s Nothing Nothing) e       <|> inherit +-- Kept as String for Text.XML.Light lookupAttrQ :: String -> [Attr] -> Maybe String lookupAttrQ s = lookupAttr (QName s Nothing Nothing) -name :: Element -> String-name (elName -> (QName n _ _)) = n+name :: Element -> T.Text+name (elName -> (QName n _ _)) = T.pack n -stripSpaces :: String -> String-stripSpaces = reverse . (dropWhile isSpace) . reverse . (dropWhile isSpace)+-- Kept as String for Text.XML.Light+tunode :: String -> T.Text -> Element+tunode s = unode s . T.unpack -toAlignment :: String -> Alignment+stripSpaces :: T.Text -> T.Text+stripSpaces = T.dropAround isSpace++toAlignment :: T.Text -> Alignment toAlignment "left" = AlignLeft toAlignment "center" = AlignCenter toAlignment "right" = AlignRight@@ -597,7 +607,7 @@ getPosition (FPostfix) = Close getPosition (FInfix) = Op -getFormType :: Maybe String -> Maybe FormType+getFormType :: Maybe T.Text -> Maybe FormType getFormType (Just "infix") = (Just FInfix) getFormType (Just "prefix") = (Just FPrefix) getFormType (Just "postfix") = (Just FPostfix)@@ -614,7 +624,7 @@ isSpace '\n' = True isSpace _    = False -spacelikeElems, cSpacelikeElems :: [String]+spacelikeElems, cSpacelikeElems :: [T.Text] spacelikeElems = ["mtext", "mspace", "maligngroup", "malignmark"] cSpacelikeElems = ["mrow", "mstyle", "mphantom", "mpadded"] @@ -623,11 +633,11 @@   uid `elem` spacelikeElems || uid `elem` cSpacelikeElems &&     and (map spacelike (elChildren e)) -thicknessZero :: Maybe String -> Bool+thicknessZero :: Maybe T.Text -> Bool thicknessZero (Just s) = thicknessToNum s == 0.0 thicknessZero Nothing  = False -widthToNum :: String -> Rational+widthToNum :: T.Text -> Rational widthToNum s =   case s of        "veryverythinmathspace"  -> 1/18@@ -646,7 +656,7 @@        "negativeveryverythickmathspace" -> -7/18        _ -> fromMaybe 0 (readLength s) -thicknessToNum :: String -> Rational+thicknessToNum :: T.Text -> Rational thicknessToNum s =   case s of        "thin" -> (3/18)
src/Text/TeXMath/Readers/MathML/EntityMap.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {- Copyright (C) 2014 Matthew Pickering <matthewtpickering@gmail.com> @@ -33,12 +34,13 @@ module Text.TeXMath.Readers.MathML.EntityMap (getUnicode) where  import qualified Data.Map as M+import qualified Data.Text as T  -- | Translates MathML entity reference to the corresponding Unicode string.-getUnicode :: String -> Maybe String+getUnicode :: T.Text -> Maybe T.Text getUnicode = flip M.lookup entityList -entityList :: M.Map String String+entityList :: M.Map T.Text T.Text entityList = M.fromList   [ ("AElig","\198")   , ("AMP","&")
src/Text/TeXMath/Readers/MathML/MMLDict.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {- Copyright (C) 2014 Matthew Pickering <matthewtpickering@gmail.com> @@ -25,15 +26,16 @@  import Text.TeXMath.Types import qualified Data.Map as M+import qualified Data.Text as T import Data.Monoid (First(..), mconcat) -dict :: M.Map (String, FormType) Operator+dict :: M.Map (T.Text, FormType) Operator dict = M.fromList (map (\o -> ((oper o, form o), o)) operators)  -- | Tries to find the 'Operator' record based on a given position. If -- there is no exact match then the positions will be tried in the -- following order (Infix, Postfix, Prefix) with the first match (if any) being returned.-getMathMLOperator :: String -> FormType -> Maybe Operator+getMathMLOperator :: T.Text -> FormType -> Maybe Operator getMathMLOperator s p =   getFirst $ mconcat $ (map (\x -> First $ M.lookup (s, x) dict) lookupOrder)   where
src/Text/TeXMath/Readers/OMML.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE PatternGuards #-}+{-# LANGUAGE OverloadedStrings #-}  {- Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu>@@ -36,13 +37,14 @@ import Data.Maybe (isJust, mapMaybe, fromMaybe) import Data.List (intercalate) import Data.Char (isDigit, readLitChar)+import qualified Data.Text as T import Text.TeXMath.Types import Text.TeXMath.Shared (fixTree, getSpaceWidth, getOperator) import Text.TeXMath.Unicode.ToTeX (getSymbolType) import Control.Applicative ((<$>))-import Text.TeXMath.Unicode.Fonts (getUnicode, stringToFont)+import Text.TeXMath.Unicode.Fonts (getUnicode, textToFont) -readOMML :: String -> Either String [Exp]+readOMML :: T.Text -> Either T.Text [Exp] readOMML s | Just e <- parseXMLDoc s =   case elemToOMML e of     Just exs -> Right $ map fixTree $ unGroup exs@@ -71,6 +73,7 @@                                 Just "w" -> elChildren element                                 _        -> [element] +-- Kept as String because of Text.XML.Light isElem :: String -> String -> Element -> Bool isElem prefix name element =   let qp = fromMaybe "" (qPrefix (elName element))@@ -78,14 +81,15 @@    qName (elName element) == name &&    qp == prefix -hasElemName:: String -> String -> QName -> Bool+-- Kept as String because of Text.XML.Light+hasElemName :: String -> String -> QName -> Bool hasElemName prefix name qn =   let qp = fromMaybe "" (qPrefix qn)   in    qName qn == name &&    qp       == prefix -data OMathRunElem = TextRun String+data OMathRunElem = TextRun T.Text                   | LnBrk                   | Tab                     deriving Show@@ -128,8 +132,8 @@ -- text lines into multiple columns. That's tricky, though, and this -- will get us most of the way for the time being. filterAmpersand :: Exp -> Exp-filterAmpersand (EIdentifier s)   = EIdentifier (filter ('&' /=) s)-filterAmpersand (EText tt s)      = EText tt (filter ('&' /=) s)+filterAmpersand (EIdentifier s)   = EIdentifier (T.filter ('&' /=) s)+filterAmpersand (EText tt s)      = EText tt (T.filter ('&' /=) s) filterAmpersand (EStyled tt exps) = EStyled tt (map filterAmpersand exps) filterAmpersand (EGrouped exps)   = EGrouped (map filterAmpersand exps) filterAmpersand e                    = e@@ -171,7 +175,7 @@ elemToOMathRunElem element   | isElem "w" "t" element     || isElem "m" "t" element-    || isElem "w" "delText" element = Just $ TextRun $ strContent element+    || isElem "w" "delText" element = Just $ TextRun $ T.pack $ strContent element   | isElem "w" "br" element = Just LnBrk   | isElem "w" "tab" element = Just Tab   | isElem "w" "sym" element = Just $ TextRun $ getSymChar element@@ -186,13 +190,13 @@  ----- And now the TeXMath Creation -oMathRunElemToString :: OMathRunElem -> String-oMathRunElemToString (TextRun s) = s-oMathRunElemToString (LnBrk) = ['\n']-oMathRunElemToString (Tab) = ['\t']+oMathRunElemToText :: OMathRunElem -> T.Text+oMathRunElemToText (TextRun s) = s+oMathRunElemToText (LnBrk) = "\n"+oMathRunElemToText (Tab) = "\t" -oMathRunElemsToString :: [OMathRunElem] -> String-oMathRunElemsToString = concatMap oMathRunElemToString+oMathRunElemsToText :: [OMathRunElem] -> T.Text+oMathRunElemsToText = T.concat . map oMathRunElemToText  oMathRunTextStyleToTextType :: OMathRunTextStyle -> Maybe TextType oMathRunTextStyleToTextType (Normal) = Just $ TextNormal@@ -241,11 +245,11 @@             findAttrBy (hasElemName "m" "val") >>=             Just . head       chr' = case chr of-        Just c -> c-        Nothing -> '\x302'       -- default to wide hat.+        Just c -> T.singleton c+        Nothing -> "\x302"       -- default to wide hat.   baseExp <- filterChildName (hasElemName "m" "e") element >>=              elemToBase-  return $ [EOver False baseExp (ESymbol Accent [chr'])]+  return $ [EOver False baseExp (ESymbol Accent chr')] elemToExps' element | isElem "m" "bar" element = do   pos <- filterChildName (hasElemName "m" "barPr") element >>=             filterChildName (hasElemName "m" "pos") >>=@@ -282,12 +286,12 @@                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 = intercalate [Left [sep]] inDelimExps+      beg = maybe "(" T.singleton begChr+      end = maybe ")" T.singleton endChr+      sep = maybe "|" T.singleton sepChr+      exps = intercalate [Left sep] inDelimExps   in-   Just [EDelimited [beg] [end] exps]+   Just [EDelimited beg end exps] elemToExps' element | isElem "m" "eqArr" element =   let expLst = mapMaybe elemToBases (elChildren element)       expLst' = map (\es -> [map filterAmpersand es]) expLst@@ -320,16 +324,16 @@   case pos of     Just "top" ->       let chr' = case chr of-            Just (c:_) -> c-            _           -> '\65079'   -- default to overbrace+            Just (c:_) -> T.singleton c+            _           -> "\65079"   -- default to overbrace       in-       return [EOver False baseExp (ESymbol TOver [chr'])]+       return [EOver False baseExp (ESymbol TOver chr')]     Just "bot" ->       let chr' = case chr of-            Just (c:_) -> c-            _           -> '\65080'   -- default to underbrace+            Just (c:_) -> T.singleton c+            _           -> "\65080"   -- default to underbrace       in-       return [EUnder False baseExp (ESymbol TUnder [chr'])]+       return [EUnder False baseExp (ESymbol TUnder chr')]     _          -> Nothing elemToExps' element | isElem "m" "limLow" element = do   baseExp <- filterChildName (hasElemName "m" "e") element@@ -360,8 +364,8 @@                 filterChildName (hasElemName "m" "chr") >>=                 findAttrBy (hasElemName "m" "val")       opChr = case naryChr of-        Just (c:_) -> c-        _          -> '\8747'   -- default to integral+        Just (c:_) -> T.singleton c+        _          -> "\8747"   -- default to integral       limLoc = naryPr >>=                filterChildName (hasElemName "m" "limLoc") >>=                findAttrBy (hasElemName "m" "val")@@ -373,12 +377,12 @@              elemToBase   case limLoc of     Just "undOvr" -> return [EUnderover True-                              (ESymbol Op [opChr])+                              (ESymbol Op opChr)                               (EGrouped subExps)                               (EGrouped supExps)                             , baseExp]     _             -> return [ESubsup-                              (ESymbol Op [opChr])+                              (ESymbol Op opChr)                               (EGrouped subExps)                               (EGrouped supExps)                             , baseExp]@@ -437,30 +441,33 @@     if null lit && null nor        then case txtSty of               Nothing ->-                interpretString $ oMathRunElemsToString mrElems+                interpretText $ oMathRunElemsToText mrElems               Just textSty ->-                [EStyled textSty $ interpretString $ oMathRunElemsToString mrElems]-       else [EText (fromMaybe TextNormal txtSty) $ oMathRunElemsToString mrElems]+                [EStyled textSty $ interpretText $ oMathRunElemsToText mrElems]+       else [EText (fromMaybe TextNormal txtSty) $ oMathRunElemsToText mrElems] elemToExps' _ = Nothing  interpretChar :: Char -> Exp-interpretChar c | isDigit c = ENumber [c]+interpretChar c | isDigit c = ENumber $ T.singleton c interpretChar c = case getSymbolType c of-  Alpha           -> EIdentifier [c]-  Ord | isDigit c -> ENumber [c]+  Alpha           -> EIdentifier c'+  Ord | isDigit c -> ENumber c'       | otherwise -> case getSpaceWidth c of                            Just x  -> ESpace x-                           Nothing -> ESymbol Ord [c]-  symType         -> ESymbol symType [c]+                           Nothing -> ESymbol Ord c'+  symType         -> ESymbol symType c'+  where+    c' = T.singleton c -interpretString :: String -> [Exp]-interpretString [c]       = [interpretChar c]-interpretString s-  | all isDigit s         = [ENumber s]+interpretText :: T.Text -> [Exp]+interpretText s+  | Just (c, xs) <- T.uncons s+  , T.null xs = [interpretChar c]+  | T.all isDigit s         = [ENumber s]   | isJust (getOperator (EMathOperator s))                           = [EMathOperator s]   | otherwise             =-      case map interpretChar s of+      case map interpretChar (T.unpack s) of             xs | all isIdentifierOrSpace xs -> [EText TextNormal s]                | otherwise                  -> xs   where isIdentifierOrSpace (EIdentifier _) = True@@ -468,15 +475,15 @@         isIdentifierOrSpace _               = False  -- The char attribute is a hex string-getSymChar :: Element -> String+getSymChar :: Element -> T.Text getSymChar element   | Just s <- lowerFromPrivate <$> getCodepoint   , Just font <- getFont =   let [(char, _)] = readLitChar ("\\x" ++ s) in-    maybe "" (:[]) $ getUnicode font char+    maybe "" T.singleton $ getUnicode font char   where     getCodepoint = findAttrBy (hasElemName "w" "char") element-    getFont = stringToFont =<< findAttrBy (hasElemName "w" "font") element+    getFont = (textToFont . T.pack) =<< findAttrBy (hasElemName "w" "font") element     lowerFromPrivate ('F':xs) = '0':xs     lowerFromPrivate xs = xs getSymChar _ = ""
src/Text/TeXMath/Readers/TeX.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} {- Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu> @@ -24,16 +25,19 @@ module Text.TeXMath.Readers.TeX (readTeX) where -import Data.List (intercalate)+import Data.List (intercalate, find) import Data.Ratio ((%)) import Control.Monad import Data.Char (isDigit, isAscii, isLetter) import qualified Data.Map as M+import qualified Data.Text as T import Data.Maybe (mapMaybe)+import Data.Semigroup ((<>)) import Text.Parsec hiding (label) import Text.Parsec.Error-import Text.Parsec.String+import Text.Parsec.Text import Text.TeXMath.Types+import Data.Functor (($>)) import Control.Applicative ((<*), (*>), (<*>), (<$>), (<$), pure) import qualified Text.TeXMath.Shared as S import Text.TeXMath.Readers.TeX.Macros (applyMacros, parseMacroDefinitions)@@ -72,32 +76,32 @@           ] <* ignorable  -- | Parse a formula, returning a list of 'Exp'.-readTeX :: String -> Either String [Exp]+readTeX :: T.Text -> Either T.Text [Exp] readTeX inp =   let (ms, rest) = parseMacroDefinitions inp in   either (Left . showParseError inp) (Right . id)-    $ parse formula "formula" (applyMacros ms rest)+    $ parse formula "formula" $ applyMacros ms rest -showParseError :: String -> ParseError -> String+showParseError :: T.Text -> ParseError -> T.Text showParseError inp pe =-  snippet ++ "\n" ++ caretline ++-    showErrorMessages "or" "unknown" "expecting" "unexpected" "eof"-       (errorMessages pe)+  snippet <> "\n" <> caretline <>+    T.pack (showErrorMessages "or" "unknown" "expecting" "unexpected" "eof"+            (errorMessages pe))   where errln = sourceLine (errorPos pe)         errcol = sourceColumn (errorPos pe)         snipoffset = max 0 (errcol - 20)-        inplns = lines inp+        inplns = T.lines inp         ln = if length inplns >= errln                 then inplns !! (errln - 1)                 else ""  -- should not happen-        snippet = take 40 $ drop snipoffset ln-        caretline = replicate (errcol - snipoffset - 1) ' ' ++ "^"+        snippet = T.take 40 $ T.drop snipoffset ln+        caretline = T.replicate (errcol - snipoffset - 1) " " <> "^" -anyCtrlSeq :: TP String+anyCtrlSeq :: TP T.Text anyCtrlSeq = lexeme $ try $ do   char '\\'   res <- count 1 (satisfy (not . isLetter)) <|> many1 (satisfy isLetter)-  return $ '\\' : res+  return $ T.pack $ '\\' : res  ctrlseq :: String -> TP String ctrlseq s = lexeme $ try $ do@@ -157,9 +161,9 @@  -- | Converts identifiers, symbols and numbers to a flat string. -- Returns Nothing if the expression contains anything else.-expToOperatorName :: Exp -> Maybe String+expToOperatorName :: Exp -> Maybe T.Text expToOperatorName e = case e of-            EGrouped xs ->  concat <$> mapM fl xs+            EGrouped xs -> T.concat <$> mapM fl xs             _ -> fl e     where fl f = case f of                     EIdentifier s -> Just s@@ -172,7 +176,7 @@                     ESymbol _ "\x02B9" -> Just "'"                     ESymbol _ s -> Just s                     ENumber s -> Just s-                    EStyled sty xs -> concat <$> sequence (map (toStr sty) xs)+                    EStyled sty xs -> T.concat <$> sequence (map (toStr sty) xs)                     _ -> Nothing           toStr sty (EIdentifier s)     = Just $ toUnicode sty s           toStr _   (EText sty' s)      = Just $ toUnicode sty' s@@ -180,7 +184,7 @@           toStr sty (EMathOperator s)   = Just $ toUnicode sty s           toStr sty (ESymbol _ s)       = Just $ toUnicode sty s           toStr _   (ESpace n)          = Just $ getSpaceChars n-          toStr _   (EStyled sty' exps) = concat <$>+          toStr _   (EStyled sty' exps) = T.concat <$>                                             sequence (map (toStr sty') exps)           toStr _   _                   = Nothing @@ -194,10 +198,10 @@   <|> (ctrlseq "nolimits" >> return (Just False))   <|> return Nothing -binomCmd :: TP String+binomCmd :: TP T.Text binomCmd = oneOfCommands (M.keys binomCmds) -binomCmds :: M.Map String (Exp -> Exp -> Exp)+binomCmds :: M.Map T.Text (Exp -> Exp -> Exp) binomCmds = M.fromList             [ ("\\choose", \x y ->                 EDelimited "(" ")" [Right (EFraction NoLineFrac x y)])@@ -222,7 +226,9 @@                       (False, _)   -> NoLineFrac                       (True, True) -> DisplayFrac                       _            -> NormalFrac-  return $ EDelimited [openDelim] [closeDelim] [Right (EFraction fracType x y)]+  return $ EDelimited (T.singleton openDelim)+                      (T.singleton closeDelim)+                      [Right (EFraction fracType x y)]  substack :: TP Exp substack = do@@ -240,12 +246,12 @@   initial <- if requireNonempty                 then many1 (notFollowedBy binomCmd >> p)                 else many (notFollowedBy binomCmd >> p)-  let withCmd :: String -> TP Exp+  let withCmd :: T.Text -> TP Exp       withCmd cmd =          case M.lookup cmd binomCmds of               Just f  -> f <$> (asGroup <$> pure initial)                            <*> (asGroup <$> many p)-              Nothing -> fail $ "Unknown command " ++ cmd+              Nothing -> fail $ "Unknown command " <> T.unpack cmd   (binomCmd >>= withCmd) <|> return (asGroup initial)  manyExp :: TP Exp -> TP Exp@@ -264,9 +270,7 @@ texChar =   do     c <- noneOf "\n\t\r \\{}" <* spaces-    return $ if isDigit c-              then ENumber [c]-              else EIdentifier [c]+    return $ (if isDigit c then ENumber else EIdentifier) $ T.singleton c  inbrackets :: TP Exp inbrackets = (brackets $ manyExp $ notFollowedBy (char ']') >> expr)@@ -278,19 +282,19 @@           ys <- option [] $ try (char '.' >> (('.':) <$> many1 digit))           case xs ++ ys of                []  -> mzero-               zs  -> return zs+               zs  -> return $ T.pack zs  enclosure :: TP Exp enclosure = basicEnclosure <|> delimited  basicEnclosure :: TP Exp basicEnclosure = try $ do-  possibleEncl <- lexeme (anyCtrlSeq <|> count 1 (oneOf "()[]|"))+  possibleEncl <- lexeme (anyCtrlSeq <|> countChar 1 (oneOf "()[]|"))   case M.lookup possibleEncl enclosures of        Just x  -> return x        Nothing -> mzero -fence :: String -> TP String+fence :: String -> TP T.Text fence cmd = do   symbol cmd   enc <- basicEnclosure <|> (try (symbol ".") >> return (ESymbol Open ""))@@ -299,17 +303,17 @@        ESymbol Close x -> return x        _ -> mzero -middle :: TP String+middle :: TP T.Text middle = fence "\\middle" -right :: TP String+right :: TP T.Text right = fence "\\right"  delimited :: TP Exp delimited = do   openc <- try $ fence "\\left"   contents <- concat <$>-              many (try $ ((:[]) . Left <$> middle)+              many (try $ ((:[]) . Left  <$> middle)                       <|> (map Right . unGrouped <$>                              many1Exp (notFollowedBy right *> expr)))   closec <- right <|> return ""@@ -319,7 +323,7 @@ scaled = do   cmd <- oneOfCommands (map fst S.scalers)   case S.getScalerValue cmd of-       Just  r -> EScaled r <$> (basicEnclosure <|> operator)+       Just r  -> EScaled r <$> (basicEnclosure <|> operator)        Nothing -> mzero  endLine :: TP Char@@ -367,12 +371,12 @@           result <- env           spaces           ctrlseq "end"-          braces (string name <* optional (char '*'))+          braces (textStr name <* optional (char '*'))           spaces           return result         Nothing  -> mzero  -- should not happen -environments :: M.Map String (TP Exp)+environments :: M.Map T.Text (TP Exp) environments = M.fromList   [ ("array", stdarray)   , ("eqnarray", eqnarray)@@ -401,11 +405,11 @@ alignsFromRows _ [] = [] alignsFromRows defaultAlignment (r:_) = replicate (length r) defaultAlignment -matrixWith :: String -> String -> TP Exp+matrixWith :: T.Text -> T.Text -> TP Exp matrixWith opendelim closedelim = do   lines' <- sepEndBy1 arrayLine endLineAMS   let aligns = alignsFromRows AlignCenter lines'-  return $ if null opendelim && null closedelim+  return $ if T.null opendelim && T.null closedelim               then EArray aligns lines'               else EDelimited opendelim closedelim                        [Right $ EArray aligns lines']@@ -453,7 +457,7 @@ variable = do   v <- letter   spaces-  return $ EIdentifier [v]+  return $ EIdentifier $ T.singleton v  isConvertible :: Exp -> Bool isConvertible (EMathOperator x) = x `elem` convertibleOps@@ -514,13 +518,13 @@ unicode = lexeme $   do     c <- satisfy (not . isAscii)-    return (ESymbol (getSymbolType c) [c])+    return (ESymbol (getSymbolType c) $ T.singleton c)  ensuremath :: TP Exp ensuremath = ctrlseq "ensuremath" *> inbraces  -- Note: cal and scr are treated the same way, as unicode is lacking such two different sets for those.-styleOps :: M.Map String ([Exp] -> Exp)+styleOps :: M.Map T.Text ([Exp] -> Exp) styleOps = M.fromList           [ ("\\mathrm",     EStyled TextNormal)           , ("\\mathup",     EStyled TextNormal)@@ -561,7 +565,7 @@   c <- oneOfCommands (M.keys textOps)   op <- maybe mzero return $ M.lookup c textOps   char '{'-  let chunk = ((op . concat) <$> many1 textual)+  let chunk = ((op . T.concat) <$> many1 textual)             <|> (char '{' *> (asGroup <$> manyTill chunk (char '}')))             <|> innermath   contents <- manyTill chunk (char '}')@@ -582,7 +586,7 @@   string closer   return e -textOps :: M.Map String (String -> Exp)+textOps :: M.Map T.Text (T.Text -> Exp) textOps = M.fromList           [ ("\\textrm", (EText TextNormal))           , ("\\text",   (EText TextNormal))@@ -658,7 +662,7 @@      [EText TextNormal x] -> return $ ESymbol ty x      [EText sty x] -> return $ EStyled sty [ESymbol ty x]      xs | ty == Op  -> return $ EMathOperator $-                         concat $ mapMaybe expToOperatorName xs+                         T.concat $ mapMaybe expToOperatorName xs         | otherwise -> return $ EGrouped xs  binary :: TP Exp@@ -685,36 +689,38 @@   sym <- operator <|> tSymbol   if negated then neg sym else return sym -oneOfCommands :: [String] -> TP String+oneOfCommands :: [T.Text] -> TP T.Text oneOfCommands cmds = try $ do   cmd <- oneOfStrings cmds-  case cmd of+  case T.unpack cmd of     ['\\',c] | not (isLetter c) -> return ()-    _ -> (do pos <- getPosition-             letter-             setPosition pos-             mzero <?> ("non-letter after " ++ cmd))+    cmd' -> (do pos <- getPosition+                letter+                setPosition pos+                mzero <?> ("non-letter after " <> cmd'))          <|> return ()   spaces   return cmd -oneOfStrings' :: (Char -> Char -> Bool) -> [String] -> TP String-oneOfStrings' _ []         = mzero+oneOfStrings' :: (Char -> Char -> Bool) -> [(String, T.Text)] -> TP T.Text+oneOfStrings' _ [] = mzero oneOfStrings' matches strs = try $ do     c <- anyChar-    let strs' = [xs | (x:xs) <- strs, x `matches` c]+    let strs' = [(xs, t) | ((x:xs), t) <- strs, x `matches` c]     case strs' of       []  -> mzero-      _   -> (c:) <$> oneOfStrings' matches strs'-                     <|> if "" `elem` strs'-                          then return [c]-                          else mzero+      _   -> oneOfStrings' matches strs'+             <|> case find (null . fst) strs' of+                   Just (_, t) -> return t+                   Nothing     -> mzero  -- | Parses one of a list of strings.  If the list contains -- two strings one of which is a prefix of the other, the longer -- string will be matched if possible.-oneOfStrings :: [String] -> TP String-oneOfStrings strs = oneOfStrings' (==) strs <??> (intercalate ", " $ map show strs)+oneOfStrings :: [T.Text] -> TP T.Text+oneOfStrings strs = oneOfStrings' (==) strs' <??> (intercalate ", " $ map show strs)+  where+    strs' = map (\x -> (T.unpack x, x)) strs  -- | Like '(<?>)', but moves position back to the beginning of the parse -- before reporting the error.@@ -763,11 +769,16 @@ brackets :: TP a -> TP a brackets p = lexeme $ char '[' *> spaces *> p <* spaces <* char ']' +textStr :: T.Text -> TP T.Text+textStr t = string (T.unpack t) $> t +countChar :: Int -> TP Char -> TP T.Text+countChar n = fmap T.pack . count n+ symbol :: String -> TP String symbol s = lexeme $ try $ string s -enclosures :: M.Map String Exp+enclosures :: M.Map T.Text Exp enclosures = M.fromList   [ ("(", ESymbol Open "(")   , (")", ESymbol Close ")")@@ -801,7 +812,7 @@   , ("\\urcorner", ESymbol Close "\x231D")   ] -operators :: M.Map String Exp+operators :: M.Map T.Text Exp operators = M.fromList [              ("+", ESymbol Bin "+")            , ("-", ESymbol Bin "\x2212")@@ -824,7 +835,7 @@            , ("/", ESymbol Ord "/")            , ("~", ESpace (4/18)) ] -symbols :: M.Map String Exp+symbols :: M.Map T.Text Exp symbols = M.fromList   [ ("\\$",ESymbol Ord "$")   , ("\\%",ESymbol Ord "%")@@ -3751,39 +3762,39 @@  -- text mode parsing -textual :: TP String+textual :: TP T.Text textual = regular <|> sps <|> ligature <|> textCommand             <?> "text" -sps :: TP String+sps :: TP T.Text sps = " " <$ skipMany1 (oneOf " \t\n") -regular :: TP String-regular = many1 (noneOf "`'-~${}\\ \t")+regular :: TP T.Text+regular = T.pack <$> many1 (noneOf "`'-~${}\\ \t") -ligature :: TP String+ligature :: TP T.Text ligature = try ("\x2014" <$ string "---")        <|> try ("\x2013" <$ string "--")-       <|> try (string "-")+       <|> try (textStr "-")        <|> try ("\x201C" <$ string "``")        <|> try ("\x201D" <$ string "''")        <|> try ("\x2019" <$ string "'")        <|> try ("\x2018" <$ string "`")        <|> try ("\xA0"   <$ string "~") -textCommand :: TP String+textCommand :: TP T.Text textCommand = do   cmd <- oneOfCommands (M.keys textCommands)   optional $ try (char '{' >> spaces >> char '}')   case M.lookup cmd textCommands of-       Nothing -> fail ("Unknown control sequence " ++ cmd)+       Nothing -> fail $ T.unpack $ "Unknown control sequence " <> cmd        Just c  -> c  tok :: TP Char tok = (try $ char '{' *> spaces *> anyChar <* spaces <* char '}')    <|> anyChar -textCommands :: M.Map String (TP String)+textCommands :: M.Map T.Text (TP T.Text) textCommands = M.fromList   [ ("\\#", return "#")   , ("\\$", return "$")@@ -3821,12 +3832,12 @@   , ("\\ ", return " ")   ] -parseC :: TP String-parseC = try $ char '`' >> count 1 anyChar+parseC :: TP T.Text+parseC = try $ char '`' >> countChar 1 anyChar  -- the functions below taken from pandoc: -grave :: Char -> String+grave :: Char -> T.Text grave 'A' = "À" grave 'E' = "È" grave 'I' = "Ì"@@ -3837,9 +3848,9 @@ grave 'i' = "ì" grave 'o' = "ò" grave 'u' = "ù"-grave c   = [c]+grave c   = T.singleton c -acute :: Char -> String+acute :: Char -> T.Text acute 'A' = "Á" acute 'E' = "É" acute 'I' = "Í"@@ -3864,9 +3875,9 @@ acute 's' = "ś" acute 'Z' = "Ź" acute 'z' = "ź"-acute c   = [c]+acute c   = T.singleton c -circ :: Char -> String+circ :: Char -> T.Text circ 'A' = "Â" circ 'E' = "Ê" circ 'I' = "Î"@@ -3891,9 +3902,9 @@ circ 'w' = "ŵ" circ 'Y' = "Ŷ" circ 'y' = "ŷ"-circ c   = [c]+circ c   = T.singleton c -tilde :: Char -> String+tilde :: Char -> T.Text tilde 'A' = "Ã" tilde 'a' = "ã" tilde 'O' = "Õ"@@ -3904,9 +3915,9 @@ tilde 'u' = "ũ" tilde 'N' = "Ñ" tilde 'n' = "ñ"-tilde c   = [c]+tilde c   = T.singleton c -umlaut :: Char -> String+umlaut :: Char -> T.Text umlaut 'A' = "Ä" umlaut 'E' = "Ë" umlaut 'I' = "Ï"@@ -3917,9 +3928,9 @@ umlaut 'i' = "ï" umlaut 'o' = "ö" umlaut 'u' = "ü"-umlaut c   = [c]+umlaut c   = T.singleton c -dot :: Char -> String+dot :: Char -> T.Text dot 'C' = "Ċ" dot 'c' = "ċ" dot 'E' = "Ė"@@ -3929,9 +3940,9 @@ dot 'I' = "İ" dot 'Z' = "Ż" dot 'z' = "ż"-dot c   = [c]+dot c   = T.singleton c -macron :: Char -> String+macron :: Char -> T.Text macron 'A' = "Ā" macron 'E' = "Ē" macron 'I' = "Ī"@@ -3942,9 +3953,9 @@ macron 'i' = "ī" macron 'o' = "ō" macron 'u' = "ū"-macron c   = [c]+macron c   = T.singleton c -cedilla :: Char -> String+cedilla :: Char -> T.Text cedilla 'c' = "ç" cedilla 'C' = "Ç" cedilla 's' = "ş"@@ -3957,9 +3968,9 @@ cedilla 'H' = "Ḩ" cedilla 'o' = "o̧" cedilla 'O' = "O̧"-cedilla c   = [c]+cedilla c   = T.singleton c -hacek :: Char -> String+hacek :: Char -> T.Text hacek 'A' = "Ǎ" hacek 'a' = "ǎ" hacek 'C' = "Č"@@ -3993,9 +4004,9 @@ hacek 'u' = "ǔ" hacek 'Z' = "Ž" hacek 'z' = "ž"-hacek c   = [c]+hacek c   = T.singleton c -breve :: Char -> String+breve :: Char -> T.Text breve 'A' = "Ă" breve 'a' = "ă" breve 'E' = "Ĕ"@@ -4008,4 +4019,4 @@ breve 'o' = "ŏ" breve 'U' = "Ŭ" breve 'u' = "ŭ"-breve c   = [c]+breve c   = T.singleton c
src/Text/TeXMath/Readers/TeX/Macros.hs view
@@ -31,13 +31,14 @@ where  import Data.Char (isDigit, isLetter)+import qualified Data.Text as T import Control.Monad import Text.Parsec import Control.Applicative ((<*)) -data Macro = Macro { macroDefinition :: String+data Macro = Macro { macroDefinition :: T.Text                    , macroParser     :: forall st m s . Stream s m Char =>-                          ParsecT s st m String }+                          ParsecT s st m T.Text }  instance Show Macro where   show m = "Macro " ++ show (macroDefinition m)@@ -46,7 +47,7 @@ -- 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 :: T.Text -> ([Macro], T.Text) parseMacroDefinitions s =   case parse pMacroDefinitions "input" s of        Left _       -> ([], s)@@ -76,7 +77,7 @@ -- | Applies a list of macros to a string recursively until a fixed -- point is reached.  If there are several macros in the list with the -- same name, earlier ones will shadow later ones.-applyMacros :: [Macro] -> String -> String+applyMacros :: [Macro] -> T.Text -> T.Text applyMacros [] s = s applyMacros ms s =   maybe s id $ iterateToFixedPoint ((2 * length ms) + 1)@@ -95,16 +96,16 @@          | y == x    -> Just y          | otherwise -> iterateToFixedPoint (limit - 1) f y -applyMacrosOnce :: [Macro] -> String -> Maybe String+applyMacrosOnce :: [Macro] -> T.Text -> Maybe T.Text applyMacrosOnce ms s =   case parse (many tok) "input" s of-       Right r -> Just $ concat r+       Right r -> Just $ T.concat r        Left _  -> Nothing     where tok = try $ do                   skipComment                   choice [ choice (map macroParser ms)-                         , ctrlseq-                         , count 1 anyChar ]+                         , T.pack <$> ctrlseq+                         , T.pack <$> count 1 anyChar ]  ctrlseq :: (Monad m, Stream s m Char)         => ParsecT s st m String@@ -140,7 +141,7 @@              (if numargs > 0 then ("[" ++ show numargs ++ "]") else "") ++              case optarg of { Nothing -> ""; Just x -> "[" ++ x ++ "]"} ++              "{" ++ body ++ "}"-  return $ Macro defn $ try $ do+  return $ Macro (T.pack defn) $ fmap T.pack $ try $ do     char '\\'     string name'     when (all isLetter name') $@@ -181,7 +182,7 @@              (if numargs > 0 then ("[" ++ show numargs ++ "]") else "") ++              case optarg of { Nothing -> ""; Just x -> "[" ++ x ++ "]"} ++              "%\n{" ++ opener ++ "}%\n" ++ "{" ++ closer ++ "}"-  return $ Macro defn $ try $ do+  return $ Macro (T.pack defn) $ fmap T.pack $ try $ do     string "\\begin"     pSkipSpaceComments     char '{'@@ -221,7 +222,7 @@   body <- inbraces <|> ctrlseq   let defn = "\\DeclareMathOperator" ++ star ++ "{" ++ name ++ "}" ++              "{" ++ body ++ "}"-  return $ Macro defn $ try $ do+  return $ Macro (T.pack defn) $ fmap T.pack $ try $ do     char '\\'     string name'     when (all isLetter name') $@@ -231,7 +232,7 @@   apply :: [String] -> String -> String-apply args ('#':d:xs) | isDigit d =+apply args ('#':d:xs) | isDigit d, d /= '0' =   let argnum = read [d]   in  if length args >= argnum          then args !! (argnum - 1) ++ apply args xs
src/Text/TeXMath/Shared.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, ScopedTypeVariables #-}+{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-} {- Copyright (C) 2014 Matthew Pickering <matthewtpickering@gmail.com> @@ -40,9 +40,11 @@ import Text.TeXMath.TeX import qualified Data.Map as M import qualified Data.Set as Set+import qualified Data.Text as T import Data.Maybe (fromMaybe) import Data.Ratio ((%)) import Data.List (sort)+import Data.Semigroup ((<>)) import Control.Applicative ((<$>), (<*>)) import Control.Monad (guard) import Text.Parsec (Parsec, parse, getInput, digit, char, many1, option)@@ -74,11 +76,11 @@ fixTree = everywhere (mkT removeNesting) . everywhere (mkT removeEmpty)  -- | Maps TextType to the corresponding MathML mathvariant-getMMLType :: TextType -> String+getMMLType :: TextType -> T.Text getMMLType t = fromMaybe "normal" (fst <$> M.lookup t textTypesMap)  -- | Maps TextType to corresponding LaTeX command-getLaTeXTextCommand :: Env -> TextType -> String+getLaTeXTextCommand :: Env -> TextType -> T.Text getLaTeXTextCommand e t =   let textCmd = fromMaybe "\\mathrm"                   (snd <$> M.lookup t textTypesMap) in@@ -87,11 +89,11 @@     else fromMaybe "\\mathrm" (M.lookup textCmd alts)  -- | Maps MathML mathvariant to the corresponing TextType-getTextType :: String -> TextType+getTextType :: T.Text -> TextType getTextType s = fromMaybe TextNormal (M.lookup s revTextTypesMap)  -- | Maps a LaTeX scaling command to the percentage scaling-getScalerCommand :: Rational -> Maybe String+getScalerCommand :: Rational -> Maybe T.Text getScalerCommand width =   case sort [ (w, cmd) | (cmd, w) <- scalers, w >= width ] of        ((_,cmd):_) -> Just cmd@@ -100,11 +102,11 @@   -- match:  \Big, not \Bigr  -- | Gets percentage scaling from LaTeX scaling command-getScalerValue :: String -> Maybe Rational+getScalerValue :: T.Text -> Maybe Rational getScalerValue command = lookup command scalers  -- | Given a diacritical mark, returns the corresponding LaTeX command-getDiacriticalCommand  :: Position -> String -> Maybe String+getDiacriticalCommand  :: Position -> T.Text -> Maybe T.Text getDiacriticalCommand pos symbol = do   command <- M.lookup symbol diaMap   guard (not $ command `elem` unavailable)@@ -120,7 +122,7 @@ getOperator :: Exp -> Maybe TeX getOperator op = fmap ControlSeq $ M.lookup op operators -operators :: M.Map Exp String+operators :: M.Map Exp T.Text operators = M.fromList            [ (EMathOperator "arccos", "\\arccos")            , (EMathOperator "arcsin", "\\arcsin")@@ -156,7 +158,7 @@            , (EMathOperator "tanh", "\\tanh") ]  -- | Attempts to convert a string into-readLength :: String -> Maybe Rational+readLength :: T.Text -> Maybe Rational readLength s = do   (n, unit) <- case (parse parseLength "" s) of                   Left _ -> Nothing@@ -164,24 +166,24 @@   (n *) <$> unitToMultiplier unit  -parseLength :: Parsec String () (Rational, String)+parseLength :: Parsec T.Text () (Rational, T.Text) parseLength = do     neg <- option "" ((:[]) <$> char '-')     dec <- many1 digit     frac <- option "" ((:) <$> char '.' <*> many1 digit)     unit <- getInput     -- This is safe as dec and frac must be a double of some kind-    let [(n :: Double, [])] = reads (neg ++ dec ++ frac) :: [(Double, String)]+    let [(n :: Double, [])] = reads (neg ++ dec ++ frac)     return (round (n * 18) % 18, unit) -textTypesMap :: M.Map TextType (String, String)+textTypesMap :: M.Map TextType (T.Text, T.Text) textTypesMap = M.fromList textTypes -revTextTypesMap :: M.Map String TextType+revTextTypesMap :: M.Map T.Text TextType revTextTypesMap = M.fromList $ map (\(k, (v,_)) -> (v,k)) textTypes  --TextType to (MathML, LaTeX)-textTypes :: [(TextType, (String, String))]+textTypes :: [(TextType, (T.Text, T.Text))] textTypes =   [ ( TextNormal       , ("normal", "\\mathrm"))   , ( TextBold         , ("bold", "\\mathbf"))@@ -198,7 +200,7 @@   , ( TextBoldFraktur         , ("bold-fraktur","\\mathbffrak"))   , ( TextSansSerifItalic     , ("sans-serif-italic","\\mathsfit")) ] -unicodeMath, base :: Set.Set String+unicodeMath, base :: Set.Set T.Text unicodeMath = Set.fromList   ["\\mathbfit", "\\mathbfsfup", "\\mathbfsfit", "\\mathbfscr",    "\\mathbffrak", "\\mathsfit"]@@ -206,7 +208,7 @@   ["\\mathbb", "\\mathrm", "\\mathbf", "\\mathit", "\\mathsf",    "\\mathtt", "\\mathfrak", "\\mathcal"] -alts :: M.Map String String+alts :: M.Map T.Text T.Text alts = M.fromList   [ ("\\mathbfit", "\\mathbf")   , ("\\mathbfsfup", "\\mathbf")@@ -216,14 +218,14 @@   , ("\\mathsfit", "\\mathsf")   ] -textPackage :: String -> [String] -> Bool+textPackage :: T.Text -> [T.Text] -> Bool textPackage s e   | s `Set.member` unicodeMath = "unicode-math" `elem` e   | s `Set.member` base    = True   | otherwise = True  -- | Mapping between LaTeX scaling commands and the scaling factor-scalers :: [(String, Rational)]+scalers :: [(T.Text, Rational)] scalers =           [ ("\\bigg", widthbigg)           , ("\\Bigg", widthBigg)@@ -263,31 +265,33 @@  -- | Returns the sequence of unicode space characters closest to the -- specified width.-getSpaceChars :: Rational -> [Char]-getSpaceChars n =-  case n of-       _ | n < 0      -> "\x200B"  -- no negative space chars in unicode-         | n <= 2/18  -> "\x200A"-         | n <= 3/18  -> "\x2006"-         | n <= 4/18  -> "\xA0"   -- could also be "\x2005"-         | n <= 5/18  -> "\x2005"-         | n <= 7/18  -> "\x2004"-         | n <= 9/18  -> "\x2000"-         | n < 1      -> '\x2000' : getSpaceChars (n - (1/2))-         | n == 1     -> "\x2001"-         | otherwise  -> '\x2001' : getSpaceChars (n - 1)+getSpaceChars :: Rational -> T.Text+getSpaceChars r+  | n < 0 = "\x200B" -- no negative space chars in unicode+  | otherwise = fracSpaces f <> emQuads n+  where+    (n, f) = properFraction r+    emQuads x = T.replicate x "\x2001"+    fracSpaces x+      | x <= 2/18 = "\x200A"+      | x <= 3/18 = "\x2006"+      | x <= 4/18 = "\xA0"   -- could also be "\x2005"+      | x <= 5/18 = "\x2005"+      | x <= 7/18 = "\x2004"+      | x <= 9/18 = "\x2000"+      | otherwise = T.cons '\x2000' $ fracSpaces (x - (1/2))  -- Accents which go under the character-under :: [String]+under :: [T.Text] under = ["\\underbrace", "\\underline", "\\underbar", "\\underbracket"]  -- We want to parse these but we can't represent them in LaTeX-unavailable :: [String]+unavailable :: [T.Text] unavailable = ["\\overbracket", "\\underbracket"]   -- | Mapping between unicode combining character and LaTeX accent command-diacriticals :: [(String, String)]+diacriticals :: [(T.Text, T.Text)] diacriticals =                [ ("\x00B4", "\\acute")                , ("\x0301", "\\acute")@@ -329,7 +333,7 @@   -- Converts unit to multiplier to reach em-unitToMultiplier :: String -> Maybe Rational+unitToMultiplier :: T.Text -> Maybe Rational unitToMultiplier s = M.lookup s units   where     units = M.fromList  [ ( "pt" , 10)
src/Text/TeXMath/TeX.hs view
@@ -1,56 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}+ module Text.TeXMath.TeX (TeX(..),                          renderTeX,                          isControlSeq,                          escapeLaTeX) where-import Data.List (isPrefixOf) import Data.Char (isLetter, isAlphaNum, isAscii)+import Data.Semigroup ((<>))+import qualified Data.Text as T  -- | An intermediate representation of TeX math, to be used in rendering.-data TeX = ControlSeq String+data TeX = ControlSeq T.Text          | Token Char-         | Literal String+         | Literal T.Text          | Grouped [TeX]          | Space          deriving (Show, Eq)  -- | Render a 'TeX' to a string, appending to the front of the given string.-renderTeX :: TeX -> String -> String-renderTeX (Token c) cs     = c:cs+renderTeX :: TeX -> T.Text -> T.Text+renderTeX (Token c) cs     = T.cons c cs renderTeX (Literal s) cs-  | startsWith (not . isLetter)-               (reverse s) = s ++ cs-  | startsWith isLetter cs = s ++ (' ':cs)-  | otherwise              = s ++ cs+  | endsWith (not . isLetter) s = s <> cs+  | startsWith isLetter cs      = s <> T.cons ' ' cs+  | otherwise                   = s <> cs renderTeX (ControlSeq s) cs-  | s == "\\ "               = s ++ cs+  | s == "\\ "               = s <> cs   | startsWith (\c -> isAlphaNum c || not (isAscii c)) cs-                             = s ++ (' ':cs)-  | otherwise                = s ++ cs+                             = s <> T.cons ' ' cs+  | otherwise                = s <> cs renderTeX (Grouped [Grouped xs]) cs  = renderTeX (Grouped xs) cs renderTeX (Grouped xs) cs     =-  '{' : foldr renderTeX "" (trimSpaces xs) ++ "}" ++ cs-renderTeX Space ""             = "" -- no need to end with space-renderTeX Space ('^':cs)       = '^':cs  -- no space before ^-renderTeX Space ('_':cs)       = '_':cs  -- no space before _-renderTeX Space (' ':cs)       = ' ':cs  -- no doubled up spaces+  "{" <> foldr renderTeX "" (trimSpaces xs) <> "}" <> cs renderTeX Space cs-  | "\\limits" `isPrefixOf` cs = cs      -- no space before \limits-  | otherwise                  = ' ':cs+  | cs == ""                   = ""+  | any (`T.isPrefixOf` cs) ps = cs+  | otherwise                  = T.cons ' ' cs+  where+    -- No space before ^, _, or \limits, and no doubled up spaces+    ps = [ "^", "_", " ", "\\limits" ]  trimSpaces :: [TeX] -> [TeX] trimSpaces = reverse . go . reverse . go   where go = dropWhile (== Space) -startsWith :: (Char -> Bool) -> String -> Bool-startsWith p (c:_) = p c-startsWith _ []    = False+startsWith :: (Char -> Bool) -> T.Text -> Bool+startsWith p t = case T.uncons t of+  Just (c, _) -> p c+  Nothing     -> False -isControlSeq :: String -> Bool-isControlSeq ['\\',c] = c /= ' '-isControlSeq ('\\':xs) = all isLetter xs-isControlSeq _ = False+endsWith :: (Char -> Bool) -> T.Text -> Bool+endsWith p t = case T.unsnoc t of+  Just (_, c) -> p c+  Nothing     -> False +isControlSeq :: T.Text -> Bool+isControlSeq t = case T.uncons t of+  Just ('\\', xs) -> T.length xs == 1 && xs /= " "+                     || T.all isLetter xs+  _               -> False+ escapeLaTeX :: Char -> TeX escapeLaTeX c =   case c of@@ -68,5 +77,5 @@        '\x2032' -> Literal "'"        '\x2033' -> Literal "''"        '\x2034' -> Literal "'''"-       _ | c `elem` "#$%&_{} " -> Literal ("\\" ++ [c])+       _ | T.any (== c) "#$%&_{} " -> Literal ("\\" <> T.singleton c)          | otherwise -> Token c
src/Text/TeXMath/Types.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances #-}+{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, OverloadedStrings #-} {- Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu> @@ -29,6 +29,7 @@ where  import Data.Generics+import qualified Data.Text as T  data TeXSymbolType = Ord | Op | Bin | Rel | Open | Close | Pun | Accent                      | Fence | TOver | TUnder | Alpha | BotAccent | Rad@@ -46,18 +47,18 @@ type ArrayLine = [[Exp]]  data Exp =-    ENumber String  -- ^ A number (@\<mn\>@ in MathML).+    ENumber T.Text  -- ^ A number (@\<mn\>@ in MathML).   | EGrouped [Exp]  -- ^ A group of expressions that function as a unit                     -- (e.g. @{...}@) in TeX, @\<mrow\>...\</mrow\>@ in MathML.-  | EDelimited String String [InEDelimited] -- ^ A group of expressions inside+  | EDelimited T.Text T.Text [InEDelimited] -- ^ A group of expressions inside                     -- paired open and close delimiters (which may in some                     -- cases be null).-  | EIdentifier String  -- ^ An identifier, e.g. a variable (@\<mi\>...\</mi\>@+  | EIdentifier T.Text  -- ^ An identifier, e.g. a variable (@\<mi\>...\</mi\>@                     -- in MathML.  Note that MathML tends to use @\<mi\>@ tags                     -- for "sin" and other mathematical operators; these                     -- are represented as 'EMathOperator' in TeXMath.-  | EMathOperator String  -- ^ A spelled-out operator like @lim@ or @sin@.-  | ESymbol TeXSymbolType String  -- ^ A symbol.+  | EMathOperator T.Text  -- ^ A spelled-out operator like @lim@ or @sin@.+  | ESymbol TeXSymbolType T.Text  -- ^ A symbol.   | ESpace Rational -- ^ A space, with the width specified in em.   | ESub Exp Exp  -- ^ An expression with a subscript.  First argument is base,                   -- second subscript.@@ -88,7 +89,7 @@                   -- specifies the alignments of the columns; the second gives                   -- the contents of the lines.  All of these lists should be                   -- the same length.-  | EText TextType String  -- ^ Some normal text, possibly styled.+  | EText TextType T.Text  -- ^ Some normal text, possibly styled.   | EStyled TextType [Exp] -- ^  A group of styled expressions.   deriving (Show, Read, Eq, Ord, Data, Typeable) @@ -96,7 +97,7 @@ -- (represented here as @Right@ values) or fences (represented here as -- @Left@, and in LaTeX using @\mid@). type InEDelimited = Either Middle Exp-type Middle = String+type Middle = T.Text  data DisplayType = DisplayBlock  -- ^ A displayed formula.                  | DisplayInline  -- ^ A formula rendered inline in text.@@ -120,13 +121,13 @@  data FormType = FPrefix | FPostfix | FInfix deriving (Show, Ord, Eq) -type Property = String+type Property = T.Text  -- | A record of the MathML dictionary as defined -- <http://www.w3.org/TR/MathML3/appendixc.html in the specification> data Operator = Operator-                  { oper :: String -- ^ Operator-                  , description :: String -- ^ Plain English Description+                  { oper :: T.Text -- ^ Operator+                  , description :: T.Text -- ^ Plain English Description                   , form :: FormType -- ^ Whether Prefix, Postfix or Infix                   , priority :: Int -- ^ Default priority for implicit                                     --   nesting@@ -141,16 +142,16 @@ -- <http://milde.users.sourceforge.net/LUCR/Math/data/unimathsymbols.txt -- here> data Record = Record { uchar :: Char -- ^ Unicode Character-                     , commands :: [(String, String)] -- ^ LaTeX commands (package, command)+                     , commands :: [(T.Text, T.Text)] -- ^ LaTeX commands (package, command)                      , category :: TeXSymbolType -- ^ TeX math category-                     , comments :: String -- ^ Plain english description+                     , comments :: T.Text -- ^ Plain english description                      } deriving (Show)  data Position = Under | Over  -- | List of available packages-type Env = [String]+type Env = [T.Text]  -- | Contains @amsmath@ and @amssymbol@-defaultEnv :: [String]+defaultEnv :: [T.Text] defaultEnv = ["amsmath", "amssymb"]
src/Text/TeXMath/Unicode/Fonts.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {- Copyright (C) 2014 Matthew Pickering <matthewtpickering@gmail.com> @@ -27,17 +28,18 @@  Utilities to convert between MS font codepoints and unicode characters. -}-module Text.TeXMath.Unicode.Fonts (getUnicode, Font(..), stringToFont) where+module Text.TeXMath.Unicode.Fonts (getUnicode, Font(..), textToFont) where import qualified Data.Map as M+import qualified Data.Text as T  -- | Enumeration of recognised fonts data Font = Symbol -- ^ <http://en.wikipedia.org/wiki/Symbol_(typeface) Adobe Symbol>           deriving (Show, Eq)  -- | Parse font name into Font if possible.-stringToFont :: String -> Maybe Font-stringToFont "Symbol" = Just Symbol-stringToFont _ = Nothing+textToFont :: T.Text -> Maybe Font+textToFont "Symbol" = Just Symbol+textToFont _ = Nothing  -- | Given a font and codepoint, returns the corresponding unicode -- character
src/Text/TeXMath/Unicode/ToTeX.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE OverloadedStrings #-} {- Copyright (C) 2014 Matthew Pickering <matthewtpickering@gmail.com> @@ -42,11 +43,12 @@ -}  module Text.TeXMath.Unicode.ToTeX ( getTeXMath-                                      , getSymbolType-                                      , records-                                      ) where+                                  , getSymbolType+                                  , records+                                  ) where  import qualified Data.Map as M+import qualified Data.Text as T import Text.TeXMath.TeX import Text.TeXMath.Types import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)@@ -57,8 +59,8 @@ -- | Converts a string of unicode characters into a strong of equivalent -- TeXMath commands. An environment is a list of strings specifying which -- additional packages are available.-getTeXMath :: String -> Env -> [TeX]-getTeXMath s e = concatMap (charToString e) s+getTeXMath :: T.Text -> Env -> [TeX]+getTeXMath s e = concatMap (charToString e) $ T.unpack s  -- Categories which require braces commandTypes :: [TeXSymbolType]@@ -78,12 +80,12 @@ charToLaTeXString environment c = do   v <- M.lookup c recordsMap   -- Required packages for the command-  let toLit [x]  = [Token x]-      toLit []   = []-      toLit cs   = [Literal cs]+  let toLit cs = case T.uncons cs of+        Just (x, xs) -> if T.null xs then [Token x] else [Literal cs]+        Nothing      -> []   let cmds = commands v-  raw <- lookup "base" cmds-          <|> listToMaybe (mapMaybe (flip lookup cmds) environment)+  raw <- lookup "base" cmds <|>+         listToMaybe (mapMaybe (flip lookup cmds) environment)   let latexCommand = if isControlSeq raw                         then [ControlSeq raw]                         else toLit raw
src/Text/TeXMath/Unicode/ToUnicode.hs view
@@ -27,15 +27,16 @@  import Text.TeXMath.Types import qualified Data.Map as M+import qualified Data.Text as T import Data.Maybe (fromMaybe)  -- | Replace characters with their corresponding mathvariant unicode character. --  MathML has a mathvariant attribute which is unimplemented in Firefox --  (see <https://bugzilla.mozilla.org/show_bug.cgi?id=114365 here>) --  Therefore, we may want to translate mathscr, etc to unicode symbols directly.-toUnicode :: TextType -> String -> String+toUnicode :: TextType -> T.Text -> T.Text toUnicode TextNormal = id-toUnicode tt = map (\c -> fromMaybe c (toUnicodeChar (tt, c)))+toUnicode tt = T.map (\c -> fromMaybe c (toUnicodeChar (tt, c)))  toUnicodeChar :: (TextType, Char) -> Maybe Char toUnicodeChar x = M.lookup x unicodeMap@@ -46,11 +47,11 @@ fromUnicodeChar c = M.lookup c reverseUnicodeMap  -- | Inverse of 'toUnicode'.-fromUnicode :: TextType -> String -> String+fromUnicode :: TextType -> T.Text -> T.Text fromUnicode tt cs =-  map (\c -> case fromUnicodeChar c of-                   Just (tt', c') | tt' == tt -> c'-                   _ -> c) cs+  T.map (\c -> case fromUnicodeChar c of+                 Just (tt', c') | tt' == tt -> c'+                 _ -> c) cs  reverseUnicodeMap :: M.Map Char (TextType, Char) reverseUnicodeMap = M.fromList $ map (\(a,b) -> (b,a)) unicodeTable
src/Text/TeXMath/Writers/Eqn.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, ViewPatterns, GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, ViewPatterns, GADTs, OverloadedStrings #-} {- Copyright (C) 2014 Matthew Pickering <matthewtpickering@gmail.com> @@ -20,41 +20,43 @@  module Text.TeXMath.Writers.Eqn (writeEqn) where -import Data.List (intercalate, transpose)+import Data.List (transpose) import Data.Char (isAscii, ord)+import qualified Data.Text as T import Text.Printf (printf) import Text.TeXMath.Types import qualified Text.TeXMath.Shared as S import Data.Generics (everywhere, mkT) import Data.Ratio ((%))+import Data.Semigroup ((<>))  -- import Debug.Trace -- tr' x = trace (show x) x  -- | Transforms an expression tree to equivalent Eqn with the default -- packages (amsmath and amssymb)-writeEqn :: DisplayType -> [Exp] -> String+writeEqn :: DisplayType -> [Exp] -> T.Text writeEqn dt exprs =-  intercalate " " $ map writeExp $ everywhere (mkT $ S.handleDownup dt) exprs+  T.intercalate " " $ map writeExp $ everywhere (mkT $ S.handleDownup dt) exprs  -- like writeExp but inserts {} if contents contain a space-writeExp' :: Exp -> String+writeExp' :: Exp -> T.Text writeExp' e@(EGrouped _) = writeExp e-writeExp' e = if ' ' `elem` s-                 then "{" ++ s ++ "}"+writeExp' e = if T.any (== ' ') s+                 then "{" <> s <> "}"                  else s                where s = writeExp e -writeExps :: [Exp] -> String-writeExps = intercalate " " . map writeExp+writeExps :: [Exp] -> T.Text+writeExps = T.intercalate " " . map writeExp -writeExp :: Exp -> String+writeExp :: Exp -> T.Text writeExp (ENumber s) = s-writeExp (EGrouped es) = "{" ++ writeExps es ++ "}"+writeExp (EGrouped es) = "{" <> writeExps es <> "}" writeExp (EDelimited open close es) =-  "left " ++ mbQuote open ++ " " ++ intercalate " " (map fromDelimited es) ++-  " right " ++ mbQuote close-  where fromDelimited (Left e)  = "\"" ++ e ++ "\""+  "left " <> mbQuote open <> " " <> T.intercalate " " (map fromDelimited es) <>+  " right " <> mbQuote close+  where fromDelimited (Left e)  = "\"" <> e <> "\""         fromDelimited (Right e) = writeExp e         mbQuote "" = "\"\""         mbQuote s  = s@@ -63,8 +65,8 @@                "tanh", "arc", "max", "min", "lim",                "log", "ln", "exp"]      then s-     else "\"" ++ s ++ "\""-writeExp (ESymbol Ord [c])  -- do not render "invisible operators"+     else "\"" <> s <> "\""+writeExp (ESymbol Ord (T.unpack -> [c]))  -- do not render "invisible operators"   | c `elem` ['\x2061'..'\x2064'] = "" -- see 3.2.5.5 of mathml spec writeExp (EIdentifier s) = writeExp (ESymbol Ord s) writeExp (ESymbol t s) =@@ -129,19 +131,19 @@     "\958" -> "xi"     "\926" -> "XI"     "\950" -> "zeta"-    _      -> let s' = if all isAscii s+    _      -> let s' = if T.all isAscii s                           then s-                          else "\\[" ++ unwords (map toUchar s) ++ "]"-                  toUchar c = printf "u%04X" (ord c)-              in  if length s > 1 && (t == Rel || t == Bin || t == Op)-                     then "roman{\"" +++                          else "\\[" <> T.unwords (map toUchar $ T.unpack s) <> "]"+                  toUchar c = T.pack $ printf "u%04X" (ord c)+              in  if T.length s > 1 && (t == Rel || t == Bin || t == Op)+                     then "roman{\"" <>                           (if t == Rel || t == Bin                               then " "-                              else "") ++-                          s' +++                              else "") <>+                          s' <>                           (if t == Rel || t == Bin || t == Op                               then " "-                              else "") +++                              else "") <>                           "\"}"                      else s' @@ -149,56 +151,58 @@   case d of       _ | d > 0 && d < (2 % 9) -> "^"         | d >= (2 % 9) && d < (3 % 9) -> "~"-        | d < 0     -> "back " ++ show (floor (-1 * d * 100) :: Int)-        | otherwise -> "fwd " ++ show (floor (d * 100) :: Int)-writeExp (EFraction fractype e1 e2) = writeExp' e1 ++ op ++ writeExp' e2+        | d < 0     -> "back " <> tshow (floor (-1 * d * 100) :: Int)+        | otherwise -> "fwd " <> tshow (floor (d * 100) :: Int)+writeExp (EFraction fractype e1 e2) = writeExp' e1 <> op <> writeExp' e2   where op = if fractype == NoLineFrac                 then " / "                 else " over "-writeExp (ESub b e1) = writeExp' b ++ " sub " ++ writeExp' e1-writeExp (ESuper b e1) = writeExp' b ++ " sup " ++ writeExp' e1+writeExp (ESub b e1) = writeExp' b <> " sub " <> writeExp' e1+writeExp (ESuper b e1) = writeExp' b <> " sup " <> writeExp' e1 writeExp (ESubsup b e1 e2) =-  writeExp' b ++ " sub " ++ writeExp' e1 ++ " sup " ++ writeExp' e2+  writeExp' b <> " sub " <> writeExp' e1 <> " sup " <> writeExp' e2 writeExp (EOver _convertible b e1) =-  writeExp' b ++ " to " ++ writeExp' e1+  writeExp' b <> " to " <> writeExp' e1 writeExp (EUnder _convertible b e1) =-  writeExp' b ++ " from " ++ writeExp' e1+  writeExp' b <> " from " <> writeExp' e1 writeExp (EUnderover convertible b e1@(ESymbol Accent _) e2) =   writeExp (EUnder convertible (EOver False b e2) e1) writeExp (EUnderover convertible b e1 e2@(ESymbol Accent _)) =   writeExp (EOver convertible (EUnder False b e1) e2) writeExp (EUnderover _convertible b e1 e2) =-  writeExp' b ++ " from " ++ writeExp' e1 ++ " to " ++ writeExp' e2-writeExp (ESqrt e) = "sqrt " ++ writeExp' e-writeExp (ERoot i e) = "\"\" sup " ++ writeExp' i ++ " sqrt " ++ writeExp' e-writeExp (EPhantom e) = "hphantom " ++ writeExp' e+  writeExp' b <> " from " <> writeExp' e1 <> " to " <> writeExp' e2+writeExp (ESqrt e) = "sqrt " <> writeExp' e+writeExp (ERoot i e) = "\"\" sup " <> writeExp' i <> " sqrt " <> writeExp' e+writeExp (EPhantom e) = "hphantom " <> writeExp' e writeExp (EBoxed e) = writeExp e -- TODO: any way to do this? writeExp (EScaled _size e) = writeExp e -- TODO: any way? writeExp (EText ttype s) =-  let quoted = "\"" ++ s ++ "\""+  let quoted = "\"" <> s <> "\""   in case ttype of-       TextNormal -> "roman " ++ quoted+       TextNormal -> "roman " <> quoted        TextItalic -> quoted-       TextBold   -> "bold " ++ quoted-       TextBoldItalic -> "bold italic " ++ quoted+       TextBold   -> "bold " <> quoted+       TextBoldItalic -> "bold italic " <> quoted        _   -> quoted writeExp (EStyled ttype es) =-  let contents = "{" ++ writeExps es ++ "}"+  let contents = "{" <> writeExps es <> "}"   in case ttype of-       TextNormal -> "roman " ++ contents-       TextItalic -> "italic " ++ contents-       TextBold   -> "bold " ++ contents-       TextBoldItalic -> "bold italic " ++ contents+       TextNormal -> "roman " <> contents+       TextItalic -> "italic " <> contents+       TextBold   -> "bold " <> contents+       TextBoldItalic -> "bold italic " <> contents        _   -> contents writeExp (EArray aligns rows) =-  "matrix{\n" ++ concat cols ++ "}"+  "matrix{\n" <> T.concat cols <> "}"   where cols = zipWith tocol aligns (transpose rows)         tocol al cs =           (case al of                AlignLeft -> "lcol"                AlignCenter -> "ccol"-               AlignRight -> "rcol") ++-            "{ " ++ intercalate " above " (map tocell cs) ++ " }\n"+               AlignRight -> "rcol") <>+            "{ " <> T.intercalate " above " (map tocell cs) <> " }\n"         tocell [e] = writeExp' e         tocell es  = writeExp (EGrouped es) +tshow :: Show a => a -> T.Text+tshow = T.pack . show
src/Text/TeXMath/Writers/MathML.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns, ScopedTypeVariables, OverloadedStrings #-} {- Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu> @@ -30,6 +30,8 @@ import Text.TeXMath.Shared (getMMLType, handleDownup) import Text.TeXMath.Readers.MathML.MMLDict (getMathMLOperator) import Control.Applicative ((<$>))+import Data.Semigroup ((<>))+import qualified Data.Text as T import Text.Printf  -- | Transforms an expression tree to a MathML XML tree@@ -64,44 +66,51 @@ spaceWidth :: Rational -> Element spaceWidth w =   withAttribute "width" (dropTrailing0s-     (printf "%.3f" (fromRational w :: Double)) ++ "em") $ unode "mspace" ()+     (T.pack $ printf "%.3f" (fromRational w :: Double)) <> "em") $ unode "mspace" ()  makeStretchy :: FormType -> Element -> Element makeStretchy (fromForm -> t)  = withAttribute "stretchy" "true"                                 . withAttribute "form" t -fromForm :: FormType -> String+fromForm :: FormType -> T.Text fromForm FInfix   = "infix" fromForm FPostfix = "postfix" fromForm FPrefix  = "prefix" - makeScaled :: Rational -> Element -> Element makeScaled x = withAttribute "minsize" s . withAttribute "maxsize" s-  where s = dropTrailing0s $ printf "%.3f" (fromRational x :: Double)+  where s = dropTrailing0s $ T.pack $ printf "%.3f" (fromRational x :: Double) -dropTrailing0s :: String -> String-dropTrailing0s = reverse . go . reverse-  where go ('0':'.':xs) = '0':'.':xs-        go ('0':xs) = go xs-        go xs       = xs +dropTrailing0s :: T.Text -> T.Text+dropTrailing0s t = case T.unsnoc t of -- T.spanEnd does not exist+  Just (ts, '0') -> addZero $ T.dropWhileEnd (== '0') ts+  _              -> t+  where+    addZero x = case T.unsnoc x of+      Just (_, '.') -> T.snoc x '0'+      _ -> x+ makeStyled :: TextType -> [Element] -> Element makeStyled a es = withAttribute "mathvariant" attr                 $ unode "mstyle" es   where attr = getMMLType a  -- Note: Converts strings to unicode directly, as few renderers support those mathvariants.-makeText :: TextType -> String -> Element+makeText :: TextType -> T.Text -> Element makeText a s = case (leadingSp, trailingSp) of                    (False, False) -> s'                    (True,  False) -> mrow [sp, s']                    (False, True)  -> mrow [s', sp]                    (True,  True)  -> mrow [sp, s', sp]   where sp = spaceWidth (1/3)-        s' = withAttribute "mathvariant" attr $ unode "mtext" $ toUnicode a s-        trailingSp = not (null s) && last s `elem` " \t"-        leadingSp  = not (null s) && head s `elem` " \t"+        s' = withAttribute "mathvariant" attr $ tunode "mtext" $ toUnicode a s+        trailingSp = case T.unsnoc s of+          Just (_, c) -> T.any (== c) " \t"+          _           -> False+        leadingSp  = case T.uncons s of+          Just (c, _) -> T.any (== c) " \t"+          _           -> False         attr = getMMLType a  makeArray :: TextType -> [Alignment] -> [ArrayLine] -> Element@@ -113,12 +122,13 @@          setAlignment AlignCenter  = withAttribute "columnalign" "center"          as'                       = as ++ cycle [AlignCenter] -withAttribute :: String -> String -> Element -> Element-withAttribute a = add_attr . Attr (unqual a)+-- Kept as String for Text.XML.Light+withAttribute :: String -> T.Text -> Element -> Element+withAttribute a = add_attr . Attr (unqual a) . T.unpack -accent :: String -> Element+accent :: T.Text -> Element accent = add_attr (Attr (unqual "accent") "true") .-           unode "mo"+           tunode "mo"  makeFence :: FormType -> Element -> Element makeFence (fromForm -> t) = withAttribute "stretchy" "false" . withAttribute "form" t@@ -132,25 +142,25 @@                            getMathMLOperator x FPostfix of                              Just True -> "true"                              _         -> "false"-      in  withAttribute "accent" isaccent $ unode "mo" x+      in  withAttribute "accent" isaccent $ tunode "mo" x     _                -> showExp tt e  showExp :: TextType -> Exp -> Element showExp tt e =  case e of-   ENumber x        -> unode "mn" x+   ENumber x        -> tunode "mn" x    EGrouped [x]     -> showExp tt x    EGrouped xs      -> mrow $ map (showExp tt) xs    EDelimited start end xs -> mrow $-                       [ makeStretchy FPrefix (unode "mo" start) | not (null start) ] ++-                       map (either (makeStretchy FInfix . unode "mo") (showExp tt)) xs ++-                       [ makeStretchy FPostfix (unode "mo" end) | not (null end) ]-   EIdentifier x    -> unode "mi" $ toUnicode tt x-   EMathOperator x  -> unode "mo" x-   ESymbol Open x   -> makeFence FPrefix $ unode "mo" x-   ESymbol Close x  -> makeFence FPostfix $ unode "mo" x-   ESymbol Ord x    -> unode "mi" x-   ESymbol _ x      -> unode "mo" x+     [ makeStretchy FPrefix (tunode "mo" start) | not (T.null start) ] +++     map (either (makeStretchy FInfix . tunode "mo") (showExp tt)) xs +++     [ makeStretchy FPostfix (tunode "mo" end) | not (T.null end) ]+   EIdentifier x    -> tunode "mi" $ toUnicode tt x+   EMathOperator x  -> tunode "mo" x+   ESymbol Open x   -> makeFence FPrefix $ tunode "mo" x+   ESymbol Close x  -> makeFence FPostfix $ tunode "mo" x+   ESymbol Ord x    -> tunode "mi" x+   ESymbol _ x      -> tunode "mo" x    ESpace x         -> spaceWidth x    EFraction ft x y -> showFraction tt ft x y    ESub x y         -> unode "msub" $ map (showExp tt) [x, y]@@ -169,3 +179,7 @@    EArray as ls     -> makeArray tt as ls    EText a s        -> makeText a s    EStyled a es     -> makeStyled a $ map (showExp a) es++-- Kept as String for Text.XML.Light+tunode :: String -> T.Text -> Element+tunode s = unode s . T.unpack
src/Text/TeXMath/Writers/OMML.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-} {- Copyright (C) 2012 John MacFarlane <jgm@berkeley.edu> @@ -26,6 +28,7 @@ import Text.TeXMath.Types import Data.Generics (everywhere, mkT) import Data.Char (isSymbol, isPunctuation)+import qualified Data.Text as T  -- | Transforms an expression tree to an OMML XML Tree writeOMML :: DisplayType -> [Exp] -> Element@@ -39,16 +42,18 @@                                     , mnode "oMath" x ]                   DisplayInline -> mnode "oMath" +-- Kept as String for Text.XML.Light mnode :: Node t => String -> t -> Element mnode s = node (QName s Nothing (Just "m")) +-- Kept as String for Text.XML.Light mnodeA :: Node t => String -> String -> t -> Element mnodeA s v = add_attr (Attr (QName "val" Nothing (Just "m")) v) . mnode s -str :: [Element] -> String -> Element-str []    s = mnode "r" [ mnode "t" s ]+str :: [Element] -> T.Text -> Element+str []    s = mnode "r" [ mnode "t" $ T.unpack s ] str props s = mnode "r" [ mnode "rPr" props-                        , mnode "t" s ]+                        , mnode "t" $ T.unpack s ]  showFraction :: [Element] -> FractionType -> Exp -> Exp -> Element showFraction props ft x y =@@ -90,7 +95,7 @@         toAlign AlignRight   = "right"         toAlign AlignCenter  = "center" -makeText :: TextType -> String -> Element+makeText :: TextType -> T.Text -> Element makeText a s = str (mnode "nor" () : setProps a) s  setProps :: TextType -> [Element]@@ -184,21 +189,21 @@    EGrouped xs      -> concatMap (showExp props) xs    EDelimited start end xs ->                        [mnode "d" [ mnode "dPr"-                                    [ mnodeA "begChr" start ()-                                    , mnodeA "endChr" end ()+                                    [ mnodeA "begChr" (T.unpack start) ()+                                    , mnodeA "endChr" (T.unpack end) ()                                     , mnode "grow" () ]                                   , mnode "e" $ concatMap                                     (either ((:[]) . str props) (showExp props)) xs                                   ] ]-    EIdentifier ""   -> [str props "\x200B"]  -- 0-width space                        -- to avoid the dashed box we get otherwise; see #118    EIdentifier x    -> [str props x]    EMathOperator x  -> [makeText TextNormal x]  -- TODO revisit, use props?-   ESymbol _ [c]-    | isSymbol c || isPunctuation c-                    -> [str props [c]]    ESymbol ty xs+    | Just (c, xs') <- T.uncons xs+    , T.null xs'+    , isSymbol c || isPunctuation c+                    -> [str props xs]     | ty `elem` [Op, Bin, Rel]                     -> [mnode "box"                         [ mnode "boxPr"@@ -206,7 +211,7 @@                         , mnode "e"                           [str props xs]                         ]]-   ESymbol _ xs     -> [str props xs]+    | otherwise     -> [str props xs]    ESpace n      | n > 0 && n <= 0.17    -> [str props "\x2009"]      | n > 0.17 && n <= 0.23 -> [str props "\x2005"]@@ -216,15 +221,15 @@      | n > 1.8               -> [str props "\x2001\x2001"]      | otherwise             -> [str props "\x200B"]        -- this is how the xslt sheet handles all spaces-   EUnder _ x (ESymbol _ [c]) | isBarChar c ->+   EUnder _ x (ESymbol _ (T.unpack -> [c])) | isBarChar c ->                        [mnode "bar" [ mnode "barPr" $                                         mnodeA "pos" "bot" ()                                     , mnode "e" $ showExp props x ]]-   EOver _ x (ESymbol _ [c]) | isBarChar c ->+   EOver _ x (ESymbol _ (T.unpack -> [c])) | isBarChar c ->                        [mnode "bar" [ mnode "barPr" $                                         mnodeA "pos" "top" ()                                     , mnode "e" $ showExp props x ]]-   EOver _ x (ESymbol st y)+   EOver _ x (ESymbol st (T.unpack -> y))     | st == Accent  -> [mnode "acc" [ mnode "accPr" [ mnodeA "chr" y () ]                                     , mnode "e" $ showExp props x ]]     | st == TUnder  -> [mnode "groupChr" [ mnode "groupChrPr"@@ -272,10 +277,11 @@ isNary (ESymbol Op _) = True isNary _ = False -makeNary :: [Element] -> String -> String -> Exp -> Exp -> Exp -> Element+-- Kept as String for Text.XML.Light+makeNary :: [Element] -> String -> T.Text -> Exp -> Exp -> Exp -> Element makeNary props t s y z w =   mnode "nary" [ mnode "naryPr"-                 [ mnodeA "chr" s ()+                 [ mnodeA "chr" (T.unpack s) ()                  , mnodeA "limLoc" t ()                  , mnodeA "subHide"                     (if y == EGrouped [] then "1" else "0") ()
src/Text/TeXMath/Writers/Pandoc.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-} {- Copyright (C) 2010-2013 John MacFarlane <jgm@berkeley.edu> @@ -23,6 +25,7 @@ module Text.TeXMath.Writers.Pandoc (writePandoc) where import Text.Pandoc.Definition+import qualified Data.Text as T import Text.TeXMath.Unicode.ToUnicode import Text.TeXMath.Types import Text.TeXMath.Shared (getSpaceChars)@@ -69,7 +72,7 @@ medspace  = EText TextNormal "\x2005" widespace = EText TextNormal "\x2004" -renderStr :: TextType -> String -> Inline+renderStr :: TextType -> T.Text -> Inline renderStr tt s =   case tt of        TextNormal       -> Str s@@ -116,29 +119,29 @@   z' <- expToInlines tt z   return $ x' ++ [Subscript y'] ++ [Superscript z'] expToInlines _ (EText tt' x) = Just [renderStr tt' x]-expToInlines tt (EOver b (EGrouped [EIdentifier [c]]) (ESymbol Accent [accent])) = expToInlines tt (EOver b (EIdentifier [c]) (ESymbol Accent [accent]))-expToInlines tt (EOver _ (EIdentifier [c]) (ESymbol Accent [accent])) =+expToInlines tt (EOver b (EGrouped [EIdentifier (T.unpack -> [c])]) (ESymbol Accent (T.unpack -> [accent]))) = expToInlines tt (EOver b (EIdentifier $ T.singleton c) (ESymbol Accent $ T.singleton accent))+expToInlines tt (EOver _ (EIdentifier (T.unpack -> [c])) (ESymbol Accent (T.unpack -> [accent]))) =     case accent of-         '\x203E' -> Just [renderStr tt' [c,'\x0304']]  -- bar-         '\x0304' -> Just [renderStr tt' [c,'\x0304']]  -- bar combining-         '\x00B4' -> Just [renderStr tt' [c,'\x0301']]  -- acute-         '\x0301' -> Just [renderStr tt' [c,'\x0301']]  -- acute combining-         '\x0060' -> Just [renderStr tt' [c,'\x0300']]  -- grave-         '\x0300' -> Just [renderStr tt' [c,'\x0300']]  -- grave combining-         '\x02D8' -> Just [renderStr tt' [c,'\x0306']]  -- breve-         '\x0306' -> Just [renderStr tt' [c,'\x0306']]  -- breve combining-         '\x02C7' -> Just [renderStr tt' [c,'\x030C']]  -- check-         '\x030C' -> Just [renderStr tt' [c,'\x030C']]  -- check combining-         '.'      -> Just [renderStr tt' [c,'\x0307']]  -- dot-         '\x0307' -> Just [renderStr tt' [c,'\x0307']]  -- dot combining-         '\x00B0' -> Just [renderStr tt' [c,'\x030A']]  -- ring-         '\x030A' -> Just [renderStr tt' [c,'\x030A']]  -- ring combining-         '\x20D7' -> Just [renderStr tt' [c,'\x20D7']]  -- arrow right-         '\x20D6' -> Just [renderStr tt' [c,'\x20D6']]  -- arrow left-         '\x005E' -> Just [renderStr tt' [c,'\x0302']]  -- hat-         '\x0302' -> Just [renderStr tt' [c,'\x0302']]  -- hat combining-         '~'      -> Just [renderStr tt' [c,'\x0303']]  -- tilde-         '\x0303' -> Just [renderStr tt' [c,'\x0303']]  -- tilde combining+         '\x203E' -> Just [renderStr tt' $ T.pack [c,'\x0304']]  -- bar+         '\x0304' -> Just [renderStr tt' $ T.pack [c,'\x0304']]  -- bar combining+         '\x00B4' -> Just [renderStr tt' $ T.pack [c,'\x0301']]  -- acute+         '\x0301' -> Just [renderStr tt' $ T.pack [c,'\x0301']]  -- acute combining+         '\x0060' -> Just [renderStr tt' $ T.pack [c,'\x0300']]  -- grave+         '\x0300' -> Just [renderStr tt' $ T.pack [c,'\x0300']]  -- grave combining+         '\x02D8' -> Just [renderStr tt' $ T.pack [c,'\x0306']]  -- breve+         '\x0306' -> Just [renderStr tt' $ T.pack [c,'\x0306']]  -- breve combining+         '\x02C7' -> Just [renderStr tt' $ T.pack [c,'\x030C']]  -- check+         '\x030C' -> Just [renderStr tt' $ T.pack [c,'\x030C']]  -- check combining+         '.'      -> Just [renderStr tt' $ T.pack [c,'\x0307']]  -- dot+         '\x0307' -> Just [renderStr tt' $ T.pack [c,'\x0307']]  -- dot combining+         '\x00B0' -> Just [renderStr tt' $ T.pack [c,'\x030A']]  -- ring+         '\x030A' -> Just [renderStr tt' $ T.pack [c,'\x030A']]  -- ring combining+         '\x20D7' -> Just [renderStr tt' $ T.pack [c,'\x20D7']]  -- arrow right+         '\x20D6' -> Just [renderStr tt' $ T.pack [c,'\x20D6']]  -- arrow left+         '\x005E' -> Just [renderStr tt' $ T.pack [c,'\x0302']]  -- hat+         '\x0302' -> Just [renderStr tt' $ T.pack [c,'\x0302']]  -- hat combining+         '~'      -> Just [renderStr tt' $ T.pack [c,'\x0303']]  -- tilde+         '\x0303' -> Just [renderStr tt' $ T.pack [c,'\x0303']]  -- tilde combining          _        -> Nothing       where tt' = if tt == TextNormal then TextItalic else tt expToInlines tt (EScaled _ e) = expToInlines tt e
src/Text/TeXMath/Writers/TeX.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, ViewPatterns, GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, ViewPatterns, GADTs, OverloadedStrings #-} {- Copyright (C) 2014 Matthew Pickering <matthewtpickering@gmail.com> @@ -18,14 +18,15 @@  -} -module Text.TeXMath.Writers.TeX (writeTeX, writeTeXWith, addLaTeXEnvironment ) where+module Text.TeXMath.Writers.TeX (writeTeX, writeTeXWith, addLaTeXEnvironment) where  import Text.TeXMath.Types import Text.TeXMath.Unicode.ToTeX (getTeXMath) import Text.TeXMath.Unicode.ToUnicode (fromUnicode) import qualified Text.TeXMath.Shared as S-import Data.Char (toLower)+import qualified Data.Text as T import Data.Generics (everywhere, mkT)+import Data.Semigroup ((<>)) import Control.Applicative ((<$>), Applicative) import Control.Monad (when, unless, foldM_) import Control.Monad.Reader (MonadReader, runReader, Reader, asks, local)@@ -38,20 +39,20 @@  -- | Transforms an expression tree to equivalent LaTeX with the default -- packages (amsmath and amssymb)-writeTeX :: [Exp] -> String+writeTeX :: [Exp] -> T.Text writeTeX = writeTeXWith defaultEnv  -- | Adds the correct LaTeX environment around a TeXMath fragment-addLaTeXEnvironment :: DisplayType -> String -> String+addLaTeXEnvironment :: DisplayType -> T.Text -> T.Text addLaTeXEnvironment dt math =     case dt of-      DisplayInline -> "\\(" ++ math ++ "\\)"-      DisplayBlock  -> "\\[" ++ math ++ "\\]"+      DisplayInline -> "\\(" <> math <> "\\)"+      DisplayBlock  -> "\\[" <> math <> "\\]"  -- |  Transforms an expression tree to equivalent LaTeX with the specified -- packages-writeTeXWith :: Env -> [Exp] -> String-writeTeXWith env es = drop 1 . init . flip renderTeX "" . Grouped $+writeTeXWith :: Env -> [Exp] -> T.Text+writeTeXWith env es = T.drop 1 . T.init . flip renderTeX "" . Grouped $                             runExpr env $                               mapM_ writeExp (removeOuterGroup es) @@ -69,13 +70,13 @@                   deriving (Functor, Applicative, Monad, MonadReader MathState                            , MonadWriter [TeX]) -getTeXMathM :: String -> Math [TeX]+getTeXMathM :: T.Text -> Math [TeX] getTeXMathM s = getTeXMath s <$> asks mathEnv  tellGroup :: Math () -> Math () tellGroup = censor ((:[]) . Grouped) -tellGenFrac :: String -> String -> Math ()+tellGenFrac :: T.Text -> T.Text -> Math () tellGenFrac open close =   tell [ ControlSeq "\\genfrac"        , Grouped [Literal open]@@ -83,7 +84,7 @@        , Grouped [Literal "0pt"]        , Grouped [] ] -writeBinom :: String -> Exp -> Exp -> Math ()+writeBinom :: T.Text -> Exp -> Exp -> Math () writeBinom cmd x y = do   env <- asks mathEnv   if "amsmath" `elem` env@@ -153,13 +154,13 @@          -- use \operatorname* if convertible          asks mathConvertible >>= flip when (tell [Token '*'])          tell [Grouped math]-writeExp (ESymbol Ord [c])  -- do not render "invisible operators"+writeExp (ESymbol Ord (T.unpack -> [c]))  -- do not render "invisible operators"   | c `elem` ['\x2061'..'\x2064'] = return () -- see 3.2.5.5 of mathml spec writeExp (ESymbol t s) = do   s' <- getTeXMathM s   when (t == Bin || t == Rel) $ tell [Space]-  if length s > 1 && (t == Bin || t == Rel || t == Op)-     then tell [ControlSeq ("\\math" ++ map toLower (show t)),+  if T.length s > 1 && (t == Bin || t == Rel || t == Op)+     then tell [ControlSeq ("\\math" <> T.toLower (tshow t)),                  Grouped [ControlSeq "\\text", Grouped s']]      else tell s'   when (t == Bin || t == Rel) $ tell [Space]@@ -239,7 +240,7 @@   | otherwise = writeExp e writeExp (EText ttype s) = do   let txtcmd = getTextCommand ttype-  case map escapeLaTeX s of+  case map escapeLaTeX (T.unpack s) of        []   -> return ()        xs   -> tell $ txtcmd (Grouped xs) writeExp (EStyled ttype es) = do@@ -257,7 +258,7 @@      then table "matrix" [] rows      else table "array" aligns rows -table :: String -> [Alignment] -> [ArrayLine] -> Math ()+table :: T.Text -> [Alignment] -> [ArrayLine] -> Math () table name aligns rows = do   tell [ControlSeq "\\begin", Grouped [Literal name]]   unless (null aligns) $@@ -266,7 +267,7 @@   mapM_ row rows   tell [ControlSeq "\\end", Grouped [Literal name]]   where-    columnAligns = map alignmentToLetter aligns+    columnAligns = T.pack $ map alignmentToLetter aligns     alignmentToLetter AlignLeft = 'l'     alignmentToLetter AlignCenter = 'c'     alignmentToLetter AlignRight = 'r'@@ -281,7 +282,7 @@  data FenceType = DLeft | DMiddle | DRight -type Delim = String+type Delim = T.Text  writeDelim :: FenceType -> Delim -> Math () writeDelim fence delim = do@@ -340,7 +341,7 @@ -- Utility  -- | Maps a length in em to the nearest LaTeX space command-getSpaceCommand :: Bool -> Rational -> String+getSpaceCommand :: Bool -> Rational -> T.Text getSpaceCommand amsmath width =   case floor (width * 18) :: Int of           -3       -> "\\!"@@ -351,8 +352,8 @@           18       -> "\\quad"           36       -> "\\qquad"           n        -> if amsmath-                         then "\\mspace{" ++ show n ++ "mu}"-                         else "{\\mskip " ++ show n ++ "mu}"+                         then "\\mspace{" <> tshow n <> "mu}"+                         else "{\\mskip " <> tshow n <> "mu}"  getTextCommand :: TextType -> TeX -> [TeX] getTextCommand tt x =@@ -394,7 +395,6 @@ isFancy (EPhantom _) = True isFancy _ = False - isOperator :: Exp -> Bool isOperator (EMathOperator _) = True isOperator (ESymbol Op _)    = True@@ -403,3 +403,6 @@ removeOuterGroup :: [Exp] -> [Exp] removeOuterGroup [EGrouped es] = es removeOuterGroup es = es++tshow :: Show a => a -> T.Text+tshow = T.pack . show
tests/test-texmath.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ import System.Directory import System.FilePath import Text.XML.Light@@ -6,18 +8,15 @@ import System.Process import Text.TeXMath import System.Exit-import Control.Applicative import Control.Monad+import Data.Semigroup ((<>)) import GHC.IO.Encoding (setLocaleEncoding) import qualified Data.Text as T import qualified Data.Text.IO as T-import Data.List (intercalate)-import Data.List.Split (splitWhen) import System.Environment (getArgs) --- strict version of readFile-readFile' :: FilePath -> IO String-readFile' f = T.unpack <$> T.readFile f+tshow :: Show a => a -> T.Text+tshow = T.pack . show  data Status = Pass FilePath FilePath             | Fail FilePath FilePath@@ -26,16 +25,16 @@  type Ext = String -readers :: [(Ext, String -> Either String [Exp])]+readers :: [(Ext, T.Text -> Either T.Text [Exp])] readers = [ (".tex", readTeX)           , (".mml", readMathML)           , (".omml", readOMML)           ] -writers :: [(Ext, [Exp] -> String)]-writers = [ (".mml", ppTopElement . writeMathML DisplayBlock)+writers :: [(Ext, [Exp] -> T.Text)]+writers = [ (".mml", T.pack . ppTopElement . writeMathML DisplayBlock)           , (".tex", writeTeX)-          , (".omml", ppTopElement . writeOMML DisplayBlock)+          , (".omml", T.pack . ppTopElement . writeOMML DisplayBlock)           , (".eqn", writeEqn DisplayBlock)           ] @@ -52,16 +51,16 @@                  then do                    texs <- runRoundTrip "tex" writeTeX readTeX                    ommls <- runRoundTrip "omml"-                               (ppTopElement .  writeOMML DisplayBlock) readOMML+                               (T.pack . ppTopElement .  writeOMML DisplayBlock) readOMML                    mathmls <- runRoundTrip "mml"-                                (ppTopElement . writeMathML DisplayBlock)+                                (T.pack . ppTopElement . writeMathML DisplayBlock)                                 readMathML-                   return $ texs ++ ommls ++ mathmls-                 else (++) <$> (concat <$> mapM (uncurry (runReader regen)) readers)+                   return $ texs <> ommls <> mathmls+                 else (<>) <$> (concat <$> mapM (uncurry (runReader regen)) readers)                            <*> (concat <$> mapM (uncurry (runWriter regen)) writers)   let passes = length $ filter isPass statuses   let failures = length statuses - passes-  putStrLn $ show passes ++ " tests passed, " ++ show failures ++ " failed."+  T.putStrLn $ tshow passes <> " tests passed, " <> tshow failures <> " failed."   if all isPass statuses      then exitWith ExitSuccess      else exitWith $ ExitFailure failures@@ -70,47 +69,49 @@ printPass _inp _out = return () -- putStrLn $ "PASSED:  " ++ inp ++ " ==> " ++ out  -- Second parameter is Left format (for round-trip) or Right output file.-printFail :: FilePath -> Either String FilePath -> String -> IO ()+printFail :: FilePath -> Either T.Text FilePath -> T.Text -> IO () printFail inp out actual =   withTempDirectory "." ((either (const inp) id out) ++ ".") $ \tmpDir -> do     -- break native files at commas for easier diffing     let breakAtCommas = case out of-                             Left _ -> intercalate ",\n" . splitWhen (==',')+                             Left _ -> T.intercalate ",\n" . T.split (==',')                              Right f | takeExtension f == ".native" ->-                                       intercalate ",\n" . splitWhen (==',')+                                       T.intercalate ",\n" . T.split (==',')                              _ -> id-    putStrLn $ "FAILED:  " ++ inp ++ " ==> " ++-              either (\x -> "round trip via " ++ x) id out-    readFile' (either (const inp) id out) >>=-      writeFile (tmpDir </> "expected") . ensureFinalNewline . breakAtCommas-    writeFile (tmpDir </> "actual") $ ensureFinalNewline $ breakAtCommas actual+    T.putStrLn $ "FAILED:  " <> T.pack inp <> " ==> " <>+      either (\x -> "round trip via " <> x) T.pack out+    T.readFile (either (const inp) id out) >>=+      T.writeFile (tmpDir </> "expected") . ensureFinalNewline . breakAtCommas+    T.writeFile (tmpDir </> "actual") $ ensureFinalNewline $ breakAtCommas actual     hFlush stdout     _ <- runProcess "diff" ["-u", tmpDir </> "expected", tmpDir </> "actual"]              Nothing Nothing Nothing Nothing Nothing >>= waitForProcess     putStrLn "" -printError :: FilePath -> FilePath -> String -> IO ()+printError :: FilePath -> FilePath -> T.Text -> IO () printError inp out msg =-  putStrLn $ "ERROR:  " ++ inp ++ " ==> " ++ out ++ "\n" ++ msg+  T.putStrLn $ "ERROR:  " <> T.pack inp <> " ==> " <> T.pack out <> "\n" <> msg -ensureFinalNewline :: String -> String-ensureFinalNewline "" = ""-ensureFinalNewline xs = if last xs == '\n' then xs else xs ++ "\n"+ensureFinalNewline :: T.Text -> T.Text+ensureFinalNewline xs = case T.unsnoc xs of+  Nothing        -> xs+  Just (_, '\n') -> xs+  _              -> xs <> "\n"  isPass :: Status -> Bool isPass (Pass _ _) = True isPass _ = False -runReader :: Bool -> String -> (String -> Either String [Exp]) -> IO [Status]+runReader :: Bool -> Ext -> (T.Text -> Either T.Text [Exp]) -> IO [Status] runReader regen ext f = do   input <- filter (\x -> takeExtension x == ext) <$> getDirectoryContents "./src"   let input' = map ("src" </>) input   mapM (\inp ->-        runReaderTest regen (\x -> show <$> f x) inp (rename inp)) input'+        runReaderTest regen (\x -> tshow <$> f x) inp (rename inp)) input'   where     rename x = replaceExtension (replaceDirectory x ("./readers" </> (tail ext))) "native" -runWriter ::  Bool -> String -> ([Exp] -> String) -> IO [Status]+runWriter :: Bool -> Ext -> ([Exp] -> T.Text) -> IO [Status] runWriter regen ext f = do   mmls <- map ("./readers/mml/"++) <$> getDirectoryContents "./readers/mml"   texs <- map ("./readers/tex/"++) <$> getDirectoryContents "./readers/tex"@@ -121,35 +122,35 @@        inputs  runRoundTrip :: String-             -> ([Exp] -> String)-             -> (String -> Either String [Exp])+             -> ([Exp] -> T.Text)+             -> (T.Text -> Either T.Text [Exp])              -> IO [Status] runRoundTrip fmt writer reader = do   inps <- filter (\x -> takeExtension x == ".native") <$>-             map (("./readers/" ++ fmt ++ "/") ++) <$>-                 getDirectoryContents ("./readers/" ++ fmt)+             map (("./readers/" <> fmt <> "/") <>) <$>+                 getDirectoryContents ("./readers/" <> fmt)   mapM (runRoundTripTest fmt writer reader) inps -runWriterTest :: Bool -> ([Exp] -> String) -> FilePath -> FilePath -> IO Status+runWriterTest :: Bool -> ([Exp] -> T.Text) -> FilePath -> FilePath -> IO Status runWriterTest regen f input output = do-  rawnative <- readFile' input-  native <- case reads rawnative of+  rawnative <- T.readFile input+  native <- case reads $ T.unpack rawnative of                  ((x,_):_) -> return x                  []        -> error $ "Could not read " ++ input   let result = ensureFinalNewline $ f native-  when regen $ writeFile output result-  out_t <- ensureFinalNewline <$> readFile' output+  when regen $ T.writeFile output result+  out_t <- ensureFinalNewline <$> T.readFile output   if result == out_t      then printPass input output >> return (Pass input output)      else printFail input (Right output) result >> return (Fail input output)  runReaderTest :: Bool-        -> (String -> Either String String)+        -> (T.Text -> Either T.Text T.Text)         -> FilePath         -> FilePath         -> IO Status runReaderTest regen fn input output = do-  inp_t <- readFile' input+  inp_t <- T.readFile input   let result = ensureFinalNewline <$> fn inp_t   let errfile = dropExtension output ++ ".error"   errorExpected <- doesFileExist errfile@@ -164,8 +165,8 @@              return (Error input errfile)      else do        when regen $-         writeFile output (either (const "") id result)-       out_t <- ensureFinalNewline <$> readFile' output+         T.writeFile output (either (const "") id result)+       out_t <- ensureFinalNewline <$> T.readFile output        case result of             Left msg -> do                 printError input output msg@@ -179,13 +180,13 @@                   return (Fail input output)  runRoundTripTest :: String-                 -> ([Exp] -> String)-                 -> (String -> Either String [Exp])+                 -> ([Exp] -> T.Text)+                 -> (T.Text -> Either T.Text [Exp])                  -> FilePath                  -> IO Status runRoundTripTest fmt writer reader input = do-  rawnative <- readFile' input-  native <- case reads rawnative of+  rawnative <- T.readFile input+  native <- case reads $ T.unpack rawnative of                  ((x,_):_) -> return x                  []        -> error $ "Could not read " ++ input   let rendered = ensureFinalNewline $ writer native@@ -195,5 +196,5 @@        Right r          | r == native -> printPass input input >>                           return (Pass input input)-         | otherwise   -> printFail input (Left fmt) (show r) >>+         | otherwise   -> printFail input (Left $ T.pack fmt) (tshow r) >>                           return (Fail input input)
texmath.cabal view
@@ -1,5 +1,5 @@ Name:                texmath-Version:             0.11.3+Version:             0.12 Cabal-Version:       >= 1.10 Build-type:          Simple Synopsis:            Conversion between formats used to represent mathematics.@@ -87,7 +87,7 @@  Library     Build-depends:       base >= 4.8 && < 5, syb >= 0.4.2 && < 0.8, xml, parsec >= 3, containers,-                         pandoc-types >= 1.12.3.3 && < 1.18, mtl+                         pandoc-types >= 1.20 && < 1.21, mtl, text          Exposed-modules:     Text.TeXMath,                          Text.TeXMath.Types,@@ -130,8 +130,8 @@     if flag(executable)       Buildable:         True       Build-Depends:     base >= 4.8 && < 5, texmath, xml,-                         pandoc-types >= 1.12.3.3 && < 1.18,-                         split, aeson, bytestring, text+                         pandoc-types >= 1.20 && < 1.21,+                         aeson, bytestring, text     else       Buildable:         False     if flag(network-uri)@@ -145,6 +145,6 @@     Hs-Source-Dirs:      tests     Build-Depends:       base >= 4.8 && < 5, process, directory, filepath,                          texmath, xml, utf8-string, bytestring, process,-                         temporary, text, split+                         temporary, text     Default-Language:    Haskell2010     Ghc-Options:         -Wall