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 = Parsec Text () (LambdaExpr Text)
-> SourceName -> Text -> Either ParseError (LambdaExpr Text)
forall s t a.
Stream s Identity t =>
Parsec s () a -> SourceName -> s -> Either ParseError a
parse (Parser ()
whitespace Parser ()
-> Parsec Text () (LambdaExpr Text)
-> Parsec Text () (LambdaExpr Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Text () (LambdaExpr Text)
expr Parsec Text () (LambdaExpr Text)
-> Parser () -> Parsec Text () (LambdaExpr Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) SourceName
""

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

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

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

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

app :: Parser (LambdaExpr Text)
app :: Parsec Text () (LambdaExpr Text)
app = Parsec Text () (LambdaExpr Text)
-> ParsecT
     Text
     ()
     Identity
     (LambdaExpr Text -> LambdaExpr Text -> LambdaExpr Text)
-> Parsec Text () (LambdaExpr Text)
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 Parsec Text () (LambdaExpr Text)
term ((LambdaExpr Text -> LambdaExpr Text -> LambdaExpr Text)
-> ParsecT
     Text
     ()
     Identity
     (LambdaExpr Text -> LambdaExpr Text -> LambdaExpr Text)
forall (m :: * -> *) a. Monad m => a -> m a
return LambdaExpr Text -> LambdaExpr Text -> LambdaExpr Text
forall name. LambdaExpr name -> LambdaExpr name -> LambdaExpr name
App)

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

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

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

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

identifier :: Parser Text
identifier :: ParsecT Text () Identity Text
identifier = ParsecT Text () Identity Text -> ParsecT Text () Identity Text
forall a. Parser a -> Parser a
lexeme (ParsecT Text () Identity Text -> ParsecT Text () Identity Text)
-> ParsecT Text () Identity Text -> ParsecT Text () Identity Text
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
Text.cons (Char -> Text -> Text)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
forall u. ParsecT Text u Identity Char
first' ParsecT Text () Identity (Text -> Text)
-> ParsecT Text () Identity Text -> ParsecT Text () Identity Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SourceName -> Text
Text.pack (SourceName -> Text)
-> ParsecT Text () Identity SourceName
-> ParsecT Text () Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
-> ParsecT Text () Identity SourceName
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' = ParsecT Text u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter 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
<|> Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'
        rest :: ParsecT Text () Identity Char
rest  = ParsecT Text () Identity Char
forall u. ParsecT Text u Identity Char
first' 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
digit

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

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