animal.hs

animal :: IO ()
animal = do
  putStrLn "Animal guessing game..."
  newGame dbInit
---------------------------------------------------------------------------
newGame :: [(String, Int)] -> IO ()
newGame db = do
  putStrLn "\nThink of an animal and I'll guess it."
  play db 0
---------------------------------------------------------------------------
playAgain :: [(String, Int)] -> 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 :: [(String, Int)]
dbInit = [ ("Is it a bird ?",1)
         , ("a penguin",0)
         , ("Is it a fish ?",3)
         , ("a shark",0)
         , ("Does it have a trunk ?",5)
         , ("an elephant",0)
         , ("Is it an insect ?",7),
           ("an ant",0),("a cobra",0) ]
---------------------------------------------------------------------------
handleResults :: [(String, Int)] -> Bool -> Int -> 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 :: [(String, Int)] -> Int -> IO ()
play db pos =
  if snd (db !! pos) == 0                             -- we're ready to guess
    then do
      putStrLn "\nI think I know the answer!"
      putStr ("Is it " ++ fst (db !! pos) ++ "? (y/n): ")
      ans  <- getChar
      handleResults db (ans == 'y') pos
    else do
      putStr ("\n" ++ fst (db !! pos) ++ " (y/n): ")   -- we have more questions
      ans  <- getChar
      let pos' = snd (db !! pos) + if ans == 'y' then 0 else 1
      play db pos'
---------------------------------------------------------------------------
-- add new question/animal to db and return updated db
add :: [(String, Int)] -> Int -> IO ()
add db pos = do
  putStr "\nPlease add your animal to my database.\nYour animal was a/an: "
  s <- getLine
  let a1 = fst (db !! pos)
  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 :: [(String, Int)] -> Int -> String -> String -> String -> IO ()
updateDb db pos qu animal1 animal2 =
  let
    prefix    = take pos db
    suffix    = drop (pos + 1) db
    question  = (qu, length db)
    guess_yes = (animal1, 0)
    guess_no  = (animal2, 0)
    newDb     = prefix ++ [question] ++ suffix ++ [guess_yes] ++ [guess_no]
  in
    playAgain newDb
---------------------------------------------------------------------------
addArticle :: String -> String
addArticle s = (if head s `elem` "aeiou" then "an " else "a ") ++ s
---------------------------------------------------------------------------
addQu :: String -> String
addQu s = if not ('?' `elem` s) then s ++ " ?" else s

typical output:

Animal guessing game...

Think of an animal and I'll guess it.

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

Oops! You beat me   !

Please add your animal to my database.
Your animal was a/an: swan

Enter a question that distinguishes a penguin and a swan:
Can it fly ?

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

Think of an animal and I'll guess it.

Is it a bird ? (y/n): y
Can it fly ? (y/n): y
I think I know the answer!
Is it a swan? (y/n): y

Hey! I got it right !

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

(this comment is literate haskell, you can copy it as is into file.lhs and run; well, if github does not mess with formatting..)

Interesting program, but i want to say a few things.

1. Almost all functions, you've defined, are in IO. And, moreover, they
   return IO (). Thus, it's hard to test and debug. Say, i want to see how
   you add a new entry to db, but i can't, because add returns nothing
   (useful). And pure function is easier to test programmatically, then one
   with side-effects (in monad).
2. Your functions call each other: play -> handleResults -> add ->
   updateDb -> playAgain.. I can't do one action at a time in e.g.
   ghci, and, thus, again i can't debug one function.
3. The numbers and shifts in a linear list are extremely hard to read. Well,
   at least for me. May be because i didn't do that a long time.
4. Your last entry with two answers does not seem to work. I tried to
   understand why, but, it seems, there are several places, where support is
   missing and i've failed to figure out the quick fix.
5. The list representing your db is linear, though the db structure is
   certainly not: you have a question and an answer (or may be even two) - two
   properties, which constitute a single item. But these items and distinction
   between question and answer can't be derived from your structure type:
   [(String, Int)]. It's buried down somewhere in values.
6. The branching (additional questions) is broken: answering 'no' for
   additional question leads to strange results. I guess, you can't make a
   proper branching without proper data types.
7. You comment lines '----' make it impossible to use vim's { and }
   navigation. I don't want to argue about editors here, but, really, don't do
   this :)

If i understand correctly, you want the second answer to be used, when user
says "no" for the first. So, first, let's change the db type:

  import Data.List
  import Control.Monad (unless)

  type Db   = [(String, [String])]

  dbInit :: Db
  dbInit    = [ ("Is it a bird ?",          ["a penguin"])
              , ("Is it a fish ?",          ["a shark"])
              , ("Does it have a trunk ?",  ["an elephant"])
              , ("Is it an insect ?",       ["an ant", "a cobra"])
              ]

I've used type synonym (just another name for the type). The type is still not
perfect, but much better, because now i may try to guess where is the question
and where are the answers. I've used list for storing answers, so i may have
many answers.. well, that because i don't want to decide, which answer to
replace in add - it's simpler to collect them all. Then let's make an
updateDb pure (it really does not need any IO - it just updates db, as it
name says):

  updateDb :: String -> String -> Db -> Db
  updateDb qu animal db = maybe new update (find ((== qu) . fst) db)
    where
      new :: Db
      new               = (qu, [animal]) : db
      update :: (String, [String]) -> Db
      update (z, xs)    = (z, animal : xs) : filter ((/= z) . fst) db

I've removed pos, because i don't think, that it's possible to implement
branching properly without proper types (i looked over week 3 titles, and, it
seems, that the data types should be introduced there..). So, here
updateDb either replaces existing element or inserts new, if there is no
such element yet.

Now, since i often ask user 'yes' or 'no', let's write a separate function for
that:

  askUser :: String -> IO Bool
  askUser ps    = do
                    unless (null ps) (putStr (ps ++ " (y/n) "))
                    ans  <- getChar
                    putStrLn ""
                    return (ans == 'y')

It displays a prompt, asks the answer and returns a Bool. Then comes the
add:

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

  addQu :: String -> String
  addQu s = if not ('?' `elem` s) then s ++ " ?" else s

  add :: Maybe String -> Db -> IO Db
  add mqu db = do
    putStr "\nPlease add your animal to my database.\n"
    qu     <- maybe getQu replaceQu mqu
    animal <- getAnimal
    return (updateDb qu animal db)
   where
    getQu :: IO String
    getQu       = do
                    putStrLn ("Enter new question: ")
                    s <- getLine
                    return (addQu s)
    getAnimal :: IO String
    getAnimal   = do
                    putStrLn "Your animal was a/an: "
                    animal <- getLine
                    return (addArticle animal)
    replaceQu :: String -> IO String
    replaceQu qu = do
                    b <- askUser ("Add the answer to an existing question: \"" ++ qu ++ "\"")
                    if b then return qu else getQu

I take an old db, maybe a question to update and return a new db. This add
covers two cases (similar to updateDb): when user answers to all questions
'no' and he may just want to add a new question, and when user answers to some
question 'yes', but i haven't guessed an animal (and user may want to add his
answer).

Now, it's time for play. Note, that now i have two lists: list of answers
and list of questions (with answers), which i want to traverse. But i want to
traverse them differently: list of answers i want to traverse until i'll find
the right one or reach the end of the list. so function with type

findM :: (a -> IO Bool) -> [a] -> IO (Maybe a)

may generalize answers traversal: i have a predicate of type (a -> IO Bool),
which gets an element from list, does something, and tells findM to continue
to next element or not.

But the list of questions i want to traverse.. well, also until i'll find the
right question, but then the right question may not have the right answers. I
still want to stop a list traversal at that point, but i need to know what was
with answers. Thus, i need an additional information to be passed from
predicate, which checks list element (the question here), - whether answer was
correct or not. So the type of function becomes

findM :: b -> (a -> IO (Bool, b)) -> [a] -> IO (Maybe a, b)

Look, it first takes the default answer state (first argument of type b): it
will be no answer. Then it tries each question in turn, until user will
confirm the question. Then i want to stop list traversal (return True as first
element of tuple) and i want to know whether i guessed or not (that will be
the second tuple element). Let's try to write it!

  findM :: b -> (a -> IO (Bool, b)) -> [a] -> IO (Maybe a, b)
  findM z _ []         = return (Nothing, z)
  findM z p (x : xs)   = do
                            (b, y) <- p x
                            if b then return (Just x, y) else findM z p xs

Then, let's write the predicate for guessing answers:

  guess :: String -> IO (Bool, ())
  guess x               = do
    b <- askUser ("Is it " ++ x ++ "?")
    return (b, ())

and the predicate for asking questions:

  playQuestion :: (String, [String]) -> IO (Bool, Bool)
  playQuestion (qu, xs) = do
    b <- askUser qu
    if b
      then do
        (mb, _) <- findM () guess xs
        return (True, maybe False (const True) mb)
      else return (False, False)

So, i've used two bools: first Bool is used by findM to determine whether to
continue list traversal, second Bool is telling outer function, whether i
guess the answer or not. Then, finally, this outer function:

  play :: Db -> IO Db
  play xs         = do
    r <- findM False playQuestion xs
    case r of
      (Nothing, _)    -> add Nothing xs
      (Just _, True)  -> do
        putStrLn "\n\nHey! I got it right !"
        return xs
      (Just x, False) -> do
        putStrLn "\n\nOops! You beat me   !"
        add (Just (fst x)) xs

  playAgain :: Db -> IO ()
  playAgain xs      = do
    xs' <- play xs
    b <- askUser "Play again?"
    if b then playAgain xs' else return ()

Now, let's see what we have:

1. The type distinguishes between question, answers and different items
   (question + answers).
2. I can run every function in ghci with some input and see how it works.
3. No recursive calls between functions until the very end. So, again, it's
   easy to try and test every element alone.
4. No numeric shifts! Well, that's may be not a big deal for you, but for me
   it's a great improvement :)

There're still many-many ways to further rewrite this code, make it more
concise or more complex or more interesting or just nicer. I think.