module Language.Lambda.Untyped.Parser
  ( parseExpr,
    module Text.Parsec
  ) where

import Control.Monad
import RIO hiding ((<|>), abs, curry, many, try)
import qualified RIO.Text as Text

import Text.Parsec
import Text.Parsec.Text

import Language.Lambda.Untyped.Expression

parseExpr :: Text -> Either ParseError (LambdaExpr Text)
parseExpr :: Text -> Either ParseError (LambdaExpr Text)
parseExpr = forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse (Parser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity (LambdaExpr Text)
expr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) [Char]
""

expr :: Parser (LambdaExpr Text)
expr :: ParsecT Text () Identity (LambdaExpr Text)
expr = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Text () Identity (LambdaExpr Text)
app forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity (LambdaExpr Text)
term

term :: Parser (LambdaExpr Text)
term :: ParsecT Text () Identity (LambdaExpr Text)
term = ParsecT Text () Identity (LambdaExpr Text)
let' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity (LambdaExpr Text)
abs forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity (LambdaExpr Text)
var forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity (LambdaExpr Text)
parens

var :: Parser (LambdaExpr Text)
var :: ParsecT Text () Identity (LambdaExpr Text)
var = forall name. name -> LambdaExpr name
Var forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
identifier

abs :: Parser (LambdaExpr Text)
abs :: ParsecT Text () Identity (LambdaExpr Text)
abs = forall {a}. [a] -> LambdaExpr a -> LambdaExpr a
curry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity [Text]
idents forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity (LambdaExpr Text)
expr
  where idents :: ParsecT Text () Identity [Text]
idents = Char -> Parser ()
symbol Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 Parser Text
identifier forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ()
symbol Char
'.'
        curry :: [a] -> LambdaExpr a -> LambdaExpr a
curry = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall name. name -> LambdaExpr name -> LambdaExpr name
Abs)

app :: Parser (LambdaExpr Text)
app :: ParsecT Text () Identity (LambdaExpr Text)
app = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainl1 ParsecT Text () Identity (LambdaExpr Text)
term (forall (m :: * -> *) a. Monad m => a -> m a
return forall name. LambdaExpr name -> LambdaExpr name -> LambdaExpr name
App)

let' :: Parser (LambdaExpr Text)
let' :: ParsecT Text () Identity (LambdaExpr Text)
let' = forall name. name -> LambdaExpr name -> LambdaExpr name
Let forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
ident forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity (LambdaExpr Text)
expr
  where ident :: Parser Text
ident = Text -> Parser ()
keyword Text
"let" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
identifier forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ()
symbol Char
'='

parens :: Parser (LambdaExpr Text)
parens :: ParsecT Text () Identity (LambdaExpr Text)
parens = Char -> Parser ()
symbol Char
'(' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity (LambdaExpr Text)
expr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ()
symbol Char
')'

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

whitespace :: Parser ()
whitespace :: Parser ()
whitespace = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf forall a b. (a -> b) -> a -> b
$ [Char]
" \t"

identifier :: Parser Text
identifier :: Parser Text
identifier = forall a. Parser a -> Parser a
lexeme forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
Text.cons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {u}. ParsecT Text u Identity Char
first' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Char] -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text () Identity Char
rest)
  where first' :: ParsecT Text u Identity Char
first' = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'
        rest :: ParsecT Text () Identity Char
rest  = forall {u}. ParsecT Text u Identity Char
first' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

symbol :: Char -> Parser ()
symbol :: Char -> Parser ()
symbol = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Parser a
lexeme forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char

keyword :: Text -> Parser ()
keyword :: Text -> Parser ()
keyword = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Parser a
lexeme forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack