Main.hs

module Main
( main
) where

import           Data.Char
import           Data.Set (Set)
import qualified Data.Set as S
import           Control.Monad.Reader
import           Control.Monad.IO.Class

type Hangman a = ReaderT String IO a

getFilteredChar :: (Char -> Bool) -> IO Char
getFilteredChar p = do
    c <- getChar
    if p c
        then return c
        else getFilteredChar p

printSeparator :: IO ()
printSeparator = putStrLn $ take 80 $ repeat '-'

hangman :: Set Char -> Hangman ()
hangman g | S.size g < 8 = do
                (g', won) <- guess g
                printState g' >> (liftIO printSeparator)
                if won then printWonMessage else hangman g'
          | otherwise    = printGameOver

guess :: Set Char -> Hangman (Set Char, Bool)
guess g = do
    w <- ask
    c <- liftIO $ getFilteredChar isAlpha
    let g' = S.insert c g
    return $ (g', guessed w g')

guessed :: String -> Set Char -> Bool
guessed w g = (S.fromList w) `S.isSubsetOf` g

printGameOver :: Hangman ()
printGameOver = do
    w <- ask
    liftIO $ putStrLn $ "You lost. The word was: " ++ w ++ "."

printWonMessage :: Hangman ()
printWonMessage = liftIO $ putStrLn "Congratulations, komrad."

printState :: Set Char -> Hangman ()
printState g = do
    w <- ask
    liftIO $ do
        putStrLn $ map (\c -> if c `S.member` g then c else '_') w
        putStrLn $ "Guessed: " ++ S.toList g

main :: IO ()
main = liftIO $ runReaderT (hangman S.empty) "hello"