import Control.Applicative 
import Data.Char

data Parser a b = Parser (a->Maybe (b,a))

instance Functor (Parser a) where
  fmap f p = Parser g
    where g inp = case parse p inp of Just (x,y) -> Just (f x,y)
                                      _          -> Nothing

instance Applicative (Parser a) where 
  pure v = Parser (\inp -> Just (v,inp))
  pg <*> px = Parser g
    where g inp = case parse pg inp of Just (f,b) -> parse (fmap f px) b
                                       _          -> Nothing

instance Alternative (Parser a) where
  empty = Parser (\_ -> Nothing)
  p1 <|> p2 = Parser g
    where g inp = case parse p1 inp of Nothing -> parse p2 inp
                                       x       -> x

instance Monad (Parser a) where
  return = pure
  p >>= f = Parser g
    where g inp = case parse p inp of Just (a,b) -> parse (f a) b
                                      _          -> Nothing

parse (Parser f) inp = f inp

satisfy :: (Char -> Bool) -> Parser String Char
satisfy f = Parser g  where g (x:xs) | f x = Just (x,xs)
                            g _            = Nothing

space :: Parser String Char
space = satisfy (==' ')
    
char :: Char -> Parser String Char
char c = satisfy (==c)

notChar :: Char -> Parser String Char
notChar c = satisfy (/=c)

num :: Parser String Int
num = read <$> some (satisfy isDigit) 

word :: String -> Parser String String
word (c:cs) = (:) <$> char c <*> word cs
word _ = pure ""

parseOp op sig = (pure (op) <* many space <*> num <* many space <* char sig <* many space <*> num )
parseOps = (parseOp (+) '+' <|> parseOp (-) '-' <|> parseOp (*) '*' <|> parseOp (div) '/')

parsePar = concat <$> some parseP where parseP = word "()" <|> (char '(' *> parsePar <* char ')')

parseAB = (\a x b -> a:x++"b") <$> char 'a' <*> parseAB <*> char 'b' <|> word "ab"

parseABC = length <$> (many $ char 'a') >>= \la -> 
           length <$> (many $ char 'b') >>= \lb ->
           length <$> (many $ char 'c') >>= \lc ->
           if la==lb&&lb==lc then pure ("ABC ok") else empty

main = do
        print $ parse parseOps "1+1"            -- 2
        print $ parse parseOps " 12 +   22"     -- 34
        print $ parse parseOps "5*5"            -- 25
        print $ parse parseOps " 6 - 1 "        -- 5

        print $ parse parsePar "((())(()()))"       -- ok
        print $ parse parsePar "((())(()(()())()"   -- bad

        print $ parse parseAB "aaaaabbbbb"          -- ok
        print $ parse parseAB "aaaaabbb"            -- bad
        print $ parse parseAB "aaaaabbbbbbbb"       -- bad (trailing b's)

        print $ parse parseABC "aaaabbbbcccc"       -- ok
        print $ parse parseABC "aaaabbbbbcccc"      -- bad