animal.hs

data Entry  = Qu String | Ans String          deriving Eq
data Tree a = Leaf | Node (Tree a) a (Tree a) deriving Eq

data YesNo = Yes | No

insert :: Eq a => Tree a -> Tree a -> Tree a -> Tree a
insert o n    e | o == e  = n
insert _ _ Leaf           = Leaf
insert o n (Node t1 m t2) = Node (f t1) m (f t2)
  where f = insert o n

animal :: IO ()
animal = do
  putStrLn "Animal guessing game..."
  newGame dbInit

newGame :: Tree Entry -> IO ()
newGame db = do
  putStrLn "\nThink of an animal and I'll guess it."
  play db db

playAgain :: Tree Entry -> IO ()
playAgain db = do
    putStr "\nPlay again ? (y/n): "
    ans <- getChar
    putStrLn ""
    if ans == 'y' then newGame db else putStrLn "Goodbye.\n"

-- database of animal info
dbInit :: Tree Entry
dbInit = Node Leaf (Ans "a whale") Leaf

handleResults :: Tree Entry -> Bool -> Tree Entry -> IO ()
handleResults db correct pos = do
    if correct
      then putStrLn "\n\nHey! I got it right !"
      else putStrLn "\n\nOops! You beat me   !"
    if not correct then add db pos else playAgain db

-- play game until a final guess is made
play :: Tree Entry -> Tree Entry -> IO ()
play db pos@(Node _ (Ans s) _) = do
    putStrLn "\nI think I know the answer!"
    putStr ("Is it " ++ s ++ "? (y/n): ")
    ans  <- getChar
    handleResults db (ans == 'y') pos
play db pos@(Node y (Qu  s) n) = do
    putStr ("\n" ++ s ++ " (y/n):")
    ans  <- getChar
    let pos' = if ans == 'y' then y else n
    play db pos'

add :: Tree Entry -> Tree Entry -> IO ()
add db pos@(Node _ (Ans a) _) = do
  putStr "\nPlease add your animal to my database.\nYour animal was a/an: "
  s <- getLine
  let a1 = a
  let a2 = addArticle s
  putStrLn ("Enter a question that distinguishes " ++ a1 ++ " and " ++ a2 ++ ":")
  s' <- getLine
  let qu = addQu s'
  putStrLn ("\nIf you're thinking of " ++ a2 ++ ", and I ask: \'" ++ qu ++ "\'")
  putStr "What would you answer ? (y/n): "
  ans  <- getChar
  if ans == 'y' then updateDb db pos qu a2 a1
                else updateDb db pos qu a1 a2

updateDb :: Tree Entry -> Tree Entry -> String -> String -> String -> IO ()
updateDb db pos qu a1 a2 =
  let
    yNode = Node Leaf (Ans a1) Leaf
    nNode = Node Leaf (Ans a2) Leaf
    qNode = Node yNode (Qu qu) nNode
    newDb = insert pos qNode db
  in
    playAgain newDb

addArticle :: String -> String
addArticle s = (if head s `elem` "aeiou" then "an " else "a ") ++ s

addQu :: String -> String
addQu s = if '?' `notElem` s then s ++ " ?" else s

sample usage:

*Main> animal
Animal guessing game...

Think of an animal and I'll guess it.

I think I know the answer!
Is it a whale? (y/n): n

Oops! You beat me   !

Please add your animal to my database.
Your animal was a/an: shark
Enter a question that distinguishes a whale and a shark:
Is it a mammal ?

If you're thinking of a shark, and I ask: 'Is it a mammal ?'
What would you answer ? (y/n): n
Play again ? (y/n): y

Think of an animal and I'll guess it.

Is it a mammal ? (y/n):y
I think I know the answer!
Is it a whale? (y/n): y

Hey! I got it right !

Play again ? (y/n): n
Goodbye.