haskell practice: basic hangman

hangman.hs

import Data.List

data Letter = Found (Char) | NotFound (Char) | Dash | None deriving Eq

type LetterSequence = [Letter]

data Hangman = Hangman {
    word :: LetterSequence,
    tries :: Int,
    won :: Bool
}

data HangmanUpdate a = HangmanUpdate {
    new :: a,
    many :: Int
}

update_letter :: Char -> Letter -> HangmanUpdate Letter
update_letter _ (Found ch) = HangmanUpdate { new = (Found ch), many = -1 }
update_letter _ (Dash) = HangmanUpdate { new = (Dash), many = 0 }
update_letter comp (NotFound ch) =
    if ch == comp
    then HangmanUpdate { new = (Found ch), many = 1 }
    else HangmanUpdate { new = (NotFound ch), many = 0 }

chain_letter_update :: HangmanUpdate LetterSequence -> HangmanUpdate Letter -> HangmanUpdate LetterSequence
chain_letter_update word_update letter_update =
    let 
        new_many
            | ((many letter_update) == -1 || (many word_update) == -1) = -1
            | otherwise                                       = (many letter_update) + (many word_update)
    in HangmanUpdate { new = (new word_update) ++ [(new letter_update)], many = new_many }

update_word :: Char -> LetterSequence -> HangmanUpdate LetterSequence
update_word char word =
    if length word == 0
    then HangmanUpdate { new = [], many = 0 }
    else foldl chain_letter_update HangmanUpdate { new = [], many = 0 } (map (update_letter char) word)

not_found :: Letter -> Bool
not_found (NotFound _) = True
not_found otherwise = False

update_hangman :: Hangman -> Char -> Hangman
update_hangman hangman guess =
    let update = update_word guess (word hangman)
        lose_life = if (many update) == 0 then -1 else 0
    in Hangman {
        word = (new update),
        tries = (tries hangman) + lose_life,
        won = (not (any not_found (new update))) }

init_letter :: Char -> Letter
init_letter char =
  case char of {
    '-'       -> Dash;
    '.'       -> Dash;
    '\''      -> Dash;
    ':'       -> Dash;
    '&'       -> Dash;
    ' '       -> Dash;
    '\n'      -> None;
    otherwise -> NotFound (char) }

stringify_letter :: Letter -> String
stringify_letter (Dash) = "-"
stringify_letter (NotFound _) = "_"
stringify_letter (Found x) = [x]

stringify_sequence :: LetterSequence -> String
stringify_sequence sequence = intercalate " " (map stringify_letter sequence)

print_hangman :: Hangman -> IO ()
print_hangman hangman = do
    putStrLn ("Lives left: "++(show $ tries hangman)++"  |  Word: "++(stringify_sequence (word hangman)))

game_loop :: Hangman -> IO ()
game_loop hangman = do
    print_hangman hangman
    putStrLn "Try to guess a letter."
    let input_loop = do
        letter <- getLine
        if (length letter) < 1
            then do
                putStrLn "Please write a letter!"
                input_loop
        else if (length letter) > 1
            then do
                putStrLn "Please write only one letter!"
                input_loop
        else do
            let new_hangman = (update_hangman hangman (letter!!0))
            if (won new_hangman) then
                putStrLn "Congratulations!!!"
            else
                game_loop new_hangman
    input_loop

main :: IO ()
main = do 
  putStrLn "Insert a word to hangman over!"
  word <- getLine
  game_loop (Hangman { word = (filter (\l -> l /= None) (map init_letter word)), tries = 7, won = False })
import Data.List

data Letter = Found (Char) | NotFound (Char) | Dash | None deriving Eq

type LetterSequence = [Letter]

data Hangman = Hangman {
    word :: LetterSequence,
    tries :: Int,
    won :: Bool
}

data HangmanUpdate a = HangmanUpdate {
    new :: a,
    many :: Int
}

update_letter :: Char -> Letter -> HangmanUpdate Letter
update_letter _ (Found ch) = HangmanUpdate { new = (Found ch), many = -1 }
update_letter _ (Dash) = HangmanUpdate { new = (Dash), many = 0 }
update_letter comp (NotFound ch) =
    if ch == comp
    then HangmanUpdate { new = (Found ch), many = 1 }
    else HangmanUpdate { new = (NotFound ch), many = 0 }

chain_letter_update :: HangmanUpdate LetterSequence -> HangmanUpdate Letter -> HangmanUpdate LetterSequence
chain_letter_update word_update letter_update =
    let 
        new_many
            | ((many letter_update) == -1 || (many word_update) == -1) = -1
            | otherwise                                       = (many letter_update) + (many word_update)
    in HangmanUpdate { new = (new word_update) ++ [(new letter_update)], many = new_many }

update_word :: Char -> LetterSequence -> HangmanUpdate LetterSequence
update_word char word =
    if length word == 0
    then HangmanUpdate { new = [], many = 0 }
    else foldl chain_letter_update HangmanUpdate { new = [], many = 0 } (map (update_letter char) word)

not_found :: Letter -> Bool
not_found (NotFound _) = True
not_found otherwise = False

update_hangman :: Hangman -> Char -> Hangman
update_hangman hangman guess =
    let update = update_word guess (word hangman)
        lose_life = if (many update) == 0 then -1 else 0
    in Hangman {
        word = (new update),
        tries = (tries hangman) + lose_life,
        won = (not (any not_found (new update))) }

init_letter :: Char -> Letter
init_letter char =
  case char of {
    '-'       -> Dash;
    '.'       -> Dash;
    '\''      -> Dash;
    ':'       -> Dash;
    '&'       -> Dash;
    ' '       -> Dash;
    '\n'      -> None;
    otherwise -> NotFound (char) }

stringify_letter :: Letter -> String
stringify_letter (Dash) = "-"
stringify_letter (NotFound _) = "_"
stringify_letter (Found x) = [x]

stringify_sequence :: LetterSequence -> String
stringify_sequence sequence = intercalate " " (map stringify_letter sequence)

print_hangman :: Hangman -> IO ()
print_hangman hangman = do
    putStrLn ("Lives left: "++(show $ tries hangman)++"  |  Word: "++(stringify_sequence (word hangman)))

game_loop :: Hangman -> IO ()
game_loop hangman = do
    print_hangman hangman
    putStrLn "Try to guess a letter."
    let input_loop = do
        letter <- getLine
        if (length letter) < 1
            then do
                putStrLn "Please write a letter!"
                input_loop
        else if (length letter) > 1
            then do
                putStrLn "Please write only one letter!"
                input_loop
        else do
            let new_hangman = (update_hangman hangman (letter!!0))
            if (won new_hangman) then
                putStrLn "Congratulations!!!"
            else
                game_loop new_hangman
    input_loop

main :: IO ()
main = do 
    putStrLn "Insert a word to hangman over!"
    word <- getLine
    game_loop (Hangman { word = (filter (\l -> l /= None) (map init_letter word)), tries = 7, won = False })