Making a Text Adventure in Haskell (Part 3)

Making a world with text

In this post, I’ll cover how the game world is structured, how it is described to the player, and how the player’s input becomes a set of commands to be evaluated by the game engine.

In a text adventure, everything you interact with is represented by text. When you enter a room, a description of everything in the room is printed to the command line. Every time you interact with the world, the response to your commands is printed to the command line.

In order to manage the interactions which can occur in the game, I had to make several new data types to represent the state of the game world:

type SceneIndex = Int
data Flags = Flags [String] deriving (Show, Eq)
data Inventory = Inventory [String] deriving (Show, Eq)

SceneIndex contains the index of the current scene in the narrative graph. When the player moves around the game world, the value of the scene index will change.

Inventory contains a list of items which the player character is currently carrying.

Flags contains keywords which represent parts of the current state of the game. For example, “opened door” will be in the Flags if the player has opened the door, but if the flag is absent, the door is in the closed state.

The description of the world and the options available to the player will conditionally depend on each of these three types of state. I’ll describe how these conditionals work later in this post.

More complex text adventures include other types of state, such as counters and locations, but for the purpose of this little adventure, I’m limiting the engine to use only these kinds of state.

The game loop

The current state of the game, represented by a tuple (SceneIndex, Inventory, Flags), is passed from one iteration of the game loop to another. The game loop is a recursively iterative function which parses the player’s input, prints the description of the current scene, and calls performInteraction function to update the state of the game.

All updates to the game world in a text adventure are the result of the player interacting with the game, so I don’t have to update the world until a command is entered.

Let’s take a look at the game loop. adventure is the entry point of the game, doAdventureLoop handles the various possible player inputs:

doAdventureLoop :: NarrativeGraph -> SceneIndex -> Inventory -> Flags -> Maybe [Sentence] -> IO (Maybe (SceneIndex, Inventory, Flags))
doAdventureLoop _ _ _ _ Nothing = return Nothing -- End state of the game
doAdventureLoop narrativeGraph sceneIndex inventory flags (Just []) = adventure narrativeGraph (Just (sceneIndex, inventory, flags)) --Failed to parse any sentences
doAdventureLoop narrativeGraph sceneIndex inventory flags (Just sentences) = performInteraction allDelimiters allColumnWidth narrativeGraph sceneIndex inventory flags sentences >>=
                                                                             adventure narrativeGraph --Perform the adventure loop

updateAdventure :: NarrativeGraph -> Maybe (SceneIndex, Inventory, Flags) -> IO (Maybe (SceneIndex, Inventory, Flags))
updateAdventure _ Nothing = return Nothing
updateAdventure narrativeGraph (Just (sceneIndex, inventory, flags))
    = putStr "\n" >>
      printInvalidInteractions narrativeGraph sceneIndex >>
      getLine >>=
      parseInput inventory flags >>=
      doAdventureLoop narrativeGraph sceneIndex inventory flags

adventure :: NarrativeGraph -> Maybe (SceneIndex, Inventory, Flags) -> IO (Maybe (SceneIndex, Inventory, Flags))
adventure _ Nothing = reflowPutStr allDelimiters allColumnWidth "Game over. Thanks for playing!" >> hFlush stdout >> return Nothing
adventure narrativeGraph (Just (sceneIndex, inventory, flags)) = printSceneDescription allDelimiters allColumnWidth narrativeGraph (Just (sceneIndex, inventory, flags)) >>=
                                                                 updateAdventure narrativeGraph

The important parts of this code are printSceneDescription, which prints the scene description to standard output, parseInput, which gets the player’s input sentences using the parser I described in my previous post, and performInteraction, which updates the game state using the player’s input.

The state of the game is taken as an input of the type Maybe (SceneIndex, Inventory, Flags) and is passed to the next iteration of the game loop by evaluating to the type IO (Maybe (SceneIndex, Inventory, Flags)). This indicates that adventure and doAdventureLoop perform IO actions and may evaluate to a type IO Nothing. IO Nothing indicates that the game is completed and that there is no next game state to transition to.

The reason that doAdventureLoop is split out of adventure is to simplify handling invalid player input and the “quit” player input.

The reason that updateAdventure is split out of adventure is that it is possible for printSceneDescription to update the game state and that will produce an IO (Maybe (SceneIndex, Inventory, Flags)), which is easier to handle by binding to a separate function.

When parseInput detects a “Quit” or “Exit” input from the player, it evaluates to Nothing. In a case where a Nothing is passed into the game loop as the result of parseInput, the entire loop just evaluates to Nothing and the game is over.

In the case where parseInput fails to generate any sentences from the player’s input, doAdventureLoop just repeats the adventure loop without updating the game state.

If the player entered a valid sentence, doAdventureLoop updates the state of the game by calling performInteraction with the current state of the game and the sentences which were matched from the player’s input.

The adventure loop is called by main as follows:

main = printIntro >>
       reflowPutStr allDelimiters allColumnWidth gameIntro >>
       putStr "\n" >>
       printHelp >>
       hFlush stdout >>
       adventure (makeNarrativeGraph adventureScenes endScenes defaultScene) (Just (0, startInventory, startFlags)) >>
       return ()
           where (adventureScenes, endScenes) = allScenes

printIntro just prints “Haskell Text Adventure Engine …”.

gameIntro, allScenes, defaultScene, startInventory, and startFlags are defined in the game module by the game designer using the text adventure domain specific language.

Describing the game world

The game world consists of a graph of Scenes called the NarrativeGraph:

--By definition the first node in the narrative graph is the starting scene of the game
data NarrativeGraph = NarrativeGraph {nodes :: Array SceneIndex Scene,
                                      endScenes :: [SceneIndex],
                                      graphDefaultScene :: Scene} deriving (Show, Eq)

The NarrativeGraph contains an array of Scenes, a list of end Scenes, and a default Scene. A NarrativeGraph is constructed with makeNarrativeGraph:

makeNarrativeGraph :: [Scene] -> [SceneIndex] -> Scene -> NarrativeGraph
makeNarrativeGraph scenes scenesEndScenes scene
   = NarrativeGraph {nodes = array (0, length scenes) (zip [0..length scenes] scenes),
                     endScenes = scenesEndScenes,
                     graphDefaultScene = scene}

array here is from the standard Data.Array module and is used to construct an immutable array from the list of Scenes. Arrays are indexed using the ! operator.

The player character always inhabits one of the Scenes in NarrativeGraph and they traverse edges of the graph (called Interactions) in order to move from one Scene to another. When they reach a scene marked in the endScenes list, the game is over. In addition to the current scene, all of the interactions in the graphDefaultScene are always available to the player. This enables the game designer to specify interactions which are the same across all scenes.

Let’s look at the definition of a Scene:

data Scene = Scene {sceneDescription :: ConditionalDescription,
                    interactions :: [Interaction]} deriving (Show, Eq)

Scenes contain a ConditionalDescription, which is printed when the player is inside the scene, and a list of Interactions which are valid in the scene.

Detecting the state of the game

In order to update the descriptions and interactions the player will encounter when the state of the game changes, it’s necessary to evaluate statements about the current state of the game. For example, we might want to print a specific description if the player has a key and a door is not opened.

In order to describe the current state of the game, the designer can use a NarrativeCondition:

data NarrativeCondition = InInventory String | --Inventory has an item
                          FlagSet String | --Flag is set
                          CTrue | --Always true
                          CFalse | --Always false
                          CNot NarrativeCondition |
                          COr NarrativeCondition NarrativeCondition |
                          CAnd NarrativeCondition NarrativeCondition deriving (Show, Eq)

It’s possible to build up a logical statement about the Flags and Inventory in the game by combining these statements.

For example, if we want to construct a NarrativeCondition that the player has a key in their inventory and the door is not opened, we can construct the following sentence:

(InInventory "key") CAnd (CNot (FlagSet "door opened"))

NarrativeConditions are evaluated by the evaluateCondition function:

evaluateCondition :: NarrativeCondition -> Inventory -> Flags -> Bool
evaluateCondition CTrue _ _ = True
evaluateCondition CFalse _ _ = False
evaluateCondition (FlagSet flag) _ (Flags flags) = flag `elem` flags
evaluateCondition (InInventory object) (Inventory inventory) _ = object `elem` inventory
evaluateCondition (CNot condition) inventory flags = not (evaluateCondition condition inventory flags)
evaluateCondition (COr condition0 condition1) inventory flags = (evaluateCondition condition0 inventory flags) || (evaluateCondition condition1 inventory flags)
evaluateCondition (CAnd condition0 condition1) inventory flags = (evaluateCondition condition0 inventory flags) && (evaluateCondition condition1 inventory flags)

evaluateCondition simply converts a narrative condition into a logical statement which can be evaluated by Haskell.

Conditional descriptions

In order to describe a scene correctly, the state of the game must be evaluated and text must be printed based on what scene the player is in, what they have in their inventory, and what flags are set. The ConditionalDescription type allows us to specify all of the possible descriptions of a Scene or Interaction.
ConditionalDescription contains a list of tuples with NarrativeConditions, description Strings, and a list of StateChanges:

data ConditionalDescription = ConditionalDescription [(NarrativeCondition, String, [StateChange])] deriving (Show, Eq)

The Strings are printed if and only if the NarrativeCondition is true. We’ll cover StateChange in my next post on updating the game world.

The function printConditionalDescription is responsible for evaluating the current state of the game and printing the strings in a ConditionalDescription based on the state:

printConditionalDescription :: [Char] -> Int -> [SceneIndex] -> ConditionalDescription -> [String] -> Maybe (SceneIndex, Inventory, Flags)

printConditionalDescription takes a list of delimiters and columnWidth for use with reflowPutStrs, the Inventory and Flags, a ConditionalDescription, the current state of the game, and the list of lines to print, which is passed through the from one iteration to the next. The printConditionalDescription evaluates to the next state of the game.

The first and third pattern of printConditionalDescription matches when the game is in an end state:

printConditionalDescription delimiters columnWidth _ (ConditionalDescription []) linesToPrint Nothing
   = reflowPutStrs delimiters columnWidth (reverse linesToPrint) >> putStr "\n" >> return Nothing --Game reached an end state
printConditionalDescription delimiters columnWidth _ (ConditionalDescription ((_, _, _) : remainingDescriptions)) linesToPrint Nothing
 = reflowPutStrs delimiters columnWidth (reverse linesToPrint) >> putStr "\n" >> return Nothing --Game reached an end state

The first and third patterns just print the lines to print and evaluate to Just Nothing as the next state of the game.

The second pattern of printConditionalDescription is the terminal pattern, where all conditions have been processed:

printConditionalDescription delimiters columnWidth _ (ConditionalDescription []) linesToPrint (Just (sceneIndex, inventory, flags))
    = reflowPutStrs delimiters columnWidth (reverse linesToPrint) >> putStr "\n" >> hFlush stdout >> return (Just (sceneIndex, inventory, flags)) --No more descriptions to print

In this case, all of the linesToPrint are printed to standard output. The list linesToPrint is reversed before being printed because it is accumulated using the : operator in reverse order.

The other pattern is matched when the list of tuples in the ConditionalDescription is not exhausted:

printConditionalDescription delimiters columnWidth endScenes
                            (ConditionalDescription ((condition, subDescription, stateChanges) : remainingDescriptions)) linesToPrint (Just (sceneIndex, inventory, flags))
    | evaluateCondition condition inventory flags =
          stateChange (Data.List.find (\x -> case x of
                                             (SceneChange _) -> True
                                             otherwise -> False) stateChanges)
                       stateChanges >>= --This conditional description passed all of the preconditions, check whether we need to transition to a new state
          printConditionalDescription delimiters columnWidth endScenes (ConditionalDescription remainingDescriptions) ((subDescription ++ " ") : linesToPrint) --Condition is true, add sub-description to print
    | otherwise
        = printConditionalDescription delimiters columnWidth endScenes (ConditionalDescription remainingDescriptions) linesToPrint (Just (sceneIndex, inventory, flags))

In this case, the NarrativeCondition is evaluated. If it’s true, the state of the game is updated based on the StateChanges in the ConditionalDescription and the subDescription is pushed onto the list of linesToPrint and the recursion continues, otherwise the subDescription is discarded and the recursion continues.

printConditionalDescription uses reflowPutStrs, which is described in my previous post Text Reflow in Haskell.

There is also a specific function to print a Scene‘s ConditionalDescription:

printSceneDescription :: [Char] -> Int -> NarrativeGraph -> Maybe (SceneIndex, Inventory, Flags) -> IO (Maybe (SceneIndex, Inventory, Flags))
printSceneDescription delimiters columnWidth (NarrativeGraph {nodes = graphNodes, endScenes = graphEndScenes}) Nothing
    = return Nothing
printSceneDescription delimiters columnWidth (NarrativeGraph {nodes = graphNodes, endScenes = graphEndScenes}) (Just (sceneIndex, inventory, flags))
    = printConditionalDescription delimiters columnWidth graphEndScenes thisSceneDescription [] (Just (sceneIndex, inventory, flags))
        where Scene {sceneDescription = thisSceneDescription,
                     interactions = _} = graphNodes ! sceneIndex

This function extracts the Scene from the NarrativeGraph and calls printConditionalDescription on its description.

Filtering interactions with the world

All player interaction with the world happens through performInteraction:

performInteraction :: [Char] -> Int -> NarrativeGraph -> SceneIndex -> Inventory -> Flags -> [Sentence] -> IO (Maybe (SceneIndex, Inventory, Flags))

performInteraction takes a set of delimiters and columnWidth for use with reflowPutStrs, the NarrativeGraph, current scene index, Inventory, Flags, and the list of strings parsed by the NaturalLanguageParser. The function evaluates to IO Just the next state of the game or IO Nothing if the game is over.

The function’s first pattern matches when the player enters no valid sentences at all:

performInteraction _ _ narrativeGraph sceneIndex inventory flags []
    = putStrLn "Please enter a command." >>
      hFlush stdout >>
      return (Just (sceneIndex, inventory, flags)) --If there are no valid sentences, just continue.

In this case, a message is printed and the game loop continues without being changed.

The function’s second pattern is matched when the player enters one or more valid sentences:

performInteraction delimiters columnWidth narrativeGraph@(NarrativeGraph {nodes = graphNodes, endScenes = graphEndScenes, graphDefaultScene = thisDefaultScene}) sceneIndex inventory flags sentences
    = hFlush stdout >>
      filterInteraction delimiters columnWidth currentScene thisDefaultScene sceneIndex graphEndScenes inventory flags sentences
          where currentScene = graphNodes ! sceneIndex

filterInteraction is called with the current state of the game as an input. ! here is the array indexing operator to get the Scene indexed by sceneIndex out of the array graphNodes.

Invalid player interactions are filtered out in filterInteraction:

filterInteraction :: [Char] -> Int -> Scene -> Scene -> SceneIndex -> [SceneIndex] -> Inventory -> Flags -> [Sentence] -> IO (Maybe (SceneIndex, Inventory, Flags))

filterInteraction takes a set of delimiters and columnWidth for use with reflowPutStrs, the current Scene and default Scene, the current scene index and the list of end scenes, the Inventory and Flags, and a list of Sentences the player entered.

filterInteraction delimiters
                  (Scene {sceneDescription = _,
                          interactions = thisSceneInteractions})
                  (Scene {sceneDescription = _,
                          interactions = defaultSceneInteractions})
    = performConditionalActions delimiters columnWidth currentScene endScenes inventory flags interaction defaultInteraction
        where interaction = findInteraction thisSceneInteractions sentences
              defaultInteraction = findInteraction defaultSceneInteractions sentences

The interactions are extracted out of the current and default Scenes and valid Interactions are found by calling findInteraction first on the current Scene then on the default Scene. If no valid Interactions are found, interaction and defaultInteraction will be Nothing, otherwise they will contain Just the interaction which matched the Sentence.

Next, the conditional actions are performed based on the valid interactions in the performConditionalActions function, which will be described in my next post.

findInteraction finds one valid Maybe Interaction from the list of potential Interactions.

findInteraction :: [Interaction] -> [Sentence] -> Maybe Interaction
findInteraction interactions sentences = (find matchInteraction ((\x -> (\y -> (x, y))) <$> interactions <*> sentences)) >>=
                                         (\(x, y) -> Just x)

There are several higher-order operations here, so let’s walk through them one by one.

Firstly, I used find, which is from the Data.List package. find takes a function of type (a -> Bool) and a list of type a as input. It evaluates to the first element in the list where the function (a -> Bool) evaluates to True when applied to that element.

find is called on the following list:

 (\x -> (\y -> (x, y))) <$> interactions <*> sentences

We have seen this syntax before in my previous post Making a Text Adventure in Haskell (Part 2). In this case I’m using the Applicative type class operations to create a list of tuples, where the tuples contain each combination of elements in the lists interactions and sentences.

Instead of using the <$> and <*> apply functions with the : operator, I’m using them with a lambda.

In this case, the lambda function (\x -> (\y -> (x, y)) is applied to every element in interactions. Let’s evaluate this using an example list step-by-step:

(\x -> (\y -> (x, y))) <$> interactions <*> sentences

(\x -> (\y -> (x, y))) <$> [interaction0, interaction1] <*> sentences

[(\x -> (\y -> (x, y))) interaction0,
 (\x -> (\y -> (x, y))) interaction1] <*> sentences

[(\y -> (interaction0, y)),
 (\y -> (interaction1, y))] <*> sentence

So now we have a list of lambda functions of the type (\y -> (interactionX, y)).

This is applied using <*> to the list sentences to form a list of tuples of each combination of interactions and sentences:

[(\y -> (interaction0, y)),
 (\y -> (interaction1, y))] <*> sentence

[(\y -> (interaction0, y)),
 (\y -> (interaction1, y))] <*> [sentence0, sentence1]

[(\y -> (interaction0, y)) sentence0,
 (\y -> (interaction0, y)) sentence1,
 (\y -> (interaction1, y)) sentence0,
 (\y -> (interaction1, y)) sentence1]

[(interaction0, sentence0),
 (interaction0, sentence1),
 (interaction1, sentence0),
 (interaction1, sentence1)]

Now that we have a list of all (interactionX, sentenceY) combinations, the matchInteraction function is used with find on this list to find a sentence which matches an Interaction in the tuple list.

Let’s look at matchInteraction:

matchInteraction :: (Interaction, Sentence) -> Bool
matchInteraction ((Interaction {sentences = thisSentences}), sentence)
 | sentence `elem` thisSentences = True
 | otherwise = False

matchInteraction checks if the Sentence is an element of the list of thisSentences in the Interaction.

Finally, the findInteraction function is supposed to return a Maybe Interaction, but the find function here returns a Maybe (Interaction, Sentence). In order to get a Maybe Interaction, I bind the output of find to a lambda which extracts the Interaction from the tuple and wraps it in a Maybe.

Here’s what the lambda looks like:

\(x, y) -> Just x

That’s all there is to filtering valid Interactions from the player’s input based on the game state.

Next time we’ll cover how valid player interactions are processed by the game engine in the performConditionalActions function.

The code for the text adventure is available at

Continue reading Making a Text Adventure in Haskell (Part 4).


Making a Text Adventure in Haskell (Part 2)

Consuming Tokens

Last time in Making a Text Adventure in Haskell (Part 1) I explained how to generate a list of tokens from a sentence by extracting important words that we’re interested in using look-ahead. This time, I’ll cover how I made sense of sentences by consuming the list of tokens which the lexer produced.

Pattern Matching Sentences

Most parsers are based on a data structure called an Abstract Syntax Tree (AST). In the case of this text adventure, the grammar that I decided on is so simple that I don’t even need to build one. I can simply pattern match the kinds of sentences that I want to accept. Although this is somewhat limiting, it can handle most of the kinds of sentences that a player will use to interact with the game.
Here’s the data structure I used to store sentences:

data Sentence = Phrase Token |
                SimpleSentence Token Token |
                SimplePrepositionSentence Token Token Token |
                ComplexSentence Token Token Token Token |
                ComplexPrepositionSentence Token Token Token Token Token deriving (Show, Eq)

As you can see, there are five kinds of sentences I want to support. Let’s look at the parsing function and then we’ll drill down to how each type of sentence is created.

Here is the parseSentence function, which takes the TokenMatch list as an input and evaluates to list of Sentences:

parseSentence :: [TokenMatch] -> [Sentence]
parseSentence [(TokenMatch _ t0), (TokenMatch _ t1), (TokenMatch _ t2), (TokenMatch _ t3), (TokenMatch _ t4)]
    = makeSentence [(verbsInTokenList t0),
                    (prepositionsInTokenList t1),
                    (nounsInTokenList t2),
                    (prepositionsInTokenList t3),
                    (nounsInTokenList t4)]
parseSentence [(TokenMatch _ t0), (TokenMatch _ t1), (TokenMatch _ t2), (TokenMatch _ t3)]
    = makeSentence [(verbsInTokenList t0),
                    (nounsInTokenList t1),
                    (prepositionsInTokenList t2),
                    (nounsInTokenList t3)]
parseSentence [(TokenMatch _ t0), (TokenMatch _ t1), (TokenMatch _ t2)]
    = makeSentence [(verbsInTokenList t0),
                    (prepositionsInTokenList t1),
                    (nounsInTokenList t2)]
parseSentence [(TokenMatch _ t0), (TokenMatch _ t1)]
    = makeSentence [(verbsInTokenList t0),
                    (nounsInTokenList t1)]
parseSentence [(TokenMatch _ t0)]
    = makeSentence [(verbsInTokenList t0)]
parseSentence _ = []

The parseSentence function is arranged to match the more complex sentence structures first and pattern matching proceeds down to simpler sentences. Let’s look at the second last non-empty case, which parses the simplest type of sentence:

parseSentence [(TokenMatch _ t0), (TokenMatch _ t1)]
    = makeSentence [(verbsInTokenList t0),
                    (nounsInTokenList t1)]

The pattern takes a list containing exactly two TokenMatches and evaluates to a list of SimpleSentence. Remember that t0 and t1 here are lists of Tokens. Since I assume that the subject of the sentence is always the player, the only things we need to match for a simple sentence are the verb and object, which are found using (verbsInTokenList t0) and (nounsInTokenList t1). verbsInTokenList and nounsInTokenList can match multiple tokens, so they also return lists of Token. These are then passed into makeSentence which builds the list of SimpleSentence.
All other parseSentence patterns are structured in the same way.

Let’s look at verbsInTokenList which tries to find a list of verbs in the Token list:

verbsInTokenList :: [Token] -> [Token]
verbsInTokenList [] = []
verbsInTokenList ((TokenVerb synonyms) : ts) = (TokenVerb synonyms) : verbsInTokenList ts
verbsInTokenList (_ : ts) = verbsInTokenList ts

verbsInTokenList takes a list of Tokens and evaluates to a list of Tokens. 

The function recursively processes the list and when it pattern matches a TokenVerb, it evaluates to (TokenVerb synonyms) and continues the recursion to search for more verbs to add to the list. It ignores any other token type.

verbsInTokenList outputs a list because multiple verbs may match the word in the string.

nounsInTokenList and prepositionsInTokenList work the same way.

So we have a list of verbs and a list of nouns. These are then passed to makeSentence:

makeSentence :: [[Token]] -> [Sentence]
makeSentence []
    = []
makeSentence [verbs]
    = fmap (\verb -> Phrase verb) verbs
makeSentence [verbs, nouns]
    = fmap (\[verb, noun] -> SimpleSentence verb noun) 
      ((:) <$> verbs <*>
           ((:) <$> nouns <*> [[]]))
makeSentence [verbs, prepositions, nouns]
    = fmap (\[verb, preposition, noun] -> SimplePrepositionSentence verb preposition noun)
      ((:) <$> verbs <*>
          ((:) <$> prepositions <*>
              ((:) <$> nouns <*> [[]])))
makeSentence [verbs, nouns0, prepositions, nouns1]
    = fmap (\[verb, noun0, preposition, noun1] -> ComplexSentence verb noun0 preposition noun1)
      ((:) <$> verbs <*>
          ((:) <$> nouns0 <*>
              ((:) <$> prepositions <*>
                  ((:) <$> nouns1 <*> [[]]))))
makeSentence [verbs, prepositions0, nouns0, prepositions1, nouns1]
    = fmap (\[verb, preposition0, noun0, preposition1, noun1] -> ComplexPrepositionSentence verb preposition0 noun0 preposition1 noun1)
      ((:) <$> verbs <*>
          ((:) <$> prepositions0 <*>
              ((:) <$> nouns0 <*>
                  ((:) <$> prepositions1 <*>
                      ((:) <$> nouns1 <*> [[]])))))

This is the most complicated function we’ve seen so far, so let’s work from the most simple pattern to the more complex patterns.

First note that makeSentence takes a list of lists of Tokens and evaluates to a list of Sentences. This is because multiple combinations of nouns, verbs, and prepositions may be valid matches for the sentence.

For example, the sentence “I look over the edge” matches the following tokens:

(TokenVerb ["look"]) (TokenPreposition ["over", "across"]) (TokenNoun ["edge"])

but it also matches the following tokens:

(TokenVerb ["look"]) (TokenPreposition ["above", "over"]) (TokenNoun ["edge"])

The difference here is subtle, but in the first match, “over” is used in the sense of “expressing passage or trajectory across”, whereas in the second match, “over” is used in the sense of “extending directly upward from” and is a synonym for “above”.
Both matches are valid for the purpose of parsing; these two meanings are syntactically identical, even though they have different semantic meanings.

All combinations of Tokens which match the syntax are valid at this stage of parsing.

We’ll discuss how to deal with this combinatorial explosion of Tokens in Haskell soon, but let’s look at the first non-empty makeSentence first:

makeSentence [verbs] = fmap (\verb -> Phrase verb) verbs

fmap is the generic map function and it takes two parameters, the first of which is a function and the second of which is a Functor. A Functor is just something which can be mapped over. (Put another way, a Functor is something which you can call fmap on).

It turns out that lists are Functors. When you call fmap on a list, it returns another list whose elements are the result of applying the function to each element of the input list. Let’s look at what might happen if we applied makeSentence to this list of verbs:

[(TokenVerb ["pass out", "faint"]), (TokenVerb ["pass out", "distribute"])]

Notice that both TokenVerbs are a valid match for the phrasal verb “pass out”.

fmap (\verb -> Phrase verb) [(TokenVerb ["pass out", "faint"]), (TokenVerb ["pass out", "distribute"])]

This would be converted into:

[(\verb -> Phrase verb) (TokenVerb ["pass out", "faint"]),
 (\verb -> Phrase verb) (TokenVerb ["pass out", "distribute"])]

After applying the lambdas, this would be:

[Phrase (TokenVerb ["pass out", "faint"]), Phrase (TokenVerb ["pass out", "distribute"])]

which is the list of sentences we want.

Now let’s consider the next pattern in makeSentence:

makeSentence [verbs, nouns]
    = fmap (\[verb, noun] -> SimpleSentence verb noun) 
      ((:) <$> verbs <*> ((:) <$> nouns <*> [[]]))

There is some unusual syntax involving the (:) list concatenation operator, <$>, and <*>. This syntax is related to a type class called Applicative, which represents a category of types called applicative functors. We’ll go into this in more detail in my Haskell tutorial later, but for now, let’s look at how this syntax helps us compute sentences.
First, let’s look at the lambda in this pattern of makeSentence and see what’s different about it:

(\[verb, noun] -> SimpleSentence verb noun)

Notice that the lambda takes a list as input, instead of a single value as it did in the Phrase pattern of makeSentence.

Neither the list verbs nor the list nouns contain lists of Tokens as elements (they both have the type [Token]). Also, fmap only takes one list as an input, not two. From these two facts,  you can infer from this that I’ve taken the two constants, verbs and nouns, of the type [Token] and combined them into a single constant of the type [[Token]]; where each element in the single constant is a list with two elements, the verb followed by the noun.

The expression which performs this combination is:

((:) <$> verbs <*> ((:) <$> nouns <*> [[]]))

<$> and <*> are sometimes called “apply”. To understand this, let’s look at the inner-most nested sub-expression:

(:) <$> nouns <*> [[]]

This code takes each combination of elements in the first list, noun, and combines it with each combination of elements in of the second list, [[]], using the operator (:).

Let’s look at a worked example of <$> and <*> using two lists of Ints:

(+) <$> [1, 2] <*> [3, 4]

This evaluates to:

[(+) 1, (+) 2] <*> [3, 4]

Notice that (+) has been distributed to each element in [1, 2]. By evaluating <$>, we have applied (+) to each element of [1, 2]. In general, <$> applies something which is not Applicative to something which is Applicative.

Let’s continue evaluating:

[(+) 1 3, (+) 1 4, (+) 2 3, (+) 2 4]
    == [1 + 3, 1 + 4, 2 + 3, 2 + 4]

Now we’ve distributed all of the elements in [(+) 1, (+) 2] into all elements of [3, 4] with all possible combinations. By evaluating <*>, we have applied each element of [(+) 1, (+) 2] to each element of [3, 4]. In general, <*> applies something which is Applicative to something else which is Applicative.

Another way of looking at this is that the resulting list contains all possible results of combining each element in the first list with each element in the second list.

We can use this Applicative list behavior to create the list of lists of all possible combinations of verbs and nouns!

Let’s go back to the previous expression:

(:) <$> nouns <*> [[]]

This joins each noun with the [] empty list using the (:) operator.

It’s impossible for two nouns to match a single word in the game, but for the sake of creating an example, let’s suppose we had two nouns, “tree” and “cat”, in the list:

(:) <$> [TokenNoun "tree", TokenNoun "cat"] <*> [[]]

[(:) (TokenNoun "tree"), (:) (TokenNoun "cat")] <*> [[]]

[(:) (TokenNoun "tree") [], (:) (TokenNoun "cat") []]

[(TokenNoun "tree") : [], (TokenNoun "cat") : []]

[[TokenNoun "tree"], [TokenNoun "cat"]]

Now we have a list of lists of Tokens, but there is still only a noun in the sub-list. We need to add the verbs in to the sub-lists and we’ll use the Applicative list behavior to do so.

Let’s continue our example using the two “pass out” verbs we defined previously:

(:) <$> verbs <*> ((:) <$> nouns <*> [[]])

(:) <$> verbs <*> [[TokenNoun "tree"], [TokenNoun "cat"]]

(:) <$> [TokenVerb ["pass out", "faint"], TokenVerb ["pass out", "distribute"]] <*> [[TokenNoun "tree"], [TokenNoun "cat"]]

[(:) (TokenVerb ["pass out", "faint"]), (:) (TokenVerb ["pass out", "distribute"])] <*> [[TokenNoun "tree"], [TokenNoun "cat"]]

[(:) (TokenVerb ["pass out", "faint"]) [TokenNoun "tree"],
 (:) (TokenVerb ["pass out", "faint"]) [TokenNoun "cat"],
 (:) (TokenVerb ["pass out", "distribute"]) [TokenNoun "tree"],
 (:) (TokenVerb ["pass out", "distribute"]) [TokenNoun "cat"]]

[(TokenVerb ["pass out", "faint"]) : [TokenNoun "tree"],
 (TokenVerb ["pass out", "faint"]) : [TokenNoun "cat"],
 (TokenVerb ["pass out", "distribute"]) : [TokenNoun "tree"],
 (TokenVerb ["pass out", "distribute"]) : [TokenNoun "cat"]]

[[TokenVerb ["pass out", "faint"], TokenNoun "tree"],
 [TokenVerb ["pass out", "faint"], TokenNoun "cat"],
 [TokenVerb ["pass out", "distribute"], TokenNoun "tree"],
 [TokenVerb ["pass out", "distribute"], TokenNoun "cat"]]

The result has type [[Token]], which exactly what the fmap function takes as an input!

In effect, the list Applicative operations enable you to work with combinatorial operations using a very small amount of code. This takes some getting used to; but once you wrap your head around the concept, you can perform a lot of work with a few lines of Haskell.

Let’s look at what happens when you apply the fmap to this:

fmap (\[verb, noun] -> SimpleSentence verb noun) ((:) <$> verbs <*> ((:) <$> nouns <*> [[]]))

fmap (\[verb, noun] -> SimpleSentence verb noun)
    [TokenVerb ["pass out", "faint"], TokenNoun "tree"],
    [TokenVerb ["pass out", "faint"], TokenNoun "cat"],
    [TokenVerb ["pass out", "distribute"], TokenNoun "tree"],
    [TokenVerb ["pass out", "distribute"], TokenNoun "cat"]]

[(\[verb, noun] -> SimpleSentence verb noun) [TokenVerb ["pass out", "faint"], TokenNoun "tree"],
 (\[verb, noun] -> SimpleSentence verb noun) [TokenVerb ["pass out", "faint"], TokenNoun "cat"],
 (\[verb, noun] -> SimpleSentence verb noun) [TokenVerb ["pass out", "distribute"], TokenNoun "tree"],
 (\[verb, noun] -> SimpleSentence verb noun) [TokenVerb ["pass out", "distribute"], TokenNoun "cat"]]

[SimpleSentence (TokenVerb ["pass out", "faint"]) (TokenNoun "tree"),
 SimpleSentence (TokenVerb ["pass out", "faint"]) (TokenNoun "cat"),
 SimpleSentence (TokenVerb ["pass out", "distribute"]) (TokenNoun "tree"),
 SimpleSentence (TokenVerb ["pass out", "distribute"]) (TokenNoun "cat")]

The other makeSentence functions work using the same principle.

Once the sentence has been parsed it’s returned to the text adventure, where it will be fed into a narrative graph, allowing the user to interact with the world. We’ll cover the narrative graph in my next blog post, so stay tuned!

The code for the text adventure is available at

Continue reading: Making a Text Adventure in Haskell (Part 3).

Making a Text Adventure in Haskell (Part 1)

Interactive Fiction

I decided to make a text adventure from scratch for my second Haskell project. Text adventures, which are one kind of interactive fiction, are games which are played entirely on a command-line terminal and are require only standard I/O.

I chose to build a text adventure because it only has a minimal dependency on I/O operations and also because they involve some interesting symbolic computations. This means that if you’ve read up to Modeling Generalized Behaviors and Imprisoning Side Effects in my tutorial series on Haskell, you should be able to understand almost all of the code for this project.

In order to interact with the game, the player inputs sentences in a natural language, which means that you need to write a simple parser to make one.

A Natural Language Lexer

The first step in writing a simple natural language parser is to perform lexical analysis on the sentence which the user enters each time they want to interact with the game. A lexical analyzer (lexer), considers each word in a sentence and outputs a token representing the role of the word in the sentence. For example, “walk” would be tokenized as a verb and “cake” would be tokenized as a noun. This is made more difficult by the fact that some words in English are lexically ambigous, for example “pick” may be either a verb or a noun. Furthermore, some tokens need to contain more than one word, for example “pick” and “pick up” are two different verbs.

I want to support two types of English language sentences, simple sentences and complex sentences. In order to represent the important parts of speech that I want to parse, I created several tokens:

data Token = TokenVerb [String] |
             TokenNoun String |
             TokenPreposition [String] deriving (Show, Eq)

With these tokens, it should be possible to create a semantic parser (which we’ll cover in my next post) to recognize both simple and complex English language sentences.

As you can see, TokenVerb and TokenPreposition have a list of Strings. This is because some verbs and prepositions have synonyms that I want to support. For example, “close” and “shut” both represent closing something. I want to support synonyms because any synonyms which aren’t supported in the vocabulary will result in a parse error and a message like “I don’t understand what you’re trying to say” being printed to the console, which will be very frustrating for the player.

I also define a type which stores which tokens match to a string to handle ambiguities where multiple tokens match to a single word:

data TokenMatch = TokenMatch String [Token] deriving (Show, Eq)

You can join two TokenMatches using the operator `join`:

join :: Maybe TokenMatch -> Maybe TokenMatch -> Maybe TokenMatch
join Nothing Nothing = Nothing
join (Just a) Nothing = Just a
join Nothing (Just b) = Just b
join (Just (TokenMatch wordA tokensA)) (Just (TokenMatch wordB tokensB))
    | wordA == wordB = Just (TokenMatch wordA (tokensA ++ tokensB))
    | otherwise = Nothing

`join` takes two TokenMatches with the Maybe typeclass and returns a TokenMatch with the Maybe typeclass.

The Maybe typeclass allows you to represent when an evaluation may have failed. In the case of failure, it has a value constructor Nothing and in the case of success, the Maybe typeclass has a value constructor Just followed by the value constructor of its type parameter. For more details about typeclasses, read my post on Modeling Generalized Behaviors and Imprisoning Side Effects.

Maybe is defined as:

data Maybe a = Nothing | Just a deriving (Eq, Ord)

For example, Nothing is a Maybe Int and Just 5 is also a Maybe Int.

`join` handles the cases where either token match failed. If both inputs matched and the words are the same, then it concatenates the matched tokens.

The top level function used in the lexer is lexInput:

lexInput :: [Token] -> [String] -> [TokenMatch]
lexInput potentialTokens [] = []
lexInput potentialTokens (word1 : word2 : words) =
    lexTokens potentialTokens (word2 : words) [(foldl (\acc token -> (tokenize (word1 ++ ' ' : word2) token) `join` acc) Nothing potentialTokens, words), --Prioritize look-ahead by putting the look-ahead option first
                               (foldl (\acc token -> (tokenize word1 token) `join` acc) Nothing potentialTokens, word2 : words)]
lexInput potentialTokens (word : words) =
    lexTokens potentialTokens words [(foldl (\acc token -> (tokenize word token) `join` acc) Nothing potentialTokens, words)]

foldl runs the lambda on every token in potentialTokens, accumulating the result into acc, which is initialized with Nothing. The lambda attempts to tokenize the word, and evaluates to a Maybe TokenMatch. The Maybe TokenMatch is joined onto the accumulator Maybe TokenMatch so that at the end we have a Maybe TokenMatch with every token that matched the word inside it.

This function takes the sentence typed by the player as an input and returns a list of tokens matched in the order they appear in the sentence. I’m not going to match every word to a token, because words like “the” or even “want” are not useful for controlling the text adventure I’m going to write. For example, “I want to go to the house” will only match “go” and “house” in this simple lexer.

The lexer recursively processes each word in order. There are two non-terminal cases, first, the lexer will attempt to try looking ahead one word, if there is more than one word to process. Otherwise it will not use look-ahead. None of the tokens will require more than one word of look-ahead.

In the look-ahead case, the function creates a list of two Maybe TokenMatches. The first Maybe TokenMatch is the result of calling tokenize on the next two words in the line, and the second is the result of calling tokenize on only the next word in the line. This is how look-ahead is implemented in the lexer, if the look-ahead matches, the single word case is ignored.

The reason I pass a tuple containing both a Maybe TokenMatch and a list of remaining strings is because if there is a look-ahead match, I want to pop off both of the matched words. If there is no look-ahead match, or no match at all, I only want to pop off one word.

We’ll look at tokenize soon, but first let’s look at lexTokens:

lexTokens :: [Token] -> [String] -> [(Maybe TokenMatch, [String])] -> [TokenMatch]
lexTokens potentialTokens words [] = lexInput potentialTokens words
lexTokens potentialTokens words ((Nothing, _) : tokens) = lexTokens potentialTokens words tokens
lexTokens potentialTokens words ((Just token, tokenWords) : tokens) = token : lexInput potentialTokens tokenWords

As you can see, lexTokens and lexInput are mutually recursive. lexTokens takes the string of words remaining to be parsed and a list of (Maybe TokenMatch, [String]) tuples. If a particular token doesn’t match the current word, then the algorithm proceeds on to the next token. If there is a token match, then the token is added to the list of lexed tokens and lexInput is then called recursively.

When there is a match in lexTokens, the remaining tokens in the token list are discarded; so if there is a look-ahead match, the evaluation proceeds without processing the single word match at all.

lexInput and lexTokens recursively produce the token list.

Now let’s look at tokenize:

tokenize :: String -> Token -> Maybe TokenMatch
tokenize "" _  = Nothing --Empty string can't match tokens
tokenize word token@(TokenVerb synonyms)
    | lowerCaseWord `elem` synonyms = Just (TokenMatch word [token])
    | otherwise = Nothing
        where lowerCaseWord = (Data.Char.toLower (head word)) : (tail word)
tokenize word token@(TokenNoun name)
    | word == name = Just (TokenMatch word [token])
    | lowerCaseWord == name = Just (TokenMatch word [token])
    | otherwise = Nothing
        where lowerCaseWord = (Data.Char.toLower (head word)) : (tail word)
tokenize word token@(TokenPreposition synonyms)
    | lowerCaseWord `elem` synonyms = Just (TokenMatch word [token])
    | otherwise = Nothing
        where lowerCaseWord = (Data.Char.toLower (head word)) : (tail word)

The token@ in front of the Tokens defines an alias for each token.

tokenize takes a word and a token and produces a Maybe TokenMatch.

tokenize has one case each for verbs, nouns and prepositions. In each of these cases, I use Data.Char.toLower on the first character of the word to ensure that the tokenizer can match words which are capitalized.

In the case of verb and preposition, I use the `elem` operator to check whether the word is in the synonym list for the token. If it is, I return a Just TokenMatch, otherwise I return Nothing.

In the case of nouns, tokenize first attempts to match the word without reducing it to lower case to match proper nouns. There are no synonyms for nouns, so matching only requires an == check.

All lexer functionality is in NaturalLanguageLexer.hs.

The full list of current tokens is in the DummyAdventure.hs file, but that will change based on the requirements of the story as I add it to the game.

The game executable code, which includes all I/O functionality and the main function is in TextAdventure.hs.

Up to this point, I’ve shown how to make a simple natural language lexer. When the user enters a sentence in the current version of this application, it just prints out the tokens which were matched in the sentence.

I don’t match the subject of the sentence because that’s always going to be the user. Also, ambiguous matches return multiple tokens.

Here’s an example of what happens when you use the current version of the text adventure:

$ ./text_adventure.exe
Help - Print help text
Nouns - Print all available nouns
Verbs - Print all available verbs
Prepositions - Print all available prepositions
Quit - Exit the game
I want to go eat with Steve
== Verb go
== Verb eat
== Preposition with
== Noun Steve
Thanks for playing!

Next time, I’ll be adding a parser to understand what kind of sentence the player has entered and a semantic analyzer to tie objects, events and actions in the game world to sentences.

The code for the text adventure is available at

Continue reading Making a Text Adventure in Haskell (Part 2).


The Maybe monad: