import Data.Char
import Control.Applicative

import Data.IORef

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

instance Functor Parser where
  fmap f p = Parser $ \s ->
    case parse p s of
      Nothing -> Nothing
      Just (v,s') -> Just (f v,s')

instance Applicative Parser where
  pure a = Parser $ \s -> Just (a,s)
  f <*> a = Parser $ \s ->
    case parse f s of
      Nothing -> Nothing
      Just (g,s') -> parse (fmap g a) s'

eof :: Parser ()
eof = Parser $ \s -> if null s then Just ((),"") else Nothing

ensure :: (a -> Bool) -> Parser a -> Parser a
ensure pred p = Parser $ \s ->
  case parse p s of
    Nothing -> Nothing
    Just (a,s') -> if pred a then Just (a,s') else Nothing

satisfy :: (Char -> Bool) -> Parser Char
satisfy p = Parser f
  where f [] = Nothing
        f (x:xs) = if p x then Just (x,xs) else Nothing

lookahead :: Parser (Maybe Char)
lookahead = Parser f
  where f [] = Just (Nothing,[])
        f (c:s) = Just (Just c,c:s)

instance Alternative Parser where
  empty = Parser $ \s -> Nothing
  p1 <|> p2 = Parser $ \s ->
    case parse p1 s of
      Just (a,s') -> Just (a,s')
      Nothing -> parse p2 s

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

spaces :: Parser ()
spaces = many (satisfy isSpace) *> pure ()

char :: Char -> Parser Char
char c = spaces *> satisfy (==c)

plus, minus, times :: Parser Char
plus = char '+'
minus = char '-'
times = char '*'

num :: Parser Int
num = spaces *> int

data Arith =
    Num Int
  | Plus Arith Arith
  | Times Arith Arith
  | Neg Arith
  deriving Show

sub :: Arith -> Arith -> Arith
sub a b = Plus a (Neg b)

addop,mulop :: Parser (Arith -> Arith -> Arith)
addop =     plus *> pure Plus
        <|> minus *> pure sub
mulop = times *> pure Times

term, factor, neg, atom :: Parser Arith
term   = factor `chainl1` addop
factor = neg `chainl1` mulop
neg    =     Neg <$> (minus *> atom)
         <|> atom
atom   =     Num <$> num
         <|> (char '(' *> (term <* char ')'))
         
chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
chainl1 p sep = foldl (\acc (oper,v) -> oper acc v) 
                <$> p <*> many ((\op v -> (op,v)) <$> sep <*> p)
                
sepBy1 :: Parser a -> Parser b -> Parser [a]
sepBy1 p sep = (:) <$> p <*> many (sep *> p)

sequenceA' :: Applicative f => [f a] -> f [a]
sequenceA' [] = pure []
sequenceA' (p:ps) = (:) <$> p <*> sequenceA' ps

sequenceA'' :: Applicative f => [f a] -> f [a]
sequenceA'' = foldr (liftA2 (:)) (pure [])

instance Monad Parser where
  p >>= k = Parser $ \s ->
    case parse p s of
      Nothing -> Nothing
      Just (v,s') -> parse (k v) s'
      


ott = [1..5]  >>= (\n1 ->
      [1..n1] >>= (\n2 ->
      return (n1 + n2)))
      
      
refs = newIORef True >>= \ref -> 
       writeIORef ref False >> 
       readIORef ref

main = putStr "What's your name? " >> hFlush stdout >> getLine >>= \s -> putStrLn ("Hello, " ++ s ++ "!")