Advertisement
Guest User

Untitled

a guest
Dec 9th, 2012
85
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. module Main
  2. ( main
  3. ) where
  4.  
  5. import           Data.Char
  6. import           Data.Set (Set)
  7. import qualified Data.Set as S
  8. import           Control.Monad.Reader
  9. import           Control.Monad.IO.Class
  10.  
  11. type Hangman a = ReaderT String IO a
  12.  
  13. getFilteredChar :: (Char -> Bool) -> IO Char
  14. getFilteredChar p = do
  15.     c <- getChar
  16.     if p c
  17.         then return c
  18.         else getFilteredChar p
  19.  
  20. printSeparator :: IO ()
  21. printSeparator = putStrLn $ take 80 $ repeat '-'
  22.  
  23. hangman :: Set Char -> Hangman ()
  24. hangman g | S.size g < 8 = do
  25.                 (g', won) <- guess g
  26.                printState g' >> (liftIO printSeparator)
  27.                 if won then printWonMessage else hangman g'
  28.          | otherwise    = printGameOver
  29.  
  30. guess :: Set Char -> Hangman (Set Char, Bool)
  31. guess g = do
  32.    w <- ask
  33.    c <- liftIO $ getFilteredChar isAlpha
  34.    let g' = S.insert c g
  35.     return $ (g', guessed w g')
  36.  
  37. guessed :: String -> Set Char -> Bool
  38. guessed w g = (S.fromList w) `S.isSubsetOf` g
  39.  
  40. printGameOver :: Hangman ()
  41. printGameOver = do
  42.     w <- ask
  43.     liftIO $ putStrLn $ "You lost. The word was: " ++ w ++ "."
  44.  
  45. printWonMessage :: Hangman ()
  46. printWonMessage = liftIO $ putStrLn "Congratulations, komrad."
  47.  
  48. printState :: Set Char -> Hangman ()
  49. printState g = do
  50.     w <- ask
  51.     liftIO $ do
  52.         putStrLn $ map (\c -> if c `S.member` g then c else '_') w
  53.         putStrLn $ "Guessed: " ++ S.toList g
  54.  
  55. main :: IO ()
  56. main = liftIO $ runReaderT (hangman S.empty) "hello"
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement