Pangolins in Haskell

pangolins.hs

module Lib
    ( playRepeatedly,
      firstStep
    ) where

import System.IO

data GameStep = Guess { animalName :: String }
  | Question {
    question :: String,
    stepIfYes :: GameStep,
    stepIfNo :: GameStep
  } deriving (Show)

askQuestion :: String -> IO String
askQuestion question = do
  putStrLn $ question ++ "?"
  getLine

askBoolean :: String -> IO Bool
askBoolean question = do
  answer <- askQuestion question
  return (answer == "y")

isItA :: String -> IO Bool
isItA animal = askBoolean $ "Is it a " ++ animal

computerLoses :: String -> IO GameStep
computerLoses animalIfNo = do
  animalIfYes <- askQuestion "What is it then"
  newQuestion <- askQuestion $ "What question would have a 'y' answer for this animal, and an 'n' answer for a " ++ animalIfNo
  return Question {
    question = newQuestion,
    stepIfYes = Guess { animalName = animalIfYes },
    stepIfNo = Guess { animalName = animalIfNo }
  }

play :: GameStep -> IO GameStep
play step@Guess{ animalName = guess } = do
  computerWins <- isItA guess
  if computerWins then do
    putStrLn "I win!"
    return step
    else computerLoses guess
play step@Question { question = q, stepIfYes = ifYes, stepIfNo = ifNo } = do
  answer <- askBoolean q
  if answer then (do
    newStep <- play ifYes
    return Question { question = q, stepIfYes = newStep, stepIfNo = ifNo })
  else (do
    newStep <- play ifNo
    return Question { question = q, stepIfYes = ifYes, stepIfNo = newStep })

playRepeatedly :: GameStep -> IO ()
playRepeatedly step = do
  newStep <- play step
  tryAgain <- askBoolean "Play again"
  if tryAgain then playRepeatedly newStep
    else return ()

firstStep = Guess{ animalName = "dog" }