{-# LANGUAGE FlexibleInstances #-}

module Language.Elsa.Parser
  ( parse
  , parseFile
  ) where

import qualified Control.Exception          as Ex
import           Control.Monad          (void)
import           Text.Megaparsec hiding (parse)
import qualified Text.Megaparsec.Char.Lexer as L
import           Text.Megaparsec.Char
import           Text.Megaparsec.Stream ()
import qualified Data.List as L
import           Language.Elsa.Types
import           Language.Elsa.UX
import           Data.List.NonEmpty         as NE

type Parser = Parsec SourcePos Text

--------------------------------------------------------------------------------
parse :: FilePath -> Text -> SElsa
--------------------------------------------------------------------------------
parse :: Text -> Text -> SElsa
parse = Parser SElsa -> Text -> Text -> SElsa
forall a. Parser a -> Text -> Text -> a
parseWith Parser SElsa
elsa

parseWith  :: Parser a -> FilePath -> Text -> a
parseWith :: forall a. Parser a -> Text -> Text -> a
parseWith Parser a
p Text
f Text
s = case Parser a
-> Text -> Text -> Either (ParseErrorBundle Text SourcePos) a
forall e s a.
Parsec e s a -> Text -> s -> Either (ParseErrorBundle s e) a
runParser (Parser a -> Parser a
forall a. Parser a -> Parser a
whole Parser a
p) Text
f Text
s of
                    Left ParseErrorBundle Text SourcePos
pErrs -> [UserError] -> a
forall a e. Exception e => e -> a
Ex.throw (ParseErrorBundle Text SourcePos -> Text -> Text -> [UserError]
mkErrors ParseErrorBundle Text SourcePos
pErrs Text
f Text
s) -- panic (show err) (posSpan . NE.head . errorPos $ err)
                    Right a
e  -> a
e

mkErrors :: ParseErrorBundle Text SourcePos -> FilePath -> Text -> [UserError]
mkErrors :: ParseErrorBundle Text SourcePos -> Text -> Text -> [UserError]
mkErrors ParseErrorBundle Text SourcePos
b Text
f Text
s = [ Text -> SourceSpan -> UserError
mkError (ParseError Text SourcePos -> Text
forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> Text
parseErrorPretty ParseError Text SourcePos
e) (ParseError Text SourcePos -> SourceSpan
forall {s} {e}. ParseError s e -> SourceSpan
span ParseError Text SourcePos
e) | ParseError Text SourcePos
e <- NonEmpty (ParseError Text SourcePos) -> [ParseError Text SourcePos]
forall a. NonEmpty a -> [a]
NE.toList (ParseErrorBundle Text SourcePos
-> NonEmpty (ParseError Text SourcePos)
forall s e. ParseErrorBundle s e -> NonEmpty (ParseError s e)
bundleErrors ParseErrorBundle Text SourcePos
b)]
  where
    span :: ParseError s e -> SourceSpan
span ParseError s e
e = let (Int
l, Int
c) = Text -> Int -> (Int, Int)
lineCol Text
s (ParseError s e -> Int
forall s e. ParseError s e -> Int
errorOffset ParseError s e
e) in SourcePos -> SourceSpan
posSpan (Text -> Pos -> Pos -> SourcePos
SourcePos Text
f (Int -> Pos
mkPos Int
l) (Int -> Pos
mkPos Int
c))

-- PosState looks relevant for finding line/column, but I (Justin) don't know how to use it

lineCol :: String -> Int -> (Int, Int)
lineCol :: Text -> Int -> (Int, Int)
lineCol Text
s Int
i = ((Int, Int) -> Char -> (Int, Int))
-> (Int, Int) -> Text -> (Int, Int)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Int, Int) -> Char -> (Int, Int)
forall {a} {b}. (Num a, Num b) => (a, b) -> Char -> (a, b)
f (Int
1, Int
1) (Int -> Text -> Text
forall a. Int -> [a] -> [a]
Prelude.take Int
i Text
s)
  where
    f :: (a, b) -> Char -> (a, b)
f (a
l, b
c) Char
char = if Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then (a
l a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
1) else (a
l, b
c b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)

instance ShowErrorComponent SourcePos where
  showErrorComponent :: SourcePos -> Text
showErrorComponent = SourcePos -> Text
forall a. Show a => a -> Text
show
 

-- panic msg sp = throw [Error msg sp]
-- instance Located (ParseError SourcePos Text) where
--  sourceSpan = posSpan . errorPos

-- instance PPrint (ParseError SourcePos Text) where
--   pprint = show

--------------------------------------------------------------------------------
parseFile :: FilePath -> IO SElsa
--------------------------------------------------------------------------------
parseFile :: Text -> IO SElsa
parseFile Text
f = Text -> Text -> SElsa
parse Text
f (Text -> SElsa) -> IO Text -> IO SElsa
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO Text
readFile Text
f

-- https://mrkkrp.github.io/megaparsec/tutorials/parsing-simple-imperative-language.html

-- | Top-level parsers (should consume all input)
whole :: Parser a -> Parser a
whole :: forall a. Parser a -> Parser a
whole Parser a
p = Parser ()
sc Parser () -> Parser a -> Parser a
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p Parser a -> Parser () -> Parser a
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

-- RJ: rename me "space consumer"
sc :: Parser ()
sc :: Parser ()
sc = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space (ParsecT SourcePos Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT SourcePos Text Identity Char
ParsecT SourcePos Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar) Parser ()
lineCmnt Parser ()
blockCmnt
  where
    lineCmnt :: Parser ()
lineCmnt  = Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment  Tokens Text
"--"
    blockCmnt :: Parser ()
blockCmnt = Tokens Text -> Tokens Text -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> Tokens s -> m ()
L.skipBlockComment Tokens Text
"{-" Tokens Text
"-}"

-- | `symbol s` parses just the string s (and trailing whitespace)
symbol :: String -> Parser String
symbol :: Text -> Parser Text
symbol = Parser ()
-> Tokens Text -> ParsecT SourcePos Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parser ()
sc

arrow :: Parser String
arrow :: Parser Text
arrow = Text -> Parser Text
symbol Text
"->"

colon :: Parser String
colon :: Parser Text
colon = Text -> Parser Text
symbol Text
":"

equal :: Parser String
equal :: Parser Text
equal = Text -> Parser Text
symbol Text
"="

lam :: Parser String
lam :: Parser Text
lam = Text -> Parser Text
symbol Text
"\\"


-- | 'parens' parses something between parenthesis.
parens :: Parser a -> Parser a
parens :: forall a. Parser a -> Parser a
parens = Text -> Text -> Parser a -> Parser a
forall a. Text -> Text -> Parser a -> Parser a
betweenS Text
"(" Text
")"

betweenS :: String -> String -> Parser a -> Parser a
betweenS :: forall a. Text -> Text -> Parser a -> Parser a
betweenS Text
l Text
r = Parser Text
-> Parser Text
-> ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
l) (Text -> Parser Text
symbol Text
r)

-- | `lexeme p` consume whitespace after running p
lexeme :: Parser a -> Parser (a, SourceSpan)
lexeme :: forall a. Parser a -> Parser (a, SourceSpan)
lexeme Parser a
p = Parser ()
-> ParsecT SourcePos Text Identity (a, SourceSpan)
-> ParsecT SourcePos Text Identity (a, SourceSpan)
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme Parser ()
sc (Parser a -> ParsecT SourcePos Text Identity (a, SourceSpan)
forall a. Parser a -> Parser (a, SourceSpan)
withSpan Parser a
p)

-- | `rWord`
rWord   :: String -> Parser SourceSpan
rWord :: Text -> Parser SourceSpan
rWord Text
w = (Tokens Text, SourceSpan) -> SourceSpan
forall a b. (a, b) -> b
snd ((Tokens Text, SourceSpan) -> SourceSpan)
-> ParsecT SourcePos Text Identity (Tokens Text, SourceSpan)
-> Parser SourceSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity (Tokens Text, SourceSpan)
forall a. Parser a -> Parser (a, SourceSpan)
withSpan (Tokens Text -> ParsecT SourcePos Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
w) ParsecT SourcePos Text Identity (Tokens Text, SourceSpan)
-> Parser ()
-> ParsecT SourcePos Text Identity (Tokens Text, SourceSpan)
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT SourcePos Text Identity Char -> Parser ()
forall a. ParsecT SourcePos Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT SourcePos Text Identity Char
ParsecT SourcePos Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT SourcePos Text Identity (Tokens Text, SourceSpan)
-> Parser ()
-> ParsecT SourcePos Text Identity (Tokens Text, SourceSpan)
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
sc)

-- | list of reserved words
keywords :: [Text]
keywords :: [Text]
keywords = [ Text
"let"  , Text
"eval"  , Text
"conf" ]

-- | `identifier` parses identifiers: lower-case alphabets followed by alphas or digits
identifier :: Parser (String, SourceSpan)
identifier :: Parser (Text, SourceSpan)
identifier = Parser Text -> Parser (Text, SourceSpan)
forall a. Parser a -> Parser (a, SourceSpan)
lexeme (Parser Text
p Parser Text -> (Text -> Parser Text) -> Parser Text
forall a b.
ParsecT SourcePos Text Identity a
-> (a -> ParsecT SourcePos Text Identity b)
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser Text
forall {m :: * -> *}. MonadFail m => Text -> m Text
check)
  where
    p :: Parser Text
p       = (:) (Char -> Text -> Text)
-> ParsecT SourcePos Text Identity Char
-> ParsecT SourcePos Text Identity (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SourcePos Text Identity Char
ParsecT SourcePos Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar ParsecT SourcePos Text Identity (Text -> Text)
-> Parser Text -> Parser Text
forall a b.
ParsecT SourcePos Text Identity (a -> b)
-> ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT SourcePos Text Identity Char -> Parser Text
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT SourcePos Text Identity Char
identChar -- alphaNumChar
    check :: Text -> m Text
check Text
x = if 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]
keywords
                then Text -> m Text
forall a. Text -> m a
forall (m :: * -> *) a. MonadFail m => Text -> m a
fail (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text
"keyword " Text -> Text -> Text
forall a. [a] -> [a] -> [a]
++ Text -> Text
forall a. Show a => a -> Text
show Text
x Text -> Text -> Text
forall a. [a] -> [a] -> [a]
++ Text
" cannot be an identifier"
                else Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x

identChar :: Parser Char
identChar :: ParsecT SourcePos Text Identity Char
identChar =  ParsecT SourcePos Text Identity Char
ParsecT SourcePos Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar
         ParsecT SourcePos Text Identity Char
-> ParsecT SourcePos Text Identity Char
-> ParsecT SourcePos Text Identity Char
forall a.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token Text] -> ParsecT SourcePos Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'_', Char
'#', Char
'\'']

-- | `binder` parses BareBind, used for let-binds and function parameters.
binder :: Parser SBind
binder :: Parser SBind
binder = (Text -> SourceSpan -> SBind) -> (Text, SourceSpan) -> SBind
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> SourceSpan -> SBind
forall a. Text -> a -> Bind a
Bind ((Text, SourceSpan) -> SBind)
-> Parser (Text, SourceSpan) -> Parser SBind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Text, SourceSpan)
identifier

withSpan' :: Parser (SourceSpan -> a) -> Parser a
withSpan' :: forall a. Parser (SourceSpan -> a) -> Parser a
withSpan' Parser (SourceSpan -> a)
p = do
  SourcePos
p1 <- ParsecT SourcePos Text Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  SourceSpan -> a
f  <- Parser (SourceSpan -> a)
p
  SourcePos
p2 <- ParsecT SourcePos Text Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  a -> Parser a
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceSpan -> a
f (SourcePos -> SourcePos -> SourceSpan
SS SourcePos
p1 SourcePos
p2))

withSpan :: Parser a -> Parser (a, SourceSpan)
withSpan :: forall a. Parser a -> Parser (a, SourceSpan)
withSpan Parser a
p = do
  SourcePos
p1 <- ParsecT SourcePos Text Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  a
x  <- Parser a
p
  SourcePos
p2 <- ParsecT SourcePos Text Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  (a, SourceSpan) -> Parser (a, SourceSpan)
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, SourcePos -> SourcePos -> SourceSpan
SS SourcePos
p1 SourcePos
p2)

--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
elsa :: Parser SElsa
elsa :: Parser SElsa
elsa = do
  [SElsaItem]
items <- ParsecT SourcePos Text Identity SElsaItem
-> ParsecT SourcePos Text Identity [SElsaItem]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT SourcePos Text Identity SElsaItem
elsaItem
  SElsa -> Parser SElsa
forall a. a -> ParsecT SourcePos Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SElsa -> Parser SElsa) -> SElsa -> Parser SElsa
forall a b. (a -> b) -> a -> b
$
    Elsa
      { defns :: [Defn SourceSpan]
defns = [Defn SourceSpan
d | DefnItem Defn SourceSpan
d <- [SElsaItem]
items],
        evals :: [Eval SourceSpan]
evals = [Eval SourceSpan
e | EvalItem Eval SourceSpan
e <- [SElsaItem]
items]
      }

elsaItem :: Parser SElsaItem
elsaItem :: ParsecT SourcePos Text Identity SElsaItem
elsaItem = 
  (Defn SourceSpan -> SElsaItem
forall a. Defn a -> ElsaItem a
DefnItem (Defn SourceSpan -> SElsaItem)
-> ParsecT SourcePos Text Identity (Defn SourceSpan)
-> ParsecT SourcePos Text Identity SElsaItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SourcePos Text Identity (Defn SourceSpan)
defn) ParsecT SourcePos Text Identity SElsaItem
-> ParsecT SourcePos Text Identity SElsaItem
-> ParsecT SourcePos Text Identity SElsaItem
forall a.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Eval SourceSpan -> SElsaItem
forall a. Eval a -> ElsaItem a
EvalItem (Eval SourceSpan -> SElsaItem)
-> ParsecT SourcePos Text Identity (Eval SourceSpan)
-> ParsecT SourcePos Text Identity SElsaItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SourcePos Text Identity (Eval SourceSpan)
eval)

defn :: Parser SDefn
defn :: ParsecT SourcePos Text Identity (Defn SourceSpan)
defn = do
  Text -> Parser SourceSpan
rWord Text
"let"
  SBind
b <- Parser SBind
binder Parser SBind -> Parser Text -> Parser SBind
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text
equal
  SExpr
e <- Parser SExpr
expr
  Defn SourceSpan
-> ParsecT SourcePos Text Identity (Defn SourceSpan)
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SBind -> SExpr -> Defn SourceSpan
forall a. Bind a -> Expr a -> Defn a
Defn SBind
b SExpr
e)

eval :: Parser SEval
eval :: ParsecT SourcePos Text Identity (Eval SourceSpan)
eval = do
  EvalKind
kind <- (Text -> Parser SourceSpan
rWord Text
"eval" Parser SourceSpan
-> ParsecT SourcePos Text Identity EvalKind
-> ParsecT SourcePos Text Identity EvalKind
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EvalKind -> ParsecT SourcePos Text Identity EvalKind
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EvalKind
Regular) ParsecT SourcePos Text Identity EvalKind
-> ParsecT SourcePos Text Identity EvalKind
-> ParsecT SourcePos Text Identity EvalKind
forall a.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser SourceSpan
rWord Text
"conf" Parser SourceSpan
-> ParsecT SourcePos Text Identity EvalKind
-> ParsecT SourcePos Text Identity EvalKind
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EvalKind -> ParsecT SourcePos Text Identity EvalKind
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EvalKind
Conf)
  SBind
name  <- Parser SBind
binder
  Parser Text
colon
  SExpr
root  <- Parser SExpr
expr
  [SStep]
steps <- ParsecT SourcePos Text Identity SStep
-> ParsecT SourcePos Text Identity [SStep]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT SourcePos Text Identity SStep
step
  Eval SourceSpan
-> ParsecT SourcePos Text Identity (Eval SourceSpan)
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Eval SourceSpan
 -> ParsecT SourcePos Text Identity (Eval SourceSpan))
-> Eval SourceSpan
-> ParsecT SourcePos Text Identity (Eval SourceSpan)
forall a b. (a -> b) -> a -> b
$ EvalKind -> SBind -> SExpr -> [SStep] -> Eval SourceSpan
forall a. EvalKind -> Bind a -> Expr a -> [Step a] -> Eval a
Eval EvalKind
kind SBind
name SExpr
root [SStep]
steps

step :: Parser SStep
step :: ParsecT SourcePos Text Identity SStep
step = Eqn SourceSpan -> SExpr -> SStep
forall a. Eqn a -> Expr a -> Step a
Step (Eqn SourceSpan -> SExpr -> SStep)
-> ParsecT SourcePos Text Identity (Eqn SourceSpan)
-> ParsecT SourcePos Text Identity (SExpr -> SStep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SourcePos Text Identity (Eqn SourceSpan)
eqn ParsecT SourcePos Text Identity (SExpr -> SStep)
-> Parser SExpr -> ParsecT SourcePos Text Identity SStep
forall a b.
ParsecT SourcePos Text Identity (a -> b)
-> ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SExpr
expr

eqn :: Parser SEqn
eqn :: ParsecT SourcePos Text Identity (Eqn SourceSpan)
eqn = Parser (SourceSpan -> Eqn SourceSpan)
-> ParsecT SourcePos Text Identity (Eqn SourceSpan)
forall a. Parser (SourceSpan -> a) -> Parser a
withSpan' Parser (SourceSpan -> Eqn SourceSpan)
parseEqn

parseEqn :: Parser (SourceSpan -> Eqn SourceSpan)
parseEqn :: Parser (SourceSpan -> Eqn SourceSpan)
parseEqn = Parser (SourceSpan -> Eqn SourceSpan)
-> Parser (SourceSpan -> Eqn SourceSpan)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (SourceSpan -> Eqn SourceSpan)
parseUnEqn Parser (SourceSpan -> Eqn SourceSpan)
-> Parser (SourceSpan -> Eqn SourceSpan)
-> Parser (SourceSpan -> Eqn SourceSpan)
forall a.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (SourceSpan -> Eqn SourceSpan)
parseRegEqn

parseUnEqn :: Parser (SourceSpan -> Eqn SourceSpan)
parseUnEqn :: Parser (SourceSpan -> Eqn SourceSpan)
parseUnEqn = do
  ParsecT SourcePos Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT SourcePos Text Identity Char -> Parser ())
-> ParsecT SourcePos Text Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SourcePos Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'<'
  EqnOp
op <- [ParsecT SourcePos Text Identity EqnOp]
-> ParsecT SourcePos Text Identity EqnOp
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol Text
"n*=") Parser Text
-> ParsecT SourcePos Text Identity EqnOp
-> ParsecT SourcePos Text Identity EqnOp
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EqnOp -> ParsecT SourcePos Text Identity EqnOp
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EqnOp
EqUnNormOrdTrans
    , Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol Text
"p*=") Parser Text
-> ParsecT SourcePos Text Identity EqnOp
-> ParsecT SourcePos Text Identity EqnOp
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EqnOp -> ParsecT SourcePos Text Identity EqnOp
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EqnOp
EqUnAppOrdTrans
    , Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol Text
"b=")  Parser Text
-> ParsecT SourcePos Text Identity EqnOp
-> ParsecT SourcePos Text Identity EqnOp
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EqnOp -> ParsecT SourcePos Text Identity EqnOp
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EqnOp
EqUnBeta
    , Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol Text
"n=") Parser Text
-> ParsecT SourcePos Text Identity EqnOp
-> ParsecT SourcePos Text Identity EqnOp
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EqnOp -> ParsecT SourcePos Text Identity EqnOp
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EqnOp
EqUnNormOrd
    , Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol Text
"p=") Parser Text
-> ParsecT SourcePos Text Identity EqnOp
-> ParsecT SourcePos Text Identity EqnOp
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EqnOp -> ParsecT SourcePos Text Identity EqnOp
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EqnOp
EqUnAppOrd
    , Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol Text
"e=")  Parser Text
-> ParsecT SourcePos Text Identity EqnOp
-> ParsecT SourcePos Text Identity EqnOp
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EqnOp -> ParsecT SourcePos Text Identity EqnOp
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EqnOp
EqUnEta
    , Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol Text
"*=")  Parser Text
-> ParsecT SourcePos Text Identity EqnOp
-> ParsecT SourcePos Text Identity EqnOp
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EqnOp -> ParsecT SourcePos Text Identity EqnOp
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EqnOp
EqUnTrans
    ]
  (SourceSpan -> Eqn SourceSpan)
-> Parser (SourceSpan -> Eqn SourceSpan)
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourceSpan -> Eqn SourceSpan)
 -> Parser (SourceSpan -> Eqn SourceSpan))
-> (SourceSpan -> Eqn SourceSpan)
-> Parser (SourceSpan -> Eqn SourceSpan)
forall a b. (a -> b) -> a -> b
$ \SourceSpan
sp -> EqnOp -> Maybe NormCheck -> SourceSpan -> Eqn SourceSpan
forall a. EqnOp -> Maybe NormCheck -> a -> Eqn a
Eqn EqnOp
op Maybe NormCheck
forall a. Maybe a
Nothing SourceSpan
sp

parseRegEqn :: Parser (SourceSpan -> Eqn SourceSpan)
parseRegEqn :: Parser (SourceSpan -> Eqn SourceSpan)
parseRegEqn = do
  ParsecT SourcePos Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT SourcePos Text Identity Char -> Parser ())
-> ParsecT SourcePos Text Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SourcePos Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='
  EqnOp
op <- [ParsecT SourcePos Text Identity EqnOp]
-> ParsecT SourcePos Text Identity EqnOp
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity (Tokens Text)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT SourcePos Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"n*") ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity EqnOp
-> ParsecT SourcePos Text Identity EqnOp
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EqnOp -> ParsecT SourcePos Text Identity EqnOp
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EqnOp
EqNormOrdTrans
    , ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity (Tokens Text)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT SourcePos Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"p*") ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity EqnOp
-> ParsecT SourcePos Text Identity EqnOp
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EqnOp -> ParsecT SourcePos Text Identity EqnOp
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EqnOp
EqAppOrdTrans
    , ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity (Tokens Text)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT SourcePos Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"n") ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity EqnOp
-> ParsecT SourcePos Text Identity EqnOp
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EqnOp -> ParsecT SourcePos Text Identity EqnOp
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EqnOp
EqNormOrd
    , ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity (Tokens Text)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT SourcePos Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"p") ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity EqnOp
-> ParsecT SourcePos Text Identity EqnOp
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EqnOp -> ParsecT SourcePos Text Identity EqnOp
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EqnOp
EqAppOrd
    , ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity (Tokens Text)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT SourcePos Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"a")  ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity EqnOp
-> ParsecT SourcePos Text Identity EqnOp
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EqnOp -> ParsecT SourcePos Text Identity EqnOp
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EqnOp
EqAlpha
    , ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity (Tokens Text)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT SourcePos Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"b")  ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity EqnOp
-> ParsecT SourcePos Text Identity EqnOp
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EqnOp -> ParsecT SourcePos Text Identity EqnOp
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EqnOp
EqBeta
    , ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity (Tokens Text)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT SourcePos Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"e")  ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity EqnOp
-> ParsecT SourcePos Text Identity EqnOp
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EqnOp -> ParsecT SourcePos Text Identity EqnOp
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EqnOp
EqEta
    , ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity (Tokens Text)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT SourcePos Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"d")  ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity EqnOp
-> ParsecT SourcePos Text Identity EqnOp
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EqnOp -> ParsecT SourcePos Text Identity EqnOp
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EqnOp
EqDefn
    , ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity (Tokens Text)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT SourcePos Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"*")  ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity EqnOp
-> ParsecT SourcePos Text Identity EqnOp
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EqnOp -> ParsecT SourcePos Text Identity EqnOp
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EqnOp
EqTrans
    , ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity (Tokens Text)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT SourcePos Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"~")  ParsecT SourcePos Text Identity (Tokens Text)
-> ParsecT SourcePos Text Identity EqnOp
-> ParsecT SourcePos Text Identity EqnOp
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EqnOp -> ParsecT SourcePos Text Identity EqnOp
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return EqnOp
EqNormTrans
    ]
  Maybe NormCheck
mChk <- ParsecT SourcePos Text Identity NormCheck
-> ParsecT SourcePos Text Identity (Maybe NormCheck)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT SourcePos Text Identity NormCheck
parseNormCheck
  Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
symbol Text
">"
  (SourceSpan -> Eqn SourceSpan)
-> Parser (SourceSpan -> Eqn SourceSpan)
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourceSpan -> Eqn SourceSpan)
 -> Parser (SourceSpan -> Eqn SourceSpan))
-> (SourceSpan -> Eqn SourceSpan)
-> Parser (SourceSpan -> Eqn SourceSpan)
forall a b. (a -> b) -> a -> b
$ \SourceSpan
sp -> EqnOp -> Maybe NormCheck -> SourceSpan -> Eqn SourceSpan
forall a. EqnOp -> Maybe NormCheck -> a -> Eqn a
Eqn EqnOp
op Maybe NormCheck
mChk SourceSpan
sp

parseNormCheck :: Parser NormCheck
parseNormCheck :: ParsecT SourcePos Text Identity NormCheck
parseNormCheck = do
  ParsecT SourcePos Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT SourcePos Text Identity Char -> Parser ())
-> ParsecT SourcePos Text Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SourcePos Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
  [ParsecT SourcePos Text Identity NormCheck]
-> ParsecT SourcePos Text Identity NormCheck
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Token Text -> ParsecT SourcePos Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
's' ParsecT SourcePos Text Identity Char
-> ParsecT SourcePos Text Identity NormCheck
-> ParsecT SourcePos Text Identity NormCheck
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NormCheck -> ParsecT SourcePos Text Identity NormCheck
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return NormCheck
Strong
    , Token Text -> ParsecT SourcePos Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'w' ParsecT SourcePos Text Identity Char
-> ParsecT SourcePos Text Identity NormCheck
-> ParsecT SourcePos Text Identity NormCheck
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NormCheck -> ParsecT SourcePos Text Identity NormCheck
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return NormCheck
Weak
    , Token Text -> ParsecT SourcePos Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'h' ParsecT SourcePos Text Identity Char
-> ParsecT SourcePos Text Identity NormCheck
-> ParsecT SourcePos Text Identity NormCheck
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NormCheck -> ParsecT SourcePos Text Identity NormCheck
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return NormCheck
Head
    ]

expr :: Parser SExpr
expr :: Parser SExpr
expr =  Parser SExpr -> Parser SExpr
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser SExpr
lamExpr
    Parser SExpr -> Parser SExpr -> Parser SExpr
forall a.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SExpr -> Parser SExpr
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser SExpr
appExpr
    Parser SExpr -> Parser SExpr -> Parser SExpr
forall a.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SExpr -> Parser SExpr
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser SExpr
idExpr
    Parser SExpr -> Parser SExpr -> Parser SExpr
forall a.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SExpr
parenExpr

parenExpr :: Parser SExpr
parenExpr :: Parser SExpr
parenExpr = Parser SExpr -> Parser SExpr
forall a. Parser a -> Parser a
parens Parser SExpr
expr

idExpr :: Parser SExpr
idExpr :: Parser SExpr
idExpr = (Text -> SourceSpan -> SExpr) -> (Text, SourceSpan) -> SExpr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> SourceSpan -> SExpr
forall a. Text -> a -> Expr a
EVar ((Text, SourceSpan) -> SExpr)
-> Parser (Text, SourceSpan) -> Parser SExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Text, SourceSpan)
identifier

appExpr :: Parser SExpr
appExpr :: Parser SExpr
appExpr  = SExpr -> [SExpr] -> SExpr
apps (SExpr -> [SExpr] -> SExpr)
-> Parser SExpr
-> ParsecT SourcePos Text Identity ([SExpr] -> SExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SExpr
funExpr ParsecT SourcePos Text Identity ([SExpr] -> SExpr)
-> ParsecT SourcePos Text Identity [SExpr] -> Parser SExpr
forall a b.
ParsecT SourcePos Text Identity (a -> b)
-> ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SExpr
-> Parser () -> ParsecT SourcePos Text Identity [SExpr]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 Parser SExpr
funExpr Parser ()
sc
  where
    apps :: SExpr -> [SExpr] -> SExpr
apps = (SExpr -> SExpr -> SExpr) -> SExpr -> [SExpr] -> SExpr
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (\SExpr
e1 SExpr
e2 -> SExpr -> SExpr -> SourceSpan -> SExpr
forall a. Expr a -> Expr a -> a -> Expr a
EApp SExpr
e1 SExpr
e2 (SExpr -> SourceSpan
forall a. Expr a -> a
forall (t :: * -> *) a. Tagged t => t a -> a
tag SExpr
e1 SourceSpan -> SourceSpan -> SourceSpan
forall a. Monoid a => a -> a -> a
`mappend` SExpr -> SourceSpan
forall a. Expr a -> a
forall (t :: * -> *) a. Tagged t => t a -> a
tag SExpr
e2))

funExpr :: Parser SExpr
funExpr :: Parser SExpr
funExpr = Parser SExpr -> Parser SExpr
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser SExpr
idExpr Parser SExpr -> Parser SExpr -> Parser SExpr
forall a.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SExpr
parenExpr

lamExpr :: Parser SExpr
lamExpr :: Parser SExpr
lamExpr = do
  Parser Text
lam
  [SBind]
xs    <- Parser SBind
-> Parser () -> ParsecT SourcePos Text Identity [SBind]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy Parser SBind
binder Parser ()
sc ParsecT SourcePos Text Identity [SBind]
-> Parser Text -> ParsecT SourcePos Text Identity [SBind]
forall a b.
ParsecT SourcePos Text Identity a
-> ParsecT SourcePos Text Identity b
-> ParsecT SourcePos Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text
arrow
  SExpr
e     <- Parser SExpr
expr
  SExpr -> Parser SExpr
forall a. a -> ParsecT SourcePos Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SBind] -> SExpr -> SExpr
forall a. Monoid a => [Bind a] -> Expr a -> Expr a
mkLam [SBind]
xs SExpr
e)