{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-
Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

{- | Functions for parsing a LaTeX formula to a Haskell representation.
-}

module Text.TeXMath.Readers.TeX (readTeX)
where

import Data.List (intercalate, intersperse, find)
import Control.Monad
import Data.Char (isDigit, isAscii, isLetter)
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Text (Text)
import Data.Maybe (catMaybes, fromJust, mapMaybe)
import Text.Parsec hiding (label)
import Text.Parsec.Error
import Text.Parsec.Text
import Text.TeXMath.Types
import Data.Functor (($>))
import qualified Text.TeXMath.Shared as S
import Text.TeXMath.Readers.TeX.Macros (applyMacros, parseMacroDefinitions)
import Text.TeXMath.Unicode.ToTeX (getSymbolType)
import Text.TeXMath.Unicode.ToUnicode (toUnicode)
import Text.TeXMath.Shared (getSpaceChars)
import Data.Generics (everywhere, mkT)
import Text.TeXMath.Readers.TeX.Commands ( styleOps, textOps, enclosures,
                                           operators, symbols, siUnitMap )

type TP = Parser

-- The parser

expr1 :: TP Exp
expr1 :: TP Exp
expr1 = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
          [ TP Exp
inbraces
          , TP Exp
variable
          , TP Exp
number
          , TP Exp
unicode
          , TP Exp
operator
          , TP Exp
bareSubSup
          , TP Exp
enclosure
          , TP Exp
hyperref
          , TP Exp
command
          ] forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* TP ()
ignorable

-- | Parse a formula, returning a list of 'Exp'.
readTeX :: Text -> Either Text [Exp]
readTeX :: Text -> Either Text [Exp]
readTeX Text
inp =
  let ([Macro]
ms, Text
rest) = Text -> ([Macro], Text)
parseMacroDefinitions Text
inp in
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParseError -> Text
showParseError Text
inp) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere (forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT Exp -> Exp
fixBins))
    forall a b. (a -> b) -> a -> b
$ forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse TP [Exp]
formula String
"formula" forall a b. (a -> b) -> a -> b
$ [Macro] -> Text -> Text
applyMacros [Macro]
ms Text
rest

-- | Convert Bin after nothing, Open, Pun, or Op to Op (#176).
fixBins :: Exp -> Exp
fixBins :: Exp -> Exp
fixBins Exp
e =
  case Exp
e of
    EGrouped [Exp]
es -> [Exp] -> Exp
EGrouped (Bool -> [Exp] -> [Exp]
fixBinList Bool
True [Exp]
es)
    EDelimited Text
op Text
cl [InEDelimited]
des -> Text -> Text -> [InEDelimited] -> Exp
EDelimited Text
op Text
cl (forall {a}. Bool -> [Either a Exp] -> [Either a Exp]
fixBinListDel Bool
True [InEDelimited]
des)
    Exp
_ -> Exp
e
 where
  fixBinList :: Bool -> [Exp] -> [Exp]
fixBinList Bool
atBeginning [Exp]
xs =
    case [Exp]
xs of
      ESymbol TeXSymbolType
Bin Text
t : [Exp]
rest
        | Bool
atBeginning
        -> TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Op Text
t forall a. a -> [a] -> [a]
: Bool -> [Exp] -> [Exp]
fixBinList Bool
False [Exp]
rest
      ESymbol TeXSymbolType
Bin Text
t : rest :: [Exp]
rest@(ESymbol TeXSymbolType
ty Text
_ : [Exp]
_)
        | TeXSymbolType
ty forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Open Bool -> Bool -> Bool
|| TeXSymbolType
ty forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Pun Bool -> Bool -> Bool
|| TeXSymbolType
ty forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Op
        -> TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Op Text
t forall a. a -> [a] -> [a]
: Bool -> [Exp] -> [Exp]
fixBinList Bool
False [Exp]
rest
      Exp
x:[Exp]
rest -> Exp
x forall a. a -> [a] -> [a]
: Bool -> [Exp] -> [Exp]
fixBinList Bool
False [Exp]
rest
      [] -> []

  fixBinListDel :: Bool -> [Either a Exp] -> [Either a Exp]
fixBinListDel Bool
atBeginning [Either a Exp]
xs =
    case [Either a Exp]
xs of
      Left a
x : [Either a Exp]
rest
        ->  forall a b. a -> Either a b
Left a
x forall a. a -> [a] -> [a]
: Bool -> [Either a Exp] -> [Either a Exp]
fixBinListDel Bool
True [Either a Exp]
rest
      Right (ESymbol TeXSymbolType
Bin Text
t) : [Either a Exp]
rest
        | Bool
atBeginning
        -> forall a b. b -> Either a b
Right (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Op Text
t) forall a. a -> [a] -> [a]
: Bool -> [Either a Exp] -> [Either a Exp]
fixBinListDel Bool
False [Either a Exp]
rest
      Right (ESymbol TeXSymbolType
Bin Text
t) : rest :: [Either a Exp]
rest@(Right (ESymbol TeXSymbolType
ty Text
_):[Either a Exp]
_)
        | TeXSymbolType
ty forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Open Bool -> Bool -> Bool
|| TeXSymbolType
ty forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Pun Bool -> Bool -> Bool
|| TeXSymbolType
ty forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Op
        -> forall a b. b -> Either a b
Right (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Op Text
t) forall a. a -> [a] -> [a]
: Bool -> [Either a Exp] -> [Either a Exp]
fixBinListDel Bool
False [Either a Exp]
rest
      Either a Exp
x:[Either a Exp]
rest -> Either a Exp
x forall a. a -> [a] -> [a]
: Bool -> [Either a Exp] -> [Either a Exp]
fixBinListDel Bool
False [Either a Exp]
rest
      [] -> []

showParseError :: Text -> ParseError -> Text
showParseError :: Text -> ParseError -> Text
showParseError Text
inp ParseError
pe =
  Text
snippet forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
caretline forall a. Semigroup a => a -> a -> a
<>
    String -> Text
T.pack (String
-> String -> String -> String -> String -> [Message] -> String
showErrorMessages String
"or" String
"unknown" String
"expecting" String
"unexpected" String
"eof"
            (ParseError -> [Message]
errorMessages ParseError
pe))
  where errln :: Line
errln = SourcePos -> Line
sourceLine (ParseError -> SourcePos
errorPos ParseError
pe)
        errcol :: Line
errcol = SourcePos -> Line
sourceColumn (ParseError -> SourcePos
errorPos ParseError
pe)
        snipoffset :: Line
snipoffset = forall a. Ord a => a -> a -> a
max Line
0 (Line
errcol forall a. Num a => a -> a -> a
- Line
20)
        inplns :: [Text]
inplns = Text -> [Text]
T.lines Text
inp
        ln :: Text
ln = if forall (t :: * -> *) a. Foldable t => t a -> Line
length [Text]
inplns forall a. Ord a => a -> a -> Bool
>= Line
errln
                then [Text]
inplns forall a. [a] -> Line -> a
!! (Line
errln forall a. Num a => a -> a -> a
- Line
1)
                else Text
""  -- should not happen
        snippet :: Text
snippet = Line -> Text -> Text
T.take Line
40 forall a b. (a -> b) -> a -> b
$ Line -> Text -> Text
T.drop Line
snipoffset Text
ln
        caretline :: Text
caretline = Line -> Text -> Text
T.replicate (Line
errcol forall a. Num a => a -> a -> a
- Line
snipoffset forall a. Num a => a -> a -> a
- Line
1) Text
" " forall a. Semigroup a => a -> a -> a
<> Text
"^"

anyCtrlSeq :: TP Text
anyCtrlSeq :: TP Text
anyCtrlSeq = forall a. TP a -> TP a
lexeme forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
  String
res <- forall s (m :: * -> *) t u a.
Stream s m t =>
Line -> ParsecT s u m a -> ParsecT s u m [a]
count Line
1 (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isLetter)) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isLetter)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Char
'\\' forall a. a -> [a] -> [a]
: String
res

ctrlseq :: String -> TP String
ctrlseq :: String -> ParsecT Text () Identity String
ctrlseq String
s = forall a. TP a -> TP a
lexeme forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  String
result <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (Char
'\\'forall a. a -> [a] -> [a]
:String
s)
  case String
s of
       [Char
c] | Bool -> Bool
not (Char -> Bool
isLetter Char
c) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
       String
_ -> (do SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
                forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos
                forall (m :: * -> *) a. MonadPlus m => m a
mzero forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> (String
"non-letter after \\" forall a. [a] -> [a] -> [a]
++ String
s))
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  forall (m :: * -> *) a. Monad m => a -> m a
return String
result

ignorable :: TP ()
ignorable :: TP ()
ignorable = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall a b. (a -> b) -> a -> b
$
        TP ()
comment
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP ()
label
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP ()
tag
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text () Identity String
ctrlseq String
"nonumber"
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"whitespace")

comment :: TP ()
comment :: TP ()
comment = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\n") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline

label :: TP ()
label :: TP ()
label = String -> ParsecT Text () Identity String
ctrlseq String
"label" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. TP a -> TP a
braces (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"}"))

tag :: TP ()
tag :: TP ()
tag = String -> ParsecT Text () Identity String
ctrlseq String
"tag" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. TP a -> TP a
braces (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"}"))

unGrouped :: Exp -> [Exp]
unGrouped :: Exp -> [Exp]
unGrouped (EGrouped [Exp]
xs) = [Exp]
xs
unGrouped Exp
x = [Exp
x]

formula :: TP [Exp]
formula :: TP [Exp]
formula = Exp -> [Exp]
unGrouped forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TP ()
ignorable forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP Exp -> TP Exp
manyExp TP Exp
expr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)

expr :: TP Exp
expr :: TP Exp
expr = do
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (String -> ParsecT Text () Identity String
ctrlseq String
"displaystyle" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text () Identity String
ctrlseq String
"textstyle" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            String -> ParsecT Text () Identity String
ctrlseq String
"scriptstyle" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text () Identity String
ctrlseq String
"scriptscriptstyle")
  (Exp
a, Bool
convertible) <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall a. TP a -> TP a
braces ParsecT Text () Identity (Exp, Bool)
operatorname) -- needed because macros add {}
                 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity (Exp, Bool)
operatorname
                 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((,Bool
False) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
expr1)
  Maybe Bool
limits <- TP (Maybe Bool)
limitsIndicator
  Maybe Bool -> Bool -> Exp -> TP Exp
subSup Maybe Bool
limits Bool
convertible Exp
a forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe Bool -> Bool -> Exp -> TP Exp
superOrSubscripted Maybe Bool
limits Bool
convertible Exp
a forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Exp
a

hyperref :: TP Exp
hyperref :: TP Exp
hyperref = do
  String -> ParsecT Text () Identity String
ctrlseq String
"hyperref"  -- we just ignore hyperref, see #186
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional TP Exp
inbrackets
  TP Exp
inbraces

command :: TP Exp
command :: TP Exp
command = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Text
c <- TP Text
anyCtrlSeq
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Text
c forall a. Eq a => a -> a -> Bool
/= Text
"\\end" -- handled in environment
       Bool -> Bool -> Bool
&& Text
c forall a. Eq a => a -> a -> Bool
/= Text
"\\operatorname" -- handled in expr
  forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
    [ Text -> TP Exp
text Text
c
    , Text -> TP Exp
styled Text
c
    , Text -> TP Exp
root Text
c
    , Text -> TP Exp
xspace Text
c
    , Text -> TP Exp
mathop Text
c
    , Text -> TP Exp
phantom Text
c
    , Text -> TP Exp
boxed Text
c
    , Text -> TP Exp
binary Text
c
    , Text -> TP Exp
genfrac Text
c
    , Text -> TP Exp
substack Text
c
    , Text -> TP Exp
environment Text
c
    , Text -> TP Exp
ensuremath Text
c
    , Text -> TP Exp
scaled Text
c
    , Text -> TP Exp
negated Text
c
    , Text -> TP Exp
siunitx Text
c
    , Text -> TP Exp
arrow Text
c
    , Text -> TP Exp
tSymbol Text
c
    ] forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (String
"control sequence " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
c)


-- | Parser for \operatorname command.
-- Returns a tuple of EMathOperator name and Bool depending on the flavor
-- of the command:
--
--     - True for convertible operator (\operator*)
--
--     - False otherwise
operatorname :: TP (Exp, Bool)
operatorname :: ParsecT Text () Identity (Exp, Bool)
operatorname = do
    String -> ParsecT Text () Identity String
ctrlseq String
"operatorname"
    -- these are slightly different but we won't worry about that here...
    Bool
convertible <- (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Exp
tok' <- TP Exp
texToken
    Exp
tok'' <- (Text -> Exp
EMathOperator forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *). MonadPlus m => Exp -> m Text
expToOperatorName Exp
tok'))
           forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return (TextType -> [Exp] -> Exp
EStyled TextType
TextNormal [Exp
tok'])
    forall (m :: * -> *) a. Monad m => a -> m a
return (Exp
tok'', Bool
convertible)

-- | Converts identifiers, symbols and numbers to a flat string.
-- Fails if the expression contains anything else.
expToOperatorName :: MonadPlus m => Exp -> m Text
expToOperatorName :: forall (m :: * -> *). MonadPlus m => Exp -> m Text
expToOperatorName Exp
e = case Exp
e of
            EGrouped [Exp]
xs -> [Text] -> Text
T.concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {m :: * -> *}. MonadPlus m => TextType -> Exp -> m Text
toStr TextType
TextNormal) [Exp]
xs
            Exp
_ -> forall {m :: * -> *}. MonadPlus m => TextType -> Exp -> m Text
toStr TextType
TextNormal Exp
e
    where
          toStr :: TextType -> Exp -> m Text
toStr TextType
sty (EIdentifier Text
s)     = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TextType -> Text -> Text
toUnicode TextType
sty Text
s
          toStr TextType
_   (EText TextType
sty' Text
s)      = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TextType -> Text -> Text
toUnicode TextType
sty' Text
s
          toStr TextType
sty (ENumber Text
s)         = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TextType -> Text -> Text
toUnicode TextType
sty Text
s
          toStr TextType
sty (EMathOperator Text
s)   = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TextType -> Text -> Text
toUnicode TextType
sty Text
s
          -- handle special characters
          toStr TextType
_ (ESymbol TeXSymbolType
_ Text
"\x2212")  = forall (m :: * -> *) a. Monad m => a -> m a
return Text
"-"
          toStr TextType
_ (ESymbol TeXSymbolType
_ Text
"\x2032")  = forall (m :: * -> *) a. Monad m => a -> m a
return Text
"'"
          toStr TextType
_ (ESymbol TeXSymbolType
_ Text
"\x2033")  = forall (m :: * -> *) a. Monad m => a -> m a
return Text
"''"
          toStr TextType
_ (ESymbol TeXSymbolType
_ Text
"\x2034")  = forall (m :: * -> *) a. Monad m => a -> m a
return Text
"'''"
          toStr TextType
_ (ESymbol TeXSymbolType
_ Text
"\x2057")  = forall (m :: * -> *) a. Monad m => a -> m a
return Text
"''''"
          toStr TextType
_ (ESymbol TeXSymbolType
_ Text
"\x02B9")  = forall (m :: * -> *) a. Monad m => a -> m a
return Text
"'"
          toStr TextType
sty (ESymbol TeXSymbolType
_ Text
s)       = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TextType -> Text -> Text
toUnicode TextType
sty Text
s
          toStr TextType
_ (ESpace Rational
n)            = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Rational -> Text
getSpaceChars Rational
n
          toStr TextType
_ (EStyled TextType
sty' [Exp]
exps)   = [Text] -> Text
T.concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (forall a b. (a -> b) -> [a] -> [b]
map (TextType -> Exp -> m Text
toStr TextType
sty') [Exp]
exps)
          toStr TextType
_   Exp
_                   = forall (m :: * -> *) a. MonadPlus m => m a
mzero

bareSubSup :: TP Exp
bareSubSup :: TP Exp
bareSubSup = Maybe Bool -> Bool -> Exp -> TP Exp
subSup forall a. Maybe a
Nothing Bool
False (Text -> Exp
EIdentifier Text
"")
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe Bool -> Bool -> Exp -> TP Exp
superOrSubscripted forall a. Maybe a
Nothing Bool
False (Text -> Exp
EIdentifier Text
"")

limitsIndicator :: TP (Maybe Bool)
limitsIndicator :: TP (Maybe Bool)
limitsIndicator =
   (String -> ParsecT Text () Identity String
ctrlseq String
"limits" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Bool
True))
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> ParsecT Text () Identity String
ctrlseq String
"nolimits" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Bool
False))
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

binomCmd :: TP Text
binomCmd :: TP Text
binomCmd = [Text] -> TP Text
oneOfCommands (forall k a. Map k a -> [k]
M.keys Map Text (Exp -> Exp -> Exp)
binomCmds)

binomCmds :: M.Map Text (Exp -> Exp -> Exp)
binomCmds :: Map Text (Exp -> Exp -> Exp)
binomCmds = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [ (Text
"\\choose", \Exp
x Exp
y ->
                Text -> Text -> [InEDelimited] -> Exp
EDelimited Text
"(" Text
")" [forall a b. b -> Either a b
Right (FractionType -> Exp -> Exp -> Exp
EFraction FractionType
NoLineFrac Exp
x Exp
y)])
            , (Text
"\\brack", \Exp
x Exp
y ->
                Text -> Text -> [InEDelimited] -> Exp
EDelimited Text
"[" Text
"]" [forall a b. b -> Either a b
Right (FractionType -> Exp -> Exp -> Exp
EFraction FractionType
NoLineFrac Exp
x Exp
y)])
            , (Text
"\\brace", \Exp
x Exp
y ->
                Text -> Text -> [InEDelimited] -> Exp
EDelimited Text
"{" Text
"}" [forall a b. b -> Either a b
Right (FractionType -> Exp -> Exp -> Exp
EFraction FractionType
NoLineFrac Exp
x Exp
y)])
            , (Text
"\\bangle", \Exp
x Exp
y ->
                Text -> Text -> [InEDelimited] -> Exp
EDelimited Text
"\x27E8" Text
"\x27E9" [forall a b. b -> Either a b
Right (FractionType -> Exp -> Exp -> Exp
EFraction FractionType
NoLineFrac Exp
x Exp
y)])
            ]

genfrac :: Text -> TP Exp
genfrac :: Text -> TP Exp
genfrac Text
"\\genfrac" = do
  let opener :: ParsecT Text u Identity Text
opener = forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" forall a b. (a -> b) -> a -> b
$
                Char -> Text
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)
  let closer :: ParsecT Text u Identity Text
closer = forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" forall a b. (a -> b) -> a -> b
$
                Char -> Text
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)
  Text
openDelim <- forall a. TP a -> TP a
braces forall {u}. ParsecT Text u Identity Text
opener forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT Text u Identity Text
opener
  Text
closeDelim <- forall a. TP a -> TP a
braces forall {u}. ParsecT Text u Identity Text
closer forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT Text u Identity Text
closer
  Bool
bar <- Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall a. TP a -> TP a
braces (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0pt")) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TP Exp
texToken
  Bool
displayStyle <- Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall a. TP a -> TP a
braces (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0')) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TP Exp
texToken
  Exp
x <- TP Exp
texToken
  Exp
y <- TP Exp
texToken
  let fracType :: FractionType
fracType = case (Bool
bar, Bool
displayStyle) of
                      (Bool
False, Bool
_)   -> FractionType
NoLineFrac
                      (Bool
True, Bool
True) -> FractionType
DisplayFrac
                      (Bool, Bool)
_            -> FractionType
NormalFrac
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> [InEDelimited] -> Exp
EDelimited Text
openDelim Text
closeDelim
                      [forall a b. b -> Either a b
Right (FractionType -> Exp -> Exp -> Exp
EFraction FractionType
fracType Exp
x Exp
y)]
genfrac Text
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

substack :: Text -> TP Exp
substack :: Text -> TP Exp
substack Text
"\\substack" = do
  [Exp]
formulas <- forall a. TP a -> TP a
braces forall a b. (a -> b) -> a -> b
$ TP ()
ignorable forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (TP Exp -> TP Exp
manyExp TP Exp
expr) forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepEndBy` TP Char
endLine
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Alignment] -> [ArrayLine] -> Exp
EArray [Alignment
AlignCenter] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Exp
x -> [[Exp
x]]) [Exp]
formulas
substack Text
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

asGroup :: [Exp] -> Exp
asGroup :: [Exp] -> Exp
asGroup [Exp
x] = Exp
x
asGroup [Exp]
xs = [Exp] -> Exp
EGrouped [Exp]
xs

-- variant of many that is sensitive to \choose and other such commands
manyExp' :: Bool -> TP Exp -> TP Exp
manyExp' :: Bool -> TP Exp -> TP Exp
manyExp' Bool
requireNonempty TP Exp
p = do
  [Exp]
initial <- if Bool
requireNonempty
                then forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy TP Text
binomCmd forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TP Exp
p)
                else forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy TP Text
binomCmd forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TP Exp
p)
  let withCmd :: Text -> TP Exp
      withCmd :: Text -> TP Exp
withCmd Text
cmd =
         case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
cmd Map Text (Exp -> Exp -> Exp)
binomCmds of
              Just Exp -> Exp -> Exp
f  -> Exp -> Exp -> Exp
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Exp] -> Exp
asGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Exp]
initial)
                           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Exp] -> Exp
asGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many TP Exp
p)
              Maybe (Exp -> Exp -> Exp)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown command " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
cmd
  (TP Text
binomCmd forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> TP Exp
withCmd) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return ([Exp] -> Exp
asGroup [Exp]
initial)

manyExp :: TP Exp -> TP Exp
manyExp :: TP Exp -> TP Exp
manyExp = Bool -> TP Exp -> TP Exp
manyExp' Bool
False

many1Exp :: TP Exp -> TP Exp
many1Exp :: TP Exp -> TP Exp
many1Exp = Bool -> TP Exp -> TP Exp
manyExp' Bool
True

inbraces :: TP Exp
inbraces :: TP Exp
inbraces = forall a. TP a -> TP a
braces (TP Exp -> TP Exp
manyExp TP Exp
expr)

texToken :: TP Exp
texToken :: TP Exp
texToken = TP Exp
texSymbol forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
inbraces forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
texChar

-- Remove superfluous EGrouped if present.
deGroup :: Exp -> Exp
deGroup :: Exp -> Exp
deGroup (EGrouped [Exp
x]) = Exp
x
deGroup Exp
x = Exp
x

texChar :: TP Exp
texChar :: TP Exp
texChar =
  do
    Char
c <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\n\t\r \\{}" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (if Char -> Bool
isDigit Char
c then Text -> Exp
ENumber else Text -> Exp
EIdentifier) forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c

inbrackets :: TP Exp
inbrackets :: TP Exp
inbrackets = (forall a. TP a -> TP a
brackets forall a b. (a -> b) -> a -> b
$ TP Exp -> TP Exp
manyExp forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TP Exp
expr)

number :: TP Exp
number :: TP Exp
number = forall a. TP a -> TP a
lexeme forall a b. (a -> b) -> a -> b
$ Text -> Exp
ENumber forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall {u}. ParsecT Text u Identity Text
decimalNumber
  where decimalNumber :: ParsecT Text u Identity Text
decimalNumber = do
          String
xs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
          String
ys <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((Char
'.'forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit))
          case String
xs forall a. [a] -> [a] -> [a]
++ String
ys of
               []  -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
               String
zs  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
zs

enclosure :: TP Exp
enclosure :: TP Exp
enclosure = TP Exp
delimited forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
delimitedImplicit forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
basicEnclosure

basicEnclosure :: TP Exp
basicEnclosure :: TP Exp
basicEnclosure = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Text
possibleEncl <- forall a. TP a -> TP a
lexeme (TP Text
anyCtrlSeq forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Line -> TP Char -> TP Text
countChar Line
1 (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"()[]|"))
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
possibleEncl Map Text Exp
enclosures of
       Just Exp
x  -> forall (m :: * -> *) a. Monad m => a -> m a
return Exp
x
       Maybe Exp
Nothing -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

fence :: String -> TP Text
fence :: String -> TP Text
fence String
cmd = do
  String -> ParsecT Text () Identity String
symbol String
cmd
  let nullDelim :: TP Exp
nullDelim = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Open Text
"" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text () Identity String
symbol String
".")
      angleDelim :: TP Exp
angleDelim = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
        [ TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Open Text
"\x27E8" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text () Identity String
symbol String
"<"
        , TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Close Text
"\x27E9" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text () Identity String
symbol String
">"
        ]
  Exp
enc <- TP Exp
basicEnclosure forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
nullDelim forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
angleDelim
  case Exp
enc of
       ESymbol TeXSymbolType
Open Text
x  -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
       ESymbol TeXSymbolType
Close Text
x -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
       Exp
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

middle :: TP Text
middle :: TP Text
middle = String -> TP Text
fence String
"\\middle"

right :: TP Text
right :: TP Text
right = String -> TP Text
fence String
"\\right"

delimited :: TP Exp
delimited :: TP Exp
delimited = do
  Text
openc <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ String -> TP Text
fence String
"\\left"
  [InEDelimited]
contents <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
              forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Text
middle)
                      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> [Exp]
unGrouped forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                             TP Exp -> TP Exp
many1Exp (forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy TP Text
right forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP Exp
expr)))
  Text
closec <- TP Text
right forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> [InEDelimited] -> Exp
EDelimited Text
openc Text
closec [InEDelimited]
contents

delimitedImplicit :: TP Exp
delimitedImplicit :: TP Exp
delimitedImplicit = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Char
openc <- forall a. TP a -> TP a
lexeme forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"()[]|"
  Char
closec <- case Char
openc of
                 Char
'(' -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
')'
                 Char
'[' -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
']'
                 Char
'|' -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'|'
                 Char
_   -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
  let closer :: TP Char
closer = forall a. TP a -> TP a
lexeme forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
closec
  [InEDelimited]
contents <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
              forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Text
middle)
                      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> [Exp]
unGrouped forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                             TP Exp -> TP Exp
many1Exp (forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy TP Char
closer forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP Exp
expr)))
  Char
_ <- TP Char
closer
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> [InEDelimited] -> Exp
EDelimited (Char -> Text
T.singleton Char
openc) (Char -> Text
T.singleton Char
closec) [InEDelimited]
contents

scaled :: Text -> TP Exp
scaled :: Text -> TP Exp
scaled Text
cmd = do
  case Text -> Maybe Rational
S.getScalerValue Text
cmd of
       Just Rational
r  -> Rational -> Exp -> Exp
EScaled Rational
r forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TP Exp
basicEnclosure forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
operator)
       Maybe Rational
Nothing -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

endLine :: TP Char
endLine :: TP Char
endLine = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  String -> ParsecT Text () Identity String
symbol String
"\\\\"
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional TP Exp
inbrackets  -- can contain e.g. [1.0in] for a line height, not yet supported
  forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'

-- Within environments provided by AMSmath, spaces are not allowed between
-- the double-backslash command and its optional argument.
endLineAMS :: TP Char
endLineAMS :: TP Char
endLineAMS = forall a. TP a -> TP a
lexeme forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\\\"
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TP ()
comment
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional TP Exp
inbrackets  -- can contain e.g. [1.0in] for a line height, not yet supported
  forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'

arrayLine :: TP ArrayLine
arrayLine :: TP ArrayLine
arrayLine = forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (String -> ParsecT Text () Identity String
ctrlseq String
"end" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 (Exp -> [Exp]
unGrouped forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    TP Exp -> TP Exp
manyExp (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TP ()
ignorable' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy TP Char
endLine) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
               TP Exp
expr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
               TP ()
ignorable')) (String -> ParsecT Text () Identity String
symbol String
"&")
  where ignorable' :: TP ()
ignorable' = TP ()
ignorable forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                     forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Text () Identity String
ctrlseq String
"hline" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TP ()
ignorable'))
  -- we don't represent the line, but it shouldn't crash parsing

arrayAlignments :: TP [Alignment]
arrayAlignments :: TP [Alignment]
arrayAlignments = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  String
as <- forall a. TP a -> TP a
braces (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|'))
  let letterToAlignment :: Char -> Alignment
letterToAlignment Char
'l' = Alignment
AlignLeft
      letterToAlignment Char
'c' = Alignment
AlignCenter
      letterToAlignment Char
'r' = Alignment
AlignRight
      letterToAlignment Char
_   = Alignment
AlignCenter
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Char -> Alignment
letterToAlignment forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'|') String
as

environment :: Text -> TP Exp
environment :: Text -> TP Exp
environment Text
"\\begin" = do
  Text
name <- forall a. TP a -> TP a
braces ([Text] -> TP Text
oneOfStrings (forall k a. Map k a -> [k]
M.keys Map Text (TP Exp)
environments) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*'))
  forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
name Map Text (TP Exp)
environments of
        Just TP Exp
env -> do
          Exp
result <- TP Exp
env
          forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
          String -> ParsecT Text () Identity String
ctrlseq String
"end"
          forall a. TP a -> TP a
braces (Text -> TP Text
textStr Text
name forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*'))
          forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
          forall (m :: * -> *) a. Monad m => a -> m a
return Exp
result
        Maybe (TP Exp)
Nothing  -> forall (m :: * -> *) a. MonadPlus m => m a
mzero  -- should not happen
environment Text
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

environments :: M.Map Text (TP Exp)
environments :: Map Text (TP Exp)
environments = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (Text
"array", TP Exp
stdarray)
  , (Text
"eqnarray", TP Exp
eqnarray)
  , (Text
"align", TP Exp
align)
  , (Text
"aligned", TP Exp
align)
  , (Text
"alignat", TP Exp
inbraces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP Exp
align)
  , (Text
"alignedat", TP Exp
inbraces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP Exp
align)
  , (Text
"flalign", TP Exp
flalign)
  , (Text
"flaligned", TP Exp
flalign)
  , (Text
"cases", TP Exp
cases)
  , (Text
"matrix", Text -> Text -> TP Exp
matrixWith Text
"" Text
"")
  , (Text
"smallmatrix", Text -> Text -> TP Exp
matrixWith Text
"" Text
"")
  , (Text
"pmatrix", Text -> Text -> TP Exp
matrixWith Text
"(" Text
")")
  , (Text
"bmatrix", Text -> Text -> TP Exp
matrixWith Text
"[" Text
"]")
  , (Text
"Bmatrix", Text -> Text -> TP Exp
matrixWith Text
"{" Text
"}")
  , (Text
"vmatrix", Text -> Text -> TP Exp
matrixWith Text
"\x2223" Text
"\x2223")
  , (Text
"Vmatrix", Text -> Text -> TP Exp
matrixWith Text
"\x2225" Text
"\x2225")
  , (Text
"split", TP Exp
align)
  , (Text
"multline", TP Exp
gather)
  , (Text
"gather", TP Exp
gather)
  , (Text
"gathered", TP Exp
gather)
  , (Text
"equation", TP Exp
equation)
  ]

alignsFromRows :: Alignment -> [ArrayLine] -> [Alignment]
alignsFromRows :: Alignment -> [ArrayLine] -> [Alignment]
alignsFromRows Alignment
_ [] = []
alignsFromRows Alignment
defaultAlignment (ArrayLine
r:[ArrayLine]
_) = forall a. Line -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Line
length ArrayLine
r) Alignment
defaultAlignment

matrixWith :: Text -> Text -> TP Exp
matrixWith :: Text -> Text -> TP Exp
matrixWith Text
opendelim Text
closedelim = do
  [ArrayLine]
lines' <- forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy1 TP ArrayLine
arrayLine TP Char
endLineAMS
  let aligns :: [Alignment]
aligns = Alignment -> [ArrayLine] -> [Alignment]
alignsFromRows Alignment
AlignCenter [ArrayLine]
lines'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
opendelim Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
closedelim
              then [Alignment] -> [ArrayLine] -> Exp
EArray [Alignment]
aligns [ArrayLine]
lines'
              else Text -> Text -> [InEDelimited] -> Exp
EDelimited Text
opendelim Text
closedelim
                       [forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [Alignment] -> [ArrayLine] -> Exp
EArray [Alignment]
aligns [ArrayLine]
lines']

stdarray :: TP Exp
stdarray :: TP Exp
stdarray = do
  [Alignment]
aligns <- TP [Alignment]
arrayAlignments
  [ArrayLine]
lines' <- forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy1 TP ArrayLine
arrayLine TP Char
endLine
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Alignment] -> [ArrayLine] -> Exp
EArray [Alignment]
aligns [ArrayLine]
lines'

gather :: TP Exp
gather :: TP Exp
gather = do
  [ArrayLine]
rows <- forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy TP ArrayLine
arrayLine TP Char
endLineAMS
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Alignment] -> [ArrayLine] -> Exp
EArray (Alignment -> [ArrayLine] -> [Alignment]
alignsFromRows Alignment
AlignCenter [ArrayLine]
rows) [ArrayLine]
rows

equation :: TP Exp
equation :: TP Exp
equation = do
  forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (String -> ParsecT Text () Identity String
ctrlseq String
"end" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n')
  TP Exp -> TP Exp
manyExp (forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy TP Char
endLine forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TP Exp
expr)

eqnarray :: TP Exp
eqnarray :: TP Exp
eqnarray = do
  [ArrayLine]
rows <- forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy1 TP ArrayLine
arrayLine TP Char
endLine
  let n :: Line
n = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Line
length [ArrayLine]
rows
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Alignment] -> [ArrayLine] -> Exp
EArray (forall a. Line -> [a] -> [a]
take Line
n forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [Alignment
AlignRight, Alignment
AlignCenter, Alignment
AlignLeft]) [ArrayLine]
rows

align :: TP Exp
align :: TP Exp
align = do
  [ArrayLine]
rows <- forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy1 TP ArrayLine
arrayLine TP Char
endLineAMS
  let n :: Line
n = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Line
length [ArrayLine]
rows
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Alignment] -> [ArrayLine] -> Exp
EArray (forall a. Line -> [a] -> [a]
take Line
n forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [Alignment
AlignRight, Alignment
AlignLeft]) [ArrayLine]
rows

flalign :: TP Exp
flalign :: TP Exp
flalign = do
  [ArrayLine]
rows <- forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy1 TP ArrayLine
arrayLine TP Char
endLineAMS
  let n :: Line
n = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Line
length [ArrayLine]
rows
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Alignment] -> [ArrayLine] -> Exp
EArray (forall a. Line -> [a] -> [a]
take Line
n forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [Alignment
AlignLeft, Alignment
AlignRight]) [ArrayLine]
rows

cases :: TP Exp
cases :: TP Exp
cases = do
  [ArrayLine]
rs <- forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy1 TP ArrayLine
arrayLine TP Char
endLineAMS
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> [InEDelimited] -> Exp
EDelimited Text
"{" Text
"" [forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [Alignment] -> [ArrayLine] -> Exp
EArray (Alignment -> [ArrayLine] -> [Alignment]
alignsFromRows Alignment
AlignLeft [ArrayLine]
rs) [ArrayLine]
rs]

variable :: TP Exp
variable :: TP Exp
variable = do
  Char
v <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
  forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Exp
EIdentifier forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
v

isConvertible :: Exp -> Bool
isConvertible :: Exp -> Bool
isConvertible (EMathOperator Text
x) = Text
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
convertibleOps
  where convertibleOps :: [Text]
convertibleOps = [ Text
"lim",Text
"liminf",Text
"limsup",Text
"inf",Text
"sup"
                         , Text
"min",Text
"max",Text
"Pr",Text
"det",Text
"gcd"
                         ]
isConvertible (ESymbol TeXSymbolType
Rel Text
_) = Bool
True
isConvertible (ESymbol TeXSymbolType
Bin Text
_) = Bool
True
isConvertible (ESymbol TeXSymbolType
Op Text
x) = Text
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
convertibleSyms
  where convertibleSyms :: [Text]
convertibleSyms = [Text
"\x2211",Text
"\x220F",Text
"\x22C2",
           Text
"\x22C3",Text
"\x22C0",Text
"\x22C1",Text
"\x2A05",Text
"\x2A06",
           Text
"\x2210",Text
"\x2A01",Text
"\x2A02",Text
"\x2A00",Text
"\x2A04"]
isConvertible Exp
_ = Bool
False

-- check if sub/superscripts should always be under and over the expression
isUnderover :: Exp -> Bool
isUnderover :: Exp -> Bool
isUnderover (EOver Bool
_ Exp
_ (ESymbol TeXSymbolType
TOver Text
"\xFE37")) = Bool
True   -- \overbrace
isUnderover (EOver Bool
_ Exp
_ (ESymbol TeXSymbolType
TOver Text
"\x23B4")) = Bool
True   -- \overbracket
isUnderover (EOver Bool
_  Exp
_ (ESymbol TeXSymbolType
TOver Text
"\x23DE")) = Bool
True  -- \overbrace
isUnderover (EUnder Bool
_ Exp
_ (ESymbol TeXSymbolType
TUnder Text
"\xFE38")) = Bool
True  -- \underbrace
isUnderover (EUnder Bool
_ Exp
_ (ESymbol TeXSymbolType
TUnder Text
"\x23B5")) = Bool
True  -- \underbracket
isUnderover (EUnder Bool
_  Exp
_ (ESymbol TeXSymbolType
TUnder Text
"\x23DF")) = Bool
True  -- \underbrace
isUnderover Exp
_ = Bool
False

subSup :: Maybe Bool -> Bool -> Exp -> TP Exp
subSup :: Maybe Bool -> Bool -> Exp -> TP Exp
subSup Maybe Bool
limits Bool
convertible Exp
a = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  let sub1 :: TP Exp
sub1 = String -> ParsecT Text () Identity String
symbol String
"_" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TP Exp
expr1
  let sup1 :: TP Exp
sup1 = String -> ParsecT Text () Identity String
symbol String
"^" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TP Exp
expr1
  (Exp
b,Exp
c) <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do {Exp
m <- TP Exp
sub1; Exp
n <- TP Exp
sup1; forall (m :: * -> *) a. Monad m => a -> m a
return (Exp
m,Exp
n)})
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do {Exp
n <- TP Exp
sup1; Exp
m <- TP Exp
sub1; forall (m :: * -> *) a. Monad m => a -> m a
return (Exp
m,Exp
n)})
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe Bool
limits of
            Just Bool
True  -> Bool -> Exp -> Exp -> Exp -> Exp
EUnderover Bool
False Exp
a Exp
b Exp
c
            Maybe Bool
Nothing | Bool
convertible Bool -> Bool -> Bool
|| Exp -> Bool
isConvertible Exp
a -> Bool -> Exp -> Exp -> Exp -> Exp
EUnderover Bool
True Exp
a Exp
b Exp
c
                    | Exp -> Bool
isUnderover Exp
a -> Bool -> Exp -> Exp -> Exp -> Exp
EUnderover Bool
False Exp
a Exp
b Exp
c
            Maybe Bool
_          -> Exp -> Exp -> Exp -> Exp
ESubsup Exp
a Exp
b Exp
c

superOrSubscripted :: Maybe Bool -> Bool -> Exp -> TP Exp
superOrSubscripted :: Maybe Bool -> Bool -> Exp -> TP Exp
superOrSubscripted Maybe Bool
limits Bool
convertible Exp
a = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Char
c <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"^_"
  forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  Exp
b <- TP Exp
expr
  case Char
c of
       Char
'^' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe Bool
limits of
                        Just Bool
True  -> Bool -> Exp -> Exp -> Exp
EOver Bool
False Exp
a Exp
b
                        Maybe Bool
Nothing
                          | Bool
convertible Bool -> Bool -> Bool
|| Exp -> Bool
isConvertible Exp
a -> Bool -> Exp -> Exp -> Exp
EOver Bool
True Exp
a Exp
b
                          | Exp -> Bool
isUnderover Exp
a -> Bool -> Exp -> Exp -> Exp
EOver Bool
False Exp
a Exp
b
                        Maybe Bool
_          -> Exp -> Exp -> Exp
ESuper Exp
a Exp
b
       Char
'_' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe Bool
limits of
                        Just Bool
True  -> Bool -> Exp -> Exp -> Exp
EUnder Bool
False Exp
a Exp
b
                        Maybe Bool
Nothing
                          | Bool
convertible Bool -> Bool -> Bool
|| Exp -> Bool
isConvertible Exp
a -> Bool -> Exp -> Exp -> Exp
EUnder Bool
True Exp
a Exp
b
                          | Exp -> Bool
isUnderover Exp
a -> Bool -> Exp -> Exp -> Exp
EUnder Bool
False Exp
a Exp
b
                        Maybe Bool
_          -> Exp -> Exp -> Exp
ESub Exp
a Exp
b
       Char
_   -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

unicode :: TP Exp
unicode :: TP Exp
unicode = forall a. TP a -> TP a
lexeme forall a b. (a -> b) -> a -> b
$
  do
    Char
c <- forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAscii)
    forall (m :: * -> *) a. Monad m => a -> m a
return (TeXSymbolType -> Text -> Exp
ESymbol (Char -> TeXSymbolType
getSymbolType Char
c) forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c)

ensuremath :: Text -> TP Exp
ensuremath :: Text -> TP Exp
ensuremath Text
"\\ensuremath" = TP Exp
inbraces
ensuremath Text
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

phantom :: Text -> TP Exp
phantom :: Text -> TP Exp
phantom Text
"\\phantom" = Exp -> Exp
EPhantom forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
texToken
phantom Text
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

boxed :: Text -> TP Exp
boxed :: Text -> TP Exp
boxed Text
"\\boxed" = Exp -> Exp
EBoxed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
texToken
boxed Text
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

text :: Text -> TP Exp
text :: Text -> TP Exp
text Text
c = do
  Text -> Exp
op <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadPlus m => m a
mzero forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
c Map Text (Text -> Exp)
textOps
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
  let chunk :: TP Exp
chunk = ((Text -> Exp
op forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 TP Text
textual)
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Exp] -> Exp
asGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
manyTill TP Exp
chunk (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}')))
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
innermath
  [Exp]
contents <- forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
manyTill TP Exp
chunk (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}')
  forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  case [Exp]
contents of
       []   -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Exp
op Text
"")
       [Exp
x]  -> forall (m :: * -> *) a. Monad m => a -> m a
return Exp
x
       [Exp]
xs   -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Exp] -> Exp
EGrouped [Exp]
xs)

innermath :: TP Exp
innermath :: TP Exp
innermath = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> TP Exp
innerMathWith
              [(String
"$",String
"$"),(String
"$$",String
"$$"),(String
"\\(",String
"\\)"),(String
"\\[",String
"\\]")]

innerMathWith :: (String, String) -> TP Exp
innerMathWith :: (String, String) -> TP Exp
innerMathWith (String
opener, String
closer) = do
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
opener)
  Exp
e <- TP Exp -> TP Exp
manyExp TP Exp
expr
  forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
closer
  forall (m :: * -> *) a. Monad m => a -> m a
return Exp
e

styled :: Text -> TP Exp
styled :: Text -> TP Exp
styled Text
c = do
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
c Map Text ([Exp] -> Exp)
styleOps of
       Just [Exp] -> Exp
f   -> do
         Exp
x <- TP Exp
texSymbol forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
inbraces forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
texChar
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Exp
x of
                       EGrouped [Exp]
xs -> [Exp] -> Exp
f [Exp]
xs
                       Exp
_           -> [Exp] -> Exp
f [Exp
x]
       Maybe ([Exp] -> Exp)
Nothing  -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- note: sqrt can be unary, \sqrt{2}, or binary, \sqrt[3]{2}
root :: Text -> TP Exp
root :: Text -> TP Exp
root Text
c = do
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Text
c forall a. Eq a => a -> a -> Bool
== Text
"\\sqrt" Bool -> Bool -> Bool
|| Text
c forall a. Eq a => a -> a -> Bool
== Text
"\\surd"
  (Exp -> Exp -> Exp
ERoot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
inbrackets forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TP Exp
texToken) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Exp -> Exp
ESqrt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
texToken)

xspace :: Text -> TP Exp
xspace :: Text -> TP Exp
xspace Text
"\\mspace" =
  forall a. TP a -> TP a
braces forall a b. (a -> b) -> a -> b
$ do
    String
len <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
    forall a. TP a -> TP a
lexeme forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"mu"
    case forall a. Read a => ReadS a
reads String
len of
       ((Integer
n :: Integer,[]):[(Integer, String)]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Rational -> Exp
ESpace (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
nforall a. Fractional a => a -> a -> a
/Rational
18)
       [(Integer, String)]
_                     -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
xspace Text
"\\hspace" = do
  forall a. TP a -> TP a
braces forall a b. (a -> b) -> a -> b
$ do
    String
len <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
    Rational
scaleFactor <-
           Rational
1      forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"em")
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Rational
1forall a. Fractional a => a -> a -> a
/Rational
12)  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"pt")
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Rational
6       forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"in")
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Rational
50forall a. Fractional a => a -> a -> a
/Rational
21) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"cm")
    case forall a. Read a => ReadS a
reads String
len of
       ((Integer
n :: Integer,[]):[(Integer, String)]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Rational -> Exp
ESpace (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n forall a. Num a => a -> a -> a
* Rational
scaleFactor)
       [(Integer, String)]
_                     -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
xspace Text
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

mathop :: Text -> TP Exp
mathop :: Text -> TP Exp
mathop Text
c =
  case Text
c of
    Text
"\\mathop"    -> TeXSymbolType -> TP Exp
mathopWith TeXSymbolType
Op
    Text
"\\mathrel"   -> TeXSymbolType -> TP Exp
mathopWith TeXSymbolType
Rel
    Text
"\\mathbin"   -> TeXSymbolType -> TP Exp
mathopWith TeXSymbolType
Bin
    Text
"\\mathord"   -> TeXSymbolType -> TP Exp
mathopWith TeXSymbolType
Ord
    Text
"\\mathopen"  -> TeXSymbolType -> TP Exp
mathopWith TeXSymbolType
Open
    Text
"\\mathclose" -> TeXSymbolType -> TP Exp
mathopWith TeXSymbolType
Close
    Text
"\\mathpunct" -> TeXSymbolType -> TP Exp
mathopWith TeXSymbolType
Pun
    Text
_              -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

mathopWith :: TeXSymbolType -> TP Exp
mathopWith :: TeXSymbolType -> TP Exp
mathopWith TeXSymbolType
ty = do
  Exp
e <- TP Exp
inbraces forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
expr1
  let es' :: [Exp]
es' = case Exp
e of
                 EGrouped [Exp]
xs -> [Exp]
xs
                 Exp
x           -> [Exp
x]
  case [Exp]
es' of
     [ESymbol TeXSymbolType
_ Text
x]   -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
ty Text
x
     [EIdentifier Text
x] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
ty Text
x
     [EText TextType
TextNormal Text
x] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
ty Text
x
     [EText TextType
sty Text
x] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TextType -> [Exp] -> Exp
EStyled TextType
sty [TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
ty Text
x]
     [Exp]
xs | TeXSymbolType
ty forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Op  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Exp
EMathOperator forall a b. (a -> b) -> a -> b
$
                         [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall (m :: * -> *). MonadPlus m => Exp -> m Text
expToOperatorName [Exp]
xs
        | Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
EGrouped [Exp]
xs

binary :: Text -> TP Exp
binary :: Text -> TP Exp
binary Text
c = do
  case Text
c of
     Text
"\\overset"  -> do
       Exp
a <- TP Exp
texToken
       Exp
b <- TP Exp
texToken
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Exp -> Exp -> Exp
EOver Bool
False Exp
b Exp
a
     Text
"\\stackrel" -> do
       Exp
a <- TP Exp
texToken
       Exp
b <- TP Exp
texToken
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Exp -> Exp -> Exp
EOver Bool
False Exp
b Exp
a
     Text
"\\underset" -> do
       Exp
a <- TP Exp
texToken
       Exp
b <- TP Exp
texToken
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Exp -> Exp -> Exp
EUnder Bool
False Exp
b Exp
a
     Text
"\\frac"     -> FractionType -> Exp -> Exp -> Exp
EFraction FractionType
NormalFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
texToken forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TP Exp
texToken
     Text
"\\tfrac"    -> FractionType -> Exp -> Exp -> Exp
EFraction FractionType
InlineFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
texToken forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TP Exp
texToken
     Text
"\\dfrac"    -> FractionType -> Exp -> Exp -> Exp
EFraction FractionType
DisplayFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
texToken forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TP Exp
texToken
     Text
"\\binom"    -> do
       Exp
a <- TP Exp
texToken
       Exp
b <- TP Exp
texToken
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> [InEDelimited] -> Exp
EDelimited Text
"(" Text
")" [forall a b. b -> Either a b
Right (FractionType -> Exp -> Exp -> Exp
EFraction FractionType
NoLineFrac Exp
a Exp
b)]
     Text
_            -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

texSymbol :: TP Exp
texSymbol :: TP Exp
texSymbol = TP Exp
operator forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do Text
c <- TP Text
anyCtrlSeq
                    Text -> TP Exp
tSymbol Text
c forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> TP Exp
negated Text
c)

negated :: Text -> TP Exp
negated :: Text -> TP Exp
negated Text
"\\not" = do
  Exp
sym <- TP Exp
texSymbol forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
texChar
  case Exp
sym of
    ESymbol TeXSymbolType
Rel Text
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Rel forall a b. (a -> b) -> a -> b
$ Text -> Text
toNeg Text
x
    EText TextType
tt Text
x    -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TextType -> Text -> Exp
EText TextType
tt forall a b. (a -> b) -> a -> b
$ Text -> Text
toNeg Text
x
    ENumber Text
x     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Exp
ENumber forall a b. (a -> b) -> a -> b
$ Text -> Text
toNeg Text
x
    EIdentifier Text
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Exp
EIdentifier forall a b. (a -> b) -> a -> b
$ Text -> Text
toNeg Text
x
    Exp
_             -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
negated Text
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

toNeg :: Text -> Text
toNeg :: Text -> Text
toNeg Text
x = case Text
x of
            Text
"\x2203" -> Text
"\x2204"
            Text
"\x2208" -> Text
"\x2209"
            Text
"\x220B" -> Text
"\x220C"
            Text
"\x2223" -> Text
"\x2224"
            Text
"\x2225" -> Text
"\x2226"
            Text
"\x2243" -> Text
"\x2244"
            Text
"\x2245" -> Text
"\x2246"
            Text
"\x2248" -> Text
"\x2249"
            Text
"="      -> Text
"\x2260"
            Text
"\x2261" -> Text
"\x2262"
            Text
"<"      -> Text
"\x226E"
            Text
">"      -> Text
"\x226F"
            Text
"\x2264" -> Text
"\x2270"
            Text
"\x2265" -> Text
"\x2271"
            Text
"\x2272" -> Text
"\x2274"
            Text
"\x2273" -> Text
"\x2275"
            Text
"\x227A" -> Text
"\x2280"
            Text
"\x227B" -> Text
"\x2281"
            Text
"\x2282" -> Text
"\x2284"
            Text
"\x2283" -> Text
"\x2285"
            Text
"\x2286" -> Text
"\x2288"
            Text
"\x2287" -> Text
"\x2289"
            Text
"\x227C" -> Text
"\x22E0"
            Text
"\x227D" -> Text
"\x22E1"
            Text
"\x2291" -> Text
"\x22E2"
            Text
"\x2292" -> Text
"\x22E3"
            Text
_        -> Text
x forall a. Semigroup a => a -> a -> a
<> Text
"\x0338"


oneOfCommands :: [Text] -> TP Text
oneOfCommands :: [Text] -> TP Text
oneOfCommands [Text]
cmds = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Text
cmd <- [Text] -> TP Text
oneOfStrings [Text]
cmds
  case Text -> String
T.unpack Text
cmd of
    [Char
'\\',Char
c] | Bool -> Bool
not (Char -> Bool
isLetter Char
c) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    String
cmd' -> (do SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
                forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos
                forall (m :: * -> *) a. MonadPlus m => m a
mzero forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> (String
"non-letter after " forall a. Semigroup a => a -> a -> a
<> String
cmd'))
         forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  forall (m :: * -> *) a. Monad m => a -> m a
return Text
cmd

oneOfStrings' :: (Char -> Char -> Bool) -> [(String, Text)] -> TP Text
oneOfStrings' :: (Char -> Char -> Bool) -> [(String, Text)] -> TP Text
oneOfStrings' Char -> Char -> Bool
_ [] = forall (m :: * -> *) a. MonadPlus m => m a
mzero
oneOfStrings' Char -> Char -> Bool
matches [(String, Text)]
strs = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
    Char
c <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
    let strs' :: [(String, Text)]
strs' = [(String
xs, Text
t) | ((Char
x:String
xs), Text
t) <- [(String, Text)]
strs, Char
x Char -> Char -> Bool
`matches` Char
c]
    case [(String, Text)]
strs' of
      []  -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
      [(String, Text)]
_   -> (Char -> Char -> Bool) -> [(String, Text)] -> TP Text
oneOfStrings' Char -> Char -> Bool
matches [(String, Text)]
strs'
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, Text)]
strs' of
                   Just (String
_, Text
t) -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
                   Maybe (String, Text)
Nothing     -> forall (m :: * -> *) a. MonadPlus m => m a
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 :: [Text] -> TP Text
oneOfStrings :: [Text] -> TP Text
oneOfStrings [Text]
strs = (Char -> Char -> Bool) -> [(String, Text)] -> TP Text
oneOfStrings' forall a. Eq a => a -> a -> Bool
(==) [(String, Text)]
strs' forall (m :: * -> *) s u a.
Monad m =>
ParsecT s u m a -> String -> ParsecT s u m a
<??> (forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Text]
strs)
  where
    strs' :: [(String, Text)]
strs' = forall a b. (a -> b) -> [a] -> [b]
map (\Text
x -> (Text -> String
T.unpack Text
x, Text
x)) [Text]
strs

-- | Like '(<?>)', but moves position back to the beginning of the parse
-- before reporting the error.
(<??>) :: Monad m => ParsecT s u m a -> String -> ParsecT s u m a
<??> :: forall (m :: * -> *) s u a.
Monad m =>
ParsecT s u m a -> String -> ParsecT s u m a
(<??>) ParsecT s u m a
p String
expected = do
  SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  ParsecT s u m a
p forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadPlus m => m a
mzero forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
expected)

infix 0 <??>

tSymbol :: Text -> TP Exp
tSymbol :: Text -> TP Exp
tSymbol Text
sym =
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
sym Map Text Exp
symbols of
       Just acc :: Exp
acc@(ESymbol TeXSymbolType
Accent Text
_) ->
         (\Exp
t -> Bool -> Exp -> Exp -> Exp
EOver Bool
False Exp
t Exp
acc) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
texToken
       Just acc :: Exp
acc@(ESymbol TeXSymbolType
TUnder Text
_) ->
         (\Exp
t -> Bool -> Exp -> Exp -> Exp
EUnder Bool
False Exp
t Exp
acc) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
texToken
       Just acc :: Exp
acc@(ESymbol TeXSymbolType
TOver Text
_) ->
         (\Exp
t -> Bool -> Exp -> Exp -> Exp
EOver Bool
False Exp
t Exp
acc) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
texToken
       Just Exp
x  -> forall (m :: * -> *) a. Monad m => a -> m a
return Exp
x
       Maybe Exp
Nothing
         | Text
sym forall a. Eq a => a -> a -> Bool
== Text
"\\mod" -> do
             Exp
x <- Exp -> Exp
deGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
expr
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
EGrouped
               [Rational -> Exp
ESpace (Rational
8forall a. Fractional a => a -> a -> a
/Rational
18), Text -> Exp
EMathOperator Text
"mod", Rational -> Exp
ESpace (Rational
4forall a. Fractional a => a -> a -> a
/Rational
18), Exp
x]
         | Text
sym forall a. Eq a => a -> a -> Bool
== Text
"\\bmod" -> do
             Exp
x <- Exp -> Exp
deGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
expr
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
EGrouped
               [Rational -> Exp
ESpace (Rational
4forall a. Fractional a => a -> a -> a
/Rational
18), Text -> Exp
EMathOperator Text
"mod", Rational -> Exp
ESpace (Rational
4forall a. Fractional a => a -> a -> a
/Rational
18), Exp
x]
         | Text
sym forall a. Eq a => a -> a -> Bool
== Text
"\\pmod" -> do
             Exp
x <- Exp -> Exp
deGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
expr
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
EGrouped
               [Rational -> Exp
ESpace (Rational
4forall a. Fractional a => a -> a -> a
/Rational
18), TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Open Text
"(", Text -> Exp
EMathOperator Text
"mod",
                Rational -> Exp
ESpace (Rational
4forall a. Fractional a => a -> a -> a
/Rational
18), Exp
x, TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Close Text
")"]
         | Text
sym forall a. Eq a => a -> a -> Bool
== Text
"\\pod"  -> do
             Exp
x <- Exp -> Exp
deGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
expr
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
EGrouped
               [Rational -> Exp
ESpace (Rational
4forall a. Fractional a => a -> a -> a
/Rational
18), TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Open Text
"(", Exp
x, TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Close Text
")"]
         | Bool
otherwise -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

operator :: TP Exp
operator :: TP Exp
operator = do
  Text
sym <- forall a. TP a -> TP a
lexeme ([Text] -> TP Text
oneOfStrings forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
M.keys Map Text Exp
operators)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
sym Map Text Exp
operators)

lexeme :: TP a -> TP a
lexeme :: forall a. TP a -> TP a
lexeme TP a
p = TP a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* TP ()
ignorable

braces :: TP a -> TP a
braces :: forall a. TP a -> TP a
braces TP a
p = forall a. TP a -> TP a
lexeme forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'

brackets :: TP a -> TP a
brackets :: forall a. TP a -> TP a
brackets TP a
p = forall a. TP a -> TP a
lexeme forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'

textStr :: Text -> TP Text
textStr :: Text -> TP Text
textStr Text
t = forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (Text -> String
T.unpack Text
t) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
t

countChar :: Int -> TP Char -> TP Text
countChar :: Line -> TP Char -> TP Text
countChar Line
n = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) t u a.
Stream s m t =>
Line -> ParsecT s u m a -> ParsecT s u m [a]
count Line
n

symbol :: String -> TP String
symbol :: String -> ParsecT Text () Identity String
symbol String
s = forall a. TP a -> TP a
lexeme forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
s

-- text mode parsing

textual :: TP Text
textual :: TP Text
textual = TP Text
regular forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Text
sps forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Text
ligature forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Text
textCommand
            forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"text"

sps :: TP Text
sps :: TP Text
sps = Text
" " forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t\n")

regular :: TP Text
regular :: TP Text
regular = String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"`'-~${}\\ \t")

ligature :: TP Text
ligature :: TP Text
ligature = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Text
"\x2014" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"---")
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Text
"\x2013" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"--")
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Text -> TP Text
textStr Text
"-")
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Text
"\x201C" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"``")
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Text
"\x201D" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"''")
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Text
"\x2019" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"'")
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Text
"\x2018" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"`")
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Text
"\xA0"   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"~")

textCommand :: TP Text
textCommand :: TP Text
textCommand = do
  Text
cmd <- [Text] -> TP Text
oneOfCommands (forall k a. Map k a -> [k]
M.keys Map Text (TP Text)
textCommands)
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}')
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
cmd Map Text (TP Text)
textCommands of
       Maybe (TP Text)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text
"Unknown control sequence " forall a. Semigroup a => a -> a -> a
<> Text
cmd
       Just TP Text
c  -> TP Text
c

tok :: TP Char
tok :: TP Char
tok = (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}')
   forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar

textCommands :: M.Map Text (TP Text)
textCommands :: Map Text (TP Text)
textCommands = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (Text
"\\#", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"#")
  , (Text
"\\$", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"$")
  , (Text
"\\%", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"%")
  , (Text
"\\&", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"&")
  , (Text
"\\_", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"_")
  , (Text
"\\{", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"{")
  , (Text
"\\}", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"}")
  , (Text
"\\ldots", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\x2026")
  , (Text
"\\textasciitilde", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"~")
  , (Text
"\\textasciicircum", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"^")
  , (Text
"\\textbackslash", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\\")
  , (Text
"\\char", TP Text
parseC)
  , (Text
"\\aa", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"å")
  , (Text
"\\AA", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"Å")
  , (Text
"\\ss", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"ß")
  , (Text
"\\o", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"ø")
  , (Text
"\\O", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"Ø")
  , (Text
"\\L", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"Ł")
  , (Text
"\\l", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"ł")
  , (Text
"\\ae", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"æ")
  , (Text
"\\AE", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"Æ")
  , (Text
"\\oe", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"œ")
  , (Text
"\\OE", forall (m :: * -> *) a. Monad m => a -> m a
return Text
"Œ")
  , (Text
"\\`", forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"`" forall a b. (a -> b) -> a -> b
$ Char -> Text
grave forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Char
tok)
  , (Text
"\\'", forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"'" forall a b. (a -> b) -> a -> b
$ Char -> Text
acute forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Char
tok)
  , (Text
"\\^", forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"^" forall a b. (a -> b) -> a -> b
$ Char -> Text
circ  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Char
tok)
  , (Text
"\\~", forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"~" forall a b. (a -> b) -> a -> b
$ Char -> Text
tilde forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Char
tok)
  , (Text
"\\\"", forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"\"" forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ Char -> Text
umlaut forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Char
tok)
  , (Text
"\\.", forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"." forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ Char -> Text
dot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Char
tok)
  , (Text
"\\=", forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"=" forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ Char -> Text
macron forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Char
tok)
  , (Text
"\\c", forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"c" forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ Char -> Text
cedilla forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Char
tok)
  , (Text
"\\v", forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"v" forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ Char -> Text
hacek forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Char
tok)
  , (Text
"\\u", forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"u" forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ Char -> Text
breve forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Char
tok)
  , (Text
"\\ ", forall (m :: * -> *) a. Monad m => a -> m a
return Text
" ")
  ]

parseC :: TP Text
parseC :: TP Text
parseC = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Line -> TP Char -> TP Text
countChar Line
1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar

-- the functions below taken from pandoc:

grave :: Char -> Text
grave :: Char -> Text
grave Char
'A' = Text
"À"
grave Char
'E' = Text
"È"
grave Char
'I' = Text
"Ì"
grave Char
'O' = Text
"Ò"
grave Char
'U' = Text
"Ù"
grave Char
'a' = Text
"à"
grave Char
'e' = Text
"è"
grave Char
'i' = Text
"ì"
grave Char
'o' = Text
"ò"
grave Char
'u' = Text
"ù"
grave Char
c   = Char -> Text
T.singleton Char
c

acute :: Char -> Text
acute :: Char -> Text
acute Char
'A' = Text
"Á"
acute Char
'E' = Text
"É"
acute Char
'I' = Text
"Í"
acute Char
'O' = Text
"Ó"
acute Char
'U' = Text
"Ú"
acute Char
'Y' = Text
"Ý"
acute Char
'a' = Text
"á"
acute Char
'e' = Text
"é"
acute Char
'i' = Text
"í"
acute Char
'o' = Text
"ó"
acute Char
'u' = Text
"ú"
acute Char
'y' = Text
"ý"
acute Char
'C' = Text
"Ć"
acute Char
'c' = Text
"ć"
acute Char
'L' = Text
"Ĺ"
acute Char
'l' = Text
"ĺ"
acute Char
'N' = Text
"Ń"
acute Char
'n' = Text
"ń"
acute Char
'R' = Text
"Ŕ"
acute Char
'r' = Text
"ŕ"
acute Char
'S' = Text
"Ś"
acute Char
's' = Text
"ś"
acute Char
'Z' = Text
"Ź"
acute Char
'z' = Text
"ź"
acute Char
c   = Char -> Text
T.singleton Char
c

circ :: Char -> Text
circ :: Char -> Text
circ Char
'A' = Text
"Â"
circ Char
'E' = Text
"Ê"
circ Char
'I' = Text
"Î"
circ Char
'O' = Text
"Ô"
circ Char
'U' = Text
"Û"
circ Char
'a' = Text
"â"
circ Char
'e' = Text
"ê"
circ Char
'i' = Text
"î"
circ Char
'o' = Text
"ô"
circ Char
'u' = Text
"û"
circ Char
'C' = Text
"Ĉ"
circ Char
'c' = Text
"ĉ"
circ Char
'G' = Text
"Ĝ"
circ Char
'g' = Text
"ĝ"
circ Char
'H' = Text
"Ĥ"
circ Char
'h' = Text
"ĥ"
circ Char
'J' = Text
"Ĵ"
circ Char
'j' = Text
"ĵ"
circ Char
'S' = Text
"Ŝ"
circ Char
's' = Text
"ŝ"
circ Char
'W' = Text
"Ŵ"
circ Char
'w' = Text
"ŵ"
circ Char
'Y' = Text
"Ŷ"
circ Char
'y' = Text
"ŷ"
circ Char
c   = Char -> Text
T.singleton Char
c

tilde :: Char -> Text
tilde :: Char -> Text
tilde Char
'A' = Text
"Ã"
tilde Char
'a' = Text
"ã"
tilde Char
'O' = Text
"Õ"
tilde Char
'o' = Text
"õ"
tilde Char
'I' = Text
"Ĩ"
tilde Char
'i' = Text
"ĩ"
tilde Char
'U' = Text
"Ũ"
tilde Char
'u' = Text
"ũ"
tilde Char
'N' = Text
"Ñ"
tilde Char
'n' = Text
"ñ"
tilde Char
c   = Char -> Text
T.singleton Char
c

umlaut :: Char -> Text
umlaut :: Char -> Text
umlaut Char
'A' = Text
"Ä"
umlaut Char
'E' = Text
"Ë"
umlaut Char
'I' = Text
"Ï"
umlaut Char
'O' = Text
"Ö"
umlaut Char
'U' = Text
"Ü"
umlaut Char
'a' = Text
"ä"
umlaut Char
'e' = Text
"ë"
umlaut Char
'i' = Text
"ï"
umlaut Char
'o' = Text
"ö"
umlaut Char
'u' = Text
"ü"
umlaut Char
c   = Char -> Text
T.singleton Char
c

dot :: Char -> Text
dot :: Char -> Text
dot Char
'C' = Text
"Ċ"
dot Char
'c' = Text
"ċ"
dot Char
'E' = Text
"Ė"
dot Char
'e' = Text
"ė"
dot Char
'G' = Text
"Ġ"
dot Char
'g' = Text
"ġ"
dot Char
'I' = Text
"İ"
dot Char
'Z' = Text
"Ż"
dot Char
'z' = Text
"ż"
dot Char
c   = Char -> Text
T.singleton Char
c

macron :: Char -> Text
macron :: Char -> Text
macron Char
'A' = Text
"Ā"
macron Char
'E' = Text
"Ē"
macron Char
'I' = Text
"Ī"
macron Char
'O' = Text
"Ō"
macron Char
'U' = Text
"Ū"
macron Char
'a' = Text
"ā"
macron Char
'e' = Text
"ē"
macron Char
'i' = Text
"ī"
macron Char
'o' = Text
"ō"
macron Char
'u' = Text
"ū"
macron Char
c   = Char -> Text
T.singleton Char
c

cedilla :: Char -> Text
cedilla :: Char -> Text
cedilla Char
'c' = Text
"ç"
cedilla Char
'C' = Text
"Ç"
cedilla Char
's' = Text
"ş"
cedilla Char
'S' = Text
"Ş"
cedilla Char
't' = Text
"ţ"
cedilla Char
'T' = Text
"Ţ"
cedilla Char
'e' = Text
"ȩ"
cedilla Char
'E' = Text
"Ȩ"
cedilla Char
'h' = Text
"ḩ"
cedilla Char
'H' = Text
"Ḩ"
cedilla Char
'o' = Text
"o̧"
cedilla Char
'O' = Text
"O̧"
cedilla Char
c   = Char -> Text
T.singleton Char
c

hacek :: Char -> Text
hacek :: Char -> Text
hacek Char
'A' = Text
"Ǎ"
hacek Char
'a' = Text
"ǎ"
hacek Char
'C' = Text
"Č"
hacek Char
'c' = Text
"č"
hacek Char
'D' = Text
"Ď"
hacek Char
'd' = Text
"ď"
hacek Char
'E' = Text
"Ě"
hacek Char
'e' = Text
"ě"
hacek Char
'G' = Text
"Ǧ"
hacek Char
'g' = Text
"ǧ"
hacek Char
'H' = Text
"Ȟ"
hacek Char
'h' = Text
"ȟ"
hacek Char
'I' = Text
"Ǐ"
hacek Char
'i' = Text
"ǐ"
hacek Char
'j' = Text
"ǰ"
hacek Char
'K' = Text
"Ǩ"
hacek Char
'k' = Text
"ǩ"
hacek Char
'L' = Text
"Ľ"
hacek Char
'l' = Text
"ľ"
hacek Char
'N' = Text
"Ň"
hacek Char
'n' = Text
"ň"
hacek Char
'O' = Text
"Ǒ"
hacek Char
'o' = Text
"ǒ"
hacek Char
'R' = Text
"Ř"
hacek Char
'r' = Text
"ř"
hacek Char
'S' = Text
"Š"
hacek Char
's' = Text
"š"
hacek Char
'T' = Text
"Ť"
hacek Char
't' = Text
"ť"
hacek Char
'U' = Text
"Ǔ"
hacek Char
'u' = Text
"ǔ"
hacek Char
'Z' = Text
"Ž"
hacek Char
'z' = Text
"ž"
hacek Char
c   = Char -> Text
T.singleton Char
c

breve :: Char -> Text
breve :: Char -> Text
breve Char
'A' = Text
"Ă"
breve Char
'a' = Text
"ă"
breve Char
'E' = Text
"Ĕ"
breve Char
'e' = Text
"ĕ"
breve Char
'G' = Text
"Ğ"
breve Char
'g' = Text
"ğ"
breve Char
'I' = Text
"Ĭ"
breve Char
'i' = Text
"ĭ"
breve Char
'O' = Text
"Ŏ"
breve Char
'o' = Text
"ŏ"
breve Char
'U' = Text
"Ŭ"
breve Char
'u' = Text
"ŭ"
breve Char
c   = Char -> Text
T.singleton Char
c

-- siunitx

siunitx :: Text -> TP Exp
siunitx :: Text -> TP Exp
siunitx Text
c = do
  case Text
c of
    Text
"\\si"       -> TP Exp
dosi
    Text
"\\unit"     -> TP Exp
dosi  -- v3 version of \si
    Text
"\\SI"       -> TP Exp
doSI
    Text
"\\qty"      -> TP Exp
doSI  -- v3 version of \SI
    Text
"\\SIrange"  -> Bool -> TP Exp
doSIrange Bool
True
    Text
"\\qtyrange" -> Bool -> TP Exp
doSIrange Bool
True -- v3 version of SIrange
    Text
"\\numrange" -> Bool -> TP Exp
doSIrange Bool
False
    Text
"\\numlist"  -> TP Exp
doSInumlist
  -- "\\SIlist"   -> doSIlist -- v3 version of SIlist
  -- "\\qtylist"  -> doSIlist -- v3 version of SIlist
    Text
"\\num"      -> TP Exp
doSInum
    Text
"\\ang"      -> TP Exp
doSIang
    Text
_          -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- converts e.g. \SIrange{100}{200}{\ms} to "100 ms--200 ms"
doSIrange :: Bool -> TP Exp
doSIrange :: Bool -> TP Exp
doSIrange Bool
includeUnits = do
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TP Exp
inbrackets
  Maybe Exp
startvalue <- forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
doSInum
  Maybe Exp
startvalueprefix <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TP a -> TP a
brackets TP Exp
expr
  Maybe Exp
stopvalue <- forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
doSInum
  Maybe Exp
stopvalueprefix <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TP a -> TP a
brackets TP Exp
expr
  Maybe Exp
unit <- if Bool
includeUnits
             then forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
dosi
             else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
EGrouped forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
           [Maybe Exp
startvalueprefix,
            Maybe Exp -> Maybe Exp
emptyOr160 Maybe Exp
startvalueprefix,
            Maybe Exp
startvalue,
            Maybe Exp -> Maybe Exp
emptyOr160 Maybe Exp
unit,
            Maybe Exp
unit,
            forall a. a -> Maybe a
Just (TextType -> Text -> Exp
EText TextType
TextNormal Text
"\8211"), -- An en-dash
            Maybe Exp
stopvalueprefix,
            Maybe Exp -> Maybe Exp
emptyOr160 Maybe Exp
stopvalueprefix,
            Maybe Exp
stopvalue,
            Maybe Exp -> Maybe Exp
emptyOr160 Maybe Exp
unit,
            Maybe Exp
unit]


doSInumlist :: TP Exp
doSInumlist :: TP Exp
doSInumlist = do
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TP Exp
inbrackets
  [Exp]
xs <- forall a. TP a -> TP a
braces (forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy TP Exp
siNum (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces))
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    case [Exp]
xs of
      []  -> [Exp] -> Exp
EGrouped []
      [Exp
x] -> Exp
x
      [Exp]
_   -> [Exp] -> Exp
EGrouped forall a b. (a -> b) -> a -> b
$
               forall a. a -> [a] -> [a]
intersperse (TextType -> Text -> Exp
EText TextType
TextNormal Text
", ") (forall a. [a] -> [a]
init [Exp]
xs) forall a. [a] -> [a] -> [a]
++
               [TextType -> Text -> Exp
EText TextType
TextNormal Text
", & ", forall a. [a] -> a
last [Exp]
xs]

dosi :: TP Exp
dosi :: TP Exp
dosi = TP Exp
siUnit forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. TP a -> TP a
braces (TP Exp -> TP Exp
manyExp (TP Exp
siUnit forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
expr))

doSIang :: TP Exp
doSIang :: TP Exp
doSIang = do
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TP Exp
inbrackets
  [Exp]
ps <- forall a. TP a -> TP a
braces forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy TP Exp
siNum (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
EGrouped forall a b. (a -> b) -> a -> b
$
    case [Exp]
ps forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat ([Exp] -> Exp
EGrouped []) of
      (Exp
d:Exp
m:Exp
s:[Exp]
_) ->
        (if Exp
d forall a. Eq a => a -> a -> Bool
== [Exp] -> Exp
EGrouped [] then [] else [Exp
d, TextType -> Text -> Exp
EText TextType
TextNormal Text
"\xb0"]) forall a. Semigroup a => a -> a -> a
<>
        (if Exp
m forall a. Eq a => a -> a -> Bool
== [Exp] -> Exp
EGrouped [] then [] else [Exp
m, TextType -> Text -> Exp
EText TextType
TextNormal Text
"\x2032"]) forall a. Semigroup a => a -> a -> a
<>
        (if Exp
s forall a. Eq a => a -> a -> Bool
== [Exp] -> Exp
EGrouped [] then [] else [Exp
s, TextType -> Text -> Exp
EText TextType
TextNormal Text
"\x2033"])
      [Exp]
_ -> []

-- converts e.g. \SI{1}[\$]{} to "$ 1" or \SI{1}{\euro} to "1 €"
doSI :: TP Exp
doSI :: TP Exp
doSI = do
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TP Exp
inbrackets
  Maybe Exp
value <- forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
doSInum
  Maybe Exp
valueprefix <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ do
                    Exp
x <- TP Exp
inbrackets
                    if Exp
x forall a. Eq a => a -> a -> Bool
== [Exp] -> Exp
EGrouped []
                       then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                       else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Exp
x
  Maybe Exp
unit <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
dosi
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
EGrouped forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
         [ Maybe Exp
valueprefix,
           Maybe Exp -> Maybe Exp
emptyOr160 Maybe Exp
valueprefix,
           Maybe Exp
value,
           Maybe Exp -> Maybe Exp
emptyOr160 Maybe Exp
unit,
           Maybe Exp
unit
         ]

emptyOr160 :: Maybe Exp -> Maybe Exp
emptyOr160 :: Maybe Exp -> Maybe Exp
emptyOr160 (Just Exp
_) = forall a. a -> Maybe a
Just (Rational -> Exp
ESpace (Rational
4forall a. Fractional a => a -> a -> a
/Rational
18))
emptyOr160 Maybe Exp
Nothing  = forall a. Maybe a
Nothing


siUnit :: TP Exp
siUnit :: TP Exp
siUnit = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Text
name <- (Char -> Bool) -> Text -> Text
T.dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'\\') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Text
anyCtrlSeq
  case Text
name of
    Text
"square" -> do
       Exp
unit <- TP Exp
siUnit
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
ESuper Exp
unit (Text -> Exp
ENumber Text
"2")
    Text
"cubic" -> do
       Exp
unit <- TP Exp
siUnit
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
ESuper Exp
unit (Text -> Exp
ENumber Text
"3")
    Text
"raisetothe" -> do
       Exp
n <- TP Exp
expr
       Exp
unit <- TP Exp
siUnit
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
ESuper Exp
unit Exp
n
    Text
_ ->
       case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
name Map Text Exp
siUnitMap of
            Just Exp
il ->
              forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Exp
il forall a b. (a -> b) -> a -> b
$
                forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
                 [ (Exp -> Exp -> Exp
ESuper Exp
il (Text -> Exp
ENumber Text
"2")) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text () Identity String
ctrlseq String
"squared"
                 , (Exp -> Exp -> Exp
ESuper Exp
il (Text -> Exp
ENumber Text
"3")) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text () Identity String
ctrlseq String
"cubed"
                 , (\Exp
n -> Exp -> Exp -> Exp
ESuper Exp
il Exp
n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT Text () Identity String
ctrlseq String
"tothe" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP Exp
expr)
                 ]
            Maybe Exp
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not an siunit unit command"

doSInum :: TP Exp
doSInum :: TP Exp
doSInum = do
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TP Exp
inbrackets
  forall a. TP a -> TP a
braces TP Exp
siNum

siNum :: TP Exp
siNum :: TP Exp
siNum = [Exp] -> Exp
asGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many TP [Exp]
parseNumPart

parseNumPart :: TP [Exp]
parseNumPart :: TP [Exp]
parseNumPart =
  forall {u}. ParsecT Text u Identity [Exp]
parseDecimalNum forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  forall {u}. ParsecT Text u Identity [Exp]
parseComma forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  forall {u}. ParsecT Text u Identity [Exp]
parsePlusMinus forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  forall {u}. ParsecT Text u Identity [Exp]
parseI forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  forall {u}. ParsecT Text u Identity [Exp]
parseExp forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  forall {u}. ParsecT Text u Identity [Exp]
parseX forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  forall {u}. ParsecT Text u Identity [Exp]
parseSpace
 where
  parseDecimalNum :: ParsecT Text u Identity [Exp]
parseDecimalNum = do
    Text
pref <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ (forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+') forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text
"\x2212" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')
    Text
basenum <- (Text
pref forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'))
    Text
uncertainty <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {u}. ParsecT Text u Identity String
parseParens
    if Text -> Bool
T.null Text
uncertainty
       then forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Exp
ENumber Text
basenum]
       else forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Exp
ENumber forall a b. (a -> b) -> a -> b
$ Text
basenum forall a. Semigroup a => a -> a -> a
<> Text
"\xa0\xb1\xa0" forall a. Semigroup a => a -> a -> a
<>
             let (Text
_,Text
ys) = (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
==Char
'.') Text
basenum
              in case (Text -> Line
T.length Text
ys forall a. Num a => a -> a -> a
- Line
1, Text -> Line
T.length Text
uncertainty) of
                   (Line
0,Line
_) -> Text
uncertainty
                   (Line
x,Line
y)
                     | Line
x forall a. Ord a => a -> a -> Bool
> Line
y  -> Text
"0." forall a. Semigroup a => a -> a -> a
<> Line -> Text -> Text
T.replicate (Line
x forall a. Num a => a -> a -> a
- Line
y) Text
"0" forall a. Semigroup a => a -> a -> a
<>
                                      (Char -> Bool) -> Text -> Text
T.dropWhileEnd (forall a. Eq a => a -> a -> Bool
==Char
'0') Text
uncertainty
                     | Bool
otherwise -> Line -> Text -> Text
T.take (Line
y forall a. Num a => a -> a -> a
- Line
x) Text
uncertainty forall a. Semigroup a => a -> a -> a
<>
                                      case (Char -> Bool) -> Text -> Text
T.dropWhileEnd (forall a. Eq a => a -> a -> Bool
==Char
'0')
                                             (Line -> Text -> Text
T.drop (Line
y forall a. Num a => a -> a -> a
- Line
x) Text
uncertainty) of
                                             Text
t | Text -> Bool
T.null Text
t -> forall a. Monoid a => a
mempty
                                               | Bool
otherwise -> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
t]
  parseComma :: ParsecT Text u Identity [Exp]
parseComma = [Text -> Exp
ENumber Text
"."] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','
  parsePlusMinus :: ParsecT Text u Identity [Exp]
parsePlusMinus = [TextType -> Text -> Exp
EText TextType
TextNormal Text
"\xa0\xb1\xa0"] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"+-")
  parseParens :: ParsecT Text u Identity String
parseParens =
    forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.')) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
  parseI :: ParsecT Text u Identity [Exp]
parseI = [Text -> Exp
EIdentifier Text
"i"] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'i'
  parseX :: ParsecT Text u Identity [Exp]
parseX = [TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Rel Text
"\xa0\xd7\xa0"] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'x'
  parseExp :: ParsecT Text u Identity [Exp]
parseExp = do
    Exp
n <- [Exp] -> Exp
asGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'e' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {u}. ParsecT Text u Identity [Exp]
parseDecimalNum)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Rel Text
"\xa0\xd7\xa0", Exp -> Exp -> Exp
ESuper (Text -> Exp
ENumber Text
"10") Exp
n ]
  parseSpace :: ParsecT Text u Identity [Exp]
parseSpace = forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ')

arrow :: Text -> TP Exp
arrow :: Text -> TP Exp
arrow Text
c = case Text
c of
  Text
"\\xleftarrow"   -> Text -> TP Exp
underoverarrow Text
"\x2190"
  Text
"\\xrightarrow"  -> Text -> TP Exp
underoverarrow Text
"\x2192"
  Text
_                -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
 where
  underoverarrow :: Text -> TP Exp
underoverarrow Text
s = do
    Maybe Exp
munder <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe TP Exp
inbrackets
    Exp
over <- TP Exp
texToken
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe Exp
munder of
      Maybe Exp
Nothing    -> Bool -> Exp -> Exp -> Exp
EOver Bool
False (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Op Text
s) Exp
over
      Just Exp
under -> Bool -> Exp -> Exp -> Exp -> Exp
EUnderover Bool
False (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Op Text
s) Exp
under Exp
over