{-# LANGUAGE OverloadedStrings, CPP #-}

-- | The /LaTeX/ parser.
-- 
--   Use 'parseLaTeX' to parse a 'Text' containing /LaTeX/ code.
--   If the 'Text' is in a file, you may want to use 'parseLaTeXFile'.
--   Use this module together with "Text.LaTeX.Base.Syntax" to perform
--   analysis and transformations of /LaTeX/ code. The parser ('parseLaTeX')
--   is related with the renderer ('render') by the following property:
--
--   /If @t :: Text@ is a syntactically valid LaTeX block, then:/
--
-- > fmap render (parseLaTeX t) == Right t
-- 
--   This property says two things:
--
-- * Given a valid LaTeX input, 'parseLaTeX' returns a 'LaTeX' value.
-- * If the parsed value is again rendered, you get the initial input.
--
--   In other words, 'parseLaTeX' is a partial function defined over the
--   set of valid LaTeX files, and 'render' is its /left/ inverse.
--
module Text.LaTeX.Base.Parser (
    -- * The parser
    parseLaTeX
  , parseLaTeXFile
    -- * Parsing errors
  , ParseError
  , errorPos
  , errorMessages
    -- ** Error messages
  , Message (..)
  , messageString
    -- ** Source positions
  , SourcePos
  , sourceLine
  , sourceColumn
  , sourceName
    -- * Configuring your parser
  , ParserConf (..)
  , defaultParserConf
  , parseLaTeXWith
  , parseLaTeXFileWith
    -- * Parser combinators
  , Parser
  , latexParser
  , latexBlockParser
    ) where

import           Text.Parsec hiding ((<|>),many)
import           Text.Parsec.Error
import           Data.Char (toLower,digitToInt)
import           Data.Functor(($>))
#if !MIN_VERSION_base(4,11,0)
import           Data.Monoid
#endif
import           Data.Maybe (fromMaybe)
import           Data.Set(Set, fromList, member)
import qualified Data.Text as T 

import           Control.Applicative
import           Control.Monad (unless)

import           Text.LaTeX.Base.Syntax
import           Text.LaTeX.Base.Render

------------------------------------------------------------------------
-- Parser configuration
------------------------------------------------------------------------

-- | Configuration for the LaTeX parser.
newtype ParserConf = ParserConf
  { -- | This is the list of names of the environments such that
    --   their content will be parsed verbatim.
    ParserConf -> [[Char]]
verbatimEnvironments :: [String]
    }

-- | Default parser configuration, used by 'parseLaTeX' and 'parseLaTeXFile'.
--
--   Defaults:
--
-- > verbatimEnvironments = ["verbatim"]
--
defaultParserConf :: ParserConf
defaultParserConf :: ParserConf
defaultParserConf = ParserConf
  { verbatimEnvironments :: [[Char]]
verbatimEnvironments = [[Char]
"verbatim"]
    }

-- | Parser with 'Text' input and 'ParserConf' environment.
type Parser = Parsec Text ParserConf

------------------------------------------------------------------------
-- Parser
------------------------------------------------------------------------

-- | Parse a 'Text' sequence as a 'LaTeX' block. If it fails, it returns
--   an error string.
parseLaTeX :: Text -> Either ParseError LaTeX
parseLaTeX :: Text -> Either ParseError LaTeX
parseLaTeX = ParserConf -> Text -> Either ParseError LaTeX
parseLaTeXWith ParserConf
defaultParserConf

parseLaTeXWith :: ParserConf -> Text -> Either ParseError LaTeX
parseLaTeXWith :: ParserConf -> Text -> Either ParseError LaTeX
parseLaTeXWith ParserConf
conf Text
t
  | Text -> Bool
T.null Text
t  = forall (m :: * -> *) a. Monad m => a -> m a
return LaTeX
TeXEmpty
  | Bool
otherwise = forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> [Char] -> s -> Either ParseError a
runParser Parser LaTeX
latexParser ParserConf
conf [Char]
"parseLaTeX input" Text
t

-- | Read a file and parse it as 'LaTeX'.
parseLaTeXFile :: FilePath -> IO (Either ParseError LaTeX)
parseLaTeXFile :: [Char] -> IO (Either ParseError LaTeX)
parseLaTeXFile = ParserConf -> [Char] -> IO (Either ParseError LaTeX)
parseLaTeXFileWith ParserConf
defaultParserConf

parseLaTeXFileWith :: ParserConf -> FilePath -> IO (Either ParseError LaTeX)
parseLaTeXFileWith :: ParserConf -> [Char] -> IO (Either ParseError LaTeX)
parseLaTeXFileWith ParserConf
conf [Char]
fp = forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> [Char] -> s -> Either ParseError a
runParser Parser LaTeX
latexParser ParserConf
conf [Char]
fp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Text
readFileTex [Char]
fp

-- | The 'LaTeX' parser.
latexParser :: Parser LaTeX
latexParser :: Parser LaTeX
latexParser = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser LaTeX
latexBlockParser forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`manyTill` forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof

-- | Parser of a single 'LaTeX' constructor, no appending blocks.
latexBlockParser :: Parser LaTeX
latexBlockParser :: Parser LaTeX
latexBlockParser = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
  [ Parser LaTeX
text            forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"text"
  , Parser LaTeX
dolMath         forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"inline math ($)"
  , Parser LaTeX
comment         forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"comment"
  , Parser LaTeX
text2           forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"text2"
  , forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser LaTeX
environment forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"environment"
  , Parser LaTeX
command         forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"command"
    ]
-- Note: text stops on ']'; if the other parsers fail on the rest
--       text2 handles it, starting with ']' 

------------------------------------------------------------------------
-- Text
------------------------------------------------------------------------
nottext :: Set Char
nottext :: Set Char
nottext = forall a. Ord a => [a] -> Set a
fromList [Char]
"$%\\{]}"

text :: Parser LaTeX
text :: Parser LaTeX
text = do
  Maybe Char
mbC <- Parser (Maybe Char)
peekChar
  case Maybe Char
mbC of
    Maybe Char
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"text: Empty input."
    Just Char
c | Char
c forall a. Ord a => a -> Set a -> Bool
`member` Set Char
nottext -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"not text"
           | Bool
otherwise          -> Text -> LaTeX
TeXRaw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
takeTill (forall a. Ord a => a -> Set a -> Bool
`member` Set Char
nottext)

------------------------------------------------------------------------
-- Text without stopping on ']'
------------------------------------------------------------------------
text2 :: Parser LaTeX
text2 :: Parser LaTeX
text2 = do
  Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
  LaTeX
t <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser LaTeX
text forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> LaTeX
TeXRaw Text
T.empty))
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> LaTeX
TeXRaw ([Char] -> Text
T.pack [Char]
"]") forall a. Semigroup a => a -> a -> a
<> LaTeX
t

------------------------------------------------------------------------
-- Environment
------------------------------------------------------------------------
environment :: Parser LaTeX
environment :: Parser LaTeX
environment = Parser LaTeX
anonym forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser LaTeX
env

anonym :: Parser LaTeX
anonym :: Parser LaTeX
anonym = do
  Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
  LaTeX
l <- LaTeX -> LaTeX
TeXBraces 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 (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser LaTeX
latexBlockParser
  Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
  forall (m :: * -> *) a. Monad m => a -> m a
return LaTeX
l

env :: Parser LaTeX
env :: Parser LaTeX
env = do
  [Char]
n  <- 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
*> [Char] -> ParsecT Text ParserConf Identity [Char]
envName [Char]
"begin"
  [Char]
sps <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '
  let lsps :: LaTeX
lsps = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
sps then forall a. Monoid a => a
mempty else Text -> LaTeX
TeXRaw forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
sps
  Maybe [TeXArg]
as <- Parser (Maybe [TeXArg])
cmdArgs
  [[Char]]
verbatims <- ParserConf -> [[Char]]
verbatimEnvironments forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  if [Char]
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
verbatims
     then let endenv :: ParsecT Text ParserConf Identity [Char]
endenv = 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]
string [Char]
"\\end" 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]
string ([Char]
"{" forall a. Semigroup a => a -> a -> a
<> [Char]
n forall a. Semigroup a => a -> a -> a
<> [Char]
"}")
          in  [Char] -> [TeXArg] -> LaTeX -> LaTeX
TeXEnv [Char]
n (forall a. a -> Maybe a -> a
fromMaybe [] Maybe [TeXArg]
as) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LaTeX
TeXRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT Text ParserConf Identity [Char]
endenv
     else do LaTeX
b <- [Char] -> Parser LaTeX
envBody [Char]
n 
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> [TeXArg] -> LaTeX -> LaTeX
TeXEnv [Char]
n (forall a. a -> Maybe a -> a
fromMaybe [] Maybe [TeXArg]
as) forall a b. (a -> b) -> a -> b
$
               case Maybe [TeXArg]
as of
                Just [] -> LaTeX
lsps forall a. Semigroup a => a -> a -> a
<> LaTeX -> LaTeX
TeXBraces forall a. Monoid a => a
mempty forall a. Semigroup a => a -> a -> a
<> LaTeX
b
                Maybe [TeXArg]
Nothing -> LaTeX
lsps forall a. Semigroup a => a -> a -> a
<> LaTeX
b
                Maybe [TeXArg]
_ -> LaTeX
b

envName :: String -> Parser String
envName :: [Char] -> ParsecT Text ParserConf Identity [Char]
envName [Char]
k = do
  [Char]
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
k
  Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
  Text
n <- (Char -> Bool) -> Parser Text
takeTill (forall a. Eq a => a -> a -> Bool
== Char
'}')
  Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
n

envBody :: String -> Parser LaTeX
envBody :: [Char] -> Parser LaTeX
envBody [Char]
n = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Parser LaTeX
bodyBlock [Char]
n forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`manyTill` ParsecT Text ParserConf Identity [Char]
endenv
  where endenv :: ParsecT Text ParserConf Identity [Char]
endenv = 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]
string [Char]
"\\end" 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]
string ([Char]
"{" forall a. Semigroup a => a -> a -> a
<> [Char]
n forall a. Semigroup a => a -> a -> a
<> [Char]
"}")

bodyBlock :: String -> Parser LaTeX
bodyBlock :: [Char] -> Parser LaTeX
bodyBlock [Char]
n = do
  Maybe Char
c <- Parser (Maybe Char)
peekChar
  case Maybe Char
c of 
     Just Char
_ -> Parser LaTeX
latexBlockParser
     Maybe Char
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Environment '" forall a. Semigroup a => a -> a -> a
<> [Char]
n forall a. Semigroup a => a -> a -> a
<> [Char]
"' not finalized."

------------------------------------------------------------------------
-- Command
------------------------------------------------------------------------
command :: Parser LaTeX
command :: Parser LaTeX
command = do
  Char
_    <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
  Maybe Char
mbX  <- Parser (Maybe Char)
peekChar
  case Maybe Char
mbX of
    Maybe Char
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return LaTeX
TeXEmpty
    Just Char
x  -> if Char -> Bool
isSpecial Char
x
                  then Parser LaTeX
special
                  else do
                    Text
c  <- (Char -> Bool) -> Parser Text
takeTill Char -> Bool
endCmd
                    forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> LaTeX
TeXCommS forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
c) ([Char] -> [TeXArg] -> LaTeX
TeXComm forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe [TeXArg])
cmdArgs

------------------------------------------------------------------------
-- Command Arguments
------------------------------------------------------------------------
cmdArgs :: Parser (Maybe [TeXArg])
cmdArgs :: Parser (Maybe [TeXArg])
cmdArgs = 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]
string [Char]
"{}" 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 []))
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (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]
many1 Parser TeXArg
cmdArg)
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

cmdArg :: Parser TeXArg
cmdArg :: Parser TeXArg
cmdArg = do
  Char
c <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
  let e :: [Char]
e = case Char
c of
            Char
'[' -> [Char]
"]"
            Char
'{' -> [Char]
"}"
            Char
_   -> forall a. HasCallStack => [Char] -> a
error [Char]
"this cannot happen!"
  LaTeX
b <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill Parser LaTeX
latexBlockParser (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
e)
  case Char
c of  
    Char
'[' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ LaTeX -> TeXArg
OptArg LaTeX
b
    Char
'{' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ LaTeX -> TeXArg
FixArg LaTeX
b
    Char
_   -> forall a. HasCallStack => [Char] -> a
error [Char]
"this cannot happen!"

------------------------------------------------------------------------
-- Special commands (consisting of one char)
------------------------------------------------------------------------
special :: Parser LaTeX
special :: Parser LaTeX
special = do
  Char
x <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
  case Char
x of
    Char
'('  -> MathType -> [Char] -> Parser LaTeX
math MathType
Parentheses [Char]
"\\)"
    Char
'['  -> MathType -> [Char] -> Parser LaTeX
math MathType
Square      [Char]
"\\]"
    Char
'{'  -> Parser LaTeX
lbrace
    Char
'}'  -> Parser LaTeX
rbrace
    Char
'|'  -> Parser LaTeX
vert
    Char
'\\' -> Parser LaTeX
lbreak
    Char
_    -> [Char] -> Parser LaTeX
commS [Char
x]

isSpecial :: Char -> Bool
isSpecial :: Char -> Bool
isSpecial = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
specials)

------------------------------------------------------------------------
-- Line break
------------------------------------------------------------------------

lbreak :: Parser LaTeX
lbreak :: Parser LaTeX
lbreak = do
  Char
y <- 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Char
' ')  
  case Char
y of
    Char
'[' -> Bool -> Parser LaTeX
linebreak Bool
False
    Char
'*' -> do Char
z <- 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Char
' ')
              case Char
z of
               Char
'[' -> Bool -> Parser LaTeX
linebreak Bool
True
               Char
_   -> forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Measure -> Bool -> LaTeX
TeXLineBreak forall a. Maybe a
Nothing Bool
True)
    Char
_   -> forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Measure -> Bool -> LaTeX
TeXLineBreak forall a. Maybe a
Nothing Bool
False)

linebreak :: Bool -> Parser LaTeX
linebreak :: Bool -> Parser LaTeX
linebreak Bool
t = do Measure
m <- ParsecT Text ParserConf Identity Measure
measure forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"measure"
                 Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
                 Char
s <- 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Char
' ')
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Measure -> Bool -> LaTeX
TeXLineBreak (forall a. a -> Maybe a
Just Measure
m) (Bool
t Bool -> Bool -> Bool
|| Char
s forall a. Eq a => a -> a -> Bool
== Char
'*')

measure :: Parser Measure
measure :: ParsecT Text ParserConf Identity Measure
measure = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser Double
floating forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Double -> ParsecT Text ParserConf Identity Measure
unit) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (LaTeX -> Measure
CustomMeasure 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 (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill Parser LaTeX
latexBlockParser (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']')

unit :: Double -> Parser Measure
unit :: Double -> ParsecT Text ParserConf Identity Measure
unit Double
f = do
  Char
u1 <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
  Char
u2 <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
  case forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char
u1, Char
u2] of
    [Char]
"pt" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Double -> Measure
Pt Double
f
    [Char]
"mm" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Double -> Measure
Mm Double
f
    [Char]
"cm" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Double -> Measure
Cm Double
f
    [Char]
"in" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Double -> Measure
In Double
f
    [Char]
"ex" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Double -> Measure
Ex Double
f
    [Char]
"em" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Double -> Measure
Em Double
f
    [Char]
_    -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"NaN"

------------------------------------------------------------------------
-- Right or left brace or vertical
------------------------------------------------------------------------
rbrace, lbrace,vert :: Parser LaTeX
lbrace :: Parser LaTeX
lbrace = [Char] -> Parser LaTeX
brace [Char]
"{"
rbrace :: Parser LaTeX
rbrace = [Char] -> Parser LaTeX
brace [Char]
"}"
vert :: Parser LaTeX
vert   = [Char] -> Parser LaTeX
brace [Char]
"|"

brace :: String -> Parser LaTeX
brace :: [Char] -> Parser LaTeX
brace = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> LaTeX
TeXCommS -- The same as commS?

commS :: String -> Parser LaTeX
commS :: [Char] -> Parser LaTeX
commS = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> LaTeX
TeXCommS

------------------------------------------------------------------------
-- Math
------------------------------------------------------------------------
dolMath :: Parser LaTeX
dolMath :: Parser LaTeX
dolMath = do
  Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$' 
  forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
    [ do Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$'
         LaTeX
b <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser LaTeX
latexBlockParser forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`manyTill` 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]
string [Char]
"$$")
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MathType -> LaTeX -> LaTeX
TeXMath MathType
DoubleDollar LaTeX
b
    , do LaTeX
b <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser LaTeX
latexBlockParser forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`manyTill` forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$'
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MathType -> LaTeX -> LaTeX
TeXMath MathType
Dollar LaTeX
b
      ]

math :: MathType -> String -> Parser LaTeX
math :: MathType -> [Char] -> Parser LaTeX
math MathType
t [Char]
eMath = do
   LaTeX
b <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser LaTeX
latexBlockParser forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`manyTill` 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]
string [Char]
eMath)
   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MathType -> LaTeX -> LaTeX
TeXMath MathType
t LaTeX
b

------------------------------------------------------------------------
-- Comment 
------------------------------------------------------------------------
comment :: Parser LaTeX
comment :: Parser LaTeX
comment = do
  Char
_  <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
  Text
c  <- (Char -> Bool) -> Parser Text
takeTill (forall a. Eq a => a -> a -> Bool
== Char
'\n')
  Bool
e  <- Parser Bool
atEnd
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
e (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ())
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> LaTeX
TeXComment Text
c

------------------------------------------------------------------------
-- Helpers
------------------------------------------------------------------------

endCmd :: Char -> Bool
endCmd :: Char -> Bool
endCmd Char
c = Bool
notLowercaseAlph Bool -> Bool -> Bool
&& Bool
notUppercaseAlph
 where c' :: Int
c' = forall a. Enum a => a -> Int
fromEnum Char
c
       notLowercaseAlph :: Bool
notLowercaseAlph = Int
c' forall a. Ord a => a -> a -> Bool
< forall a. Enum a => a -> Int
fromEnum Char
'a' Bool -> Bool -> Bool
|| Int
c' forall a. Ord a => a -> a -> Bool
> forall a. Enum a => a -> Int
fromEnum Char
'z'
       notUppercaseAlph :: Bool
notUppercaseAlph = Int
c' forall a. Ord a => a -> a -> Bool
< forall a. Enum a => a -> Int
fromEnum Char
'A' Bool -> Bool -> Bool
|| Int
c' forall a. Ord a => a -> a -> Bool
> forall a. Enum a => a -> Int
fromEnum Char
'Z'

specials :: String
specials :: [Char]
specials = [Char]
"'(),.-\"!^$&#{}%~|/:;=[]\\` "

peekChar :: Parser (Maybe Char)
peekChar :: Parser (Maybe Char)
peekChar = forall a. a -> Maybe a
Just 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 s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

atEnd :: Parser Bool
atEnd :: Parser Bool
atEnd = (forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

takeTill :: (Char -> Bool) -> Parser Text
takeTill :: (Char -> Bool) -> Parser Text
takeTill Char -> Bool
p = [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (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
p))

-- Parsing doubles
--
-- Code for 'floating', 'fractExponent', and 'sign' comes from parsers package:
--
-- http://hackage.haskell.org/package/parsers
--

floating :: Parser Double
floating :: Parser Double
floating = Parser Integer
decimal forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Integer -> Double)
fractExponent

fractExponent :: Parser (Integer -> Double)
fractExponent :: Parser (Integer -> Double)
fractExponent = (\Double
fract Double
expo Integer
n -> (forall a. Num a => Integer -> a
fromInteger Integer
n forall a. Num a => a -> a -> a
+ Double
fract) forall a. Num a => a -> a -> a
* Double
expo) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {u}. ParsecT Text u Identity Double
fraction forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Double
1.0 Parser Double
exponent'
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (\Double
expo Integer
n -> forall a. Num a => Integer -> a
fromInteger Integer
n forall a. Num a => a -> a -> a
* Double
expo) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double
exponent' where
  fraction :: ParsecT Text u Identity Double
fraction = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}. Fractional a => Char -> a -> a
op Double
0.0 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"fraction"))
  op :: Char -> a -> a
op Char
d a
f = (a
f forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
d))forall a. Fractional a => a -> a -> a
/a
10.0
  exponent' :: Parser Double
exponent' = ((\Integer -> Integer
f Integer
e -> forall {b} {a}. (Fractional a, Integral b) => b -> a
power (Integer -> Integer
f Integer
e)) 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
oneOf [Char]
"eE" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Integer -> Integer)
sign forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Integer
decimal forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"exponent")) forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"exponent"
  power :: b -> a
power b
e
    | b
e forall a. Ord a => a -> a -> Bool
< b
0     = a
1.0forall a. Fractional a => a -> a -> a
/b -> a
power(-b
e)
    | Bool
otherwise = forall a. Num a => Integer -> a
fromInteger (Integer
10forall a b. (Num a, Integral b) => a -> b -> a
^b
e)

decimal :: Parser Integer
decimal :: Parser Integer
decimal = forall a. Read a => [Char] -> a
read 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

sign :: Parser (Integer -> Integer)
sign :: Parser (Integer -> Integer)
sign = forall a. Num a => a -> a
negate 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> a
id 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id