hangman.hs

module Hangman(
         Hangman,
         createHangman,
         chooseWord,
         playGame,
         Guess
         ) where

   import System.IO(readFile)
   import System.Random
   import Data.Char(isLower)
   import qualified Data.Map as Map
   import qualified Data.List as List

   data Guess ch = Guessed ch | Unguessed deriving (Eq)
   instance (Show ch) => Show (Guess ch) where
      show (Guessed ch)  = show ch
      show (Unguessed) = show '_'

   instance (Ord ch) => Ord (Guess ch)


   data Hangman ct = Hangman { ctype :: ct, dictwords :: [String], word :: String, rgen :: StdGen, guesses :: Map.Map (Guess ct) Bool }

   instance (Show c) => Show (Hangman c) where
      show (Hangman { guesses = g }) = show $ Map.mapWithKey (\k _ -> case k of (Guessed x) -> show x; (Unguessed) -> "_") g
{-
   removePossessives :: [String] -> [String]
   removePossessives words = filter (\w -> drop (length w -2) w /= "'s") words

   removeProperNouns :: [String] -> [String]
   removeProperNouns words = filter (isLower . head) words

   getDictionary :: String -> IO [String]
   getDictionary name = do
      c <- readFile $ "/usr/share/dict/" ++ name
      return $ removePossessives $ removeProperNouns $ words c


   createHangman :: IO Hangman
   createHangman = do
      hwords <- getDictionary "american-english"
      gen <- newStdGen
      let word = chooseWord gen hwords
      return Hangman { dictwords = hwords, word = "",  rgen = gen, guesses = Map.fromList _guesses } where
         _guesses = map (\x -> (x, False)) ['a'..'z']

   chooseWord :: StdGen -> [a] -> a
   chooseWord gen words = words !! (rn `mod` (length words)) where 
      rn = head (randoms gen :: [Int])
      
   
   guessLetter :: Hangman -> Char -> Hangman
   guessLetter hng ltr = hng

   playGame :: IO () 
   playGame = do
      hng <- createHangman
      gen <- newStdGen
      let guess = guessLetter hng -- Curry that shit

      putStrLn $ chooseWord gen $ dictwords hng
      return ()
-}