record Adventure =
    inventory          : List-Set Item,
    current-place-name : String,
    places             : List-Dict String Place,
    combinations       : List Combination,

func adventure : String -> List (Pair String Place) -> List Combination -> Adventure =
    \current-place-name \places \combinations
    Adventure
        (list-set (==) [])
        current-place-name
        (list-dict (==) invalid-place places)
        combinations

func current-place : Adventure -> Place =
    \adv
    (at (current-place-name adv) . places) adv

func current-place : (Place -> Place) -> Adventure -> Adventure =
    \f \adv
    (places . at (current-place-name adv)) f adv

func show-inventory : Adventure -> String =
    join " " . map name . values . inventory

record Place =
    description : String,
    items       : List-Set Item,
    objects     : List-Set Object,
    directions  : List-Dict Direction String,

func place : String -> List Item -> List Object -> List (Pair Direction String) -> Place =
    \description \items \objects \directions
    Place
        description
        (list-set (==) items)
        (list-set (==) objects)
        (list-dict (==) "" directions)

func invalid-place : Place = place "Invalid place. Reaching this place is a bug." [] [] []

record Direction =
    name        : String,
    description : String,

func dir : String -> String -> Description = Direction

func == : Direction -> Direction -> Bool =
    \dir1 \dir2
    name dir1 == name dir2

func != : Direction -> Direction -> Bool =
    not (==)

func full-description : Place -> String =
    \place
    yield-all (description place);
    for (values; items place)
        (yield-all . (" " ++) . short-description);
    for (values; objects place)
        (yield-all . (" " ++) . short-description);
    for (keys; directions place)
        (yield-all . (" " ++) . description);
    empty

record Item =
    name              : String,
    short-description : String,
    long-description  : String,

func item : String -> String -> String -> Item = Item

func == : Item -> Item -> Bool =
    \item1 \item2
    name item1 == name item2

func != : Item -> Item -> Bool =
    not (==)

record Object =
    name              : String,
    short-description : String,
    long-description  : String,
    actions           : List Action,

func object : String -> String -> String -> List Action -> Object = Object

func == : Object -> Object -> Bool =
    \object1 \object2
    name object1 == name object2

func != : Object -> Object -> Bool =
    not (==)

record Action =
    name        : String,
    description : String,
    items       : List-Set Item,
    outcome     : Maybe (Adventure -> Adventure),

func action : String -> String -> List Item -> Maybe (Adventure -> Adventure) -> Action =
    \name \description \items \outcome
    Action
        name
        description
        (list-set (==) items)
        outcome

record Combination =
    description : String,
    use-items   : List-Set Item,
    new-items   : List-Set Item,

func combination : String -> List Item -> List Item -> Combination =
    \description \use-items \new-items
    Combination
        description
        (list-set (==) use-items)
        (list-set (==) new-items)

func pick : Item -> Adventure -> Adventure =
    \item \adv
    start-with adv;
    (current-place . items) <- remove item;
    inventory <- add item;
    return self

func use : Object -> Action -> Adventure -> Adventure =
    \object \action \adv
    start-with adv;
    inventory <- - items action;
    if-none (return self);
    let-some (outcome action) \outcome
    (current-place . objects) <- remove object;
    self <- outcome;
    return self

func combine : Combination -> Adventure -> Adventure =
    \combo \adv
    start-with adv;
    inventory <- - use-items combo;
    inventory <- + new-items combo;
    return self

func go-to : String -> Adventure -> Adventure =
    \new-place-name \adv
    start-with adv;
    current-place-name := new-place-name;
    return self

func special-words : Adventure -> List-Set String =
    \adv
    list-set (==);
    yield-all ["end", "inventory", "look", "pick"];
    for (values; inventory adv)
        (yield . name);
    for (values; items; current-place adv)
        (yield . name);
    for (values; objects; current-place adv)
        (yield . name);
    for (values; objects; current-place adv)
        (yield-all . map name . actions);
    for (map name; keys; directions; current-place adv)
        yield;
    empty

func play : Adventure -> IO =
    \adv
    println "Welcome to the adventure! Are you ready?";
    println "If not, type 'end' to quit the game.";
    println (description; decode-command adv; parse-words adv "look around");
    adv |> recur \loop \adv
    print "> ";
    scanln \input
    let (parse-words adv input) \words
    if (empty? words)
        (loop adv);
    if (words == list-set (==) ["end"])
        quit;
    let (decode-command adv words) \command
    println (description command);
    loop (change command adv)

record Command =
    description : String,
    change      : Adventure -> Adventure,

func parse-words : Adventure -> String -> List-Set String =
    \adv \input
    special-words adv & list-set (==) (split-no-empty whitespace? input)

func decode-command : Adventure -> List-Set String -> Command =
    \adv \words

    if (words == list-set (==) ["inventory"])
        (Command (show-inventory adv) self);

    if (words == list-set (==) ["look"])
        (Command (full-description; current-place adv) self);

    for (values; inventory adv) (
        \item \next
        if (words == list-set (==) ["look", name item])
            (Command (long-description item) self);
        next
    );

    for (values; items; current-place adv) (
        \item \next
        if (words == list-set (==) ["look", name item])
            (Command (long-description item) self);

        let (list-set (==) ["pick", name item]) \pick-words
        if (words == pick-words)
            (Command
                ("You picked " ++ name item ++ ".")
                (pick item));
        next
    );

    for (values; objects; current-place adv) (
        \object \next
        if (words == list-set (==) ["look", name object])
            (Command (long-description object) self);

        for (actions object) (
            \action \next
            let (map name; values; items action) \required-items
            let (list-set (==) (name object :: name action :: required-items)) \use-words
            if ((words == use-words) && (items action <= inventory adv))
                (Command
                    (description action)
                    (use object action));
            next
        );
        next
    );

    for-pair (entries; directions; current-place adv) (
        \dir \place-name \next
        let (list-set (==) [name dir]) \required-words
        if (words == required-words) (
            let (at place-name; places adv) \new-place
            Command
                (full-description new-place)
                (go-to place-name)
        );
        next
    );

    for (combinations adv) (
        \combo \next
        let (list-set (==) (map name; values; use-items combo)) \combo-words
        if ((words == combo-words) && (use-items combo <= inventory adv))
            (Command
                (description combo)
                (combine combo));
        next
    );

    Command "Can't do that." self