module Minilang.Lambda.Parser where

import Control.Applicative (Alternative (many), (<|>))
import Data.Bifunctor (first)
import Data.Text (Text, pack)
import Data.Void (Void)
import Text.Megaparsec (Parsec, between, empty, errorBundlePretty, manyTill, notFollowedBy, optional, parse, try)
import Text.Megaparsec.Char (alphaNumChar, char, letterChar, space1, string, symbolChar)
import qualified Text.Megaparsec.Char.Lexer as L

type Parser = Parsec Void Text

data ParseError = ParseError Text
  deriving (Eq, Show)

data AST = Sym Text | Abs [Text] AST
  deriving (Eq, Show)

parse :: Text -> Either ParseError AST
parse =
  first (ParseError . pack . errorBundlePretty) . Text.Megaparsec.parse ast ""

ast :: Parser AST
ast = try lambda <|> try sym

lambda :: Parser AST
lambda =
  between
    lpar
    rpar
    ( lexeme "lam"
        *> ( (Abs . fmap pack <$> between lpar rpar (many identifier))
               <*> ast
           )
    )

lpar :: Parser Text
lpar = symbol "("

rpar :: Parser Text
rpar = symbol ")"

symbol :: Text -> Parser Text
symbol = L.symbol spaceConsumer

sym :: Parser AST
sym = Sym . pack <$> identifier

identifier :: Parser String
identifier =
  lexeme $
    (:)
      <$> (letterChar <|> extraChars)
      <*> many (alphaNumChar <|> extraChars)

lexeme :: Parser a -> Parser a
lexeme = L.lexeme spaceConsumer

extraChars :: Parser Char
extraChars =
  foldl (\b a -> char a <|> b) symbolChar extraIdentifierChars

initialChars :: [Char]
initialChars =
  ['a' .. 'z'] <> ['A' .. 'Z'] <> extraIdentifierChars

restChars :: [Char]
restChars =
  initialChars <> ['0' .. '9']

extraIdentifierChars :: String
extraIdentifierChars = ['-', '_', '*', '#', '%', '&', ':', '@', '/']

spaceConsumer :: Parser ()
spaceConsumer =
  L.space space1 (L.skipLineComment ";") empty