{-# LANGUAGE UnicodeSyntax #-}
module ParserMaybe where

import Prelude.Unicode
import Control.Monad.State
import Control.Applicative

data Parser a = Parser {parser ∷ State String (Maybe a)}

runParser ∷ Parser a → String → Maybe a
runParser p = evalState (parser p)

anyChar ∷ Parser Char
anyChar = Parser $ do
	input ← get
	if null input
		then return Nothing
		else do
			put $ tail input
			return $ Just $ head input

char ∷ Char → Parser Char
char c = satisfy (c ≡) anyChar

satisfy ∷ (a → Bool) → Parser a → Parser a
satisfy pred p = do
	tok ← p
	if pred tok then return tok else fail "predicate not met"

string ∷ String → Parser ()
string str = mapM char str >> return ()

(<|>) ∷ Parser a → Parser a → Parser a
p <|> q = Parser $ do
	input ← get
	tok ← parser p
	maybe (put input >> parser q) (return . Just) tok

instance Monad Parser where
	return = Parser . return . return
	p >>= q = Parser $ parser p >>= maybe (return Nothing) (parser . q)
	fail msg = Parser $ return Nothing

instance Functor Parser where
	fmap = liftM

instance Applicative Parser where
	pure = return
	p <*> q = do
		f ← p
		x ← q
		return $ f x

instance Alternative Parser where
	empty = fail "empty"
	p <|> q = error "fill in definition above"