module Logic.Parse where

import Control.Applicative (Applicative, Alternative(..))
import Data.Functor (Functor)

newtype Parser symbol output = Parser
  { runParser :: Input symbol -> Either ParseError (output, Input symbol)
  }

data Input symbol = Input
  { inputPos :: Int
  , inputSeq :: [symbol]
  } deriving Show

mkInput :: [symbol] -> Input symbol
mkInput = Input 0

data ParseError =
  ParseError Int String
  deriving Show

expected :: Show s => String -> Input s -> ParseError
expected thing input = ParseError (inputPos input) $
  "expected " <> thing <> ", found " <> show (take 20 $ inputSeq input)

eof :: Show symbol => Parser symbol a -> Input symbol -> Either ParseError a
eof p input = do
  (result, rest) <- runParser p input
  case inputSeq rest of
    [] -> Right result
    _ -> Left $ expected "end of input" rest

instance Functor (Parser s) where
  fmap :: (a -> b) -> Parser symbol a -> Parser symbol b
  fmap f (Parser p) = Parser $ \input -> do
    (result, rest) <- p input
    return (f result, rest)

instance Applicative (Parser s) where
  pure :: a -> Parser s a
  pure result = Parser $ \input -> Right (result, input)

  (<*>) :: Parser s (a -> b) -> Parser s a -> Parser s b
  (Parser p1) <*> (Parser p2) =
    Parser $ \input -> do
      (f, rest) <- p1 input
      (result, rest') <- p2 rest
      return (f result, rest')

instance Alternative (Parser s) where
  empty :: Parser s a
  empty = Parser $ const empty

  (<|>) :: Parser s a -> Parser s a -> Parser s a
  (Parser p1) <|> (Parser p2) =
    Parser $ \input -> p1 input <|> p2 input

instance Alternative (Either ParseError) where
  empty :: Either ParseError a
  empty = Left $ ParseError 0 "this parser always fails"

  (<|>) :: Either ParseError a -> Either ParseError a -> Either ParseError a
  (Right x) <|> _ = Right x
  (Left _) <|> e = e

instance Monad (Parser s) where
  (>>=) :: Parser s a -> (a -> Parser s b) -> Parser s b
  p1 >>= next = Parser $ \input ->
    case runParser p1 input of
      Right (result, rest) -> runParser (next result) rest
      Left err -> Left err

parseToken :: (Eq s, Show s) => [s] -> Parser s [s]
parseToken token = Parser parse
  where
    n = length token
    parse input@(Input pos xs)
      | token == take n xs = Right $ (token,) $ Input (pos + n) (drop n xs)
      | otherwise = Left $ expected (show token) input

parseIf :: Show s => String -> (s -> Bool) -> Parser s s
parseIf description check = Parser $ \input ->
  case inputSeq input of
    [] -> Left $ ParseError (inputPos input) "unexpected end of input"
    (char:chars)
      | check char -> Right $ (char,) $ Input (inputPos input + 1) chars
      | otherwise -> Left $ expected description input