Hangman game

Main.hs

module Main where

import Control.Monad (forever)
import Data.Char (toLower)
import Data.Maybe (isJust)
import Data.List (intersperse, (\\))
import System.Exit (exitSuccess)
import System.Random (randomRIO)
   
type WordList = [String]

minWordLength = 5 :: Int
maxWordLength = 9 :: Int

-- A list of words read from data/dict.txt
allWords :: IO WordList
allWords = do
  dict <- readFile "data/dict.txt"
  return (lines dict)

-- Filtered list of words suitable for game
gameWords :: IO WordList
gameWords = do
  aw <- allWords
  return (filter gameLength aw)
  where gameLength w =
          let l = length (w :: String)
          in l > minWordLength && l < maxWordLength

-- Random word out of given word list
randomWord :: WordList -> IO String
randomWord wl = do 
  randomIndex <- randomRIO (0, (length wl) - 1)
  return $ wl !! randomIndex

-- Random word from gameWords (specifically)
randomWord' :: IO String
randomWord' = gameWords >>= randomWord

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

-- show implementation for Puzzle
instance Show Puzzle where
  show puzzle@(Puzzle _ discovered guessed) =
    (intersperse ' ' $ fmap renderPuzzleChar discovered)
    ++ " Words wrongly guessed so far: " ++ (wronglyGuessed puzzle) 

-- Generates new Puzzle
freshPuzzle :: String -> Puzzle
freshPuzzle w =
  Puzzle w (fmap (\x -> Nothing) w)  ""

-- Wheter a char is in word
charInWord :: Puzzle -> Char -> Bool
charInWord (Puzzle word _ _) ch = ch `elem` word

-- Whether a char is already guessed
alreadyGuessed :: Puzzle -> Char -> Bool
alreadyGuessed (Puzzle _ _ guessed) ch = ch `elem` guessed

-- Render Puzzle char
-- Just to its value, Nothing to '_'
renderPuzzleChar :: Maybe Char -> Char
renderPuzzleChar ch = case ch of
                        Just a -> a
                        Nothing -> '_'

-- Updates the Puzzle word
fillInCharacter :: Puzzle -> Char -> Puzzle
fillInCharacter (Puzzle word filledInSoFar s) c =
  Puzzle word newFilledInSoFar (c: s)
  where zipper guessed wordChar guessChar =
          if wordChar == guessed
          then Just wordChar
          else guessChar
        newFilledInSoFar =
          zipWith (zipper c) word filledInSoFar

-- Returns Puzzle according to guess
-- along with apropriate message
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\
                \ character, pick spmething else!"
      return puzzle
    (True, _) -> do
      putStrLn "This character was in the word, \
                \ filling in the word accordingly"
      return (fillInCharacter puzzle guess)
    (False, _) -> do
      putStrLn "This character wasn't in \
                \ the word, try again."
      return (fillInCharacter puzzle guess)

-- List of wrongly guessed characters for Puzzle
wronglyGuessed (Puzzle _ maybeWord guessed) =
  guessed \\ matchedWords
  where matchedWords = [x | Just x <- maybeWord ]

-- Handle how game is over
gameOver :: Puzzle -> IO ()
gameOver puzzle@(Puzzle wordToGuess maybeWord guessed) =
  if length (wronglyGuessed puzzle) > 7 then
    do putStrLn "You lose!"
       putStrLn $ "The word was: " ++ wordToGuess
       exitSuccess
  else return ()

-- Handle how game is won
gameWin :: Puzzle -> IO ()
gameWin (Puzzle word filledInSoFar _) =
  if all isJust filledInSoFar then
    do putStrLn $ "You win!" ++ " The word is: " ++ word
       exitSuccess
  else return ()

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

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