module Hint.Parser where

import           Control.Applicative (Alternative (..), many)
import           Data.Either         (fromRight)
import           Hint.Lexer          (Input, Token (..), TokenKind (..),
                                      runProd)

data ParseError
  = UnexpectedToken [TokenKind]
  | NoParse
  deriving (Show, Eq)

data Value
  = VInt Int
  | VString String
  | VList Value
  deriving (Show, Eq)

data Expr
  = EVar String
  | EValue Value
  | EBinding String Expr
  | EFunc String [String] Expr
  deriving (Show, Eq)

newtype Parser a = Parser
  { unParser :: [Token] -> Either ParseError (a, [Token]) }

instance Functor Parser where
  fmap f (Parser p) = Parser $ \ts -> do
    (a, rest) <- p ts
    pure (f a, rest)

instance Applicative Parser where
  pure a = Parser $ \ts -> Right (a, ts)

  (<*>) (Parser pf) (Parser px) = Parser $ \ts -> do
    (f, ts') <- pf ts
    (x, ts'') <- px ts'
    pure (f x, ts'')

instance Monad Parser where
  return = pure

  (>>=) (Parser p) f = Parser $ \ts -> do
    (x, ts') <- p ts
    unParser (f x) ts'

instance Alternative Parser where
  empty = Parser $ const $ Left NoParse
  (<|>) (Parser p) (Parser q) = Parser $ \ts ->
    case p ts of
      Right a -> Right a
      Left _  -> q ts

runParser :: Parser a -> Input -> Either ParseError (a, [Token])
runParser p = unParser p . fromRight [] . runProd

parseWord :: String -> Parser Token
parseWord name = Parser parse
  where
    parse [] = Left NoParse
    parse (t@(Token (TIdent n) _) : ts)
      | name == n = Right (t, ts)
    parse _  = Left NoParse

parseValue :: Parser Expr
parseValue = EValue <$> Parser parse
  where
    parse ((Token (TInt n) _) : ts)    = pure (VInt n, ts)
    parse ((Token (TString s) _) : ts) = pure (VString s, ts)
    parse _                            = Left $ UnexpectedToken []

parseBinding :: Parser Expr
parseBinding = EBinding
  <$> phrase
  <*> expr <* sat (== KeywordIn)
  where
    phrase = sat (== KeywordLet) *> ident <* sat (== TEquals)
    ident = Parser $ \((Token (TIdent name) _) : ts) -> pure (name, ts)

parseFunc :: Parser Expr
parseFunc = EFunc
  <$> ident
  <*> many ident <* sat (== TEquals)
  <*> parseValue
  where
    parse ((Token (TIdent name) _) : ts) = pure (name, ts)
    parse _                              = Left NoParse
    ident = Parser parse

expr :: Parser Expr
expr = parseValue <|> parseBinding

sat :: (TokenKind -> Bool) -> Parser Token
sat p = Parser parse
  where
    parse [] = Left $ UnexpectedToken [TEof]
    parse (t@(Token kind _) : ts)
      | p kind = Right (t, ts)
      | otherwise = Left $ UnexpectedToken [kind]

-- parseBind :: Parser Expr
-- parseBind = EBinding <$> name <*> result
--   where
--     name = Parser $ \(t : ts) ->
--       case t of
--         (Token (TIdent s) _) -> pure (s, ts)
--         _                    -> Left $ UnexpectedToken $ [TIdent ""]

--     result = Parser $ \(t : ts) ->
--       case t of
--         (Token (TInt n) _) -> pure (ELit n, ts)
--         _                  -> Left $ UnexpectedToken $ [TIdent ""]