Haskell Book Chapter 13

haskellbook-chapter-13-hangman.hs

module Main where

import Control.Monad (forever)
import Data.Char (toLower)
import Data.Maybe (isJust)
import Data.List (intersperse, nub)
import System.Exit (exitSuccess)
import System.Random (randomRIO)
import System.IO

type WordList = [String]

allWords :: IO WordList
allWords = do
  dict <- readFile "data/dict.txt"
  return (lines dict)

minWordLength :: Int
minWordLength = 5

maxWordLength :: Int
maxWordLength = 10

gameWords :: IO WordList
gameWords = do
  aw <- allWords
  return (filter gameLength aw)
  where gameLength w =
          let l = length (w :: String)
          in  l > minWordLength && l < maxWordLength

randomWord :: WordList -> IO String
randomWord wl = do
  randomIndex <- randomRIO (0, length wl - 1)
  return $ wl !! randomIndex

randomWord' :: IO String
randomWord' = gameWords >>= randomWord

data Puzzle = Puzzle String [Maybe Char] [Char]

instance Show Puzzle where
  show (Puzzle _ discovered guessed) =
    (intersperse ' ' $ fmap renderPuzzleChar discovered)
    ++ " Guessed so far: " ++ guessed

freshPuzzle :: String -> Puzzle
freshPuzzle word = Puzzle word discovered guessed
              where discovered = map (const Nothing) word
                    guessed = []

charInWord :: Puzzle -> Char -> Bool
charInWord (Puzzle word _ _) c = elem c word

alreadyGuessed :: Puzzle -> Char -> Bool
alreadyGuessed (Puzzle _ _ guessed) c = elem c guessed

renderPuzzleChar :: Maybe Char -> Char
renderPuzzleChar Nothing = '_'
renderPuzzleChar (Just c) = c

fillInCharacter :: Puzzle -> Char -> Puzzle
fillInCharacter (Puzzle word discovered guessed) c =
  Puzzle word newDiscovered (c : guessed)
  where zipper guess wordChar discoveredChar =
          if wordChar == guess
          then Just wordChar
          else discoveredChar
        newDiscovered =
          zipWith (zipper c) word discovered

handleGuess :: Puzzle -> Char -> IO Puzzle
handleGuess puzzle guess = do
  putStrLn $ "Your guess was: " ++ [guess]
  case (charInWord puzzle guess, alreadyGuessed puzzle guess) of
    (_, True) -> do
      putStrLn "You already guessed that, pick something else!"
      return puzzle
    (True, _) -> do
      putStrLn "Great guess! That's in, filling it accordingly."
      return (fillInCharacter puzzle guess)
    (False, _) -> do
      putStrLn "Too bad! This isn't in the word, try again."
      return (fillInCharacter puzzle guess)

gameOver :: Puzzle -> IO ()
gameOver (Puzzle word discovered guessed) =
  if (length guessed - (length $ nub $ filter isJust discovered) > 7) then
    do putStrLn "You lost!"
       putStrLn $ "The answer was: " ++ word
       exitSuccess
  else
    return ()

gameWin :: Puzzle -> IO ()
gameWin (Puzzle word discovered _) =
  if all isJust discovered then
    do putStrLn "You win!"
       putStrLn $ "The answer was: " ++ word
       exitSuccess
  else
    return ()

runGame :: Puzzle -> IO ()
runGame puzzle = forever $ do
  gameOver puzzle
  gameWin puzzle
  putStrLn $ "Current puzzle is: " ++ show puzzle
  hSetBuffering stdout NoBuffering
  putStr "Guess a letter: "
  guess <- getLine
  case guess of
    [c] -> handleGuess puzzle c >>= runGame
    _   -> putStrLn "Your guess must be a single character."

main :: IO ()
main = do
  word <- randomWord'
  let puzzle = freshPuzzle (fmap toLower word)
  runGame puzzle

haskellbook-chapter-13-palindrome.hs

module Palindrome where

import Control.Monad (forever)
import Data.Char (isLetter, toLower)
import System.Exit (exitSuccess)

letters :: [Char] -> [Char]
letters cs = map toLower $ filter isLetter cs

palindrome :: IO ()
palindrome = forever $ do
    line1 <- getLine
    case (letters line1 == reverse (letters line1)) of
        True -> putStrLn "It's a palindrome!"
        False -> do
            putStrLn "Nope!"
            exitSuccess

haskellbook-chapter-13-person.hs

module Person where

import Data.Char
import System.IO

type Name = String
type Age = Integer

data Person = Person Name Age deriving Show

data PersonInvalid = NameEmpty
                   | AgeTooLow
                   | PersonInvalidUnknown String
                   deriving (Eq, Show)

mkPerson :: Name -> Age -> Either PersonInvalid Person
mkPerson name age
    | name /= "" && age > 0 = Right $ Person name age
    | name == ""            = Left NameEmpty
    | not (age > 0)         = Left AgeTooLow
    | otherwise             = Left $ PersonInvalidUnknown $
                                     "Name was: " ++ show name ++
                                     " Age was: " ++ show age

gimmePerson :: IO ()
gimmePerson = do
    hSetBuffering stdout NoBuffering
    putStr "Enter name: "
    name <- getLine
    putStr "Enter age: "
    ageString <- getLine
    case mkPerson name $ read ageString of
        Right p -> putStrLn $ show p
        Left e -> putStrLn $ show e