This task has been flagged for clarification. Code on this page in its current state may be flagged incorrect once this task has been clarified. See this page's Talk page for discussion.
Create a simple implementation of the classic textual game Hunt The Wumpus.

The rules are:

The game is set in a cave that consists of a 20 room labyrinth.
Each room is connected to 3 other rooms (the cave is modeled after the
vertices of a dodecahedron).
The objective of the player is to find and kill the horrendous beast Wumpus that lurks in the cave.

The player has 5 arrows.
If they run out of arrows before killing the Wumpus, the player loses the game.

In the cave there are:

 One Wumpus
 Two giant bats
 Two bottomless pits
If the player enters a room with the Wumpus, he is eaten by it and the game is lost.

If the player enters a room with a bottomless pit, he falls into it and the game is lost.

If the player enters a room with a giant bat, the bat takes him and transports him into a random empty room.

Each turn the player can either walk into an adjacent room or shoot into an adjacent room.

Whenever the player enters a room, he "senses" what happens in adjacent rooms.
The messages are:

 Nearby Wumpus: "You smell something terrible nearby."
 Nearby bat: "You hear a rustling."
 Nearby pit: "You feel a cold wind blowing from a nearby cavern."
When the player shoots, he wins the game if he is shooting in the room with the Wumpus.
If he shoots into another room, the Wumpus has a 75% of chance of waking up and moving into an adjacent room: if this is the room with the player, he eats him up and the game is lost.

import System.Random
import System.IO
import Data.List
import Data.Char
import Control.Monad
 
-- Rooms
cave :: [[Int]]
cave = [
    [1,4,7],    [0,2,9],   [1,3,11],   [2,4,13],   [0,3,5],
    [4,6,14],   [5,7,16],  [0,6,8],    [7,9,17],   [1,8,10],
    [9,11,18],  [2,10,12], [11,13,19], [3,12,14],  [5,13,15],
    [14,16,19], [6,15,17], [8,16,18],  [10,17,19], [12,15,18]]
 
caveSize :: Int
caveSize = length cave
 
-- Game state
data GameState = GameState {
    wumpus :: Int,
    player :: Int,
    arrows :: Int,
    pits :: [Int],
    bats :: [Int]
}
 
-- Print the state of the game
instance Show GameState where
    show g = "You are in room " ++ show (player g) ++ ". " ++
             "Adjacent rooms are: " ++ (intercalate ", " $ map show adjs) ++
             ".\nYou have " ++ show (arrows g) ++ " arrows.\n\n" ++
             adjMsgs 
        where adjs    = cave!!player g
              adj     = any (`elem` adjs) . ($ g)
              adjMsgs = unlines $
                  ["You smell something terrible nearby." | adj $ pure.wumpus]
               ++ ["You hear a rustling." | adj bats]
               ++ ["You feel a cold wind blowing from a nearby cavern." | adj pits]
 
-- Generate random initial state
initGame :: StdGen -> GameState
initGame g = 
    GameState {wumpus=w, player=p, arrows=5, pits=[p1,p2], bats=[b1,b2]}
    where [w, p, p1, p2, b1, b2] = take 6 $ nub $ map (`mod` 20) $ randoms g
 
-- Move wumpus into adjacent free room (if possible)
moveWumpus :: GameState -> StdGen -> GameState
moveWumpus s g
    | null freeAdj = s
    | otherwise = s {wumpus = freeAdj!!(fst $ randomR (0, length freeAdj-1) g)}
    where freeAdj = [r | r <- cave!!wumpus s, not $ elem r $ pits s++bats s]
 
-- Move player into random adjacent room
movePlayer :: GameState -> StdGen -> GameState 
movePlayer s g = s {player = (cave !! player s) !! (fst $ randomR (0,2) g)}
 
-- Move or shoot
data Action = Move | Shoot | Quit deriving Show
inputAction :: IO Action
inputAction = do
    putStr "M)ove, S)hoot or Q)uit? "
    hFlush stdout
    ch <- getChar
    putStrLn "" 
    case toLower ch of
        'm' -> return Move
        's' -> return Shoot
        'q' -> return Quit
        _   -> putStrLn "Invalid command" >> inputAction
 
-- Get room from current room
inputDestination :: Int -> IO Int
inputDestination cur = do
    putStr "Where to? "
    hFlush stdout
    input <- getLine
    case reads input of
        []      -> err "Sorry?"
        [(x,_)] -> if x `elem` (cave !! cur)
                   then return x
                   else err "Can't get there from here."
  where
    err x = putStrLn x >> inputDestination cur
 
-- Input yes or no
inputYesNo :: IO Bool
inputYesNo = do
    ch <- getChar
    case toLower ch of
        'n' -> putStrLn "" >> return False
        'y' -> putStrLn "" >> return True
        _   -> putStr (map chr [7,8]) >> inputYesNo
 
-- See if anything has happened to the player
data PlayerState = NoArrows | Bat | Pit | Wumpus | Alive deriving Show
playerState :: GameState -> PlayerState
playerState s | player s == wumpus s   = Wumpus
              | player s `elem` bats s = Bat 
              | player s `elem` pits s = Pit
              | arrows s == 0          = NoArrows
              | otherwise              = Alive
 
-- Game loop
data GameResult = Win | Lose | Stop deriving Show
game :: GameState -> IO GameResult
game s = case playerState s of
    Wumpus   -> putStrLn "You find yourself face to face with the wumpus."
             >> putStrLn "It eats you alive in one bite.\n"
             >> return Lose
    Pit      -> putStrLn "You fall into a deep pit. Death waits at the bottom.\n"
             >> return Lose
    Bat      -> putStrLn "You have walked into the lair of a giant bat."
             >> putStrLn "It picks you up and deposits you outside.\n"
             >> newStdGen >>= game . movePlayer s
    NoArrows -> putStrLn "You notice you are out of arrows."
             >> putStrLn "You hear a large beast approaching.\n"
             >> return Lose
    Alive    -> do
        putStrLn "" 
        putStrLn $ show s
        action <- inputAction
        case action of
            Quit -> return Stop
            _    -> do
                dest <- inputDestination (player s)
                case action of
                    Move  -> game s {player = dest}
                    Shoot -> shoot s dest
 
-- Shoot at the wumpus
shoot :: GameState -> Int -> IO GameResult
shoot s tgt
    | tgt == wumpus s = do
        putStrLn "Congratulations! You shot the wumpus!\n"
        return Win
    | otherwise = do
        let s'' = s { arrows = pred $ arrows s }
        putStrLn "That's a miss."
        awake <- randomRIO (0,3::Int)
        if awake /= 0 then do
            putStrLn "The wumpus wakes from his slumber."
            newStdGen >>= game . moveWumpus s''
        else
            game s''
 
-- Play a game
playGame :: IO () 
playGame = do
    result <- newStdGen >>= game . initGame 
    case result of
        Stop -> return ()
        _    -> do
            case result of
                Lose -> putStrLn "You have met your demise."
                Win  -> putStrLn "You win!"
            putStr "\nAnother game? (Y/N) "
            inputYesNo >>= flip when playGame
 
main :: IO ()
main = do
    hSetBuffering stdin NoBuffering
    hSetBuffering stdout NoBuffering
    putStrLn "*** HUNT THE WUMPUS ***"
    putStrLn ""
    playGame