{-# LANGUAGE LambdaCase #-}

module CombParse (runParser, parseExpr, parseAtom, parseVal, Value (..), Expr (..), toComblang) where

import Text.ParserCombinators.ReadP (ReadP, between, char, choice, eof, many1, munch, munch1, optional, readP_to_S, satisfy, skipSpaces, (+++), (<++))
import Unicode.Char (isDigit)
import Unicode.Char.Identifiers (isXIDContinue, isXIDStart)

data Value = Str String | Id String | Numb Int deriving (Show, Eq)

data Expr = Var Value | Comb Expr Expr | Param Int | Op String Expr deriving (Show, Eq)

toComblang :: Expr -> String
toComblang (Comb e1 e2) = "(" ++ toComblang e1 ++ " " ++ toComblang e2 ++ ")"
toComblang (Var (Id str)) = str
toComblang (Var (Str str)) = '"' : str ++ "\""
toComblang (Var (Numb n)) = show n
toComblang _ = error "passed a compile time parameter to a parse time function"

token :: ReadP a -> ReadP a
token = (skipSpaces +++ (optional (char '\r') <* char '\n') *>)

parseVal :: ReadP Value
parseVal =
  choice
    [ Str <$> between (char '"') (char '"') (munch (/= '"')),
      Numb . read <$> munch1 isDigit,
      Id <$> ((:) <$> satisfy isXIDStart <*> munch isXIDContinue)
    ]

parseAtom :: ReadP Expr
parseAtom = token $ (Var <$> parseVal) <++ between (token $ char '(') (char ')') parseExpr

parseExpr :: ReadP Expr
parseExpr = foldl1 Comb <$> many1 parseAtom

runParser :: ReadP a -> String -> Maybe a
runParser =
  ( \case
      [] -> Nothing
      x -> Just $ fst $ last x
  )
    .: readP_to_S
    . (<* token eof)
    . token

infixr 9 .:

(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(.:) = (.) . (.)