{-# LANGUAGE LambdaCase #-}

-- | Parsec utils for parsing Tokens into Tokens
module L3.Parse.TokenParsec where

import Control.Applicative (Alternative ((<|>)))
import L3.Parse.Lexer
  ( Token (CloseParen, CloseBracket, Number, OpenParen, OpenBracket, Symbol),
  )
import L3.Parse.Parsec
import L3.Parse.Parser

item :: Parser [Token] Token
item :: Parser [Token] Token
item = ([Token] -> [(Token, [Token])]) -> Parser [Token] Token
forall i o. (i -> [(o, i)]) -> Parser i o
Parser (([Token] -> [(Token, [Token])]) -> Parser [Token] Token)
-> ([Token] -> [(Token, [Token])]) -> Parser [Token] Token
forall a b. (a -> b) -> a -> b
$ \case
  [] -> []
  (Token
c : [Token]
cs) -> [(Token
c, [Token]
cs)]

satisfy :: (Token -> Bool) -> Parser [Token] Token
satisfy :: (Token -> Bool) -> Parser [Token] Token
satisfy Token -> Bool
p =
  Parser [Token] Token
item Parser [Token] Token
-> (Token -> Parser [Token] Token) -> Parser [Token] Token
forall i o o'. Parser i o -> (o -> Parser i o') -> Parser i o'
`bind` \Token
c ->
    if Token -> Bool
p Token
c
      then Token -> Parser [Token] Token
forall o i. o -> Parser i o
unit Token
c
      else ([Token] -> [(Token, [Token])]) -> Parser [Token] Token
forall i o. (i -> [(o, i)]) -> Parser i o
Parser ([(Token, [Token])] -> [Token] -> [(Token, [Token])]
forall a b. a -> b -> a
const [])

one :: Token -> Parser [Token] Token
one :: Token -> Parser [Token] Token
one Token
s = (Token -> Bool) -> Parser [Token] Token
satisfy (Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
s)

oneOf :: [Token] -> Parser [Token] Token
oneOf :: [Token] -> Parser [Token] Token
oneOf [Token]
s = (Token -> Bool) -> Parser [Token] Token
satisfy (Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Token]
s)

token :: Parser [Token] a -> Parser [Token] a
token :: Parser [Token] a -> Parser [Token] a
token Parser [Token] a
p = do Parser [Token] a
p

reserved :: Token -> Parser [Token] Token
reserved :: Token -> Parser [Token] Token
reserved Token
s = Parser [Token] Token -> Parser [Token] Token
forall a. Parser [Token] a -> Parser [Token] a
token (Token -> Parser [Token] Token
one Token
s)

number :: Parser [Token] Token
number :: Parser [Token] Token
number = (Token -> Bool) -> Parser [Token] Token
satisfy Token -> Bool
isNumber
  where
    isNumber :: Token -> Bool
isNumber (Number Int
n) = Bool
True
    isNumber Token
_ = Bool
False

symbol :: Parser [Token] Token
symbol :: Parser [Token] Token
symbol = (Token -> Bool) -> Parser [Token] Token
satisfy Token -> Bool
isSymbol
  where
    isSymbol :: Token -> Bool
isSymbol (Symbol String
s) = Bool
True
    isSymbol Token
_ = Bool
False

parens :: Parser [Token] a -> Parser [Token] a
parens :: Parser [Token] a -> Parser [Token] a
parens Parser [Token] a
m = Parser [Token] a -> Parser [Token] a
forall a. Parser [Token] a -> Parser [Token] a
parentheses Parser [Token] a
m Parser [Token] a -> Parser [Token] a -> Parser [Token] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token] a -> Parser [Token] a
forall a. Parser [Token] a -> Parser [Token] a
brackets Parser [Token] a
m

brackets :: Parser [Token] a -> Parser [Token] a
brackets :: Parser [Token] a -> Parser [Token] a
brackets Parser [Token] a
m = do
  Token
_ <- Token -> Parser [Token] Token
reserved Token
OpenBracket
  a
n <- Parser [Token] a
m
  Token
_ <- Token -> Parser [Token] Token
reserved Token
CloseBracket
  a -> Parser [Token] a
forall (m :: * -> *) a. Monad m => a -> m a
return a
n

parentheses :: Parser [Token] a -> Parser [Token] a
parentheses :: Parser [Token] a -> Parser [Token] a
parentheses Parser [Token] a
m = do
  Token
_ <- Token -> Parser [Token] Token
reserved Token
OpenParen
  a
n <- Parser [Token] a
m
  Token
_ <- Token -> Parser [Token] Token
reserved Token
CloseParen
  a -> Parser [Token] a
forall (m :: * -> *) a. Monad m => a -> m a
return a
n