PlayHangmanGame-0.2: src/main.hs

module Main where

import Control.Monad.State
import Control.Monad.Trans
import qualified Data.Map as Map
import System.Environment (getArgs)

import GameRandom
import GameStrategy
import Hangman
import Types
import WordsOp

main :: IO ()
main = do
       args      <- getArgs
       (ws, wm)  <- defaultWords
       rs        <- randomRange (testWordsNum args) (length ws)
       let words = [ ws !! i | i <- rs ]
       ys        <- mapM (playgame' wm) words
       print $ "DONE: " ++ show (length $ filter (== GAME_WON) ys) ++ "/" ++ show (length words)
     where testWordsNum :: [String] -> Int
           testWordsNum []    = 2
           testWordsNum (i:_) = read i

-- |  Run
playgame' :: MapPerLength -> SecretWord -> IO GameStatus
playgame' map sw = case Map.lookup (length sw) map of
                     Just xs -> evalStateT ( run (newSimpleStrategy xs) ) (initHG sw)
                     Nothing -> return GAME_LOST
  
-- | FIXME: non-deminited if keeping guessing same letter
run :: SimpleStrategy -> HangmanGame GameStatus
run gs = do
           hg <- get
           case gameStatus hg of
             KEEP_GUESSING -> do
                              (NextGuess guess, updatedStrategy) <- runStrategy hg gs
                              put (makeGuess guess hg)
                              logHangmanGame
                              run updatedStrategy
             x             -> return x
        where runStrategy hg gs = lift $ runStateT (nextGuess hg) gs
              logHangmanGame = do hg <- get
                                  liftIO $ print $ displayGame hg