{-# 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, foldl')
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.Ratio ((%))
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 )
import Data.Text.Read (decimal)

type TP = Parser

-- The parser

expr1 :: TP Exp
expr1 :: TP Exp
expr1 = do
  e <- TP Exp
expr2
  -- check for primes and add them as a subscript
  -- in TeX ' is shorthand for ^{\prime}
  primes <- many (char '\'')
  let getPrimes String
cs = case String
cs of
                       String
"" -> String
""
                       String
"'" -> String
"\x2032"
                       String
"''" -> String
"\x2033"
                       String
"'''" -> String
"\x2034"
                       String
"''''" -> String
"\x2057"
                       String
_ -> String
"\x2057" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
getPrimes (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4 String
cs)
  ignorable
  case getPrimes primes of
    String
"" -> Exp -> TP Exp
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
e
    String
cs -> Exp -> TP Exp
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> TP Exp) -> Exp -> TP Exp
forall a b. (a -> b) -> a -> b
$ case Exp
e of
                     ESub Exp
b Exp
sub -> Exp -> Exp -> Exp -> Exp
ESubsup Exp
b Exp
sub (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Pun (String -> Text
T.pack String
cs))
                     Exp
_ -> Exp -> Exp -> Exp
ESuper Exp
e (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Pun (String -> Text
T.pack String
cs))

expr2 :: TP Exp
expr2 :: TP Exp
expr2 = [TP Exp] -> TP Exp
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
          ]

-- | 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
  (ParseError -> Either Text [Exp])
-> ([Exp] -> Either Text [Exp])
-> Either ParseError [Exp]
-> Either Text [Exp]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Either Text [Exp]
forall a b. a -> Either a b
Left (Text -> Either Text [Exp])
-> (ParseError -> Text) -> ParseError -> Either Text [Exp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParseError -> Text
showParseError Text
inp) ([Exp] -> Either Text [Exp]
forall a b. b -> Either a b
Right ([Exp] -> Either Text [Exp])
-> ([Exp] -> [Exp]) -> [Exp] -> Either Text [Exp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Exp] -> [Exp]
fixBinList)
    (Either ParseError [Exp] -> Either Text [Exp])
-> Either ParseError [Exp] -> Either Text [Exp]
forall a b. (a -> b) -> a -> b
$ Parsec Text () [Exp] -> String -> Text -> Either ParseError [Exp]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec Text () [Exp]
formula String
"formula" (Text -> Either ParseError [Exp])
-> Text -> Either ParseError [Exp]
forall a b. (a -> b) -> a -> b
$ [Macro] -> Text -> Text
applyMacros [Macro]
ms Text
rest
 where
  -- | Convert Bin symbol type in certain contexts (#176, #234).
  fixBinList :: [Exp] -> [Exp]
  fixBinList :: [Exp] -> [Exp]
fixBinList =
    [Exp] -> [Exp]
forall a. [a] -> [a]
reverse ([Exp] -> [Exp]) -> ([Exp] -> [Exp]) -> [Exp] -> [Exp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Exp] -> Exp -> [Exp]) -> [Exp] -> [Exp] -> [Exp]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Exp] -> Exp -> [Exp]
goExp [] ([Exp] -> [Exp]) -> ([Exp] -> [Exp]) -> [Exp] -> [Exp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((Exp -> Exp) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT Exp -> Exp
fixBins)

  -- TeXBook:
  -- 5. If the current item is a Bin atom, and if this was the first
  -- atom in the list, or if the most recent previous atom was Bin, Op,
  -- Rel, Open, or Punct, change the current Bin to Ord and continue with
  -- Rule 14. Otherwise continue with Rule 17.
  -- 6. If the current item is a Rel or Close or Punct atom, and if
  -- the most recent previous atom was Bin, change that previous Bin
  -- to Ord. Continue with Rule 17.

  fixBins :: Exp -> Exp
  fixBins :: Exp -> Exp
fixBins Exp
e =
    case Exp
e of
      EGrouped [Exp]
es
        -> [Exp] -> Exp
EGrouped ([Exp] -> [Exp]
forall a. [a] -> [a]
reverse ([Exp] -> [Exp]) -> [Exp] -> [Exp]
forall a b. (a -> b) -> a -> b
$ ([Exp] -> Exp -> [Exp]) -> [Exp] -> [Exp] -> [Exp]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Exp] -> Exp -> [Exp]
goExp [] [Exp]
es)
      EDelimited Text
op Text
cl [InEDelimited]
des
        -> Text -> Text -> [InEDelimited] -> Exp
EDelimited Text
op Text
cl ([InEDelimited] -> [InEDelimited]
forall a. [a] -> [a]
reverse ([InEDelimited] -> [InEDelimited])
-> [InEDelimited] -> [InEDelimited]
forall a b. (a -> b) -> a -> b
$ ([InEDelimited] -> InEDelimited -> [InEDelimited])
-> [InEDelimited] -> [InEDelimited] -> [InEDelimited]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [InEDelimited] -> InEDelimited -> [InEDelimited]
goInDel [] [InEDelimited]
des)
      EArray [Alignment]
als [ArrayLine]
alines
        -> [Alignment] -> [ArrayLine] -> Exp
EArray [Alignment]
als ((ArrayLine -> ArrayLine) -> [ArrayLine] -> [ArrayLine]
forall a b. (a -> b) -> [a] -> [b]
map (([Exp] -> [Exp]) -> ArrayLine -> ArrayLine
forall a b. (a -> b) -> [a] -> [b]
map ([Exp] -> [Exp]
forall a. [a] -> [a]
reverse ([Exp] -> [Exp]) -> ([Exp] -> [Exp]) -> [Exp] -> [Exp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Exp] -> Exp -> [Exp]) -> [Exp] -> [Exp] -> [Exp]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Exp] -> Exp -> [Exp]
goExp [])) [ArrayLine]
alines)
      EStyled TextType
tt [Exp]
es
        -> TextType -> [Exp] -> Exp
EStyled TextType
tt ([Exp] -> [Exp]
forall a. [a] -> [a]
reverse ([Exp] -> [Exp]) -> [Exp] -> [Exp]
forall a b. (a -> b) -> a -> b
$ ([Exp] -> Exp -> [Exp]) -> [Exp] -> [Exp] -> [Exp]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Exp] -> Exp -> [Exp]
goExp [] [Exp]
es)
      Exp
_ -> Exp
e

  goExp :: [Exp] -> Exp -> [Exp]
  goExp :: [Exp] -> Exp -> [Exp]
goExp [] (ESymbol TeXSymbolType
Bin Text
t) = [TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Ord Text
t]
  goExp  accum :: [Exp]
accum@(ESymbol TeXSymbolType
ty Text
_ : [Exp]
_) (ESymbol TeXSymbolType
Bin Text
t)
    | TeXSymbolType
ty TeXSymbolType -> [TeXSymbolType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TeXSymbolType
Bin, TeXSymbolType
Op, TeXSymbolType
Rel, TeXSymbolType
Open, TeXSymbolType
Pun]
      = TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Ord Text
t Exp -> [Exp] -> [Exp]
forall a. a -> [a] -> [a]
: [Exp]
accum
  goExp (ESymbol TeXSymbolType
Bin Text
t' : [Exp]
rest) (ESymbol TeXSymbolType
ty Text
t)
    | TeXSymbolType
ty TeXSymbolType -> [TeXSymbolType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TeXSymbolType
Rel, TeXSymbolType
Close, TeXSymbolType
Pun]
      = TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
ty Text
t Exp -> [Exp] -> [Exp]
forall a. a -> [a] -> [a]
: TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Ord Text
t' Exp -> [Exp] -> [Exp]
forall a. a -> [a] -> [a]
: [Exp]
rest
  goExp [Exp]
xs Exp
x = Exp
x Exp -> [Exp] -> [Exp]
forall a. a -> [a] -> [a]
: [Exp]
xs

  goInDel :: [InEDelimited] -> InEDelimited -> [InEDelimited]
  goInDel :: [InEDelimited] -> InEDelimited -> [InEDelimited]
goInDel [] (Right (ESymbol TeXSymbolType
Bin Text
t)) = [Exp -> InEDelimited
forall a b. b -> Either a b
Right (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Ord Text
t)]
  goInDel accum :: [InEDelimited]
accum@(Left Text
_ : [InEDelimited]
_) (Right (ESymbol TeXSymbolType
Bin Text
t))
    = Exp -> InEDelimited
forall a b. b -> Either a b
Right (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Ord Text
t) InEDelimited -> [InEDelimited] -> [InEDelimited]
forall a. a -> [a] -> [a]
: [InEDelimited]
accum
  goInDel accum :: [InEDelimited]
accum@(Right (ESymbol TeXSymbolType
ty Text
_) : [InEDelimited]
_) (Right (ESymbol TeXSymbolType
Bin Text
t))
    | TeXSymbolType
ty TeXSymbolType -> [TeXSymbolType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TeXSymbolType
Bin, TeXSymbolType
Op, TeXSymbolType
Rel, TeXSymbolType
Open, TeXSymbolType
Pun]
      = Exp -> InEDelimited
forall a b. b -> Either a b
Right (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Ord Text
t) InEDelimited -> [InEDelimited] -> [InEDelimited]
forall a. a -> [a] -> [a]
: [InEDelimited]
accum
  goInDel (Right (ESymbol TeXSymbolType
Bin Text
t') : [InEDelimited]
rest) (Right (ESymbol TeXSymbolType
ty Text
t))
    | TeXSymbolType
ty TeXSymbolType -> [TeXSymbolType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TeXSymbolType
Rel, TeXSymbolType
Close, TeXSymbolType
Pun]
      = Exp -> InEDelimited
forall a b. b -> Either a b
Right (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
ty Text
t) InEDelimited -> [InEDelimited] -> [InEDelimited]
forall a. a -> [a] -> [a]
: Exp -> InEDelimited
forall a b. b -> Either a b
Right (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Ord Text
t') InEDelimited -> [InEDelimited] -> [InEDelimited]
forall a. a -> [a] -> [a]
: [InEDelimited]
rest
  goInDel [InEDelimited]
xs InEDelimited
x = InEDelimited
x InEDelimited -> [InEDelimited] -> [InEDelimited]
forall a. a -> [a] -> [a]
: [InEDelimited]
xs

showParseError :: Text -> ParseError -> Text
showParseError :: Text -> ParseError -> Text
showParseError Text
inp ParseError
pe =
  Text
snippet Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
caretline Text -> Text -> Text
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 :: Int
errln = SourcePos -> Int
sourceLine (ParseError -> SourcePos
errorPos ParseError
pe)
        errcol :: Int
errcol = SourcePos -> Int
sourceColumn (ParseError -> SourcePos
errorPos ParseError
pe)
        snipoffset :: Int
snipoffset = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
errcol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
20)
        inplns :: [Text]
inplns = Text -> [Text]
T.lines Text
inp
        ln :: Text
ln = if [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
inplns Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
errln
                then [Text]
inplns [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! (Int
errln Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                else Text
""  -- should not happen
        snippet :: Text
snippet = Int -> Text -> Text
T.take Int
40 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
snipoffset Text
ln
        caretline :: Text
caretline = Int -> Text -> Text
T.replicate (Int
errcol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
snipoffset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"^"

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

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

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

comment :: TP ()
comment :: TP ()
comment = Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%' ParsecT Text () Identity Char -> TP () -> TP ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Char -> TP ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\n") TP () -> TP () -> TP ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Char -> TP ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Text () Identity Char
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" ParsecT Text () Identity String -> TP () -> TP ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP () -> TP ()
forall a. TP a -> TP a
braces (ParsecT Text () Identity Char -> TP ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (String -> ParsecT Text () Identity Char
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" ParsecT Text () Identity String -> TP () -> TP ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Char -> TP ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*') TP () -> TP () -> TP ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP () -> TP ()
forall a. TP a -> TP a
braces (ParsecT Text () Identity Char -> TP ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (String -> ParsecT Text () Identity Char
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 :: Parsec Text () [Exp]
formula = Exp -> [Exp]
unGrouped (Exp -> [Exp]) -> TP Exp -> Parsec Text () [Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TP ()
ignorable TP () -> TP Exp -> TP Exp
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP Exp -> TP Exp
manyExp TP Exp
expr TP Exp -> TP () -> TP Exp
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* TP ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)

expr :: TP Exp
expr :: TP Exp
expr = do
  ParsecT Text () Identity String -> TP ()
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" ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
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" ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
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" ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
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")
  (a, convertible) <- ParsecT Text () Identity (Exp, Bool)
-> ParsecT Text () Identity (Exp, Bool)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Identity (Exp, Bool)
-> ParsecT Text () Identity (Exp, Bool)
forall a. TP a -> TP a
braces ParsecT Text () Identity (Exp, Bool)
operatorname) -- needed because macros add {}
                 ParsecT Text () Identity (Exp, Bool)
-> ParsecT Text () Identity (Exp, Bool)
-> ParsecT Text () Identity (Exp, Bool)
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
                 ParsecT Text () Identity (Exp, Bool)
-> ParsecT Text () Identity (Exp, Bool)
-> ParsecT Text () Identity (Exp, Bool)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((,Bool
False) (Exp -> (Exp, Bool))
-> TP Exp -> ParsecT Text () Identity (Exp, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
expr1)
  limits <- limitsIndicator
  subSup limits convertible a <|> superOrSubscripted limits convertible a <|> return a

hyperref :: TP Exp
hyperref :: TP Exp
hyperref = do
  String -> ParsecT Text () Identity String
ctrlseq String
"hyperref"  -- we just ignore hyperref, see #186
  TP Exp -> TP ()
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 = TP Exp -> TP Exp
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TP Exp -> TP Exp) -> TP Exp -> TP Exp
forall a b. (a -> b) -> a -> b
$ do
  c <- TP Text
anyCtrlSeq
  guard $ c /= "\\end" -- handled in environment
       && c /= "\\operatorname" -- handled in expr
  choice
    [ text c
    , styled c
    , colored c
    , root c
    , xspace c
    , mathop c
    , phantom c
    , boxed c
    , binary c
    , genfrac c
    , substack c
    , environment c
    , ensuremath c
    , scaled c
    , negated c
    , siunitx c
    , arrow c
    , tSymbol c
    ] <|> unexpected ("control sequence " <> T.unpack 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...
    convertible <- (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*' ParsecT Text () Identity Char -> TP () -> TP ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TP ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces TP ()
-> ParsecT Text () Identity Bool -> ParsecT Text () Identity Bool
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Text () Identity Bool
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) ParsecT Text () Identity Bool
-> ParsecT Text () Identity Bool -> ParsecT Text () Identity Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> ParsecT Text () Identity Bool
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    tok' <- texSymbol <|> braces (manyExp expr2) <|> texChar
    tok'' <- (EMathOperator <$> (expToOperatorName tok'))
           <|> return (EStyled TextNormal [tok'])
    return (tok'', 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 ([Text] -> Text) -> m [Text] -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Exp -> m Text) -> [Exp] -> m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (TextType -> Exp -> m Text
forall {m :: * -> *}. MonadPlus m => TextType -> Exp -> m Text
toStr TextType
TextNormal) [Exp]
xs
            Exp
_ -> TextType -> Exp -> m Text
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)     = Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ TextType -> Text -> Text
toUnicode TextType
sty Text
s
          toStr TextType
_   (EText TextType
sty' Text
s)      = Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ TextType -> Text -> Text
toUnicode TextType
sty' Text
s
          toStr TextType
sty (ENumber Text
s)         = Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ TextType -> Text -> Text
toUnicode TextType
sty Text
s
          toStr TextType
sty (EMathOperator Text
s)   = Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ TextType -> Text -> Text
toUnicode TextType
sty Text
s
          -- handle special characters
          toStr TextType
_ (ESymbol TeXSymbolType
_ Text
"\x2212")  = Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"-"
          toStr TextType
_ (ESymbol TeXSymbolType
_ Text
"\x2032")  = Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"'"
          toStr TextType
_ (ESymbol TeXSymbolType
_ Text
"\x2033")  = Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"''"
          toStr TextType
_ (ESymbol TeXSymbolType
_ Text
"\x2034")  = Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"'''"
          toStr TextType
_ (ESymbol TeXSymbolType
_ Text
"\x2057")  = Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"''''"
          toStr TextType
_ (ESymbol TeXSymbolType
_ Text
"\x02B9")  = Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"'"
          toStr TextType
sty (ESymbol TeXSymbolType
_ Text
s)       = Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ TextType -> Text -> Text
toUnicode TextType
sty Text
s
          toStr TextType
_ (ESpace Rational
n)            = Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Rational -> Text
getSpaceChars Rational
n
          toStr TextType
_ (EStyled TextType
sty' [Exp]
exps)   = [Text] -> Text
T.concat ([Text] -> Text) -> m [Text] -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            [m Text] -> m [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ((Exp -> m Text) -> [Exp] -> [m Text]
forall a b. (a -> b) -> [a] -> [b]
map (TextType -> Exp -> m Text
toStr TextType
sty') [Exp]
exps)
          toStr TextType
_   Exp
_                   = m Text
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

bareSubSup :: TP Exp
bareSubSup :: TP Exp
bareSubSup = Maybe Bool -> Bool -> Exp -> TP Exp
subSup Maybe Bool
forall a. Maybe a
Nothing Bool
False (Text -> Exp
EIdentifier Text
"")
  TP Exp -> TP Exp -> TP Exp
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
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" ParsecT Text () Identity String
-> TP (Maybe Bool) -> TP (Maybe Bool)
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Bool -> TP (Maybe Bool)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True))
  TP (Maybe Bool) -> TP (Maybe Bool) -> TP (Maybe Bool)
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" ParsecT Text () Identity String
-> TP (Maybe Bool) -> TP (Maybe Bool)
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Bool -> TP (Maybe Bool)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False))
  TP (Maybe Bool) -> TP (Maybe Bool) -> TP (Maybe Bool)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe Bool -> TP (Maybe Bool)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bool
forall a. Maybe a
Nothing

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

substack :: Text -> TP Exp
substack :: Text -> TP Exp
substack Text
"\\substack" = do
  formulas <- Parsec Text () [Exp] -> Parsec Text () [Exp]
forall a. TP a -> TP a
braces (Parsec Text () [Exp] -> Parsec Text () [Exp])
-> Parsec Text () [Exp] -> Parsec Text () [Exp]
forall a b. (a -> b) -> a -> b
$ TP ()
ignorable TP () -> Parsec Text () [Exp] -> Parsec Text () [Exp]
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (TP Exp -> TP Exp
manyExp TP Exp
expr) TP Exp -> ParsecT Text () Identity Char -> Parsec Text () [Exp]
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` ParsecT Text () Identity Char
endLine
  return $ EArray [AlignCenter] $ map (\Exp
x -> [[Exp
x]]) formulas
substack Text
_ = TP Exp
forall a. ParsecT Text () Identity a
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
  initial <- if Bool
requireNonempty
                then TP Exp -> Parsec Text () [Exp]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (TP Text -> TP ()
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 TP () -> TP Exp -> TP Exp
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TP Exp
p)
                else TP Exp -> Parsec Text () [Exp]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (TP Text -> TP ()
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 TP () -> TP Exp -> TP Exp
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TP Exp
p)
  let withCmd :: Text -> TP Exp
      withCmd Text
cmd =
         case Text -> Map Text (Exp -> Exp -> Exp) -> Maybe (Exp -> Exp -> Exp)
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 (Exp -> Exp -> Exp)
-> TP Exp -> ParsecT Text () Identity (Exp -> Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Exp] -> Exp
asGroup ([Exp] -> Exp) -> Parsec Text () [Exp] -> TP Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Exp] -> Parsec Text () [Exp]
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Exp]
initial)
                           ParsecT Text () Identity (Exp -> Exp) -> TP Exp -> TP Exp
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Exp] -> Exp
asGroup ([Exp] -> Exp) -> Parsec Text () [Exp] -> TP Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp -> Parsec Text () [Exp]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many TP Exp
p)
              Maybe (Exp -> Exp -> Exp)
Nothing -> String -> TP Exp
forall a. String -> ParsecT Text () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> TP Exp) -> String -> TP Exp
forall a b. (a -> b) -> a -> b
$ String
"Unknown command " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
cmd
  (binomCmd >>= withCmd) <|> return (asGroup 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 = TP Exp -> TP Exp
forall a. TP a -> TP a
braces (TP ()
ignorable TP () -> TP Exp -> TP Exp
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP Exp -> TP Exp
manyExp TP Exp
expr)

texToken :: TP Exp
texToken :: TP Exp
texToken = TP Exp
texSymbol TP Exp -> TP Exp -> TP Exp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
inbraces TP Exp -> TP Exp -> TP Exp
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
    c <- String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\n\t\r \\{}" ParsecT Text () Identity Char
-> TP () -> ParsecT Text () Identity Char
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* TP ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
    return $ (if isDigit c then ENumber else EIdentifier) $ T.singleton c

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

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

enclosure :: TP Exp
enclosure :: TP Exp
enclosure = TP Exp
delimited TP Exp -> TP Exp -> TP Exp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
delimitedImplicit TP Exp -> TP Exp -> TP Exp
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 = TP Exp -> TP Exp
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TP Exp -> TP Exp) -> TP Exp -> TP Exp
forall a b. (a -> b) -> a -> b
$ do
  possibleEncl <- TP Text -> TP Text
forall a. TP a -> TP a
lexeme (TP Text
anyCtrlSeq TP Text -> TP Text -> TP Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> ParsecT Text () Identity Char -> TP Text
countChar Int
1 (String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"()[]|"))
  case M.lookup possibleEncl enclosures of
       Just Exp
x  -> Exp -> TP Exp
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
x
       Maybe Exp
Nothing -> TP Exp
forall a. ParsecT Text () Identity a
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 = TP Exp -> TP Exp
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Open Text
"" Exp -> ParsecT Text () Identity String -> TP Exp
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text () Identity String
symbol String
".")
      angleDelim :: TP Exp
angleDelim = TP Exp -> TP Exp
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TP Exp -> TP Exp) -> TP Exp -> TP Exp
forall a b. (a -> b) -> a -> b
$ [TP Exp] -> TP Exp
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" Exp -> ParsecT Text () Identity String -> TP Exp
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
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" Exp -> ParsecT Text () Identity String -> TP Exp
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text () Identity String
symbol String
">"
        ]
  enc <- TP Exp
basicEnclosure TP Exp -> TP Exp -> TP Exp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
nullDelim TP Exp -> TP Exp -> TP Exp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
angleDelim
  case enc of
       ESymbol TeXSymbolType
Open Text
x  -> Text -> TP Text
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
       ESymbol TeXSymbolType
Close Text
x -> Text -> TP Text
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
       Exp
_ -> TP Text
forall a. ParsecT Text () Identity a
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
  openc <- TP Text -> TP Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TP Text -> TP Text) -> TP Text -> TP Text
forall a b. (a -> b) -> a -> b
$ String -> TP Text
fence String
"\\left"
  contents <- concat <$>
              many (try $ ((:[]) . Left  <$> middle)
                      <|> (map Right . unGrouped <$>
                             many1Exp (notFollowedBy right *> expr)))
  closec <- right <|> return ""
  return $ EDelimited openc closec contents

delimitedImplicit :: TP Exp
delimitedImplicit :: TP Exp
delimitedImplicit = TP Exp -> TP Exp
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TP Exp -> TP Exp) -> TP Exp -> TP Exp
forall a b. (a -> b) -> a -> b
$ do
  (opent, closer) <- ((Text
"\x2016", String
"\x2016" String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text () Identity String
ctrlseq String
"rVert") (Text, ParsecT Text () Identity String)
-> ParsecT Text () Identity String
-> ParsecT Text () Identity (Text, ParsecT Text () Identity String)
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text () Identity String
ctrlseq String
"lVert")
  contents <- concat <$>
              many (try $ ((:[]) . Left  <$> middle)
                      <|> (map Right . unGrouped <$>
                             many1Exp (notFollowedBy closer *> expr)))
  closet <- T.pack <$> closer
  return $ EDelimited opent closet 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 (Exp -> Exp) -> TP Exp -> TP Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TP Exp
basicEnclosure TP Exp -> TP Exp -> TP Exp
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 -> TP Exp
forall a. ParsecT Text () Identity a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

endLine :: TP Char
endLine :: ParsecT Text () Identity Char
endLine = ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Identity Char -> ParsecT Text () Identity Char)
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall a b. (a -> b) -> a -> b
$ do
  String -> ParsecT Text () Identity String
symbol String
"\\\\"
  TP Exp -> TP ()
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
  Char -> ParsecT Text () Identity Char
forall a. a -> ParsecT Text () Identity a
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 :: ParsecT Text () Identity Char
endLineAMS = ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall a. TP a -> TP a
lexeme (ParsecT Text () Identity Char -> ParsecT Text () Identity Char)
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall a b. (a -> b) -> a -> b
$ ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Identity Char -> ParsecT Text () Identity Char)
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall a b. (a -> b) -> a -> b
$ do
  String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\\\"
  TP () -> TP ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TP ()
comment
  TP Exp -> TP ()
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
  Char -> ParsecT Text () Identity Char
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'

arrayLine :: TP ArrayLine
arrayLine :: TP ArrayLine
arrayLine =
  Parsec Text () [Exp]
-> ParsecT Text () Identity String -> TP ArrayLine
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
    (TP ()
ignorable' TP () -> Parsec Text () [Exp] -> Parsec Text () [Exp]
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      (Exp -> [Exp]
unGrouped (Exp -> [Exp]) -> TP Exp -> Parsec Text () [Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        TP Exp -> TP Exp
manyExp (TP () -> TP ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Identity Char -> TP ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ((Char
'\n' Char
-> ParsecT Text () Identity String -> ParsecT Text () Identity Char
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text () Identity String
ctrlseq String
"end") ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity Char
endLine)) TP () -> TP Exp -> TP Exp
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                   TP Exp
expr TP Exp -> TP () -> TP Exp
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
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 TP () -> TP () -> TP ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TP () -> TP ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (TP () -> TP ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Text () Identity String
ctrlseq String
"hline" ParsecT Text () Identity String -> TP () -> TP ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
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 = [[Alignment]] -> [Alignment]
forall a. Monoid a => [a] -> a
mconcat ([[Alignment]] -> [Alignment])
-> ParsecT Text () Identity [[Alignment]] -> TP [Alignment]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ParsecT Text () Identity [[Alignment]]
-> ParsecT Text () Identity [[Alignment]]
forall a. TP a -> TP a
braces (TP [Alignment] -> ParsecT Text () Identity [[Alignment]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (
                ((Alignment -> [Alignment] -> [Alignment]
forall a. a -> [a] -> [a]
:[]) (Alignment -> [Alignment])
-> (Char -> Alignment) -> Char -> [Alignment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Alignment
letterToAlignment (Char -> [Alignment])
-> ParsecT Text () Identity Char -> TP [Alignment]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter)
            TP [Alignment] -> TP [Alignment] -> TP [Alignment]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([] [Alignment] -> ParsecT Text () Identity Char -> TP [Alignment]
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|')
            TP [Alignment] -> TP [Alignment] -> TP [Alignment]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([] [Alignment] -> ParsecT Text () Identity Char -> TP [Alignment]
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t")
            TP [Alignment] -> TP [Alignment] -> TP [Alignment]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([] [Alignment] -> ParsecT Text () Identity Char -> TP [Alignment]
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ((Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'@' ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'!') ParsecT Text () Identity Char
-> TP Exp -> ParsecT Text () Identity Char
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* TP Exp
inbraces))
            TP [Alignment] -> TP [Alignment] -> TP [Alignment]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*'
                    num <- String -> Text
T.pack (String -> Text) -> ParsecT Text () Identity String -> TP Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity String -> ParsecT Text () Identity String
forall a. TP a -> TP a
braces (ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit)
                    cols <- arrayAlignments
                    case decimal num of
                      Left String
msg -> String -> TP [Alignment]
forall a. String -> ParsecT Text () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
                      Right (Int
n :: Int, Text
_)
                               -> [Alignment] -> TP [Alignment]
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Alignment] -> TP [Alignment]) -> [Alignment] -> TP [Alignment]
forall a b. (a -> b) -> a -> b
$ [[Alignment]] -> [Alignment]
forall a. Monoid a => [a] -> a
mconcat ([[Alignment]] -> [Alignment]) -> [[Alignment]] -> [Alignment]
forall a b. (a -> b) -> a -> b
$ Int -> [Alignment] -> [[Alignment]]
forall a. Int -> a -> [a]
replicate Int
n [Alignment]
cols)
               ))
 where
   letterToAlignment :: Char -> Alignment
letterToAlignment Char
'l' = Alignment
AlignLeft
   letterToAlignment Char
'c' = Alignment
AlignCenter
   letterToAlignment Char
'r' = Alignment
AlignRight
   letterToAlignment Char
_   = Alignment
AlignCenter

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

environments :: M.Map Text (TP Exp)
environments :: Map Text (TP Exp)
environments = [(Text, TP Exp)] -> Map Text (TP Exp)
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 TP Exp -> TP () -> TP ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces TP () -> TP Exp -> TP Exp
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP Exp
align)
  , (Text
"alignedat", TP Exp
inbraces TP Exp -> TP () -> TP ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces TP () -> TP Exp -> TP Exp
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
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
"multlined", 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]
_) = Int -> Alignment -> [Alignment]
forall a. Int -> a -> [a]
replicate (ArrayLine -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ArrayLine
r) Alignment
defaultAlignment

matrixWith :: Text -> Text -> TP Exp
matrixWith :: Text -> Text -> TP Exp
matrixWith Text
opendelim Text
closedelim = do
  lines' <- TP ArrayLine
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity [ArrayLine]
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 ParsecT Text () Identity Char
endLineAMS
  let aligns = Alignment -> [ArrayLine] -> [Alignment]
alignsFromRows Alignment
AlignCenter [ArrayLine]
lines'
  return $ if T.null opendelim && T.null closedelim
              then EArray aligns lines'
              else EDelimited opendelim closedelim
                       [Right $ EArray aligns lines']

stdarray :: TP Exp
stdarray :: TP Exp
stdarray = do
  aligns <- TP [Alignment]
arrayAlignments
  lines' <- sepEndBy1 arrayLine endLine
  return $ EArray aligns lines'

gather :: TP Exp
gather :: TP Exp
gather = do
  rows <- TP ArrayLine
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity [ArrayLine]
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 ParsecT Text () Identity Char
endLineAMS
  return $ EArray (alignsFromRows AlignCenter rows) rows

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

eqnarray :: TP Exp
eqnarray :: TP Exp
eqnarray = do
  rows <- TP ArrayLine
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity [ArrayLine]
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 ParsecT Text () Identity Char
endLine
  let n = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (ArrayLine -> Int) -> [ArrayLine] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ArrayLine -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ArrayLine]
rows
  return $ EArray (take n $ cycle [AlignRight, AlignCenter, AlignLeft]) rows

align :: TP Exp
align :: TP Exp
align = do
  rows <- TP ArrayLine
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity [ArrayLine]
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 ParsecT Text () Identity Char
endLineAMS
  let n = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (ArrayLine -> Int) -> [ArrayLine] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ArrayLine -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ArrayLine]
rows
  return $ EArray (take n $ cycle [AlignRight, AlignLeft]) rows

flalign :: TP Exp
flalign :: TP Exp
flalign = do
  rows <- TP ArrayLine
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity [ArrayLine]
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 ParsecT Text () Identity Char
endLineAMS
  let n = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (ArrayLine -> Int) -> [ArrayLine] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ArrayLine -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ArrayLine]
rows
  return $ EArray (take n $ cycle [AlignLeft, AlignRight]) rows

cases :: TP Exp
cases :: TP Exp
cases = do
  rs <- TP ArrayLine
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity [ArrayLine]
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 ParsecT Text () Identity Char
endLineAMS
  return $ EDelimited "{" "" [Right $ EArray (alignsFromRows AlignLeft rs) rs]

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

isConvertible :: Exp -> Bool
isConvertible :: Exp -> Bool
isConvertible (EMathOperator Text
x) = Text
x Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
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
Op Text
x) = Text
x Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
convertibleSyms
  where convertibleSyms :: [Text]
convertibleSyms =
         [Text
"\x2211", Text
"\x220F", Text
"\x2210", -- \sum \prod \amalg
          Text
"\x22C0", Text
"\x22C1", -- bigwedge \bigvee
          Text
"\x22C2", Text
"\x22C3", -- \bigcap \bigcup
          Text
"\x2A05", Text
"\x2A06"] -- \bigsqcap \bisqcup
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 = TP Exp -> TP Exp
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TP Exp -> TP Exp) -> TP Exp -> TP Exp
forall a b. (a -> b) -> a -> b
$ do
  let sub1 :: TP Exp
sub1 = String -> ParsecT Text () Identity String
symbol String
"_" ParsecT Text () Identity String -> TP Exp -> TP Exp
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
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
"^" ParsecT Text () Identity String -> TP Exp -> TP Exp
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TP Exp
expr1
  (b,c) <- ParsecT Text () Identity (Exp, Exp)
-> ParsecT Text () Identity (Exp, Exp)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do {m <- TP Exp
sub1; n <- sup1; return (m,n)})
       ParsecT Text () Identity (Exp, Exp)
-> ParsecT Text () Identity (Exp, Exp)
-> ParsecT Text () Identity (Exp, Exp)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do {n <- TP Exp
sup1; m <- sub1; return (m,n)})
  return $ case 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 = TP Exp -> TP Exp
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TP Exp -> TP Exp) -> TP Exp -> TP Exp
forall a b. (a -> b) -> a -> b
$ do
  c <- String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"^_"
  spaces
  b <- expr
  case c of
       Char
'^' -> Exp -> TP Exp
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> TP Exp) -> Exp -> TP Exp
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
'_' -> Exp -> TP Exp
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> TP Exp) -> Exp -> TP Exp
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
_   -> TP Exp
forall a. ParsecT Text () Identity a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

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

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

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

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

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

innermath :: TP Exp
innermath :: TP Exp
innermath = [TP Exp] -> TP Exp
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([TP Exp] -> TP Exp) -> [TP Exp] -> TP Exp
forall a b. (a -> b) -> a -> b
$ ((String, String) -> TP Exp) -> [(String, String)] -> [TP Exp]
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
  ParsecT Text () Identity String -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
opener)
  e <- TP Exp -> TP Exp
manyExp TP Exp
expr
  string closer
  return e

styled :: Text -> TP Exp
styled :: Text -> TP Exp
styled Text
c = do
  case Text -> Map Text ([Exp] -> Exp) -> Maybe ([Exp] -> Exp)
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
         x <- TP Exp
texSymbol TP Exp -> TP Exp -> TP Exp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
inbraces TP Exp -> TP Exp -> TP Exp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp
texChar
         return $ case x of
                       EGrouped [Exp]
xs -> [Exp] -> Exp
f [Exp]
xs
                       Exp
_           -> [Exp] -> Exp
f [Exp
x]
       Maybe ([Exp] -> Exp)
Nothing  -> TP Exp
forall a. ParsecT Text () Identity a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

colored :: Text -> TP Exp
colored :: Text -> TP Exp
colored Text
"\\color" = do
  _ <- TP Exp
inbraces -- skip the color
  -- in the future we might add color to the types or to the styles
  texSymbol <|> inbraces <|> texChar
colored Text
_ = TP Exp
forall a. ParsecT Text () Identity a
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
  Bool -> TP ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> TP ()) -> Bool -> TP ()
forall a b. (a -> b) -> a -> b
$ Text
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\\sqrt" Bool -> Bool -> Bool
|| Text
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\\surd"
  (Exp -> Exp -> Exp
ERoot (Exp -> Exp -> Exp)
-> TP Exp -> ParsecT Text () Identity (Exp -> Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
inbrackets ParsecT Text () Identity (Exp -> Exp) -> TP Exp -> TP Exp
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TP Exp
texToken) TP Exp -> TP Exp -> TP Exp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Exp -> Exp
ESqrt (Exp -> Exp) -> TP Exp -> TP Exp
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
"\\enspace" = Exp -> TP Exp
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> TP Exp) -> Exp -> TP Exp
forall a b. (a -> b) -> a -> b
$ Rational -> Exp
ESpace (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)
xspace Text
"\\mspace" =
  TP Exp -> TP Exp
forall a. TP a -> TP a
braces (TP Exp -> TP Exp) -> TP Exp -> TP Exp
forall a b. (a -> b) -> a -> b
$ do
    len <- ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
    lexeme $ string "mu"
    case reads len of
       ((Integer
n :: Integer,[]):[(Integer, String)]
_) -> Exp -> TP Exp
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> TP Exp) -> Exp -> TP Exp
forall a b. (a -> b) -> a -> b
$ Rational -> Exp
ESpace (Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
nRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18)
       [(Integer, String)]
_                     -> TP Exp
forall a. ParsecT Text () Identity a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
xspace Text
"\\hspace" = do
  TP Exp -> TP Exp
forall a. TP a -> TP a
braces (TP Exp -> TP Exp) -> TP Exp -> TP Exp
forall a b. (a -> b) -> a -> b
$ do
    neg <- Rational
-> ParsecT Text () Identity Rational
-> ParsecT Text () Identity Rational
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Rational
1 (ParsecT Text () Identity Rational
 -> ParsecT Text () Identity Rational)
-> ParsecT Text () Identity Rational
-> ParsecT Text () Identity Rational
forall a b. (a -> b) -> a -> b
$ (-Rational
1) Rational
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity Rational
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
    as <- option "" $ many1 digit
    bs <- option "" $ char '.' *> many1 digit
    let denominator = Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
bs)
    as' <- if null as then pure 0 else stringToInteger as
    bs' <- if null bs then pure 0 else stringToInteger bs
    let numerator = (Integer
as' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
denominator) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
bs'
    let n = Rational
neg Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Integer
numerator Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
denominator)
    scaleFactor <- lexeme $
           1      <$ (string "em")
      <|> (1/12)  <$ (string "pt")
      <|> 6       <$ (string "in")
      <|> (50/21) <$ (string "cm")
    return $ ESpace (n * scaleFactor)
xspace Text
_ = TP Exp
forall a. ParsecT Text () Identity a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

stringToInteger :: String -> TP Integer
stringToInteger :: String -> ParsecT Text () Identity Integer
stringToInteger String
s =
  case ReadS Integer
forall a. Read a => ReadS a
reads String
s of
    ((Integer
n :: Integer, []):[(Integer, String)]
_) -> Integer -> ParsecT Text () Identity Integer
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
n
    [(Integer, String)]
_ -> String -> ParsecT Text () Identity Integer
forall a. String -> ParsecT Text () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT Text () Identity Integer)
-> String -> ParsecT Text () Identity Integer
forall a b. (a -> b) -> a -> b
$ String
"Could not read " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" as Integer."

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
_              -> TP Exp
forall a. ParsecT Text () Identity a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

mathopWith :: TeXSymbolType -> TP Exp
mathopWith :: TeXSymbolType -> TP Exp
mathopWith TeXSymbolType
ty = do
  e <- TP Exp
inbraces TP Exp -> TP Exp -> TP Exp
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' = case Exp
e of
                 EGrouped [Exp]
xs -> [Exp]
xs
                 Exp
x           -> [Exp
x]
  case es' of
     [ESymbol TeXSymbolType
_ Text
x]   -> Exp -> TP Exp
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> TP Exp) -> Exp -> TP Exp
forall a b. (a -> b) -> a -> b
$ TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
ty Text
x
     [EIdentifier Text
x] -> Exp -> TP Exp
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> TP Exp) -> Exp -> TP Exp
forall a b. (a -> b) -> a -> b
$ TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
ty Text
x
     [EText TextType
TextNormal Text
x] -> Exp -> TP Exp
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> TP Exp) -> Exp -> TP Exp
forall a b. (a -> b) -> a -> b
$ TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
ty Text
x
     [EText TextType
sty Text
x] -> Exp -> TP Exp
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> TP Exp) -> Exp -> TP Exp
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 TeXSymbolType -> TeXSymbolType -> Bool
forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Op  -> Exp -> TP Exp
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> TP Exp) -> Exp -> TP Exp
forall a b. (a -> b) -> a -> b
$ Text -> Exp
EMathOperator (Text -> Exp) -> Text -> Exp
forall a b. (a -> b) -> a -> b
$
                         [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Exp -> Maybe Text) -> [Exp] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Exp -> Maybe Text
forall (m :: * -> *). MonadPlus m => Exp -> m Text
expToOperatorName [Exp]
xs
        | Bool
otherwise -> Exp -> TP Exp
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> TP Exp) -> Exp -> TP Exp
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
       a <- TP Exp
texToken
       b <- texToken
       return $ EOver False b a
     Text
"\\stackrel" -> do
       a <- TP Exp
texToken
       b <- texToken
       return $ EOver False b a
     Text
"\\underset" -> do
       a <- TP Exp
texToken
       b <- texToken
       return $ EUnder False b a
     Text
"\\frac"     -> FractionType -> Exp -> Exp -> Exp
EFraction FractionType
NormalFrac (Exp -> Exp -> Exp)
-> TP Exp -> ParsecT Text () Identity (Exp -> Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
texToken ParsecT Text () Identity (Exp -> Exp) -> TP Exp -> TP Exp
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
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 (Exp -> Exp -> Exp)
-> TP Exp -> ParsecT Text () Identity (Exp -> Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
texToken ParsecT Text () Identity (Exp -> Exp) -> TP Exp -> TP Exp
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
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 (Exp -> Exp -> Exp)
-> TP Exp -> ParsecT Text () Identity (Exp -> Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
texToken ParsecT Text () Identity (Exp -> Exp) -> TP Exp -> TP Exp
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TP Exp
texToken
     Text
"\\binom"    -> do
       a <- TP Exp
texToken
       b <- texToken
       return $ EDelimited "(" ")" [Right (EFraction NoLineFrac a b)]
     Text
_            -> TP Exp
forall a. ParsecT Text () Identity a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

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

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


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

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

infix 0 <??>

tSymbol :: Text -> TP Exp
tSymbol :: Text -> TP Exp
tSymbol Text
sym =
  case Text -> Map Text Exp -> Maybe Exp
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) (Exp -> Exp) -> TP Exp -> TP Exp
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) (Exp -> Exp) -> TP Exp -> TP Exp
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) (Exp -> Exp) -> TP Exp -> TP Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
texToken
       Just (ESymbol TeXSymbolType
Alpha Text
t) -> Exp -> TP Exp
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> TP Exp) -> Exp -> TP Exp
forall a b. (a -> b) -> a -> b
$ Text -> Exp
EIdentifier Text
t -- see #256
       Just Exp
x  -> Exp -> TP Exp
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
x
       Maybe Exp
Nothing
         | Text
sym Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\\mod" -> do
             x <- Exp -> Exp
deGroup (Exp -> Exp) -> TP Exp -> TP Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
expr
             return $ EGrouped
               [ESpace (8/18), EMathOperator "mod", ESpace (4/18), x]
         | Text
sym Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\\bmod" -> do
             x <- Exp -> Exp
deGroup (Exp -> Exp) -> TP Exp -> TP Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
expr
             return $ EGrouped
               [ESpace (4/18), EMathOperator "mod", ESpace (4/18), x]
         | Text
sym Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\\pmod" -> do
             x <- Exp -> Exp
deGroup (Exp -> Exp) -> TP Exp -> TP Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
expr
             return $ EGrouped
               [ESpace (4/18), ESymbol Open "(", EMathOperator "mod",
                ESpace (4/18), x, ESymbol Close ")"]
         | Text
sym Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\\pod"  -> do
             x <- Exp -> Exp
deGroup (Exp -> Exp) -> TP Exp -> TP Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
expr
             return $ EGrouped
               [ESpace (4/18), ESymbol Open "(", x, ESymbol Close ")"]
         | Bool
otherwise -> TP Exp
forall a. ParsecT Text () Identity a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

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

lexeme :: TP a -> TP a
lexeme :: forall a. TP a -> TP a
lexeme TP a
p = TP a
p TP a -> TP () -> TP a
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
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 = TP a -> TP a
forall a. TP a -> TP a
lexeme (TP a -> TP a) -> TP a -> TP a
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' ParsecT Text () Identity Char -> TP () -> TP ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces TP () -> TP a -> TP a
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP a
p TP a -> TP () -> TP a
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* TP ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces TP a -> ParsecT Text () Identity Char -> TP a
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text () Identity Char
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 = TP a -> TP a
forall a. TP a -> TP a
lexeme (TP a -> TP a) -> TP a -> TP a
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[' ParsecT Text () Identity Char -> TP () -> TP ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces TP () -> TP a -> TP a
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TP a
p TP a -> TP () -> TP a
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* TP ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces TP a -> ParsecT Text () Identity Char -> TP a
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text () Identity Char
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 = String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (Text -> String
T.unpack Text
t) ParsecT Text () Identity String -> Text -> TP Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
t

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

symbol :: String -> TP String
symbol :: String -> ParsecT Text () Identity String
symbol String
s = ParsecT Text () Identity String -> ParsecT Text () Identity String
forall a. TP a -> TP a
lexeme (ParsecT Text () Identity String
 -> ParsecT Text () Identity String)
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT Text () Identity String -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Identity String
 -> ParsecT Text () Identity String)
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text () Identity String
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 TP Text -> TP Text -> TP Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Text
sps TP Text -> TP Text -> TP Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Text
ligature TP Text -> TP Text -> TP Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Text
textCommand
            TP Text -> String -> TP Text
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
" " Text -> TP () -> TP Text
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text () Identity Char -> TP ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 (String -> ParsecT Text () Identity Char
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 (String -> Text) -> ParsecT Text () Identity String -> TP Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"`'-~${}\\ \t")

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

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

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

parseC :: TP Text
parseC :: TP Text
parseC = TP Text -> TP Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TP Text -> TP Text) -> TP Text -> TP Text
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`' ParsecT Text () Identity Char -> TP Text -> TP Text
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT Text () Identity Char -> TP Text
countChar Int
1 ParsecT Text () Identity Char
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
_          -> TP Exp
forall a. ParsecT Text () Identity a
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
  TP () -> TP ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (TP () -> TP ()) -> TP () -> TP ()
forall a b. (a -> b) -> a -> b
$ TP Exp -> TP ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TP Exp
inbrackets
  startvalue <- Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp)
-> TP Exp -> ParsecT Text () Identity (Maybe Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
doSInum
  startvalueprefix <- option Nothing $ Just <$> brackets expr
  stopvalue <- Just <$> doSInum
  stopvalueprefix <- option Nothing $ Just <$> brackets expr
  unit <- if includeUnits
             then option Nothing $ Just <$> dosi
             else return Nothing
  return $ EGrouped $ catMaybes
           [startvalueprefix,
            emptyOr160 startvalueprefix,
            startvalue,
            emptyOr160 unit,
            unit,
            Just (EText TextNormal "\8211"), -- An en-dash
            stopvalueprefix,
            emptyOr160 stopvalueprefix,
            stopvalue,
            emptyOr160 unit,
            unit]


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

dosi :: TP Exp
dosi :: TP Exp
dosi = TP Exp
siUnit TP Exp -> TP Exp -> TP Exp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TP Exp -> TP Exp
forall a. TP a -> TP a
braces (TP Exp -> TP Exp
manyExp (TP Exp
siUnit TP Exp -> TP Exp -> TP Exp
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
  TP () -> TP ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (TP () -> TP ()) -> TP () -> TP ()
forall a b. (a -> b) -> a -> b
$ TP Exp -> TP ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TP Exp
inbrackets
  ps <- Parsec Text () [Exp] -> Parsec Text () [Exp]
forall a. TP a -> TP a
braces (Parsec Text () [Exp] -> Parsec Text () [Exp])
-> Parsec Text () [Exp] -> Parsec Text () [Exp]
forall a b. (a -> b) -> a -> b
$ TP Exp -> ParsecT Text () Identity Char -> Parsec Text () [Exp]
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 (TP ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces TP ()
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';' ParsecT Text () Identity Char
-> TP () -> ParsecT Text () Identity Char
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* TP ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces)
  return $ EGrouped $
    case ps ++ repeat (EGrouped []) of
      (Exp
d:Exp
m:Exp
s:[Exp]
_) ->
        (if Exp
d Exp -> Exp -> Bool
forall a. Eq a => a -> a -> Bool
== [Exp] -> Exp
EGrouped [] then [] else [Exp
d, TextType -> Text -> Exp
EText TextType
TextNormal Text
"\xb0"]) [Exp] -> [Exp] -> [Exp]
forall a. Semigroup a => a -> a -> a
<>
        (if Exp
m Exp -> Exp -> Bool
forall a. Eq a => a -> a -> Bool
== [Exp] -> Exp
EGrouped [] then [] else [Exp
m, TextType -> Text -> Exp
EText TextType
TextNormal Text
"\x2032"]) [Exp] -> [Exp] -> [Exp]
forall a. Semigroup a => a -> a -> a
<>
        (if Exp
s Exp -> Exp -> Bool
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
  TP () -> TP ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (TP () -> TP ()) -> TP () -> TP ()
forall a b. (a -> b) -> a -> b
$ TP Exp -> TP ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TP Exp
inbrackets
  value <- Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp)
-> TP Exp -> ParsecT Text () Identity (Maybe Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TP Exp
doSInum
  valueprefix <- option Nothing $ do
                    x <- inbrackets
                    if x == EGrouped []
                       then return Nothing
                       else return $ Just x
  unit <- option Nothing $ Just <$> dosi
  return $ EGrouped $ catMaybes
         [ valueprefix,
           emptyOr160 valueprefix,
           value,
           emptyOr160 unit,
           unit
         ]

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


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

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

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

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