module Parser where

import Data.Char
import Control.Arrow
import Control.Applicative
import Control.Monad

newtype Parser a = Parser { parse :: String -> [(a,String)] }

instance Functor Parser where
  fmap f (Parser a) = Parser $ \s -> first f <$> a s

instance Applicative Parser where
  pure x = Parser $ \s -> pure (x,s)
  (Parser pab) <*> (Parser pa) = Parser $ \s -> do
    (ab, s1) <- pab s
    (a, s2) <- pa s1
    pure (ab a, s2)

instance Monad Parser where
  return = pure
  (Parser a) >>= f = Parser $ \s -> (\(x,s1) -> parse (f x) s1) =<< a s

instance Alternative Parser where
  empty = Parser $ \s -> []
  (Parser p) <|> (Parser q) = Parser $ \s -> p s <|> q s

token :: Parser Char
token = Parser $ \s -> case s of
  (x:xs) -> [(x,xs)]
  _ -> []

satisfy :: (Char -> Bool) -> Parser Char
satisfy p = do
  x <- token
  guard (p x)
  pure x