cabal install readline \
--configure-option=--with-readline-libraries="/usr/local/Cellar/readline/6.2.2/lib" \
--configure-option=--with-readline-includes="/usr/local/Cellar/readline/6.2.2/include"

main :: IO ()
main = runInputT defaultSettings loop

import System.Random

randomNumGen :: IO Int
randomNumGen = getStdRandom (randomR (1,20))

main :: IO ()
main = do
  print "Hello! What is your name?"
  myName <- getLine
  print $ "Well, " ++ myName ++ ", I am thinking of a number between 1 and 20."
  print "Take a guess."
  answer <- randomNumGen
  guessNumber 0 answer myName
      where guessNumber gt answer name =
              if gt > 4 
              then do print $ "Nope. The number I was thinking of was " ++ show answer
              else do
                  line <- getLine
                  let guess = read line :: Int
                  case (compare guess answer) of
                    LT -> print "Your guess is too low." >> guessNumber (gt + 1) answer name
                    GT -> print "Your guess is too high." >> guessNumber (gt + 1) answer name
                    EQ -> print $ "Good job, " ++ name ++ "! You guessed my number in " ++ (show gt) ++ " guesses!"

line <- getLine
let guess = read line :: Int

PrimitiveFunc ([LispVal] -> ThrowsError LispVal)
Func {params :: [String], vararg :: (Maybe String), 
      body :: [LispVal], closure :: Env}

(eqv? 2 "2")
#f
(equal? 2 "2")
#t

data Unpacker = forall a. Eq a => AnyUnpacker (LispVal -> ThrowsError a)

unpackEquals :: LispVal -> LispVal -> Unpacker -> ThrowsError Bool
unpackEquals arg1 arg2 (AnyUnpacker unpacker) = 
             do unpacked1 <- unpacker arg1
                unpacked2 <- unpacker arg2
                return $ unpacked1 == unpacked2
        `catchError` (const $ return False)

-- or :: [Bool] -> Bool 
equal :: [LispVal] -> ThrowsError LispVal
equal [arg1, arg2] = do
    primitiveEquals <- liftM or $ mapM (unpackEquals arg1 arg2) 
                      [AnyUnpacker unpackNum, AnyUnpacker unpackStr, AnyUnpacker unpackBool]
    eqvEquals <- eqv [arg1, arg2]
    return $ Bool $ (primitiveEquals || let (Bool x) = eqvEquals in x)
equal badArgList = throwError $ NumArgs 2 badArgList

{-# LANGUAGE ExistentialQuantification #-}

data HeteroEq = forall a. Eq a => HeteroEq (a -> Bool)

heterolist = [HeteroEq (3==), HeteroEq ("test"==), HeteroEq (True==)]

collectUntil :: (s -> Bool) -> State s a -> State s [a]
collectUntil f s = do 
  s0 <- get
  let (a,s') = runState s s0
  put s'
  if (f s') then return [a] else liftM (a:) $ collectUntil f s

collectUntil2 :: MonadState t m => (t -> Bool) -> m a -> m [a]
collectUntil2 f s = do
  s' <- get
  if f s' then return []              
  else do
    x  <- s
    xs <- collectUntil2 f s
    return (x:xs)

collectUntil3 :: MonadState t m => (t -> Bool) -> m a -> m [a]
collectUntil3 f s = get >>= \s' -> 
                    if f s' 
                    then return []              
                    else s >>= \x -> collectUntil3 f s >>= \xs -> return (x:xs)

instance Error e => MonadError e (Either e) where
    throwError             = Left
    Left  l `catchError` h = h l
    Right r `catchError` _ = Right r

type ThrowsError = Either LispError

instance Show LispVal where show = showVal
instance Show LispError where show = showError
instance Error LispError where
     noMsg = Default "An error has occurred"
     strMsg = Default

type ParseMonad = Either ParseError

eval0 :: Env -> Exp -> Value

type Eval1  a = Identity a

type Eval2  a = ErrorT String Identity a

type Eval3 a = ReaderT Env (ErrorT String Identity) a

type Eval4 a = ReaderT Env (ErrorT String (StateT Integer Identity)) a

type Eval5 q = ReaderT Env (ErrorT String
  (WriterT [String ] (StateT Integer Identity))) q

type Eval6 a = ReaderT Env (ErrorT String
  (WriterT [String ] (StateT Integer IO))) a