{-# LANGUAGE LambdaCase #-}

import Data.Char

---------------- Parser declerations ---------------------------


newtype Parser a = P (String -> [(a,String)])

apply :: Parser a -> String -> [(a,String)]
apply (P p) = p

instance Functor Parser where
  -- fmap :: (a -> b) -> Parser a -> Parser b
  fmap g p = P (\s -> case apply p s of
                        []        -> []
                        [(v,out)] -> [(g v, out)])


instance Applicative Parser where
  -- pure :: a -> Parser a
  pure v = P (\inp -> [(v,inp)])

  -- <*> :: Parser (a -> b) -> Parser a -> Parser b
  pg <*> px = P (\inp -> case apply pg inp of
                           []        -> []
                           [(g,out)] -> apply (fmap g px) out)

instance Monad Parser where
  -- (>>=) :: Parser a -> (a -> Parser b) -> Parser b
  p >>= f = P (\s -> case apply p s of
                       [] -> []
                       [(g, left)] -> apply (f g) left)

(<|>) :: Parser a -> Parser a -> Parser a
p <|> q = P (\s -> let ps = apply p s in
                     if null ps
                       then apply q s
                       else ps)

item :: Parser Char
item = P (\case
            []     -> []
            (x:xs) -> [(x,xs)])


none :: Parser [a]
none = return []

sat :: (Char -> Bool) -> Parser Char
sat p = do x <- item
           if p x then return x else parse_fail

parse_fail :: Parser a
parse_fail = P (const [])

some :: Parser a -> Parser [a]
-- some p = do x <- p
            -- xs <- some p
            -- return (x:xs)

some p = p >>= (\x -> some p >>= (\xs -> return (x : xs)))

optional :: Parser [a] -> Parser [a]
optional = (<|> none)

many :: Parser a -> Parser [a]
many = optional . some

----------------- Calculator -----------------------------------

newtype Expr = Compose [Atom] deriving Eq
data Atom = Var VarName | Con ConName [Expr]
  deriving Eq

type VarName = String
type ConName = String