Unison toy adventure game

gistfile1.txt

-- Text Adventure Game in Unison
-- A simple dungeon adventure

-- Room identifiers
unique type RoomId = Entrance | DarkHallway | TreasureRoom

-- Command types
unique type Command = North | South | East | West | Look | Help | Quit | Take | Inventory | Unknown

-- Game state
unique type GameState = { currentRoom : RoomId, hasKey : Boolean, hasTreasure : Boolean }

-- Room description data
roomDescription : RoomId -> Boolean -> Text
roomDescription room hasKey = match room with
  Entrance ->
    base = "You are at the dungeon entrance. A musty smell fills the air.\nA dark hallway leads north."
    if hasKey then base
    else base ++ "\nA rusty key lies on the ground."
  DarkHallway -> "You are in a dark hallway. You can barely see.\nThe entrance is to the south. A faint glow comes from the east."
  TreasureRoom -> "You found the treasure room! Gold coins glitter everywhere!\nA treasure chest sits in the center.\nThe hallway is to the west."

-- Room name for display
roomName : RoomId -> Text
roomName = cases
  Entrance -> "Dungeon Entrance"
  DarkHallway -> "Dark Hallway"
  TreasureRoom -> "Treasure Room"

-- Parse user input into a command using pattern matching
parseCommand : Text -> Command
parseCommand = cases
  "n" -> North
  "north" -> North
  "s" -> South
  "south" -> South
  "e" -> East
  "east" -> East
  "w" -> West
  "west" -> West
  "look" -> Look
  "l" -> Look
  "help" -> Help
  "h" -> Help
  "?" -> Help
  "quit" -> Quit
  "q" -> Quit
  "exit" -> Quit
  "take" -> Take
  "get" -> Take
  "take key" -> Take
  "get key" -> Take
  "take treasure" -> Take
  "get treasure" -> Take
  "inventory" -> Inventory
  "inv" -> Inventory
  "i" -> Inventory
  _ -> Unknown

-- Show the current room
showRoom : GameState -> '{IO, Exception} ()
showRoom state = do
  printLine ""
  printLine ("=== " ++ roomName (GameState.currentRoom state) ++ " ===")
  printLine (roomDescription (GameState.currentRoom state) (GameState.hasKey state))
  printLine ""

-- Show help
showHelp : '{IO, Exception} ()
showHelp = do
  printLine ""
  printLine "Commands:"
  printLine "  n/north    - Go north"
  printLine "  s/south    - Go south"
  printLine "  e/east     - Go east"
  printLine "  w/west     - Go west"
  printLine "  look       - Look around"
  printLine "  take       - Take an item"
  printLine "  inventory  - Show inventory"
  printLine "  help       - Show this help"
  printLine "  quit       - Exit the game"
  printLine ""

-- Show inventory
showInventory : GameState -> '{IO, Exception} ()
showInventory state = do
  printLine ""
  printLine "Inventory:"
  if GameState.hasKey state then printLine "  - Rusty key"
  else ()
  if GameState.hasTreasure state then printLine "  - Golden treasure"
  else ()
  if (not (GameState.hasKey state)) && (not (GameState.hasTreasure state)) then
    printLine "  (empty)"
  else ()
  printLine ""

-- Get user input
getInput : '{IO, Exception} Text
getInput = do
  print "> "
  getLine stdIn

-- Try to move in a direction, returns new room or None if blocked
tryMove : RoomId -> Command -> Optional RoomId
tryMove room dir = match (room, dir) with
  (Entrance, North) -> Some DarkHallway
  (DarkHallway, South) -> Some Entrance
  (DarkHallway, East) -> Some TreasureRoom
  (TreasureRoom, West) -> Some DarkHallway
  _ -> None

-- Handle take command at entrance
handleTakeEntrance : GameState -> '{IO, Exception} GameState
handleTakeEntrance state =
  if GameState.hasKey state then do
    printLine "There's nothing here to take."
    state
  else do
    printLine "You pick up the rusty key."
    GameState.hasKey.set true state

-- Handle take command at treasure room
handleTakeTreasure : GameState -> '{IO, Exception} GameState
handleTakeTreasure state =
  if GameState.hasTreasure state then do
    printLine "You already have the treasure!"
    state
  else if not (GameState.hasKey state) then do
    printLine "The treasure chest is locked. You need a key."
    state
  else do
    printLine "You use the key to unlock the chest and take the golden treasure!"
    GameState.hasTreasure.set true state

-- Handle take command (main dispatcher)
handleTake : GameState -> '{IO, Exception} GameState
handleTake state = do
  match GameState.currentRoom state with
    Entrance -> !(handleTakeEntrance state)
    TreasureRoom -> !(handleTakeTreasure state)
    _ ->
      printLine "There's nothing here to take."
      state

-- Show victory message
showVictory : '{IO, Exception} ()
showVictory = do
  printLine ""
  printLine "=========================================="
  printLine "  CONGRATULATIONS! YOU WON THE GAME!"
  printLine "  You escaped the dungeon with the treasure!"
  printLine "=========================================="
  printLine ""

-- Handle take and check for win
handleTakeAndCheck : GameState -> '{IO, Exception} ()
handleTakeAndCheck state = do
  newState = !(handleTake state)
  if GameState.hasTreasure newState then !(showVictory)
  else !(gameLoop newState)

-- Main game loop
gameLoop : GameState -> '{IO, Exception} ()
gameLoop state = do
  input = !getInput
  cmd = parseCommand input
  match cmd with
    Quit -> printLine "Thanks for playing!"
    Help ->
      !(showHelp)
      !(gameLoop state)
    Look ->
      !(showRoom state)
      !(gameLoop state)
    Inventory ->
      !(showInventory state)
      !(gameLoop state)
    Take -> !(handleTakeAndCheck state)
    North -> !(handleMove state North)
    South -> !(handleMove state South)
    East -> !(handleMove state East)
    West -> !(handleMove state West)
    Unknown ->
      printLine "I don't understand that command. Type 'help' for available commands."
      !(gameLoop state)

-- Handle movement
handleMove : GameState -> Command -> '{IO, Exception} ()
handleMove state dir = do
  match tryMove (GameState.currentRoom state) dir with
    None ->
      printLine "You can't go that way."
      !(gameLoop state)
    Some newRoom ->
      newState = GameState.currentRoom.set newRoom state
      !(showRoom newState)
      !(gameLoop newState)

-- Initialize game
initGame : GameState
initGame = GameState Entrance false false

main : '{IO, Exception} ()
main = do
  printLine ""
  printLine "=========================================="
  printLine "  DUNGEON ADVENTURE"
  printLine "=========================================="
  printLine ""
  printLine "You stand at the entrance of an ancient dungeon."
  printLine "Legends say a golden treasure lies within..."
  printLine ""
  printLine "Type 'help' for commands, 'quit' to exit."
  state = initGame
  !(showRoom state)
  !(gameLoop state)