Taking a Shortcut!

In the last couple weeks we focused on code improvements and peripheral features. We added parameters and enabled saving and loading. This week we're going back into the meat of the game to add a new feature. We want to give our player another option for navigating the maze faster. We'll add some "drill" power-ups throughout the map. These will allow our player to "drill" through a wall, permanently removing that wall from our grid. Then we can take shortcuts through the maze!

This article will once again emphasize using a methodical process. We'll add the feature step-by-step. We'll include specific commit links for each of the process, so you can follow along. You'll want to be on the part-10 branch of our Github repository. As reminder, here's our development approach with this game:

1. Determine what extra data we need in our World and related types. Initialize these with reasonable values.
2. Implement the core logic. This means determining how the new data affects either player inputs or the passage of game time. This means changing our update function and/or our input handler.
3. Update the drawing function. Determine what Pictures we can make to represent the new data.

Steps 1 and 3 will involve modifying our parameter types and changing JSON instances. We won't emphasize these changes in the article because they're boilerplate code. But it's good to be aware of that! Check out the commits if you're confused about how to update the instances!

For some more ideas on building full-fleged Haskell applications, download our Production Checklist!

Modifying Data

We'll first concern ourselves with the status of the player's drilling ability. We'll add power-ups to the map later. What information do we need to have? First, the Player type needs a field for drillsRemaining.

data Player = Player
  { …
  , playerDrillsRemaining :: Word
  }

We'll also need to select an initial value for this. We'll put this in our game parameters.

data PlayerGameParameters = PlayerGameParameters
  { …
  , initialDrills :: Word
  }

Now when we initialize the player, we'll use that parameter:

newPlayer :: PlayerGameParameters -> Player
newPlayer params = Player (0, 0) 0
  (initialStunTimer params) (initialDrills params)

In this step we also need to update our JSON instances, and add to the game's default parameters.

Our drilling action will also change the maze itself. To make this easier, let's add the adjacent location to our Wall constructor:

data BoundaryType =
  WorldBoundary |
  Wall Location |
  AdjacentCell Location
  deriving (Show, Eq)

The resulting changes aren't too complicated. In pretty much all cases of initialization, we already have access to the proper location.

You can explore these changes more by perusing the first two commits on this branch. The first is for the player data, the second is for the adjacent walls.

Activating the Drill

Now let's implement the logic for actually breaking down these walls! We'll break down walls in response to key commands. So the main part of our logic goes in the input handler. But first, a few helpers will be very useful. For best code reuse, we're going to make some functions that mutate cell boundaries. Each one will remove a wall in the specified direction. Here's an example removing the wall in the "up" direction:

breakUpWall :: CellBoundaries -> CellBoundaries
breakUpWall cb = case upBoundary cb of
  (Wall adjacentLoc) -> cb {upBoundary = AdjacentCell adjacentLoc}
  _ -> error "Can't break wall"

Notice how the extra location information makes it easy to create the AdjacentCell! We want to throw an error because we shouldn't invoke this function if it's not a wall in that direction. We'll want comparable functions for the other three directions.

We also want a mutator function on the player. This reduces the number of drills remaining:

activatePlayerDrill :: Player -> Player
activatePlayerDrill pl = pl
  { playerDrillsRemaining = decrementIfPositive (playerDrillsRemaining pl)}

Now we can create a function drillLocation. This function will fall under our input handler. This way, we don't have to pass all the world state information as parameters.

where
    worldBounds = worldBoundaries w
    currentPlayer = worldPlayer w
    currentLocation = playerLocation currentPlayer
    cellBounds = worldBounds Array.! currentLocation

    drillLocation = ...

The function will take two of the mutator functions for breaking walls. The first will allow us to break the wall from the current cell. The second will allow us to break the wall from the adjacent cell. It will also take a function giving us the cell boundaries in a particular direction. Finally, it will take the World as a parameter. We could access the existing w value if we wanted. But doing it this way could allow us to chain multiple World mutation functions in the future.

drillLocation
      :: (CellBoundaries -> BoundaryType)
      -> (CellBoundaries -> CellBoundaries)
      -> (CellBoundaries -> CellBoundaries)
      -> World
      -> World
    drillLocation boundaryFunc breakFunc1 breakFunc2 w = ...

We first need to determine if we can drill in this state. Our player must have a drill remaining, and there must be a wall in the given direction. If these conditions aren't met, we return our original World parameter.

drillLocation boundaryFunc breakFunc1 breakFunc2 w =
  case (drillLeft, boundaryFunc cellBounds) of
    (True, Wall location2) -> …
    _ -> w
  where
    drillLeft = playerDrillsRemaining currentPlayer > 0

Now we'll create our "new" player with the activateDrill function from above. And we'll use the input functions to get our new cell boundaries. We'll update our maze, and then return the new world!

drillLocation boundaryFunc breakFunc1 breakFunc2 w =
  case (drillLeft, boundaryFunc cellBounds) of
    (True, Wall location2) ->
      let newPlayer = activatePlayerDrill currentPlayer
          newBounds1 = breakFunc1 cellBounds
          newBounds2 = breakFunc2 (worldBounds Array.! location2)
          newMaze = worldBounds Array.//
            [(currentLocation, newBounds1), (location2, newBounds2)]
      in  w { worldPlayer = newPlayer, worldBoundaries = newMaze }
    _ -> w
  where
    drillLeft = playerDrillsRemaining currentPlayer > 0

Last of all, we have to make key inputs for this handler. We'll use the "alt" key in conjunction with a direction to signify that we should drill. We use the Modifiers constructor to signal such a combination. Here's that little snippet:

inputHandler event w
  ...
  | otherwise = case event of
      (EventKey (SpecialKey KeyUp) Down (Modifiers _ _ Down) _) ->
        drillLocation upBoundary breakUpWall breakDownWall w
      (EventKey (SpecialKey KeyDown) Down (Modifiers _ _ Down) _) ->
        drillLocation downBoundary breakDownWall breakUpWall w
      (EventKey (SpecialKey KeyRight) Down (Modifiers _ _ Down) _) ->
        drillLocation rightBoundary breakRightWall breakLeftWall w
      (EventKey (SpecialKey KeyLeft) Down (Modifiers _ _ Down) _) ->
        drillLocation leftBoundary breakLeftWall breakRightWall w

Again, notice how we use our mutator functions as parameters. When drilling "up", we pass the breakUpWall and breakDownWall functions, and so on. For a review of all these steps, take a look at this commit!

Drill Power Ups

At this point, we can use our drill within the game. But we can only use it the specified number of times from the initialDrills parameter. Next, we're going to add power-ups we can pick up in the grid that will give us more drilling abilities. This requires adding a bit more data to our world. We'll have a list of locations for the power-ups, as well as a parameter for the number of them:

data World = World
  { ...
  , worldDrillPowerUpLocations :: [Location]
  }

data GameParameters = GameParameters
  { ...
  , numDrillPowerups :: Int
  }

When we initialize our game, we have to create these locations, as we did for enemies. Since these are the same essential task, we can replicate that logic:

main = …
      let (enemyLocations, gen'') = runState
            (replicateM (numEnemies gameParams) 
              (generateRandomLocation
                (numRows gameParams, numColumns gameParams)))
            gen'
          (drillPowerupLocations, gen''') = runState
            (replicateM (numDrillPowerups gameParams) 
              (generateRandomLocation 
                (numRows gameParams, numColumns gameParams)))
            gen''
    in ...

We also need this same process when resetting the game, whether after winning or losing.

We'll also change how we update the world after a player move. We'll add a wrapper function to update the world whenever the player moves. We'll supply a directional function parameter to determine where the player goes next:

inputHandler :: Event -> World -> World
inputHandler event w
  ...
  | otherwise = case event of
      (EventKey (SpecialKey KeyUp) Down _ _) ->
        updatePlayerMove upBoundary
      (EventKey (SpecialKey KeyDown) Down _ _) ->
        updatePlayerMove downBoundary
      (EventKey (SpecialKey KeyRight) Down _ _) ->
        updatePlayerMove rightBoundary
      (EventKey (SpecialKey KeyLeft) Down _ _) ->
        updatePlayerMove leftBoundary
  where
    updatePlayerMove :: (CellBoundaries -> BoundaryType) -> World
    updatePlayerMove = …

    -- Other values we have in scope, for convenience
    playerParams = playerGameParameters . worldParameters $ w
    enemyParams = enemyGameParameters . worldParameters $ w

    worldRows = numRows . worldParameters $ w
    worldCols = numColumns . worldParameters $ w
    worldBounds = worldBoundaries w
    currentPlayer = worldPlayer w
    currentLocation = playerLocation currentPlayer
    cellBounds = worldBounds Array.! currentLocation

Let's devise a couple more mutators to help us fill in this new function. One moves the player to a new location, the other gives them an extra drill power-up if they find one:

pickupDrill :: Player -> Player
pickupDrill pl = pl
  { playerDrillsRemaining = (playerDrillsRemaining pl) + 1}

movePlayer :: Location -> Player -> Player
movePlayer newLoc pl = pl
  { playerLocation = newLoc }

Now if the location in the proper direction is "adjacent" to us (no wall), then we'll move there and try to pick up a drill. If it is not, the world does not change!

updatePlayerMove :: (CellBoundaries -> BoundaryType) -> World
updatePlayerMove boundaryFunc = case boundaryFunc cellBounds of
  (AdjacentCell cell) ->
    let movedPlayer = movePlayer cell currentPlayer
        drillLocs = worldDrillPowerUpLocations w
        ...
      _ -> w

Then for one last trick. When our next location has a drill, we have to update the player again. We also have to remove this power-up from the world! We update the world with those parameters, and we're done!

updatePlayerMove :: (CellBoundaries -> BoundaryType) -> World
updatePlayerMove boundaryFunc = case boundaryFunc cellBounds of
  (AdjacentCell cell) ->
    let movedPlayer = movePlayer cell currentPlayer
        drillLocs = worldDrillPowerUpLocations w
        (finalPlayer, finalDrillList) = if cell `elem` drillLocs
          then (pickupDrill movedPlayer, delete cell drillLocs)
          else (movedPlayer, drillLocs)
    in w
      { worldPlayer = finalPlayer, 
        worldDrillPowerUpLocations = finalDrillList }
  _ -> w

Check out this commit for a more thorough look at the changes in this part!

Drawing our Drills

We're almost done now! We have to actually draw the drills on the screen so we can figure out what's happening! As with the stun indicator, we'll use a circular ring to show when our player has a drill ready. We'll show the power-ups using purple triangles on the grid. With our new parameters system, we'll want to specify the color we'll use and the size of these indicators.

data PlayerRenderParameters = PlayerRenderParameters
  { ...
  , playerDrillPowerupSize :: Float
  , playerDrillIndicatorSize :: Float
  , playerDrillColor :: Color
  }

defaultRenderParameters :: RenderParameters
defaultRenderParameters = RenderParameters ...
  where
    playerParams = PlayerRenderParameters 10 black 5 red
      5.0 2.0 violet
    ...

As with our game parameters change, this also involves updating JSON instances. We'll also have to update the command line options parsing. But let's focus on the actual drawing that needs to take place.

The player indicator code looks a lot like the code for the stun indicator. We'll use different parameters and a different condition, but nothing else changes:

playerRP = playerRenderParameters rp
drillReadyMarker = if playerDrillsRemaining (worldPlayer world) > 0
  then Color (playerDrillColor playerRP)
    (Circle (playerDrillIndicatorSize playerRP))
  else Blank
...
playerMarker = translate px py (Pictures [drillReadyMarker, ...])

Then for the power-ups, we want to handle them like we do enemies. We'll loop through the list of locations, and apply a picture function against each one:

drawingFunc :: RenderParameters -> World -> Picture
drawingFunc rp world
  ...
 | otherwise = Pictures
    [ ...
    , Pictures (enemyPic <$> worldEnemies world)
    , Pictures (drillPic <$> worldDrillPowerUpLocations world)
    ]
  where
    ...
    drillPic :: Location -> Picture
    ...

The drillPic function will even look a lot like the function for enemy pictures. We'll just use different coordinates to make a triangle instead of a square!

drillPic :: Location -> Picture
drillPic loc =
  let (centerX, centerY) = cellCenter $ conversion loc
      radius = playerDrillPowerupSize playerRP
      top = (centerX, centerY + radius)
      br = (centerX + radius, centerY - radius)
      bl = (centerX - radius, centerY - radius)
      drillColor = playerDrillColor playerRP
  in  Color drillColor (Polygon [top, br, bl])

And that's all! We've got a working, rendered prototype of this feature now! Take a look at this commit for some wrap-up details.

Drills in Action

Here are a few quick pictures of our game in action now! We can see our player is out of drills but near a power-up here:

Then we pick up the new drill, and we're fresh again!

Then we can use it to make a hole and get closer to the end!

Conclusion

This wraps up our feature! In the next couple weeks we're going to take a step back and re-organize things a bit. We want to work towards adding an AI for the main player, and enhancing the AI for the enemies. It would be cool to use some more advanced tactics, rather than relying on hard-coded rules. At some point, we'll consider using machine learning to improve this AI. This will require re-working our code a bit so we can run it independently of Gloss. This will allow us to run many game situations!

As we get ready to try some more advanced AI ideas, it might be a good idea to brush up on how and why we can use Haskell for AI development. Take a look at our Haskell AI series for some ideas! You can also download our Haskell Tensorflow Guide to learn more!

Loading Games and Changing Colors!

Last week we added functionality for serializing our world state. This allowed us to save our game with the press of a button. We also parameterized our application so that we could customize many aspects of it. We didn't explore all the possibilities though! This week, we'll see how we can load a previous game-state by using command line options. We'll also use options to specify how the game appears!

As always, take a look at our Github repository to see the full code. This article corresponds to the part-9 branch.

All this is part of our effort to make our game more "mature". But you should also consider some libraries that will be more useful in industry! Take a look at our Production Checklist!. Whether it's web servers or databases, you'll learn how Haskell interacts with more advanced concepts!

Command Line Options

Everything we do this week will happen through command line options. For a quick refresher on these, take a look at this article! We'll have a couple main concerns. First, we want to take an optional filename argument to load the initial world state. If we get this, we'll throw the player right back into their game! If we don't get this argument, we'll generate a new, random state for them to work with.

Second, we'll make command line parameters for all our different render parameters. This will allow anyone invoking the game to customize the appearance! We'll also allow them to specify a whole file for these as well. This will involve quite a bit of work with the Options.Applicative library.

Our main goal is this function:

parseOptions :: IO (Maybe FilePath, RenderParameters)

This will return us a possible file path to load our world state from, as well as a set of render parameters. Let's start with some basic framework code.

Parser Setup

The first item we want is a generic parser that will give us Maybe values. As far as I could tell the options library doesn't have this built-in. But it's not too hard to write. We want to use the option function to start with. It will attempt the given parser. If it succeeds, we want to wrap it with Just. Then we'll append a default value of Nothing to the options in case it fails.

maybeParser ::
  ReadM a -> Mod OptionFields (Maybe a) -> Parser (Maybe a)
maybeParser reader opts =
  option (Just <$> reader) (opts <> value Nothing)

We can now use this to build a parser for the maze file:

mazeFileParser :: Parser (Maybe FilePath)
mazeFileParser = maybeParser str
 (long "load-file" <> short 'f'
   <> help "A file to use to load the world state")

And now we just apply execParser on this, supplying some simple Info for our parser:

parseOptions :: IO (Maybe FilePath)
parseOptions = execParser $ info mazeFileParser commandInfo

commandInfo :: InfoMod (Maybe FilePath)
commandInfo = fullDesc <> progDesc "Haskell Maze Game"

Runner Updates

The next step is a short function for loading our world from the file. Since we have our JSON instance on the World type, we'll rely on decodeFileStrict'. There's one caveat. If the game parameters don't have a random seed value, we'll use a new one. Otherwise we'll use mkStdGen on the seed:

loadWorldFromFile :: FilePath -> IO World
loadWorldFromFile fp = do
 parseResult <- Data.Aeson.decodeFileStrict' fp
 case parseResult of
   Just w -> do
     gen <- case randomGeneratorSeed (worldParameters w) of
       Nothing -> getStdGen
       Just i -> return $ mkStdGen i
     return $ w { worldRandomGenerator = gen }
   Nothing -> error $ "Couldn't parse world from file " ++ fp ++ "!"

Now we want to make some changes to our main running function. We'll run our argument parser first. If we get a file from the options, we'll load the initial World from that file. Otherwise, we'll use our previous flow with generating a random maze.

main :: IO ()
main = do
 maybeLoadFile <- parseOptions
 initialWorld <- case maybeLoadFile of
   Just loadFile -> loadWorldFromFile loadFile
   Nothing -> …
 play ...

Parsing a Render File

This is good enough to load the world, so we can re-start from a saved (or derived) position. But suppose we wanted to go a step further. Suppose we wanted to also load our render parameters. We could use another file if we liked. We could start with another parser for a file path:

renderFileParser :: Parser (Maybe FilePath)
renderFileParser = maybeParser str
 (long "render-param-file" <> short 'r'
   <> help "A file to use to load render parameters")

Then we'll combine our two parsers together like so:

parser :: Parser (Maybe FilePath, Maybe FilePath)
parser = (,) <$>
 mazeFileParser <*>
 renderFileParser

Now we'll add a bit more logic to the wrapper function. If we have a file, we should use it to load the RenderParameters object:

parseOptions :: IO (Maybe FilePath, RenderParameters)
parseOptions = do
 (mazeFile, renderFile) <- execParser $ info parser commandInfo
 case renderFile of
   Nothing -> return (mazeFile, defaultRenderParameters)
   Just fp -> do
     parseResult <- decodeFileStrict' fp
     case parseResult of
       Nothing -> return (mazeFile, defaultRenderParameters)
       Just fileRenderParams -> return (mazeFile, fileRenderParams)

Note that the type of our commandInfo will also need to change as a result of this. But then we just have the simple task of getting other these items out in our main function:

main :: IO ()
main = do
 (maybeLoadFile, renderParams) <- parseOptions
 ...

Individual Render Parameters

We have one last trick though! Suppose we want to change one thing about the game's appearance and we don't want to use a JSON file. We can add individual options on render elements. We've got a lot of possible elements. We'll wrap them all in a basic type, matching the fields we have in the different sub-components. Each of these fields is optional. We'll "merge" them with a complete set of render parameters to get a final result.

data RenderParamInfo = RenderParamInfo
 -- Screen/Text Parameters
 (Maybe Int)
 (Maybe Int)
 (Maybe Int)
 (Maybe Float)
 (Maybe Float)
 (Maybe Float)
 (Maybe Float)
 -- Player Parameters
 (Maybe Float)
 (Maybe Color)
 (Maybe Float)
 (Maybe Color)
 -- Enemy Parameters
 (Maybe Float)
 (Maybe Color)
 (Maybe Color)
 -- Cell Parameters
 (Maybe Color)
 (Maybe Color)
 (Maybe Float)

Each field will have it's own parser. These will all be variations on our maybeParser:

maybeIntParser :: Mod OptionFields (Maybe Int) -> Parser (Maybe Int)
maybeIntParser = maybeParser auto

maybeFloatParser ::
  Mod OptionFields (Maybe Float) -> Parser (Maybe Float)
maybeFloatParser = maybeParser auto

maybeColorParser ::
  Mod OptionFields (Maybe Color) -> Parser (Maybe Color)
maybeColorParser = maybeParser (maybeReader colorReader)
 where
   colorReader "blue" = Just blue
   … -- other colors

Then we can combine them using applicative syntax, and providing some help information:

parseRenderInfo :: Parser RenderParamInfo
parseRenderInfo = RenderParamInfo <$>
 maybeIntParser (long "screen-dimen"
   <> help "The screen width/height") <*>
 maybeIntParser (long "screen-offset-x"
   <> help "The screen width/height") <*>
 ...

Next we'll write a "merge" function. This will take a RenderParameters item with default values, and apply the Just values.

mergeOptions ::
  RenderParameters -> RenderParamInfo -> RenderParameters
mergeOptions rp (RenderParamInfo sd_ sox_ ...)
 = RenderParameters
   (fromMaybe (screenDimen rp) sd_)
   (fromMaybe (screenOffsetX rp) sox_)
   ...

Then we add this new parser to our set:

parser :: Parser (Maybe FilePath, Maybe FilePath, RenderParamInfo)
parser = (,,) <$>
 mazeFileParser <*>
 renderFileParser <*>
 parseRenderInfo

And our original function should now reflect the need to merge parameters.

parseOptions :: IO (Maybe FilePath, RenderParameters)
parseOptions = do
 (mazeFile, renderFile, renderInfo) <- execParser $
                                         info parser commandInfo
 case renderFile of
   Nothing -> return
     (mazeFile, mergeOptions defaultRenderParameters renderInfo)
   Just fp -> do
     parseResult <- decodeFileStrict' fp
     case parseResult of
       Nothing -> return
         (mazeFile, mergeOptions defaultRenderParameters renderInfo)
       Just fileRenderParams -> return
         (mazeFile, mergeOptions fileRenderParams renderInfo)

Wrapping Up

Now we've got a lot of interesting possibilities. We can save our game from a particular state:

Then we can load it back up with different colors. For example, we can make some obnoxious green walls:

stack exec -- maze-game --load-file=maze_game_save_1557121650\
  --cell-wall-color=green --enemy-base-color=red

Conclusion

Now that our game is customizable and re-loadable we'll be able to do a lot more interesting things with it. We'll be able to run many simulations that test the difficulty. Some day, we'll be able to make the AI much better! For the time being though, there are still some more features we can add. So the next couple parts of this series will explore some other exciting twists in the game-play. This will lead us to a point where other types of refactors will be necessary.

Making a project like this requires a good knowledge of the Stack tool. To learn more, take our free mini-course on Using Stack!.

Spring Cleaning: Parameters and Saving!

Our game is a lot more interesting after the changes we made last week. But there's still lots of room for improvement. There are many things that could make the game more or less interesting, depending how we tune things. For instance, how many enemies is too many? What's a good stun duration? How quickly does the game get harder if we tweak these parameters?

Right now, it would be hard for us to answer these questions in a systematic way. We've baked many of these parameters directly into the code. So we would have to recompile everything if we wanted to test out another version of the game. This is a bad sign. We should be able to run the same binary with different sets of parameters.

Another issue with our game is that the only real "flow" is to start off with a random arrangement. We don't know what the map will be or where the enemies start. But if we want to test how well certain concepts work, we'll want true re-playability. In other words, we'll want to be able to start the game from a certain state we've established.

This week, we'll start to clean these things up. The first job will be to move a lot of our magic numbers into the World type. Then we'll devise a way to serialize the complete world state. We've already done the hard work of ensuring we can serialize the map. The rest will be pretty straightforward using JSON instances. We'll wrap up this week by adding the option to save the game in the middle of the action. Then next week, we'll add some options to our game so we can load a particular starting state from a file.

As with each of the different phases of this projects, you can take a look at our Github repository to see how we do everything. For this article, you should be following the part-8 branch. We'll also provide a couple commit links for so you can follow along step-by-step.

As you get better at using Haskell, you'll be able to use it for more and more types of projects. Download our Production Checklist for some ideas!

Parameterizing the App

There are a lot of "magic numbers" floating around our app right now. Some of these have to do with game-play logic. How many enemies are there? What's their cool-down time? How long is our player's stun timer? Then there are other parameters that have to do with how we draw the game. For instance, what colors do we use? How big are the cells?

We make this distinction because we should be able to run our game without any render information. At some point, we'll run simulations of this game that don't get drawn at all. So it would be useless to have drawing information around. Thus we'll have GameParameters types that will live in the World. Then we'll have RenderParameters types for drawing everything.

With that said, let's starting devising what information these types contain. We'll start out with types describing the player and enemy parameters:

data PlayerGameParameters = PlayerGameParameters
  { initialStunTimer :: Word
  , stunTimerIncrease :: Word
  , stunTimerMax :: Word
  , stunRadius :: Int
  }

data EnemyGameParameters = EnemyGameParameters
  { initialStunTime :: Word
  , stunTimeDecrease :: Word
  , minStunTime :: Word
  , enemyRandomMoveChance :: Word
  , initialLagTime :: Word
  , minLagTime :: Word
  }

Now we can use these to populate a bigger type with more generic game parameters:

data GameParameters = GameParameters
  { numRows :: Int
  , numColumns :: Int
  , numEnemies :: Int
  , tickRate :: Int
  , playerGameParameters :: PlayerGameParameters
  , enemyGameParameters :: EnemyGameParameters
  , randomGeneratorSeed :: Maybe Int
  }

Notice the random seed is a Maybe value. In the normal circumstances of running the program, we don't want to fix the random generator. But there are cases where we'll want to load from a specific stored state. If we fix the generator seed value, gameplay will be deterministic. This could be a desirable property in some circumstances. In most cases though, this will be Nothing.

With all these types in place, we'll now add the game parameters to our World:

data World = World
  { …
  , worldParameters :: GameParameters
  }

We'll go through a similar process with RenderParameters. The main difference will be that we will not attach the type to the World. There will also be a CellRenderParameters type as well as types for the Player and Enemy. This gives us information about how individual cells get displayed on our screen. Here's a quick sample of this code. You can see the other types at the bottom as an appendix.

data RenderParameters = RenderParameters
  { screenWidth :: Float
  , screenHeight :: Float
  , screenOffsetX :: Float
  , screenOffsetY :: Float
  , textOffset :: (Float, Float)
  , textScale :: (Float, Float)
  , playerRenderParameters :: PlayerRenderParameters
  , enemyRenderParameters :: EnemyRenderParameters
  , cellRenderParameters :: CellRenderParameters
  }

data CellRenderParameters = CellRenderParameters
  { cellWallColor :: Color
  , cellStunColor :: Color
  , cellWallWidth :: Float
  }

No More Magic

Once we have these types in place, our next step is to replace the magic numbers (and colors) in our application. We'll need to add the parameters as arguments in a few places. Most of all, the drawingFunc will need the RenderParameters argument.

drawingFunc :: RenderParameters -> World -> Picture
...

This process isn't too much of a challenge, as all our important functions take the World as an input. Then for now, we'll pass our default parameter packs as arguments when running the program. Here's a quick look at changes to our main function:

main :: IO ()
main = do
  gen <- getStdGen
  let gameParams = defaultGameParameters
      renderParams = defaultRenderParameters
      (maze, gen') = generateRandomMaze
        gen (numRows gameParams, numColumns gameParams)
      (randomLocations, gen'') = runState
        (replicateM
          (numEnemies gameParams)
          (generateRandomLocation
            (numRows gameParams, numColumns gameParams)))
            gen'
      enemies = (mkNewEnemy
        (enemyGameParameters gameParams)) <$> randomLocations
      endCell = (numColumns gameParams - 1, numRows gameParams - 1)
      initialWorld = World
        (newPlayer (playerGameParameters gameParams))
        (0,0) endCell maze GameInProgress gen'' enemies [] 0 
        gameParams
  play
    (windowDisplay renderParams)
    white
    (tickRate gameParams)
    initialWorld
    (drawingFunc renderParams)
    inputHandler
    updateFunc

Take a look at this commit for a longer look at all our parameter changes.

Serializing Our World

Now that we've updated our World type, we'll want to determine how we can serialize it. For simplicity's sake we'll use JSON serialization. This is mostly a matter of creating (or, if you wish, deriving), a bunch of ToJSON and FromJSON instances. Check out this article for a refresher on the Data.Aeson library.

Most of this code is pretty simple. With game parameters, a lot of the instances are a simple matter of creating and parsing pairs. Here's an example with Player:

instance FromJSON Player where
  parseJSON = withObject "Player" $ \o -> do
    location <- o .: "location"
    currentStunDelay <- o .: "currentStunDelay"
    nextStunDelay <- o .: "nextStunDelay"
    return $ Player location currentStunDelay nextStunDelay

instance ToJSON Player where
  toJSON p = object
    [ "location" .= playerLocation p
    , "currentStunDelay" .= playerCurrentStunDelay p
    , "nextStunDelay" .= playerNextStunDelay p
    ]

But there are a few caveats. To start, we need to make a separate file for these instances. We'll need our maze parsing code for the World type, and this depends on the Types module. We have to avoid the resulting dependency cycle.

It's generally a bad practice to separate instances from the type declarations. We call these "orphan" instances and you'll get a compiler warning about them in other projects. A way around this is to create wrapper types. This is a little tedious, so we won't do it for all the types. But we will show the concept for the Color type from Graphics.Gloss. Let's start with a wrapper type:

newtype ColorWrapper = ColorWrapper { unColor :: Color }

Now we can create instances on this wrapper, and they're considered valid. To cover all cases of color, we'd use RGB arrays. But we'll color cover the 9 or so colors we care about and parse them as strings. Here's what the instances look like. Notice how we wrap and unwrap the actually library functions for the colors:

instance ToJSON ColorWrapper where
  toJSON (ColorWrapper c) = Ae.String colorStr
    where
      colorStr
        | c == blue = "blue"
        | c == red = "red"
        | c == yellow = "yellow"
        | c == green = "green"
        | c == cyan = "cyan"
        | c == orange = "orange"
        | c == magenta = "magenta"
        | c == rose = "rose"
        | c == black = "black"

instance FromJSON ColorWrapper where
  parseJSON = withText "ColorWrapper" parseText
    where
      parseText "blue" = return (ColorWrapper blue)
      parseText "red" = return (ColorWrapper red)
      parseText "yellow" = return (ColorWrapper yellow)
      parseText "green" = return (ColorWrapper green)
      parseText "cyan" = return (ColorWrapper cyan)
      parseText "orange" = return (ColorWrapper orange)
      parseText "magenta" = return (ColorWrapper magenta)
      parseText "rose" = return (ColorWrapper rose)
      parseText "black" = return (ColorWrapper black)
      parseText _ = error "Couldn't parse color!"

Then we can use these instances within other parsers for render parameters. The other caveat now is to parse out our World in two stages. We'll get all the basic fields and parameters first:

instance FromJSON World where
  parseJSON = withObject "World" $ \o -> do
    player <- o .: "player"
    startLoc <- o .: "startLocation"
    endLoc <- o .: "endLocation"
    result <- o .: "result"
    enemies <- o .: "enemies"
    stunCells <- o .: "stunCells"
    time <- o .: "time"
    params <- o .: "gameParameters"
  ...

Now we'll get the boundaries as a Text item. We'll parse the maze boundaries out using our parser as well as the number of rows and columns.

instance FromJSON World where
  parseJSON = withObject "World" $ \o -> do
    ...
    (boundaryString :: Text) <- o .: "boundaries"
    let (rs, cs) = (numRows params, numColumns params)
    let boundaries =
      case runParser (mazeParser (rs, cs)) "" boundaryString of
          Right result -> result
          _ -> error "Map parse failed!"

As a last trick, we'll check what the random seed is within our parameters. If it's Nothing, we'll fix the generator with a seed of 1 and rely on other code to change it:

instance FromJSON World where
  parseJSON = withObject "World" $ \o -> do
    ...
    let gen = case randomGeneratorSeed params of
          Just i -> mkStdGen i
          _ -> mkStdGen 1
    return $ World player startLoc endLoc boundaries
      result gen enemies stunCells time params

Take a look at this commit to see the full code for these instances. Now let's see how we use them!

Saving Our World

We'd like to make it so that our user can save their game-state by hitting the s key at any point in the game. This idea starts out simple enough. We add a handler for the key in our inputHandler.

inputHandler :: Event -> World -> World
inputHandler event w
  | worldResult w == GameWon = ...
  | worldResult w == GameLost = ...
  | otherwise = case event of
      ...
      (EventKey (Char 's') Down _ _) -> ...

But now we're a little stuck! We want to write out to a file, but our handler is a pure function! There miiight be a way to do this without breaking functional purity. Perhaps we could keep a list of saved world states and add a handler to save them at the end of our program. But Gloss wasn't made for that. So we're going to break the rules a bit and resort to unsafePerformIO. This allows us to run an IO computation from a seemingly pure context. Here's the basic layout:

inputHandler :: Event -> World -> World
inputHandler event w
      ...
      (EventKey (Char 's') Down _ _) -> unsafeSaveWorldToFile w

unsafeSaveWorldToFile :: World -> World
unsafeSaveWorldToFile w = unsafePerformIO $ do
  …
  return w

Since we have a JSON instance for our World, we'll lean on the encodeFile function. The rest of the work here comes from generating a filename using the current time, for uniqueness:

unsafeSaveWorldToFile :: World -> World
unsafeSaveWorldToFile w = unsafePerformIO $ do
  timeAsString <- show . floor <$> getPOSIXTime
  currentDir <- getCurrentDirectory
  let filename = currentDir ++ "/maze_game_save_" ++ timeAsString
  encodeFile filename w
  return w

And that's all it takes for us to save some game files! Perhaps you've heard the phrase "don't try this at home." When it comes to unsafePerformIO, feel free to try it at home, but don't try it at work! Take a look at this commit for details on saving the state.

Conclusion

In spite of unsafePerformIO, our game feel like a much more "grown-up" program now. The code quality is much better with our parameters. We now have a lot more options of what to do when it comes to improving it. Saving the world state is the first step towards solving some interesting problems. Next week, we'll explore how we can load the saved game states we've created.

As we move forward, we'll keep trying to turn this game into a more mature program. Eventually though, you should think about using Haskell for more common production use cases. To learn about different libraries you can use, download our Production Checklist!

Appendix: Render Parameter Types

data RenderParameters = RenderParameters
  { screenDimen :: Int
  , screenOffsetX :: Int
  , screenOffsetY :: Int
  , textOffset :: (Float, Float)
  , textScale :: (Float, Float)
  , playerRenderParameters :: PlayerRenderParameters
  , enemyRenderParameters :: EnemyRenderParameters
  , cellRenderParameters :: CellRenderParameters
  }

data PlayerRenderParameters = PlayerRenderParameters
  { playerIndicatorSize :: Float
  , playerIndicatorColor :: Color
  , playerStunIndicatorSize :: Float
  , playerStunIndicatorColor :: Color
  }

data EnemyRenderParameters = EnemyRenderParameters
  { enemySize :: Float
  , enemyBaseColor :: Color
  , enemyStunnedColor :: Color
  }

data CellRenderParameters = CellRenderParameters
  { cellWallColor :: Color
  , cellStunColor :: Color
  , cellWallWidth :: Float
  }

defaultRenderParameters :: RenderParameters
defaultRenderParameters = RenderParameters
  625 10 10 (-275, 0) (0.12, 0.25) playerParams enemyParams cellParams
  where
    playerParams = PlayerRenderParameters 10 black 5 red
    enemyParams = EnemyRenderParameters 10 orange yellow
    cellParams = CellRenderParameters blue cyan 2

Fighting Back!

In last week's article, we made our enemies a lot smarter. We gave them a breadth-first-search algorithm so they could find the shortest path to find us. This made it much harder to avoid them. This week, we fight back! We'll develop a mechanism so that our player can stun nearby enemies and bypass them.

None of the elements we're going to implement are particularly challenging in isolation. The focus this week is on maintaining a methodical development process. To that end, it'll help a lot to take a look at the Github Repository for this project when reading this article. The code for this part is on the part-7 branch.

We won't go over every detail in this article. Instead, each section will describe one discrete stage in developing these features. We'll examine the important parts, and give some high level guidelines for the rest. Then there will be a single commit, in case you want to examine anything else that changed.

Haskell is a great language for following a methodical process. This is especially true if you use the idea of compile driven development (CDD). If you've never written any Haskell before, you should try it out! Download our Beginners Checklist and get started! You can also read about CDD and other topics in our Haskell Brain series!

Feature Overview

To start, let's formalize the definition of our new feature.

1. The player can stun all enemies within a 5x5 tile radius (ignoring walls) around them.
2. This will stun enemies for a set duration of time. However, the stun duration will go down each time an enemy gets stunned.
3. The player can only use the stun functionality once every few seconds. This delay should increase each time they use the stun.
4. Enemies will move faster each time they recover from getting stunned.
5. Stunned enemies appear as a different color
6. Affected tiles briefly appear as a different color.
7. When the player's stun is ready, their avatar should have an indicator.

It seems like there are a lot of different criteria here. But no need to worry! We'll follow our development process and it'll be fine! We'll need more state in our game for a lot of these changes. So, as we have in the past, let's start by modifying our World and related types.

World State Modifications

The first big change is that we're going to add a Player type to carry more information about our character. This will replace the playerLocation field in our World. It will have current location, as well as timer values related to our stun weapon. The first value will be the time remaining until we can use it again. The second value will be the next delay after we use it. This second value is the one that will increase each time we use the stun. We'll use Word (unsigned int) values for all our timers.

data Player = Player
  { playerLocation :: Location
  , playerCurrentStunDelay :: Word
  , playerNextStunDelay :: Word
  }


data World = World
  { worldPlayer :: Player
  ...

We'll add some similar new fields to the enemy. The first of these is a lagTime. That is, the number of ticks an enemy will wait before moving. The more times we stun them, the lower this will go, and the faster they'll get. Then, just as we keep track of a stun delay for the player, each enemy will have a stun remaining time. (If the enemy is active, this will be 0). We'll also store the "next stun duration", like we did with the Player. For the enemy, this delay will decrease each time the enemy gets stunned, so the game gets harder.

data Enemy = Enemy
  { enemyLocation :: Location
  , enemyLagTime :: Word
  , enemyNextStunDuration :: Word
  , enemyCurrentStunTimer :: Word
  }

Finally, we'll add a couple fields to our world. First, a list of locations affected by the stun. These will briefly highlight when we use the stun and then go away. Second, we need a worldTime. This will help us keep track of when enemies should move.

data World = World
  { worldPlayer :: Player
  , startLocation :: Location
  , endLocation :: Location
  , worldBoundaries :: Maze
  , worldResult :: GameResult
  , worldRandomGenerator :: StdGen
  , worldEnemies :: [Enemy]
  , stunCells :: [Location]
  , worldTime :: Word
  }

At this point, we should stop thinking about our new features for a second and get the rest of our code to compile. Here are the broad steps we need to take.

1. Every instance of playerLocation w should change to access playerLocation (worldPlayer w).
2. We should make a newPlayer expression and use it whenever we re-initialize the world.
3. We should make a similar function mkNewEnemy. This should take a location and initialize an Enemy.
4. Any instances of Enemy constructors in pattern matches need the new arguments. Use wildcards for now.
5. Other places where we initialize the World should add extra arguments as well. Use the empty list for the stunCells and 0 the world timer.

Take a look at this commit for details!

A Matter of Time

For the next step, we want to ensure all our time updates occur. Our game entities now have several fields that should be changing each tick. Our world timer should go up, our stun delay timers should go down. Let's start with a simple function that will increment the world timer:

incrementWorldTime :: World -> World
incrementWorldTime w = w { worldTime = worldTime w + 1 }

In our normal case of the update function, we want to apply this increment:

updateFunc :: Float -> World -> World
updateFunc _ w
  ...
  | otherwise = incrementWorldTime (w 
    { worldRandomGenerator = newGen
    , worldEnemies = newEnemies
    })

Now there are some timers we'll want to decrement. Let's make a quick helper function:

decrementIfPositive :: Word -> Word
decrementIfPositive 0 = 0
decrementIfPositive x = x - 1

We can use this to create a function to update our player each tick. All we need to do is reduce the stun delay. We'll apply this function within our update function for the world.

updatePlayerOnTick :: Player -> Player
updatePlayerOnTick p = p
  { playerCurrentStunDelay =
      decrementIfPositive (playerCurrentStunDelay p)
  }

updateFunc :: Float -> World -> World
updateFunc _ w
  ...
  | otherwise = incrementWorldTime (w
    { worldPlayer = newPlayer
    , ...
    })
  where
    player = worldPlayer w
    newPlayer = updatePlayerOnTick player
    ...

Now we need to change how we update enemies:

1. The function needs the world time. Enemies should only move when the world time is a multiple of their lag time.
2. Enemies should also only move if they aren't stunned.
3. Reduce the stun timer if it exists.

updateEnemy
  :: Word
  -> Maze
  -> Location
  -> Enemy
  -> State StdGen Enemy
updateEnemy time maze playerLocation
  e@(Enemy location lagTime nextStun currentStun) =
    if not shouldUpdate
      then return e
      else do
        … -- Make the new move!
        return (Enemy newLocation lagTime nextStun 
                 (decrementIfPositive currentStun))
      where
        isUpdateTick = time `mod` lagTime == 0
        shouldUpdate = isUpdateTick && 
                         currentStun == 0 && 
                         not (null potentialLocs)
        potentialLocs = …
      ...

There are also a couple minor modifications elsewhere.

1. The time step argument for the play function should now be 20 steps per second, not 1.
2. Enemies should start with 20 for their lag time.

We haven't affected the game yet, since we can't use the stun! This is the next step. But this is important groundwork for making everything work. Take a look at this commit for how this part went down.

Activating the Stun

Let's make that stun work! We'll do this with the space-bar key. Most of this logic will go into the event handler. Let's set up the point where we enter this command:

inputHandler :: Event -> World -> World
inputHandler event w
  ...
  | otherwise = case event of
      … -- (movement keys)
      (EventKey (SpecialKey KeySpace) Down _ _) -> ...

What are all the different things that need to happen?

1. Enemies within range should get stunned. This means they receive their "next stun timer" value for their current stun timer.
2. Their "next stun timers" should decrease (let's say by 5 to a minimum of 20).
3. Our player stun delay timer should get the "next" value as well. Then we'll increase the "next" value by 10.
4. Our "stun cells" list should include all cells within range.

None of these things are challenging on their own. But combining them all is a bit tricky. Let's start with some mutation functions:

activatePlayerStun :: Player -> Player
activatePlayerStun (Player loc _ nextStunTimer) =
  Player loc nextStunTimer (nextStunTimer + 10)

stunEnemy :: Enemy -> Enemy
stunEnemy (Enemy loc lag nextStun _) =
  Enemy loc newLag newNextStun nextStun
  where
    newNextStun = max 20 (nextStun - 5)
    newLag = max 10 (lag - 1)

Now we want to apply these mutators within our input handler. To start, let's remember that we should only be able to trigger any of this logic if the player's stun timer is already 0!

inputHandler :: Event -> World -> World
inputHandler event w
  ...
  | otherwise = case event of
      … -- (movement keys)
      (EventKey (SpecialKey KeySpace) Down _ _) ->
        if playerCurrentStunDelay currentPlayer /= 0 then w
          else ...

Now let's add a helper that will give us all the locations affected by the stun. We want everything in a 5x5 grid around our player, but we also want bounds checking. Luckily, we can do all this with a neat list comprehension!

where
    ...
    stunAffectedCells :: [Location]
    stunAffectedCells =
      let (cx, cy) = playerLocation currentPlayer
      in  [(x,y) | x <- [(cx-2)..(cx+2)], y <- [(cy-2)..(cy+2)], 
            x >= 0 && x <= 24, y >= 0 && y <= 24]

Now we'll make a wrapper around our enemy mutation to determine which enemies get stunned:

where
    ...
    stunEnemyIfClose :: Enemy -> Enemy
    stunEnemyIfClose e = if enemyLocation e `elem` stunAffectedCells
      then stunEnemy e
      else e

Now we can incorporate all our functions into a final update!

inputHandler :: Event -> World -> World
inputHandler event w
  ...
  | otherwise = case event of
      … -- (movement keys)
      (EventKey (SpecialKey KeySpace) Down _ _) ->
        if playerCurrentStunDelay currentPlayer /= 0 
          then w
          else w
            { worldPlayer = activatePlayerStun currentPlayer
            , worldEnemies = stunEnemyIfClose <$> worldEnemies w
            , stunCells = stunAffectedCells
            }

Other small updates:

1. When initializing game objects, they should get default values for their "next" timers. For the player, we give 200 (10 seconds). For the enemies, we stun them for 60 ticks (3 seconds) initially.
2. When updating the world, clear out the "stun cells". Use another mutator function to achieve this:

clearStunCells :: World -> World
clearStunCells w = w { stunCells = []}

Take a look at this commit for a review on this part!

Drawing the Changes

Our game works as expected now! But as our last update, let's make sure we represent these changes on the screen. This will make the game a much better experience. Here are some changes:

1. Enemies will turn yellow when stunned
2. Affected squares will flash teal
3. Our player will have red inner circle when the stun is ready

Each of these is pretty simple! For our enemies, we'll add a little extra logic around what color to use, depending on the stun timer:

enemyPic :: Enemy -> Picture
enemyPic (Enemy loc _ _ currentStun) =
  let enemyColor = if currentStun == 0 then orange else yellow
      ...
  in  Color enemyColor (Polygon [tl, tr, br, bl])

For the player, we'll add some similar logic. The indicator will be a smaller red circle inside of the normal black circle:

stunReadyCircle = if playerCurrentStunDelay (worldPlayer world) == 0
  then Color red (Circle 5)
  else Blank
playerMarker = translate px py (Pictures [stunReadyCircle, Circle 10])

Finally, for the walls, we need to check if a location is among the stunCells. If so, we'll add a teal (cyan) background.

makeWallPictures :: (Location, CellBoundaries) -> [Picture]
makeWallPictures ((x,y), CellBoundaries up right down left) =
  let coords = conversion (x,y)
      tl = cellTopLeft coords
      tr = cellTopRight coords
      bl = cellBottomLeft coords
      br = cellBottomRight coords
      stunBackground = if (x, y) `elem` stunCells world
        then Color cyan (Polygon [tl, tr, br, bl])
        else Blank
  in  [ stunBackground
      … (wall edges)
      ]

And that's all! We can now tell what is happening in our game, so we're done with these features! You can take a look at this commit for all the changes we made to the drawing!

Conclusion

Now our game is a lot more interesting. There's a lot of tuning we can do with various parameters to make our levels more and more competitive. For instance, how many enemies is appropriate per level? What's a good stun delay timer? If we're going to experiment with all these, we'll want to be able to load full game states from the file system. We've got a good start with serializing mazes. But now we want to include information about the player, enemies, and timers.

So next week, we'll go further and serialize our complete game state. We'll also look at how we parameterize the application and fix all the "magic numbers". This will add new options for customization and flexibility. It will also enable us to build a full game that gets harder as it goes on, and allow saving and loading of your progress.

Throughout this article (and series), we've tried to use a clean, precise development process. Read our Haskell Brain series to learn more about this! You can also download our Beginners Checklist if you are less familiar with the language!

Smarter Enemies with BFS!

Last week we added enemies to our maze. These little squares will rove around the maze, and if they touch our character, we have to restart the maze. We made it so that these enemies moved around at random. Thus they're not particularly efficient at getting to us.

This week, we're going to make them much more dangerous! They'll use the breadth first search algorithm to find the shortest path towards our player. We'll use three kinds of data structures from the containers package. So if you want to get a little more familiar with that, this article is a great start! Take a look at our Github Repository to see the full code! Look at the part-6 branch for this article!

We'll also make use of the state monad throughout. If you're still a little uncomfortable with monads, make sure to read our series on them! It'll help you with the basics. By the end you'll know about the state monad and how to use it in conjunction with other monads! If you're new to Haskell, you should also take a look at our Beginners Checklist!

BFS Overview

The goal of our breadth first search will be to return the fastest path from one location to another. We'll be writing this function:

getShortestPath :: Maze -> Location -> Location -> [Location]

It will return all the locations on the path from the initial location to the target location. If there's no possible path, we'll return the empty list. In practice, we'll usually only want to take the first element of this list. But there are use cases for having the whole path that we'll explore later. Here's a basic outline of our algorithm:

1. Keep a queue of locations that we'll visit in the future. At the start, this should contain our starting location.
2. Dequeue the first location (if the queue is empty, return the empty list). Mark this location as visited. If it is our target location, skip to step 5.
3. Find all adjacent locations that we haven't visited/enqueued yet. Put them into the search queue. Mark the dequeued location as the "parent" location for each of these new locations.
4. Continue dequeuing elements and inserting their unvisited neighbors. Stop when we dequeue the target location.
5. Once we have the target location, use the "parents" map to create the full path from start to finish.

Data Structures Galore

Now let's start getting into the details. As we'll see, there are several different data structures we'll need for this! We'll do some of the same things we did for depth first search (the first time around). We'll make a type to represent our current algorithm state. Then we'll make a recursive, stateful function over that type. In this case, we'll want three items in our search state.

1. A set of "visited" cells
2. A queue for cells we are waiting to visit
3. A mapping of cells to their "parent"

And for all three of these, we'll want different structures. Data.Set will suffice for our visited cells. Then we'll want Data.Map for the parent map. For the search queue though, we'll use something that we haven't used on this blog before: Data.Sequence. This structure allows us to add to the back and remove from the front quickly. Here's our search state type:

data BFSState = BFSState
  { bfsSearchQueue :: Seq.Seq Location
  , bfsVisistedLocations :: Set.Set Location
  , bfsParents :: Map.Map Location Location
  }

Before we get carried away with our search function, let's fill in our wrapper function. This will initialize the state with the starting location. Then it will call evalState to get the result:

getShortestPath :: Maze -> Location -> Location -> [Location]
getShortestPath maze initialLocation targetLocation = evalState
  (bfs maze initialLocation targetLocation)
  (BFSState 
    (Seq.singleton initialLocation) 
    (Set.singleton initialLocation) 
    Map.empty)

bfs :: Maze -> Location -> Location -> State BFSState [Location]
bfs = ...

Making Our Search

As with depth first search, we'll start by retrieving the current state. Then we'll ask if the search queue is empty. If it is, this means we've exhausted all possibilities, and should return the empty list. This indicates no path is possible:

bfs :: Maze -> Location -> Location -> State BFSState [Location]
bfs maze initialLocation targetLocation = do
  BFSState searchQueue visitedSet parentsMap <- get
  if Seq.null searchQueue
    then return []
    else do
      ...

Now let's consider the first element in our queue. If it's our target location, we're done. We'll write the exact helper for this part later. But first let's get into the meat of the algorithm:

bfs maze initialLocation targetLocation = do
  BFSState searchQueue visitedSet parentsMap <- get
  if Seq.null searchQueue
    then return []
    else do
      let nextLoc = Seq.index searchQueue 0
      if nextLoc == targetLocation
        then … -- Get results
        else do
          ...

Now our code will actually look imperative, to match the algorithm description above:

1. Get adjacent cells and filter based on those we haven't visited
2. Insert the current cell into the visited set
3. Insert the new cells at the end of the search queue, but drop the current (first) element from the queue as well.
4. Mark the current cell as the "parent" for each of these new cells. The new cell should be the "key", the current should be the value.

There's a couple tricky folds involved here, but nothing too bad. Here's what it looks like:

bfs :: Maze -> Location -> Location -> State BFSState [Location]
bfs maze initialLocation targetLocation = do
  BFSState searchQueue visitedSet parentsMap <- get
  ...
      if nextLoc == targetLocation
        then ...
        else do
              -- Step 1 (Find next locations)
          let adjacentCells = getAdjacentLocations maze nextLoc
              unvisitedNextCells = filter 
                (\loc -> not (Set.member loc visitedSet)) 
                adjacentCells

              -- Step 2 (Mark as visited)
              newVisitedSet = Set.insert nextLoc visitedSet

              -- Step 3 (Enqueue new elements)
              newSearchQueue = foldr
                (flip (Seq.|>))
                -- (Notice we remove the first element!)
                (Seq.drop 1 searchQueue)
                unvisitedNextCells

              -- Step 4
              newParentsMap = foldr
                (\loc -> Map.insert loc nextLoc)
                parentsMap
                unvisitedNextCells

Then once we're done, we'll insert these new elements into our search state. Then we'll make a recursive call to bfs to continue the process!

bfs :: Maze -> Location -> Location -> State BFSState [Location]
bfs maze initialLocation targetLocation = do
  BFSState searchQueue visitedSet parentsMap <- get
  ...
      if nextLoc == targetLocation
        then ...
        else do
              -- Step 1
          let adjacentCells = getAdjacentLocations maze nextLoc
              unvisitedNextCells = filter 
                (\loc -> not (Set.member loc visitedSet)) 
                adjacentCells
              -- Step 2
              newVisitedSet = Set.insert nextLoc visitedSet
              -- Step 3
              newSearchQueue = foldr
                (flip (Seq.|>))
                -- (Notice we remove the first element!)
                (Seq.drop 1 searchQueue)
                unvisitedNextCells
              -- Step 4
              newParentsMap = foldr
                (\loc -> Map.insert loc nextLoc)
                parentsMap
                unvisitedNextCells

          -- Replace the state and make recursive call!
          put (BFSState newSearchQueue newVisitedSet newParentsMap)
          bfs maze initialLocation targetLocation

For the last part of this, we need to consider what happens when we hit our target. In this case, we'll "unwind" the path using the parents map. We'll start with the target location in our path list. Then we'll look up its parent, and append it to the list. Then we'll look up the parent's parent. And so on. We do this recursion (of course).

bfs :: Maze -> Location -> Location -> State BFSState [Location]
bfs maze initialLocation targetLocation = do
  BFSState searchQueue visitedSet parentsMap <- get
  if Seq.null searchQueue
    then return []
    else do
      let nextLoc = Seq.index searchQueue 0
      if nextLoc == targetLocation
        then return (unwindPath parentsMap [targetLocation])
        ...
  where
    unwindPath parentsMap currentPath =
      case Map.lookup (head currentPath) parentsMap of
        Nothing -> tail currentPath
        Just parent -> unwindPath parentsMap (parent : currentPath)

The only cell we should find without a parent is the initial cell. So when we hit this case, we return the trail of the current path (so removing the current cell from it). And that's all!

Modifying the Game

All we have to do to wrap things up is call this function instead of our random function for the enemy movements. We'll keep things a little fresh by having them make a random move about 20% of the time. (We'll make this a tunable parameter in the future). Here's the bit where we keep some randomness, like what we have now:

updateEnemy :: Maze -> Location -> Enemy -> State StdGen Enemy
updateEnemy maze playerLocation e@(Enemy location) =
  if (null potentialLocs)
    then return e
    else do
      gen <- get
      let (randomMoveRoll, gen') = randomR (1 :: Int, 5) gen
      let (newLocation, newGen) = if randomMoveRoll == 1
            then
              let (randomIndex, newGen) =
                randomR (0, (length potentialLocs) - 1) gen'
              in  (potentialLocs !! randomIndex, newGen)
          ...
  where
    potentialLocs = getAdjacentLocations maze location

And in the rest of the cases, we'll call our getShortestPath function!

updateEnemy :: Maze -> Location -> Enemy -> State StdGen Enemy
updateEnemy maze playerLocation e@(Enemy location) =
  if (null potentialLocs)
    then return e
    else do
      gen <- get
      let (randomMoveRoll, gen') = randomR (1 :: Int, 5) gen
      let (newLocation, newGen) = if randomMoveRoll == 1
            then
              let (randomIndex, newGen) =
                randomR (0, (length potentialLocs) - 1) gen'
              in  (potentialLocs !! randomIndex, newGen)
            else
              let shortestPath =
                getShortestPath maze location playerLocation
              in  (if null shortestPath then location 
                     else head shortestPath, gen')
      put newGen
      return (Enemy newLocation)
    where
      potentialLocs = getAdjacentLocations maze location

And now the enemies will chase us around! They're hard to avoid!

Conclusion

With our enemies now being more intelligent, we'll want to allow our player to fight back against them! Next week, we'll create a mechanism to stun the ghosts to give ourselves a better chance! After, we'll look a some other ways to power up our player!

If you've never programmed in Haskell, hopefully this series is giving you some good ideas of the possibilities! We have a lot of resources for beginners! Check out our Beginners Checklist as well as our Liftoff Series!

Running From Enemies!

We've spent a few weeks now refactoring a few things in our game. We made it more performant and examined some related concepts. This week, we're going to get back to adding new features to the game! We'll add some enemies, represented by little squares, to rove around our maze! If they touch our player, we'll have to re-start the level!

In the next couple weeks, we'll make these enemies smarter by giving them a better search strategy. Then later, we'll give ourselves the ability to fight back against the enemies. So there will be interesting trade-offs in features.

Remember we have a Github Repository for this project! You can find all the code for this part can in the part-5 branch! For some other interesting Haskell project ideas, download our Production Checklist!

Organizing

Let's remind ourselves of our process for adding new features. Remember that at the code level, our game has a few main elements:

1. The World state type
2. The update function
3. The drawing function
4. The event handler

So to change our game, we should update each of these in turn. Let's start with the changes to our world type. First, it's now possible for us to "lose" the game. So we'll need to expand our GameResult type:

data GameResult = GameInProgress | GameWon | GameLost

Now we need to store the enemies. We'll add more data about our enemies as the game develops. So let's make a formal data type and store a list of them in our World. But for right now, all we need to know about them is their current location:

data Enemy = Enemy
  { enemyLocation :: Location
  }

data World = World
  { …
  , worldEnemies :: [Enemy]
  }

Updating The Game

Now that our game contains information about the enemies, let's determine what they do! Enemies won't respond to any input events from the player. Instead, they'll update at a regular interval via our updateFunc. Our first concern will be the game end condition. If the player's current location is one of the enemies locations, we've "lost".

updateFunc :: Float -> World -> World
updateFunc _ w =
  -- Game Win Condition
  | playerLocation w == endLocation w = w { worldResult = GameWon }
  -- Game Loss Condition
  | playerLocation w `elem` (enemyLocation <$> worldEnemies w) = 
      w { worldResult = GameLost }
  | otherwise = ...

Now we'll need a function that updates the location for an individual enemy. We'll have the enemies move at random. This means we'll need to manipulate the random generator in our world. Let's make this function stateful over the random generator.

updateEnemy :: Maze -> Enemy -> State StdGen Enemy
...

We'll want to examine the enemy's location, and find all the possible locations it can move to. Then we'll select from them at random. This will look a lot like the logic we used when generating our random mazes. It would also be a great spot to use prisms if we were generating them for our types! We might explore this possibility later on in this series.

updateEnemy :: Maze -> Enemy -> State StdGen Enemy
updateEnemy maze e@(Enemy location) = if (null potentialLocs)
  then return e
  else do
    gen <- get
    let (randomIndex, newGen) = randomR
                                  (0, (length potentialLocs) - 1) 
                                  gen
        newLocation = potentialLocs !! randomIndex
    put newGen
    return (Enemy newLocation)
  where
    bounds = maze Array.! location
    maybeUpLoc = case upBoundary bounds of
      (AdjacentCell loc) -> Just loc
      _ -> Nothing
    maybeRightLoc = case rightBoundary bounds of
      (AdjacentCell loc) -> Just loc
      _ -> Nothing
    maybeDownLoc = case downBoundary bounds of
      (AdjacentCell loc) -> Just loc
      _ -> Nothing
    maybeLeftLoc = case leftBoundary bounds of
      (AdjacentCell loc) -> Just loc
      _ -> Nothing
    potentialLocs = catMaybes
      [maybeUpLoc, maybeRightLoc, maybeDownLoc, maybeLeftLoc]

Now that we have this function, we can incorporate it into our main update function. It's a little tricky though. We have to use the sequence function to combine all these stateful actions together. This will also give us our final list of enemies. Then we can insert the new generator and the new enemies into our state!

updateFunc _ w =
  ...
  | otherwise = 
      w { worldRandomGenerator = newGen, worldEnemies = newEnemies} 
  where
    (newEnemies, newGen) = runState
      (sequence (updateEnemy (worldBoundaries w) <$> worldEnemies w))
      (worldRandomGenerator w)

Drawing our Enemies

Now we need to draw our enemies on the board. Most of the information is already there. We have a conversion function to get the drawing coordinates. Then we'll derive the corner points of the square within that cell, and draw an orange square.

drawingFunc =
  …
  | otherwise = Pictures
      [..., Pictures (enemyPic <$> worldEnemies world)]
  where
    ...
    enemyPic :: Enemy -> Picture
    enemyPic (Enemy loc) =
      let (centerX, centerY) = cellCenter $ conversion loc
          tl = (centerX - 5, centerY + 5)
          tr = (centerX + 5, centerY + 5)
          br = (centerX + 5, centerY - 5)
          bl = (centerX - 5, centerY - 5)
      in  Color orange (Polygon [tl, tr, br, bl])

One extra part of updating the drawing function is that we'll have to draw a "losing" message. This will be a lot like the winning message.

drawingFunc :: (Float, Float) -> Float -> World -> Picture
drawingFunc (xOffset, yOffset) cellSize world
 ...
 | worldResult world == GameLost =
     Translate (-275) 0 $ Scale 0.12 0.25
       (Text "Oh no! You've lost! Press enter to restart this maze!")
...

Odds and Ends

Two little things remain. First, we want a function to randomize the locations of the enemies. We'll use this to decide their positions at the beginning and when we restart. In the future we may add a power-up that allows the player to run this randomizer. As with other random functions, we'll make this function stateful over the StdGen element.

generateRandomLocation :: (Int, Int) -> State StdGen Location
generateRandomLocation (numCols, numRows) = do
  gen <- get
  let (randomCol, gen') = randomR (0, numCols - 1) gen
      (randomRow, gen'') = randomR (0, numRows - 1) gen'
  put gen''
  return (randomCol, randomRow)

As before, we can sequence these stateful actions together. In the case of initializing the board, we'll use replicateM and the number of enemies. Then we can use the locations to make our enemies, and then place the final generator back into our world.

main = do
  gen <- getStdGen
  let (maze, gen') = generateRandomMaze gen (25, 25)
      numEnemies = 4
      (randomLocations, gen'') = runState
        (replicateM numEnemies (generateRandomLocation (25,25)))
        gen'
      enemies = Enemy <$> randomLocations
      initialWorld = World (0, 0) (0,0) (24,24)
                       maze GameInProgress gen'' enemies
  play ...

The second thing we'll want to do is update the event handler so that it restarts the game when we lose. We'll have similar code to when we win. However, we'll stick with the original maze rather than re-randomizing.

inputHandler :: Event -> World -> World
inputHandler event w
  ...
  | worldResult w == GameLost = case event of
      (EventKey (SpecialKey KeyEnter) Down _ _) ->
        let (newLocations, gen') = runState
              (replicateM (length (worldEnemies w)) 
                (generateRandomLocation (25, 25)))
                (worldRandomGenerator w)
        in  World (0,0) (0,0) (24, 24)
             (worldBoundaries w) GameInProgress gen'
             (Enemy <$> newLocations)
      _ -> w
  ...

(Note we also have to update the game winning code!) And now we have enemies roving around our maze. Awesome!

Conclusion

Next week we'll step up the difficulty of our game! We'll make the enemies much smarter so that they'll move towards us! This will give us an opportunity to learn about the breadth first search algorithm. There are a few nuances to writing this in Haskell. So don't miss it! The week after, we'll develop a way to stun the enemies. Remember you can follow this project on our Github! The code for this article is on the part-5 branch.

We've used monads, particularly the State monad, quite a bit in this series. Hopefully you can see now how important they are! But they don't have to be difficult to learn! Check out our series on Functional Structures to learn more! It starts with simpler structures like functors. But it will ultimately teach you all the common monads!

Quicksort with Haskell!

Last week we referenced the ST monad and went into a little bit of depth with how it enables mutable arrays. It provides an alternative to the IO monad that gives us mutable data without side effects. This week, we're going to take a little bit of a break from adding features to our Maze game. We'll look at a specific example where mutable data can allow different algorithms.

Let's consider the quicksort algorithm. We can do this "in place", mutating an input array. But immutable data in Haskell makes it difficult to implement this approach. We'll examine one approach using normal, immutable lists. Then we'll see how we can use a more common quicksort algorithm using ST. At the end of the day, there are still difficulties with making this work the way we'd like. But it's a useful experiment to try nonetheless.

Still new to monads in Haskell? You should read our series on Monads and Functional Structures! It'll help you learn monads from the ground up, starting with simpler concepts like functors!

The ST Monad

Before we dive back into using arrays, let's take a quick second to grasp the purpose of the ST monad. My first attempt at using mutable arrays in the Maze game involved using an IOArray. This worked, but it caused generateRandomMaze to use the IO monad. You should be very wary of any action that changes your code from pure to using IO. The old version of the function couldn't have weird side effects like file system access! The new version could have any number of weird bugs present! Among other things, it makes it much harder to use and test this code.

In my specific case, there was a more pressing issue. It became impossible to run random generation from within the eventHandler. This meant I couldn't restart the game how I wanted. The handler is a pure function and can't use IO.

The ST monad provides precisely what we need. It allows us to run code that can mutate values in place without allowing arbitrary side effects, as IO does. We can use the generic runST function to convert a computation in the ST monad to it's pure result. This is similar to how we can use runState to run a State computation from a pure one.

runST :: (forall s. ST s a) -> a

The s parameter is a little bit magic. We generally don't have to specify what it is. But the parameter prevents the outside world from having extra side effects on the data. Don't worry about it too much.

There's another function runSTArray. This does the same thing, except it works with mutable arrays:

runSTArray :: (forall s. ST s (STArray s i e)) -> Array i e

This allows us to use STArray instead of IOArray as our mutable data type. Later in this article, we'll use this type to make our "in-place" quicksort algorithm. But first, let's look at a simpler version of this algorithm.

Slow Quicksort

Learn You a Haskell For Great Good presents a short take on the quicksort algorithm. It demonstrates the elegance with which we can express recursive solutions.

quicksort1 :: (Ord a) => [a] -> [a]
quicksort1 [] = []
quicksort1 (x:xs) =
  let smallerSorted = quicksort1 [a | a <- xs, a <= x]
      biggerSorted = quicksort1 [a | a <- xs, a > x]
  in  smallerSorted ++ [x] ++ biggerSorted

This looks very nice! It captures the general idea of quicksort. We take the first element as our pivot. We divide the remaining list into the elements greater than the pivot and less than the pivot. Then we recursively sort each of these sub-lists, and combine them with the pivot in the middle.

However, each new list we make takes extra memory. So we are copying part of the list at each recursive step. This means we will definitely use at least O(n) memory for this algorithm.

We can also note the way this algorithm chooses its pivot. It always selects the first element. This is quite inefficient on certain inputs (sorted or reverse sorted arrays). To get our expected performance to a good point, we want to choose the pivot index at random. But then we would need an extra argument of type StdGen, so we'll ignore it for this article.

It's possible of course, to do quicksort "in place", without making any copies of any part of the array! But this requires mutable memory. To get an idea of what this algorithm looks like, we'll implement it in Java first. Mutable data is more natural in Java, so this code will be easier to follow.

In-Place Quicksort (Java)

The quicksort algorithm is recursive, but we're going to handle the recursion in a helper. The helper will take two add extra arguments: the int values for the "start" and "end" of this quicksort section. The goal of quicksortHelper will be to ensure that we've sorted only this section. As a stylistic matter, I use "end" to mean one index past the point we're sorting to. So our main quicksort function will call the helper with 0 and arr.length.

public static void quicksort(int[] arr) {
  quicksortHelper(arr, 0, arr.length);
}

public static void quicksortHelper(int[] arr, int start, int end) {
  ...
}

Before we dive into the rest of that function though, let's design two smaller helpers. The first is very simple. It will swap two elements within the array:

public static void swap(int[] arr, int i, int j) {
  int temp = arr[i];
  arr[i] = arr[j];
  arr[j] = temp;
}

The next helper will contain the core of the algorithm. This will be our partition function. It's responsible for choosing a pivot (again, we'll use the first element for simplicity). Then it divides the array so that everything smaller than the pivot is in the first part of the array. After, we insert the pivot, and then we get the larger elements. It returns the index of partition:

public static int partition(int[] arr, int start, int end) {
  int pivotElement = arr[start];
  int pivotIndex = start + 1;
  for (int i = start + 1; i < end; ++i) {
    if (arr[i] <= pivotElement) {
      swap(arr, i, pivotIndex);
      ++pivotIndex;
    }
  }
  swap(arr, start, pivotIndex - 1);
  return pivotIndex - 1;
}

Now our quicksort helper is easy! It will partition the array, and then make recursive calls on the sub-parts! Notice as well the base case:

public static void quicksortHelper(int[] arr, int start, int end) {
  if (start + 1 >= end) {
    return;
  }
  int pivotIndex = partition(arr, start, end);
  quicksortHelper(arr, start, pivotIndex);
  quicksortHelper(arr, pivotIndex + 1, end);
}

Since we did everything in place, we didn't allocate any new arrays! So our function definitions only add O(1) extra memory for the temporary values. Since the stack depth is, on average, O(log n), that is the asymptotic memory usage for this algorithm.

In-Place Quicksort (Haskell)

Now that we're familiar with the in-place algorithm, let's see what it looks like in Haskell. We want to do this with STArray. But we'll still write a function with pure input and output. Unfortunately, this means we'll end up using O(n) memory anyway. The thaw function must copy the array to make a mutable version of it. However, the rest of our operations will work in-place on the mutable array. We'll follow the same patterns as our Java code! Let's start simple and write our swap function!

swap :: ST s Int a -> Int -> Int -> ST s ()
swap arr i j = do
  elem1 <- readArray arr i
  elem2 <- readArray arr j
  writeArray arr i elem2
  writeArray arr j elem1

Now let's write out our partition function. We're going to make it look as much like our Java version as possible. But it's a little tricky because we're don't have for-loops! Let's deal with this problem head on by first designing a function to handle the loop.

The loop produces our value for the final pivot index. But we have to keep track of its current value. This sounds like a job for the State monad! Our state function will take the pivotElement and the array itself as a parameter. Then it will take a final parameter for the i value we have in our partition loop in the Java version.

partitionLoop :: (Ord a)
  => STArray s Int a
  -> a
  -> Int
  -> StateT Int (ST s) ()
partitionLoop arr pivotElement i = do
  ...

We fill this with comparable code to Java. We read the current pivot and the element for the current i index. Then, if it's smaller, we swap them in our array, and increment the pivot:

partitionLoop :: (Ord a)
  => STArray s Int a
  -> a
  -> Int
  -> StateT Int (ST s) ()
partitionLoop arr pivotElement i = do
  pivotIndex <- get
  thisElement <- lift $ readArray arr i
  when (thisElement <= pivotElement) $ do
    lift $ swap arr i pivotIndex
    put (pivotIndex + 1)

Now we incorporate this loop into our primary partition function after getting the pivot element. We'll use mapM to sequence the state actions together and pass that to execStateT. Then we'll return the final pivot (subtracting 1). Don't forget to swap the pivot into the middle of the array though!

partition :: (Ord a)
 => STArray s Int a
 -> Int
 -> Int
 -> ST s Int
partition arr start end = do
  pivotElement <- readArray arr start
  let pivotIndex_0 = start + 1
  finalPivotIndex <- execStateT
    (mapM (partitionLoop arr pivotElement) [(start+1)..(end-1)])
    pivotIndex_0
  swap arr start (finalPivotIndex - 1)
  return $ finalPivotIndex - 1

Now it's super easy to incorporate these into our final function!

quicksort2 :: (Ord a) => Array Int a -> Array Int a
quicksort2 inputArr = runSTArray $ do
  stArr <- thaw inputArr
  let (minIndex, maxIndex) = bounds inputArr
  quicksort2Helper minIndex (maxIndex + 1) stArr
  return stArr

quicksort2Helper :: (Ord a)
  => Int 
  -> Int
  -> STArray s Int a
  -> ST s ()
quicksort2Helper start end stArr = when (start + 1 < end) $ do
  pivotIndex <- partition stArr start end
  quicksort2Helper start pivotIndex stArr
  quicksort2Helper (pivotIndex + 1) end stArr

This completes our algorithm! Notice again though, that we use thaw and freeze. This means our main quicksort2 function can have pure inputs and outputs. But it comes at the price of extra memory. It's still cool though that we can use mutable data from inside a pure function!

Conclusion

Since we have to copy the list, this particular example doesn't result in much improvement. In fact, when we benchmark these functions, we see that the first one actually performs quite a bit faster! But it's still a useful trick to understand how we can manipulate data "in-place" in Haskell. The ST monad allows us to do this in a "pure" way. If we're willing to accept impure code, the IO monad is also possible.

Next week we'll get back to game development! We'll add enemies to our game that will go around and try to destroy our player! As we add more and more features, we'll continue to see cool ways to learn about algorithms in Haskell. We'll also see new ways to architect the game code.

There are many other advanced Haskell programs you can write! Check out our Production Checklist for ideas!

Making Arrays Mutable!

Last week we walked through the process of refactoring our code to use Data.Array instead of Data.Map. But in the process, we introduced a big inefficiency! When we use the Array.// function to "update" our array, it has to create a completely new copy of the array! For various reasons, Map doesn't have to do this.

So how can we fix this problem? The answer is to use the MArray interface, for mutable arrays. With mutable arrays, we can modify them in-place, without a copy. This results in code that is much more efficient. This week, we'll explore the modifications we can make to our code to allow this. You can see a quick summary of all the changes in this Git Commit.

Refactoring code can seem like an hard process, but it's actually quite easy with Haskell! In this article, we'll use the idea of "Compile Driven Development". With this process, we update our types and then let compiler errors show us all the changes we need. To learn more about this, and other Haskell paradigms, read our Haskell Brain series!

Mutable Arrays

To start with, let's address the seeming contradiction of having mutable data in an immutable language. We'll be working with the IOArray type in this article. An item of type IOArray acts like a pointer, similar to an IORef. And this pointer is, in fact, immutable! We can't make it point to a different spot in memory. But we can change the underlying data at this memory. But to do so, we'll need a monad that allows such side effects.

In our case, with IOArray, we'll use the IO monad. This is also possible with the ST monad. But the specific interface functions we'll use (which are possible with either option) live in the MArray library. There are four in particular we're concerned with:

freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)

thaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)

readArray :: (MArray a e m, Ix i) => a i e -> i -> m e

writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()

The first two are conversion functions between normal, immutable arrays and mutable arrays. Freezing turns the array immutable, thawing makes it mutable. The second two are our replacements for Array.! and Array.// when reading and updating the array. There are a lot of typeclass constraints in these. So let's simplify them by substituting in the types we'll use:

freeze
  :: IOArray Location CellBoundaries 
  -> IO (Array Location CellBoundaries)

thaw 
  :: Array Location CellBoundaries 
  -> IO (IOArray Location CellBoundaries)

readArray
  :: IOArray Location CellBoundaries 
  -> Location 
  -> IO CellBoundaries

writeArray
  :: IOArray Location CellBoundaries
  -> Location
  -> CellBoundaries
  -> IO ()

Obviously, we'll need to add the IO monad into our code at some point. Let's see how this works.

Basic Changes

We won't need to change how the main World type uses the array. We'll only be changing how the SearchState stores it. So let's go ahead and change that type:

type MMaze = IA.IOArray Location CellBoundaries

data SearchState = SearchState
  { randomGen :: StdGen
  , locationStack :: [Location]
  , currentBoundaries :: MMaze
  , visitedCells :: Set.Set Location
  }

The first issue is that we should now pass a mutable array to our initial search state. We'll use the same initialBounds item, except we'll thaw it first to get a mutable version. Then we'll construct the state and pass it along to our search function. At the end, we'll freeze the resulting state. All this involves making our generation function live in the IO monad:

-- This did not have IO before!
generateRandomMaze :: StdGen -> (Int, Int) -> IO Maze
generateRandomMaze gen (numRows, numColumns) = do
  initialMutableBounds <- IA.thaw initialBounds
  let initialState = SearchState 
                       g2
                       [(startX, startY)]
                       initialMutableBounds
                       Set.empty
  let finalBounds = currentBoundaries
                      (execState dfsSearch initialState)
  IA.freeze finalBounds
  where
    (startX, g1) = …
    (startY, g2) = …

    initialBounds :: Maze
    initialBounds = …

This seems to "solve" our issues in this function and push all our errors into dfsSearch. But it should be obvious that we need a fundamental change there. We'll need the IO monad to make array updates. So the type signatures of all our search functions need to change. In particular, we want to combine monads with StateT SearchState IO. Then we'll make any "pure" functions use IO instead.

dfsSearch :: StateT SearchState IO ()

findCandidates :: Location -> Maze -> Set.Set Location
  -> IO [(Location, CellBoundaries, Location, CellBoundaries)]

chooseCandidate
  :: [(Location, CellBoundaries, Location, CellBoundaries)]
  -> StateT SearchState IO ()

This will lead us to update our generation function.

generateRandomMaze :: StdGen -> (Int, Int) -> IO Maze
generateRandomMaze gen (numRows, numColumns) = do
  initialMutableBounds <- IA.thaw initialBounds
  let initialState = SearchState
                       g2
                       [(startX, startY)]
                       initialMutableBounds
                       Set.empty
  finalBounds <- currentBoundaries <$>
                  (execStateT dfsSearch initialState)
  IA.freeze finalBounds
  where
  …

The original dfsSearch definition is almost fine. But findCandidates is now a monadic function. So we'll have to extract its result instead of using let:

-- Previously
let candidateLocs = findCandidates currentLoc bounds visited

-- Now
candidateLocs <- lift $ findCandidates currentLoc bounds visited

The findCandidates function though will need a bit more re-tooling. The main this is that we need readArray instead of Array.!. The first swap is easy:

findCandidates currentLocation@(x, y) bounds visited = do
  currentLocBounds <- IA.readArray bounds currentLocation
  ...

It's tempting to go ahead and read all the other values for upLoc, rightLoc, etc. right now:

findCandidates currentLocation@(x, y) bounds visited = do
  currentLocBounds <- IA.readArray bounds currentLocation
  let upLoc = (x, y + 1)
  upBounds <- IA.readArray bounds upLoc
  ...

We can't do that though, because this will access them in a strict way. We don't want to access upLoc until we know the location is valid. So we need to do this within the case statement:

findCandidates currentLocation@(x, y) bounds visited = do
  currentLocBounds <- IA.readArray bounds currentLocation
  let upLoc = (x, y + 1)
  maybeUpCell <- case (upBoundary currentLocBounds,
                       Set.member upLoc visited) of
    (Wall, False) -> do
      upBounds <- IA.readArray bounds upLoc
      return $ Just
        ( upLoc
        , upBounds {downBoundary = AdjacentCell currentLocation}
        , currentLocation
        , currentLocBounds {upBoundary = AdjacentCell upLoc}
        )
    _ -> return Nothing

And then we'll do the same for the other directions and that's all for this function!

Choosing Candidates

We don't have to change too much about our chooseCandidates function! The primary change is to eliminate the line where we use Array.// to update the array. We'll replace this with two monadic lines using writeArray instead. Here's all that happens!

chooseCandidate candidates = do
  (SearchState gen currentLocs boundsMap visited) <- get
  ...
  lift $ IA.writeArray boundsMap chosenLocation newChosenBounds
  lift $ IA.writeArray boundsMap prevLocation newPrevBounds
  put (SearchState newGen (chosenLocation : currentLocs) boundsMap newVisited)

Aside from that, there's one small change in our runner to use the IO monad for generateRandomMaze. But after that, we're done!

Conclusion

As mentioned above, you can see all these changes in this commit on our github repository. The last two articles have illustrated how it's not hard to refactor our Haskell code much of the time. As long as we are methodical, we can pick the one thing that needs to change. Then we let the compiler errors direct us to everything we need to update as a result. I find refactoring other languages (particularly Python/Javascript) to be much more stressful. I'm often left wondering...have I actually covered everything? But in Haskell, there's a much better chance of getting everything right the first time!

To learn more about Compile Driven Development, read our Haskell Brain Series. If you're new to Haskell you can also read our Liftoff Series and download our Beginners Checklist!

Compile Driven Development In Action: Refactoring to Arrays!

In the last couple weeks, we've been slowly building up our maze game. For instance, last week, we added the ability to serialize our mazes. But software development is never a perfect process! So it's not uncommon to revisit some past decisions and come up with better approaches. This week we're going to address a particular code wart in the random maze generation code.

Right now, we store our Maze as a mapping from Locations to CellBoundaries items. We do this using Data.Map. The Map.lookup function returns a Maybe result, since it might not exist. But most of the time we accessed a location, we had good reason to believe that it would exist in the map. This led to several instances of the following idiom:

fromJust $ Map.lookup location boundsMap

Using a function like fromJust is a code smell, a sign that we could be doing something better. This week, we're going to change this structure so that it uses the Array type instead from Data.Array. It captures our idiomatic definitions better. We'll use "Compile Driven Development" to make this change. We won't need to hunt around our code to figure out what's wrong. We'll just make type changes and follow the compiler errors!

To learn more about compile driven development and the mental part of Haskell, read our Haskell Brain series. It will help you think about the language in a different way. So it's a great tool for beginners!

Another good resource for this article is to look at the Github repository for this project. The complete code for this part is on the part-3 branch. You can consult this commit to see all the changes we make in migrating to arrays.

Initial Changes

To start with, we should make sure our code uses the following type synonym for our maze type:

type Maze = Map.Map Location CellBoundaries

Now we can observe the power of type synonyms! We'll make a change in this one type, and that'll update all the instances in our code!

import qualified Data.Array as Array

type Maze = Array.Array Location CellBoundaries

Of course, this will cause a host of compiler issues! But most of these will be pretty simple to fix. But we should be methodical and start at the top. The errors begin in our parsing code. In our mazeParser, we use Map.fromList to construct the final map. This requires the pairs of Location and CellBoundaries.

mazeParser :: (Int, Int) -> Parsec Void Text Maze
mazeParser (numRows, numColumns) = do
  …
  return $ Map.fromList (cellSpecToBounds <$> (concat rows))

The Array library has a similar function, Array.array. However, it also requires us to provides the bounds for the Array. That is, we need the "min" and "max" locations in a tuple. But these are easy, since we have the dimensions as an input!

mazeParser :: (Int, Int) -> Parsec Void Text Maze
mazeParser (numRows, numColumns) = do
  …
  return $ Array.array 
    ((0,0), (numColumns - 1, numRows - 1))
    (cellSpecToBounds <$> (concat rows))

Our next issue comes up in the dumpMaze function. We use Map.mapKeys to transpose the keys of our map. Then we use Map.toList to get the association list back out. Again, all we need to do is find the comparable functions for arrays to update these.

To change the keys, we want the ixmap function. It does the same thing as mapKeys. As with Array.array, we need to provide an extra argument for the min and max bounds. We'll provide the bounds of our original maze.

transposedMap = Array.ixmap (Array.bounds maze) (\(x, y) -> (y, x)) maze

A few lines below, we can see the usage of Map.toList when grouping our pairs. All we need instead is Array.assocs

cellsByRow :: [[(Location, CellBoundaries)]]
cellsByRow = groupBy
  (\((r1, _), _) ((r2, _), _) -> r1 == r2)
  (Array.assocs transposedMap)

Updating Map Generation

That's all the changes for the basic parsing code. Now let's move on to the random generation code. This is where we have a lot of those yucky fromJust $ Map.lookup calls. We can now instead use the "bang" operator, Array.! to access those elements!

findCandidates currentLocation@(x, y) bounds visited =
  let currentLocBounds = bounds Array.! currentLocation
  ...

Of course, it's possible for an "index out of bounds" error to occur if we aren't careful! But our code should reflect the fact that we expect all these calls to work. After fixing the initial call, we need to change each directional component. Here's what the first update looks like:

findCandidates currentLocation@(x, y) bounds visited =
      let currentLocBounds = bounds Array.! currentLocation
          upLoc = (x, y + 1)
          maybeUpCell = case (upBoundary currentLocBounds,
                              Set.member upLoc visited) of
                          (Wall, False) -> Just
                            ( upLoc
                            , (bounds Array.! upLoc) {downBoundary = 
                                AdjacentCell currentLocation}
                            , currentLocation
                            , currentLocBounds {upBoundary =
                                AdjacentCell upLoc}
                            )
                          _ -> Nothing

We've replaced Map.lookup with Array.! in the second part of the resulting tuple. The other three directions need the same fix.

Then there's one last change in the random generation section! When we choose a new candidate, we currently need two calls to Map.insert. But arrays let us do this with one function call. The function is Array.//, and it takes a list of association updates. Here's what it looks like:

chooseCandidate candidates = do
      (SearchState gen currentLocs boundsMap visited) <- get
      ...
      -- Previously used Map.insert twice!!!
      let newBounds = boundsMap Array.//
            [(chosenLocation, newChosenBounds),
             (prevLocation, newPrevBounds)]
      let newVisited = Set.insert chosenLocation visited
      put (SearchState
             newGen
             (chosenLocation : currentLocs) 
             newBounds 
             newVisited)

Final Touch Ups

Now our final remaining issues are within the Runner code. But they're all similar fixes to what we saw in the parsing code.

In our sample boundariesMap, we once again replace Map.fromList with Array.array. Again, we add a parameter with the bounds of the array. Then, when drawing the pictures for our cells, we need to use Array.assocs instead of Map.toList.

For the final change, we need to update our input handler so that it accesses the array properly. This is our final instance of fromJust $ Map.lookup! We can replace it like so:

inputHandler :: Event -> World -> World
inputHandler event w = case event of
  ...
  where
    cellBounds = (worldBoundaries w) Array.! (playerLocation w)

And that's it! Now our code will compile and work as it did before!

Conclusion

There's a pretty big inefficiency with our new approach. Whereas Map.insert can give us an updated map in log(n) time, the Array.// function isn't so nice. It has to create a complete copy of the array, and we run that function many times! How can we fix this? Next week, we'll find out! We'll use the Mutable Array interface to make it so that we can update our array in-place! This is super efficient, but it requires our code to be more monadic!

For some more ideas of cool projects you can do in Haskell, download our Production Checklist! It goes through a whole bunch of libraries on topics from database management to web servers!

Serializing Mazes!

Last week we improved our game so that we could solve additional random mazes after the first. This week, we'll step away from the randomness and look at how we can serialize our mazes. This will allow us to have a consistent and repeatable game. It will also enable us to save the game state later.

We'll be using the Megaparsec library as part of this article. If you aren't familiar with that (or parsing in Haskell more generally), check out our Parsing Series!

A Serialized Representation

The serialized representation of our maze doesn't need to be human readable. We aren't trying to create an ASCII art style representation. That said, it would be nice if it bore some semblance to the actual layout. There are a couple properties we'll aim for.

First, it would be good to have one character represent one cell in our maze. This dramatically simplifies any logic we'll use for serializing back and forth. Second, we should layout the cell characters in a way that matches the maze's appearance. So for instance, the top left cell should be the first character in the first row of our string. Then, each row should appear on a separate line. This will make it easier to avoid silly errors when coming up with test cases.

So how can we serialize a single cell? We could observe that for each cell, we have sixteen possible states. There are 4 sides, and each side is either a wall or it is open. This suggests a hexadecimal representation.

Let's think of the four directions as being 4 bits, where if there is a wall, the bit is set to 1, and if it is open, the bit is set to 0. We'll order the bits as up-right-down-left, as we have in a couple other areas of our code. So we have the following example configurations:

1. An open cell with no walls around it is 0.
2. A totally surrounded cell is 1111 = F.
3. A cell with walls on its top and bottom would be 1010 = A.
4. A cell with walls on its left and right would be 0101 = 5.

With that in mind, we can create a small 5x5 test maze with the following representation:

98CDF
1041C
34775
90AA4
32EB6

And this ought to look like so:

This serialization pattern lends itself to a couple helper functions we'll use later. The first, charToBoundsSet, will take a character and give us four booleans. These represent the presence of a wall in each direction. First, we convert the character to the hex integer. Then we use patterns about hex numbers and where the bits lie. For instance, the first bit is only set if the number is at least 8. The last bit is only set for odd numbers. This gives us the following:

charToBoundsSet :: Char -> (Bool, Bool, Bool, Bool)
charToBoundsSet c =
  ( num > 7,
  , num `mod` 8 > 3
  , num `mod` 4 > 1
  , num `mod` 2 > 0
  )

Then, we also want to go backwards. We want to take a CellBoundaries item and convert it to the proper character. We'll look at each direction. If it's an AdjacentCell, it contributes nothing to the final Int value. But otherwise, it contributes the hex digit value for its place. We add these up and convert to a char with intToDigit:

cellToChar :: CellBoundaries -> Char
cellToChar bounds =
  let top = case upBoundary bounds of
        (AdjacentCell _) -> 0
        _ -> 8
  let right = case rightBoundary bounds of
        (AdjacentCell _) -> 0
        _ -> 4
  let down = case downBoundary bounds of
        (AdjacentCell _) -> 0
        _ -> 2
  let left = case leftBoundary bounds of
        (AdjacentCell _) -> 0
        _ -> 1
  in toUpper $ intToDigit (top + right + down + bottom)

We'll use both of these functions in the next couple parts.

Serializing a Maze

Let's move on now to determining how we can take a maze and represent it as Text. For this part, let's first apply a type synonym on our maze type:

type Maze = Map.Map Location CellBoundaries

dumpMaze :: Maze -> Text
dumpMaze = ...

First, let's imagine we have a single row worth of locations. We can convert that row to a string easily using our helper function from above:

dumpMaze = …
  where
    rowToString :: [(Location, CellBoundaries)] -> String
    rowToString = map (cellToChar . snd)

Now we'd like to take our maze map and group it into the different rows. The groupBy function seems appropriate. It groups elements of a list based on some predicate. We'd like to take a predicate that checks if the rows of two elements match. Then we'll apply that against the toList representation of our map:

rowsMatch :: (Location, CellBoundaries) -> (Location, CellBoundaries) -> Bool
rowsMatch ((_, y1), _) ((_, y2), _) = y1 == y2

We have a problem though because groupBy only works when the elements are next to each other in the list. The Map.toList function will give us a column-major ordering. We can fix this by first creating a transposed version of our map:

dumpMaze maze = …
  where
    transposedMap :: Maze
    transposedMap = Map.mapKeys (\(x, y) -> (y, x)) maze

Now we can go ahead and group our cells by row:

dumpMaze maze = …
  where
    transposedMap = …

    cellsByRow :: [[(Location, CellBoundaries)]]
    cellsByRow = groupBy (\((r1, _), _) ((r2, _), _) -> r1 == r2) 
                   (Map.toList transposedMap)

And now we can complete our serialization function! We get the string for each row, and combine them with unlines and then pack into a Text.

dumpMaze maze = pack $ (unlines . reverse) (rowToString <$> cellsByRow)
  where
    transposedMap = …

    cellsByRow = …

    rowToString = ...

As a last trick, note we reverse the order of the rows. This way, we get that the top row appears first, rather than the row corresponding to y = 0.

Parsing a Maze

Now that we can dump our maze into a string, we also want to be able to go backwards. We should be able to take a properly formatted string and turn it into our Maze type. We'll do this using the Megaparsec library, as we discussed in part 4 of our series on parsing in Haskell. So we'll create a function in the Parsec monad that will take the dimensions of the maze as an input:

import qualified Text.Megaparsec as M

mazeParser :: (Int, Int) -> M.Parsec Void Text Maze
mazeParser (numRows, numColumns) = ...

We want to parse the input into a format that will match each character up with its location in the (x,y) coordinate space of the grid. This means parsing one row at a time, and passing in a counter argument. To make the counter match with the desired row, we'll use a descending list comprehension like so:

mazeParser (numRows, numColumns = do
  rows <- forM [(numRows - 1), (numRows - 2)..0] $ \i -> do
  ...

For each row, we'll parse the individual characters using M.hexDigit and match them up with a column index:

mazeParser (numRows, numColumns = do
  rows <- forM [0..(numRows - 1)] $ \i -> do
    (columns :: [(Int, Char)]) <-
      forM [0..(numColumns - 1)] $ \j -> do
        c <- M.hexDigitChar
        return (j, c)
    ...

We conclude the parsing of a row by reading the newline character. Then we make the indices match the coordinates in discrete (x,y) space. Remember, the "column" should be the first item in our location.

mazeParser (numRows, numColumns = do
  (rows :: [[(Location, Char)]]) <-
    forM [0..(numRows - 1)] $ \i -> do
      columns <- forM [0..(numColumns - 1)] $ \j -> do
        c <- M.hexDigitChar
        return (j, c)
      M.newline
      return $ map (\(col, char) -> ((col, i), char)) columns
  ...

Now we'll need a function to convert one of these Location, Char pairs into CellBoundaries. For the most part, we just want to apply our charToBoundsSet function and get the boolean values. Remember these tell us if walls are present or not:

mazeParser (numRows, numColumns = do
  rows <- …
  where
    cellSpecToBounds :: (Location, Char) -> (Location, CellBoundaries)
    cellSpecToBounds (loc@(x, y), c) =
      let (topIsWall, rightIsWall, bottomIsWall, leftIsWall) = 
            charToBoundsSet c
      ...

Now it's a matter of applying a case by case basis in each direction. We just need a little logic to determine, in the True case, if it should be a Wall or a WorldBoundary. Here's the implementation:

cellSpecToBounds :: (Location, Char) -> (Location, CellBoundaries)
cellSpecToBounds (loc@(x, y), c) =
  let (topIsWall, rightIsWall, bottomIsWall, leftIsWall) = 
         charToBoundsSet c
      topCell = if topIsWall
        then if y + 1 == numRows
          then WorldBoundary
          else Wall
        else (AdjacentCell (x, y + 1))
      rightCell = if rightIsWall
        then if x + 1 == numColumns
          then WorldBoundary
          else Wall
        else (AdjacentCell (x + 1, y))
      bottomCell = if bottomIsWall
        then if y == 0
          then WorldBoundary
          else Wall
        else (AdjacentCell (x, y - 1))
      leftCell = if leftIsWall
        then if x == 0
          then WorldBoundary
          else Wall
        else (AdjacentCell (x - 1, y))
  in  (loc, CellBoundaries topCell rightCell bottomCell leftCell)

And now we can complete our parsing function by applying this helper over all our rows!

mazeParser (numRows, numColumns = do
  (rows :: [[(Location, Char)]]) <-
    forM [0..(numRows - 1)] $ \i -> do
      columns <- forM [0..(numColumns - 1)] $ \j -> do
        c <- M.hexDigitChar
        return (j, c)
      M.newline
      return $ map (\(col, char) -> ((col, i), char)) columns
  return $ Map.fromList (cellSpecToBounds <$> (concat rows))
  where
    cellSpecToBounds = ...

Conclusion

This wraps up our latest part on serializing maze definitions. The next couple parts will still be more code-focused. We'll look at ways to improve our data structures and an alternate way of generating random mazes. But after those, we'll get back to adding some new game features, such as wandering enemies and combat!

To learn more about serialization, you should read our series on parsing. You can also download our Production Checklist for more ideas!

Declaring Victory! (And Starting Again!)

In last week's article, we used a neat little algorithm to generate random mazes for our game. This was cool, but nothing happens yet when we "finish" the maze! We'll change that this week. We'll allow the game to continue re-generating new mazes when we're finished! You can find all the code for this part on the part-2 branch on the Github repository for this project!

If you're a beginner to Haskell, hopefully this series is helping you learn simple ways to do cool things! If you're a little overwhelmed, try reading our Liftoff Series first!

Goals

Our objectives for this part are pretty simple. We want to make it so that when we reach the "end" location, we get a "victory" message and can restart the game by pressing a key. We'll get a new maze when we do this. There are a few components to this:

1. Reaching the end should change a component of our World.
2. When that component changes, we should display a message instead of the maze.
3. Pressing "Enter" with the game in this state should start the game again with a new maze.

Sounds pretty simple! Let's get going!

Game Result

We'll start by adding a new type to represent the current "result" of our game. We'll add this piece of state to our World. As an extra little piece, we'll add a random generator to our state. We'll need this when we re-make the maze:

data GameResult = GameInProgress | GameWon
  deriving (Show, Eq)

data World = World
  { playerLocation :: Location
  , startLocation :: Location
  , endLocation :: Location
  , worldBoundaries :: Maze
  , worldResult :: GameResult
  , worldRandomGenerator :: StdGen
  }

Our generation step needs a couple small tweaks. The function itself should now return its final generator as an extra result:

generateRandomMaze :: StdGen -> (Int, Int) -> (Maze, StdGen)
generateRandomMaze gen (numRows, numColumns) =
  (currentBoundaries finalState, randomGen finalState)
  where
    ...
    finalState = execState dfsSearch initialState

Then in our main function, we incorporate the new generator and game result into our World:

main = do
  gen <- getStdGen
  let (maze, gen') = generateRandomMaze gen (25, 25)
  play
    windowDisplay
    white
    20
    (World (0, 0) (0, 0) (24, 24) maze GameInProgress gen')
    ...

Now let's fix our updating function so that it changes the game result if we hit the final location! We'll add a guard here to check for this condition and update accordingly:

updateFunc :: Float -> World -> World
updateFunc _ w
  | playerLocation w == endLocation w = w { worldResult = GameWon }
  | otherwise = w

We could do this in the eventHandler but it seems more idiomatic to let the update function handle it. If we use the event handler, we'll never see our token enter the final square. The game will jump straight to the victory screen. That would be a little odd. Here there's at least a tiny gap.

Displaying Victory!

Now our game will update properly. But we have to respond to this change by changing what the display looks like! This is a quick fix. We'll add a similar guard to our drawingFunc:

drawingFunc :: (Float, Float) -> Float -> World -> Picture
drawingFunc (xOffset, yOffset) cellSize world
  | worldResult world == GameWon =
      Translate (-275) 0 $ Scale 0.12 0.25
        (Text "Congratulations! You've won!\
              \Press enter to restart with a new maze!")
  | otherwise = ...

Note that Text here is the Gloss Picture constructor, not Data.Text. We also scale and translate it a bit to make the text appear on the screen. This is all we need to get the victory screen to appear on completion!

Restarting the Game

The last step is that we have to follow through on our process to restart the game if they hit enter! This involves changing our inputHandler to give us a brand new World. As with our other functions, we'll add a guard to handle the GameWon case:

inputHandler :: Event -> World -> World
inputHandler event w
  | worldResult w == GameWon = …
  | otherwise = case event of
    ...

We'll want to make a new case section that accounts for the user pressing the "Enter" key. All this section needs to do is call generateRandomMaze and re-initialize the world!

inputHandler event w
  | worldResult w == GameWon = case event of
      (EventKey (SpecialKey KeyEnter) Down _ _) ->
        let (newMaze, gen') = generateRandomMaze 
              (worldRandomGenerator w) (25, 25)
        in  World (0, 0) (0, 0) (24, 24) newMaze GameInProgress gen'
      _ -> w

And with that, we're done! We can restart the game and navigate random mazes to our heart's content!

Conclusion

The ability to restart the game is great! But if we want to make our game re-playable instead of random, we'll need some way of storing mazes. In the next part, we'll look at some code for dumping a maze to an output format. We'll also need a way to re-load from this stored representation. This will ultimately allow us to make a true game with saving and loading state.

In preparation for that, you can read our series on Parsing. You'll especially want to acquaint yourself with the Megaparsec library. We go over this in Part 4 of the series!

Generating More Difficult Mazes!

In the last part of this series, we established the fundamental structures for our maze game. But our "maze" was still rather bland. It didn't have any interior walls, so getting to the goal point was trivial. In this next part, we'll look at an algorithm for random maze generation. This will let us create some more interesting challenges. In upcoming parts of this series, we'll explore several more related topics. We'll see how to serialize our maze definition. We'll refactor some of our data structures. And we'll also take a look at another random generation algorithm.

If you've never programmed in Haskell before, you should download our Beginners Checklist! It will help you learn the basics of the language so that the concepts in this series will make more sense. The State monad will also see a bit of action in this part. So if you're not comfortable with monads yet, you should read our series on them!

Getting Started

We represent a maze with the type Map.Map Location CellBoundaries. For a refresher, a Location is an Int tuple. And the CellBoundaries type determines what borders a particular cell in each direction:

type Location = (Int, Int)

data BoundaryType = Wall | WorldBoundary | AdjacentCell Location

data CellBoundaries = CellBoundaries
  { upBoundary :: BoundaryType
  , rightBoundary :: BoundaryType
  , downBoundary :: BoundaryType
  , leftBoundary :: BoundaryType
  }

An important note is that a Location refers to the position in discrete x,y space. That is, the first index is the column (starting from 0) and the second index is the row. Don't confuse row-major and column-major ordering! (I did this when implementing this solution the first time).

To generate our maze, we'll want two inputs. The first will be a random number generator. This will help randomize our algorithm so we can keep generating new, fresh mazes. The second will be the desired size of our grid.

import System.Random (StdGen, randomR)

…

generateRandomMaze
  :: StdGen
  -> (Int, Int)
  -> Map.Map Location CellBoundaries
generateRandomMaze gen (numRows, numColumns) = ...

A Simple Randomization Algorithm

This week, we're going to use a relatively simple algorithm for generating our maze. We'll start by assuming everything is a wall, and we've selected some starting position. We'll use the following depth-first-search pattern:

1. Consider all cells around us
2. If there are any we haven't visited yet, choose one of them as the next cell.
3. "Break down" the wall between these cells, and put that new cell onto the top of our search stack, marking it as visited.
4. If we have visited all other cells around us, pop this current location from the stack
5. As long as there is another cell on the stack, choose it as the current location and continue searching from step 1.

There are several pieces of state we have to maintain throughout the process. So the State monad is an excellent candidate for this problem! Let's make a SearchState type for all these:

data SearchState = SearchState
  { randomGenerator :: StdGen
  , locationStack :: [Location]
  , currentBoundaries :: Map.Map Location CellBoundaries
  , visitedCells :: Set.Set Location
  }

dfsSearch :: State SearchState ()
dfsSearch = ...

Each time we make a random selection, we'll use the randomR function that returns the appropriate value as well as a new generator. Then we'll use a normal list for our search stack since we can push and pop from the top with ease. Next, we'll track the current state of the maze (it starts as all walls and we'll gradually break those down). Finally, there's the set of all cells we've already visited.

Starting Our Search!

To start our search process, we'll pull all our information out of the state monad, and examine the stack. If it's empty, we're done and can return! Otherwise, we'll want to consider the top location:

dfsSearch = do
  (SearchState gen locs bounds visited) <- get
  case locs of
    [] -> return ()
    (currentLoc : rest) -> do
      ...

Finding New Search Candidates

Given a particular location, we need to find the potential neighbors. We want to satisfy two conditions:

1. It shouldn't be in our visited set.
2. The boundary to this location should be a Wall

Then we'll want to use these properties to determine a list of candidates. Each candidate will contain 4 items:

1. The next location
2. The bounds we would use for the new location
3. The previous location
4. The new bounds for the previous location.

This seems like a lot, but it'll make more sense as we fill out our algorithm. With that in mind, here's the structure of our findCandidates function:

findCandidates
  :: Location -- Current location
  -> Map.Map Location CellBoundaries -- Current maze state
  -> Set.Set Location -- Visited Cells
  -> [(Location, CellBoundaries, Location, CellBoundaries)]
findCandidates currentLocation bounds visited = ...

Filling in this function consists of following the same process for each of the four directions from our starting point. First we check if the adjacent cell in that direction is valid. Then we create the candidate, containing the locations and their new boundaries. Since the location could be invalid, the result is a Maybe. Here's what we do for the "up" direction:

findCandidates =
  let currentLocBounds = fromJust $
        Map.lookup currentLocation bounds
      upLoc = (x, y + 1)
      maybeUpCandidate = case
        (upBoundary currentLocBounds, Set.member upLoc visited) of
        (Wall, False) -> Just
          ( upLoc
          , (fromJust $ Map.lookup upLoc bounds)
              { downBoundary = AdjacentCell currentLocation }
          , currentLocation
          , currentLocBounds { upBoundary = AdjacentCell upLoc }
          )
        ...

We replace the existing Wall elements with AdjacentCell elements in our maze map. This may seem like it's doing a lot of unnecessary work in calculating bounds that we'll never use. But remember that Haskell is lazy! Any candidate that isn't chosen by our random algorithm won't be fully evaluated. We repeat this process for each direction and then use catMaybes on them all:

findCandidates =
  let currentLocBounds = fromJust $ Map.lookup currentLocation bounds
      upLoc = (x, y + 1)
      maybeUpCandidate = …
      rightLoc = (x + 1, y)
      maybeRightCandidate = …
      downLoc = (x, y - 1)
      maybeDownCandidate = …
      leftLoc = (x - 1, y)
      maybeLeftCandidate = …
  in  catMaybes [maybeUpCandidate, maybeRightCandidate, … ]

Choosing A Candidate

Our search function is starting to come together now. Here's what we've got so far. If we don't have any candidates, we'll reset our search state by popping the current location off our stack. Then we can continue the search by making another call to dfsSearch.

dfsSearch = do
  (SearchState gen locs bounds visited) <- get
  case locs of
    [] -> return ()
    (currentLoc : rest) -> do
      let candidateLocs = findCandidates currentLoc bounds visited
      if null candidateLocs
        then put (SearchState gen rest bounds visited) >> dfsSearch
        else ...

But assuming we have a non-empty list of candidates, we'll need to choose one. This function will update most of our state elements, so we'll put in in the State monad as well:

chooseCandidate
  :: [(Location, CellBoundaries, Location, CellBoundaries)]
  -> State SearchState ()
chooseCandidate candidates = do
  (SearchState gen currentLocs boundsMap visited) <- get
  ...

First, we'll need to select a random index into this list, which assumes it is non-empty.:

chooseCandidate candidates = do
  (SearchState gen currentLocs boundsMap visited) <- get
  let (randomIndex, newGen) = randomR (0, (length candidates) - 1) gen
      (chosenLocation, newChosenBounds, prevLocation, newPrevBounds) =
        candidates !! randomIndex

Since we did the hard work of creating the new bounds objects up above, the rest is straightforward. We'll create our new state with different components.

We get a new random generator from the randomR call. Then we can push the new location onto our search stack. Next, we update the bounds map with the new locations. Last, we can add the new location to our visited array:

chooseCandidate candidates = do
  (SearchState gen currentLocs boundsMap visited) <- get
  let (randomIndex, newGen) = randomR (0, (length candidates) - 1) gen
      (chosenLocation, newChosenBounds, prevLocation, newPrevBounds) =
        candidates !! randomIndex
      newBounds = Map.insert prevLocation newPrevBounds
        (Map.insert chosenLocation newChosenBounds boundsMap)
      newVisited = Set.insert chosenLocation visited
      newSearchStack = chosenLocation : currentLocs
  put (SearchState newGen newSearchStack newBounds newVisited)

Then to wrap up our DFS, we'll call this function at the very end. Remember to make the recursive call to dfsSearch!

dfsSearch = do
  (SearchState gen locs bounds visited) <- get
  case locs of
    [] -> return ()
    (currentLoc : rest) -> do
      let candidateLocs = findCandidates currentLoc bounds visited
      if null candidateLocs
        then put (SearchState gen rest bounds visited) >> dfsSearch
        else (chooseCandidate candidateLocs) >> dfsSearch

Incorporating Our Search

As a last step in our process, we need to incorporate our search function. At the most basic level, we'll want to execute our DFS state function and extract the boundaries from it:

generateRandomMaze :: StdGen -> (Int, Int) -> Map.Map Location CellBoundaries
generateRandomMaze gen (numRows, numColumns) =
  currentBoundaries (execState dfsSearch initialState)
  where
    initialState :: SearchState
    initialState = ...

But we need to build our initial state. We'll start our search from a random location. Our initial stack and visited set will contain this location. Notice that with each random call, we use a new generator.

generateRandomMaze gen (numRows, numColumns) =
  currentBoundaries (execState dfsSearch initialState)
  where
    (startX, g1) = randomR (0, numColumns - 1) gen
    (startY, g2) = randomR (0, numRows - 1) g1

    initialState :: SearchState
    initialState = SearchState
      g2
      [(startX, startY)]
      … -- TODO Bounds
      (Set.fromList [(startX, startY)])

The last thing we need is our initial bounds set. For this, I'm going to tease the next part of the series. We'll write a function to parse a maze from a string representation (and reverse the process). Our encoding will represent a "surrounded" cell with the character 'F'. So we can represent a completely blocked maze like so:

generateRandomMaze gen (numRows, numCols) = …
  where
    …

    fullString :: Text
    fullString = pack . unlines $
      take numRows $ repeat (take numColumns (repeat 'F'))

Finally, we'll apply the mazeParser function in Megaparsec style. You'll have to wait a couple weeks to see how to implement that! It will give us the appropriate cell boundaries.

generateRandomMaze gen (numRows, numColumns) =
  currentBoundaries (execState dfsSearch initialState)
  where
    (startX, g1) = randomR (0, numColumns - 1) gen
    (startY, g2) = randomR (0, numRows - 1) g1

    initialState :: SearchState
    initialState = SearchState
      g2
      [(startX, startY)]
      initialBounds
      (Set.fromList [(startX, startY)])

    initialBounds :: Map.Map Location CellBoundaries
    initialBounds = case Megaparsec.runParser
      (mazeParser (numRows, numColumns) "" fullString of
        Right bounds -> bounds
        _ -> error "Couldn't parse maze for some reason!"

    fullString :: Text
    fullString = ...

You can also look at our Github repo for some details. You'll want the part-2 branch if you want more details about how everything works!

Conclusion

Generating random mazes is cool. But it would be nice if we could actually finish the maze we're running and do another one! Next week, we'll make some modifications to the game state so that when we finish with one maze, we'll have the option to try another random one!

If you're just getting started with Haskell, we have some great resources to get you going! Download our Beginners Checklist and read our Liftoff Series!

Building a Bigger World

Last week we looked at some of the basic components of the Gloss library. We made simple animations and simulations, as well as a very simple "game" taking player input. This week, we're going to start making a more complex game!

Our game will involve navigating a maze, from start to finish. In fact, this week, we're not even going to make it very "mazy". We're just going to set up an open grid to navigate around with our player. But over the course of these next few weeks, we'll add more and more features, like enemies and hazards. At some point, we'll have so many features that we'll need a more organized scheme to keep track of everything. At that point, we'll discuss game architecture. You can take a look at the code for this game on our Github repository. For this part, you'll want to look at the part-1 branch.

Game programming is only one of the many interesting ways we can use Haskell. Take a look at our Production Checklist for some more ideas!

Making Our World

As we explored in the last part, the World type is central to how we define our game. It is a parameter to all the important functions we'll write. Before we define our World though, let's define a couple helper types. These will clarify many of our other functions.

-- Defined in Graphics.Gloss
-- Refers to (x, y) within the drawable coordinate system
type Point = (Float, Float)

-- Refers to discrete (x, y) within our game grid.
type Location = (Int, Int)

data GameResult = InProgress | PlayerWin | PlayerLoss

Let's start our World type now with a few simple elements. We'll imagine the game board as a grid with a fixed size, with the tiles having coordinates like (0,0) in the bottom left. We'll want a start location and an ending location for the maze. We'll also want to track the player's current location as well as the current "result" of the game:

data  World = World
  { playerLocation :: Location
  , startLocation :: Location
  , endLocation :: Location
  , gameResult :: GameResult
  …
  }

Now we need to represent the "maze". In other words, we want to be able to track where the "walls" are in our grid. We'll make a data type to represent to boundaries for any particular cell. Then we'll stick a mapping from each location in our grid to its boundaries:

data BoundaryType = WorldBoundary | Wall | AdjacentCell Location

data CellBoundaries = CellBoundaries
  { upBoundary :: BoundaryType
  , rightBoundary :: BoundaryType
  , downBoundary :: BoundaryType
  , leftBoundary :: BoundaryType
  }

data  World = World
  { …
  , worldBoundaries :: Map Location CellBoundaries
  }

Populating Our World

Next week we'll look into how we can generate interesting mazes. But for now, our grid will only have "walls" on the outside, not in the middle. To start, we'll define a function that takes the number of rows and columns in our grid and a particular location. It will return the "boundaries" of the cell at that location. Each boundary tells us if there is a wall in one direction, or if we are clear to move to a different cell. All we need to check is if we're about to exceed the boundary in that direction.

simpleBoundaries :: (Int, Int) -> Location -> CellBoundaries
simpleBoundaries (numColumns, numRows) (x, y) = CellBoundaries
  (if y + 1 < numRows
    then AdjacentCell (x, y+1)
    else WorldBoundary)
  (if x + 1 < numColumns
    then AdjacentCell (x+1, y)
    else WorldBoundary)
  (if y > 0 then AdjacentCell (x, y-1) else WorldBoundary)
  (if x > 0 then AdjacentCell (x-1, y) else WorldBoundary)

Our main function now will loop through all the different cells in our grid and make a map out of them:

boundariesMap :: (Int, Int) -> Map.Map Location CellBoundaries
boundariesMap (numColumns, numRows) = Map.fromList
  (buildBounds <$> (range ((0,0), (numColumns, numRows))))
  where
    buildBounds :: Location -> (Location, CellBoundaries)
    buildBounds loc =
      (loc, simpleBoundaries (numColumns, numRows) loc)

Now we have all the tools we need to populate our initial world:

main = play
  windowDisplay
  white
  20
  (World (0, 0) (0,0) (24, 24) InProgress (boundariesMap (25, 25))
  drawingFunc ...
  inputHandler …
  updateFunc ...

Drawing Our World

Now we need to draw our world. We'll begin by passing a couple new parameters to our drawing function. We'll need offset values that will tell us the Point in our geometric coordinate system for the Location (0,0). We'll also take a floating point value for the cell size. Then we will also, of course, take the World as a parameter:

drawingFunc :: (Float, Float) -> Float -> World -> Picture
drawingFunc (xOffset, yOffset) cellSize world = …

Before we do anything else, let's define a type called CellCoordinates. This will contain the Points for the center and four corners of a cell in our grid.

data CellCoordinates = CellCoordinates
  { cellCenter :: Point
  , cellTopLeft :: Point
  , cellTopRight :: Point
  , cellBottomLeft :: Point
  , cellBottomRight :: Point
  }

Next, let's define a conversion function from a Location to one of the coordinate objects. This will take the offsets, cell size, and the desired location.

locationToCoords ::
  (Float, Float) -> Float -> Location -> CellCoordinates
locationToCoords (xOffset, yOffset) cellSize (x, y) = CellCoordinates
  (centerX, centerY) -- Center
  (centerX - halfCell, centerY + halfCell) -- Top Left
  (centerX + halfCell, centerY + halfCell) -- Top Right
  (centerX - halfCell, centerY - halfCell) -- Bottom Left
  (centerX + halfCell, centerY - halfCell) -- Bottom Right
  where
    (centerX, centerY) =
      ( xOffset + (fromIntegral x) * cellSize
      , yOffset + (fromIntegral y) * cellSize)
    halfCell = cellSize / 2.0

Now we can go ahead and make the first few simple pictures in our game. We'll have colored polygons for the start and end locations, and a circle for the player token. The player marker is easiest:

drawingFunc (xOffset, yOffset) cellSize world =
  Pictures [startPic, endPic, playerMarker]
  where
    conversion = locationToCoords (xOffset, yOffset) cellSize
    (px, py) = cellCenter (conversion (playerLocation world))
    playerMarker = translate px py (Circle 10)
    startPic = …
    endPic = ...

We find its coordinates through our conversion, and then translate a circle. For our start and end points, we'll want to do something similar, except we want the corners, not the center. We'll use the corners as the points in our polygons and draw these polygons in appropriate colors.

drawingFunc (xOffset, yOffset) cellSize world =
  Pictures [startPic, endPic, playerMarker]
  where
    conversion = locationToCoords (xOffset, yOffset) cellSize
    ...
    startCoords = conversion (startLocation world)
    endCoords = conversion (endLocation world)
    startPic = Color blue (Polygon
      [ cellTopLeft startCoords
      , cellTopRight startCoords
      , cellBottomRight startCoords
      , cellBottomLeft startCoords
      ])
    endPic = Color green (Polygon
      [ cellTopLeft endCoords
      , cellTopRight endCoords
      , cellBottomRight endCoords
      , cellBottomLeft endCoords
      ])

Now we need to draw the wall lines. So we'll have to loop through the wall grid, drawing the relevant lines for each individual cell.

drawingFunc (xOffset, yOffset) cellSize world = Pictures
  [mapGrid, startPic, endPic, playerMarker]
  where
  …
    mapGrid = Pictures $concatMap makeWallPictures
      (Map.toList (worldBoundaries world))

    makeWallPictures :: (Location, CellBoundaries) -> [Picture]
    makeWallPictures ((x, y), CellBoundaries up right down left) = ...

When drawing the lines for an individual cell, we'll use thin lines when there is no wall. We can make these with the Line constructor and the two corner points. But we want a separate color and thickness to distinguish an impassable wall. In this second case, we'll want two extra points that are offset so we can draw a polygon. Here's a helper function we can use:

drawingFunc (xOffset, yOffset) cellSize world = ...
  where
   ...
    drawEdge :: (Point, Point, Point, Point) ->
                 BoundaryType -> Picture
    drawEdge (p1, p2, _, _) (AdjacentCell _) = Line [p1, p2]
    drawEdge (p1, p2, p3, p4) _ =
      Color blue (Polygon [p1, p2, p3, p4])

Now to apply this function, we'll need to do a little math to dig out all the individual coordinates out of this cell.

drawingFunc (xOffset, yOffset) cellSize world =
  Pictures [mapGrid, startPic, endPic, playerMarker]
  where
    ...
    makeWallPictures :: (Location, CellBoundaries) -> [Picture]
    makeWallPictures ((x,y), CellBoundaries up right down left) =
      let coords = conversion (x,y)
          tl@(tlx, tly) = cellTopLeft coords
          tr@(trx, try) = cellTopRight coords
          bl@(blx, bly) = cellBottomLeft coords
          br@(brx, bry) = cellBottomRight coords
      in  [ drawEdge (tr, tl, (tlx, tly - 2), (trx, try - 2)) up
          , drawEdge (br, tr, (trx-2, try), (brx-2, bry)) right
          , drawEdge (bl, br, (brx, bry+2), (blx, bly+2)) down
          , drawEdge (tl, bl, (blx+2, bly), (tlx+2, tly)) left
          ]

But that's all we need! Now our drawing function is complete!

Player Input

The last thing we need is our input function. This is going to look a lot like it did last week. We'll only be looking at the arrow keys. And we'll be updating the player's coordinates if the move they entered is valid. To start, let's figure out how we get the bounds for the player's current cell (we'll assume the location is in our map).

inputHandler :: Event -> World -> World
inputHandler event w = case event of
  (EventKey (SpecialKey KeyUp) Down _ _) -> ...
  (EventKey (SpecialKey KeyDown) Down _ _) -> ...
  (EventKey (SpecialKey KeyRight) Down _ _) -> ...
  (EventKey (SpecialKey KeyLeft) Down _ _) -> ...
  _ -> w
  where
    cellBounds = fromJust $ Map.lookup (playerLocation w) (worldBoundaries w)

Now we'll define a function that will take an access function to the CellBoundaries. It will determine what our "next" location is.

inputHandler :: Event -> World -> World
inputHandler event w = case event of
  ...
  where
    nextLocation :: (CellBoundaries -> BoundaryType) -> Location
    nextLocation boundaryFunc = case boundaryFunc cellBounds of
      (AdjacentCell cell) -> cell
      _ -> playerLocation w

Finally, we pass the proper access function for the bounds with each direction, and we're done!

inputHandler :: Event -> World -> World
inputHandler event w = case event of
  (EventKey (SpecialKey KeyUp) Down _ _) ->
    w { playerLocation = nextLocation upBoundary }
  (EventKey (SpecialKey KeyDown) Down _ _) ->
    w { playerLocation = nextLocation downBoundary }
  (EventKey (SpecialKey KeyRight) Down _ _) ->
    w { playerLocation = nextLocation rightBoundary }
  (EventKey (SpecialKey KeyLeft) Down _ _) ->
    w { playerLocation = nextLocation leftBoundary }
  _ -> w
  where
    ...

Tidying Up

Now we can put everything together in our main function with a little bit of glue.

main :: IO ()
main = play
  windowDisplay
  white
  20
  (World (0, 0) (0,0) (24,24) (boundariesMap (25, 25)))
  (drawingFunc (globalXOffset, globalYOffset) globalCellSize)
  inputHandler
  updateFunc

updateFunc :: Float -> World -> World
updateFunc _ = id

Note that for now, we don't have much of an "update" function. Our world doesn't change over time. Yet! We'll see in the coming weeks what other features we can add that will make use of this.

Conclusion

So we've finished stage 1 of our simple game! You can explore the part-1 branch on our Github repository to look at the code if you want! Come back next week and we'll explore how we can actually create a true maze, instead of an open grid. This will involve some interesting algorithmic challenges!

For some more ideas of advanced Haskell libraries, check out our Production Checklist. You can also read our Web Skills Series for a more in-depth tutorial on some of those ideas.

Making a Glossy Game! (Part 1)

I've always had a little bit of an urge to try out game development. It wasn't something I associated with Haskell in the past. But recently, I started learning a bit about game architecural patterns. I stumbled on some ideas that seemed "Haskell-esque". I learned about the Entity-Component-System model, which suits typeclasses rather than object-oriented design.

So I've decided to do a few articles on writing a basic game in Haskell. We'll delve more into these architectural ideas later in the series. But to start, we have to learn a few building blocks! The first couple weeks will focus on the basics of the Gloss library. This library has some simple tools for creating 2D graphics that we can use to make a game. Frequent readers of this blog will note a lot of commonalities between Gloss and the Codeworld library we studied a while back. In this first part, we'll learn some basic combinators.

If you're looking for some more practical usages of Haskell, we have some tools for you! Download our Production Checklist to learn many interesting libraries you can use! You can also read our Haskell Web Skills series to go a bit more in depth!

A Basic Gloss Tutorial

The get started with the Gloss library, let's draw a simple picture using the display function. All this does is make a full screen window with a circle in the middle.

-- Always imported
import Graphics.Glass

main :: IO ()
main = display FullScreen white (Circle 80)

All the arguments here are pretty straightforward. The program opens a full screen window and displays a circle against a white background. We can make the window smaller by using InWindow instead of FullScreen for the Display type. This takes a window "name", as well as dimensions for the size and offset of the window.

windowDisplay :: Display
windowDisplay = InWindow "Window" (200, 200) (10, 10)

main :: IO ()
main = display windowDisplay white (Circle 80)

The primary argument here is this last one, a Picture using the Circle constructor. We can draw many different things, including circles, lines, boxes, text, and so on. The Picture type also allows for translation, rotation, and aggregation of other pictures.

Animating

We can take our drawing to the next level by using the animate function. Instead of only drawing a static picture, we'll take the animation time as an input to a function. Here's how we can provide an animation of a growing circle:

main = animate windowDisplay white animationFunc

animationFunc :: Float -> Picture
animationFunc time = Circle (2 * time)

Simulating

The next stage of our program's development is to add a model. This allows us to add state to our animation so that it is no longer merely a function of the time. For our next example, we'll make a pendulum. We'll keep two pieces of information in our model. These are the current angle ("theta") and the derivative of that angle ("dtheta"). The simulate function takes more arguments than animate. Here's the skeleton of how we use it. We'll go over the new arguments one-by-one.

type Model = (Float, Float)

main = simulate
  displayWindow
  white
  simulationRate
  initialModel
  drawingFunc
  updateFunc
  where
    simulationRate :: Int
    simulationRate = 20

    initialModel :: Model
    initialModel = (0,0)

    drawingFunc :: Model -> Picture
    drawingFunc (theta, dtheta) = …

    updateFunc :: ViewPort -> Float -> Model -> Model
    updateFunc _ dt (theta, dtheta) = ...

The first extra argument (simulationRate) tells us how many model steps per second. Then we have our initial model. Then there's a function taking the model and telling us how to draw the picture. We'll fill this in to draw a line at the appropriate angle.

drawingFunc :: Model -> Picture
drawingFunc (theta, dtheta) = Line [(0, 0), (50 * cos theta, 50 * sin theta)]

Finally, we have an updating function. This takes the view-port, which we won't use. It also takes the amount of time for this simulation step (dt). Then it takes a current model. It uses these to determine the new model. We can fill this in with a little bit of trigonometry. Then we'll have a working pendulum simulation!

updateFunc :: ViewPort -> Float -> Model -> Model
updateFunc _ dt (theta, dtheta) = (theta + dt * dtheta, dtheta - dt * (cos theta))

Playing a Game

The final element we need to make a playable game is to accept user input. The play function provides us what we need here. It looks like the simulate function except for an extra function for handling input. We're going to make a game where the user can move a circle around with the arrow keys. We'll add an extra mechanic where the circle keeps trying to move back towards the center. Here's the skeleton:

type World = (Float, Float)

main :: IO ()
main = play
  windowDisplay
  white
  20
  (0, 0)
  drawingFunc
  inputHandler
  updateFunc

drawingFunc :: World -> Picture
drawingFunc (x, y) = ...

inputHandler :: Event -> World -> World
inputHandler event (x, y) = ...

updateFunc :: Float -> World -> World
updateFunc dt (x, y) = ...

Our World will represent the current location of our circle. The drawing function will draw a simple circle, translated by this amount.

drawingFunc :: World -> Picture
drawingFunc (x, y) = translate x y (Circle 20)

Now for our input handler, we only care about a few inputs. We'll read the up/down/left/right arrows, and adjust the coordinates:

inputHandler :: Event -> World -> World
inputHandler (EventKey (SpecialKey KeyUp) Down _ _) (x, y) = (x, y + 10)
inputHandler (EventKey (SpecialKey KeyDown) Down _ _) (x, y) = (x, y - 10)
inputHandler (EventKey (SpecialKey KeyRight) Down _ _) (x, y) = (x + 10, y)
inputHandler (EventKey (SpecialKey KeyLeft) Down _ _) (x, y) = (x - 10, y)
inputHandler _ w = w

Finally, let's write our "update" function. This will keep trying to move the circle's coordinates towards the center of the frame:

updateFunc :: Float -> World -> World
updateFunc _ (x, y) = (towardCenter x, towardCenter y)
  where
    towardCenter :: Float -> Float
    towardCenter c = if abs c < 0.25
      then 0
      else if c > 0
        then c - 0.25
        else c + 0.25

And that's it, we have our miniature game!

Conclusion

Hopefully this article gave you a good, quick overview on the basics of the Gloss library. Next week, we'll start making a more complicated game with a more interesting model!

We have other resources for the more adventurous Haskellers out there! Download our Production Checklist and read our Haskell Web Skills Series!

Extending Haskell's Syntax!

When you're starting out with Haskell, compiler extensions seem a little weird. And in a way, they are. It's strange to think that you need to "opt in" to certain compiler features. And as a beginner, it can be overwhelming to think you need to know the meaning of certain odd terms. I still remember how some of the first Haskell code I worked on had at least 10 extensions in every file. And I didn't have a clue what they meant!

But there are good reasons for certain features to be "opt in". They might make the compilation process longer. Or they might make some types of code less performant. But there are many extensions you can use that can make you life easier without worrying. And many extensions are easy to learn, so you can get the hang of the concept.

In this article, we’re going to do a quick run-down of some simple extensions. You’ve probably heard of at least of few of these. But it’s always good to keep learning. None of these are too advanced. For the most part, they allow you to use some more syntactic sugar and write cleaner code. So they’re pretty uncontroversial and you should feel free to use them in any file you want. Learning a few of these will help you get more comfortable so you can tackle harder extensions when you need to.

For some more tools to take your Haskell to the next level, download our Production Checklist! You can also read our Haskell Web Series for some tutorials.

Overloaded Strings

We’ve done one article already on overloaded strings. But here’s another quick summary. There are five different string types in Haskell. By default, Haskell assumes that whenever you use a string literal, you intend for it to be the String type.

-- Defaults as String
aString = "Hello"

-- The following will NOT WORK (by default)
aText :: Text
aText = "Hello"

This is annoying, because String is generally inferior to the other string types. You should be using Text most of the time for performance reasons. If we use the OverloadedStrings extension, then we can use literals for any of these string types!

{-# LANGUAGE OverloadedStrings #-}

-- Now this works!
aText :: Text
aText = "Hello"

aByteString :: ByteString
aByteString = "Hello"

And, in fact, you can use string literals for any type you want! All you have to do is create an instance of the IsString class for it by defining the fromString function.

newtype Name = Name String

instance IsString Name where
  fromString s = Name s

myName :: Name
myName = "James"

This is one of the most common and simplest extensions you can use, so it's a great one to start with!

Lambda Case

Lambda case is another simple extension, but it isn’t quite as common as overloaded strings. It helps clean up a particular syntax wart that comes up from time to time. Consider a function where we take a single argument, and then immediately run a case statement on it:

useParseResult :: Either ParseError Result -> IO ()
useParseResult x = case x of
  Left parseError -> …
  Right goodResult -> ...

You could do a direct pattern match, but sometimes this is impossible if you’re in-lining the function. Notice that we use a one-letter variable name x. We could come up with a better name. But it seems like a waste since we don't use this variable anywhere else in the function definition. If would be nice if we could remove it altogether.

The LambdaCase extension allows this by providing the following syntactic sugar. You can use case as if it were the argument of a lambda expression, and then immediately do the pattern match:

{-# LANGUAGE LambdaCase #-}

useParserResult :: EitherParseError Result -> IO ()
useParserResult = \case ->
  Left parseError -> ...
  Right goodResult -> ...

At the end of the day, it’s a small difference. But it's a nice little trick you can use to save yourself some unneeded variable names.

Bang Patterns

Haskell is lazy by default. But there are certain situations where you need a strict value as an input to your function. This means the value should get evaluated BEFORE the function gets run. This is a little tricky to do with normal Haskell syntax. Consider this function:

bangTest :: Bool -> Int -> Int
bangTest b i = if b then 42 else 2 * i

If the boolean is true, laziness means we never evaluate the int argument. Hence the following works:

>> bangTest True undefined
42

But if we want that situation to fail, we need to use seq:

bangTest b i = seq i $ if b then 42 else 2 * i

…
>> bangTest True undefined
***Exception: Prelude.undefined

The BangPatterns extension allows us to use the bang character ! to specify that the function should be strict in an argument. So instead of using seq like above, we can get the same behavior like so:

bangTest :: Bool -> Int -> Int
bangTest b !i = if b then 42 else 2 * i

…

>> bangTest True undefined
***Exception: Prelude.undefined

Even without this extension, you can use strictness annotations in type definitions. Consider this example:

data Person = Person String

printName :: Bool -> Person -> IO ()
printName b (Person name) = if b
  then putStrLn "Hello"
  else putStrLn name

…
>> printName True (Person undefined)
Hello

But we can also make person strict in its string argument like so:

data Person = Person !String

…

>> printName True (Person undefined)
*** Exception: Prelude.undefined

And again, this last example works even without the extension!

Type Operators

Haskell is sometimes criticized for an abundance of confusing operators. This next syntax extension does not ease this criticism! But it does provide some neat new possibilities when defining types! Here's an example with the Servant library. It requires both DataKinds and TypeOperators, but we'll focus on the latter.

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

type PersonAPI =
       "person" :> Capture "personid" Int :> Get '[JSON] Person
  :<|> "person" :> ReqBody '[JSON] Person :> Post '[JSON] Int

As a reminder, we've defined a type up there, not a normal expression! This means the :> and :<|> operators are actually constructors! Let's define an example for ourselves. Suppose we have a simple type that wraps a couple other types in a pair:

data MyPair a b = MyPair a b

collection :: MyPair [Int] [String]
...

Now suppose we want to join more types together. We can do this by nesting MyPair instances, but the type signatures will get messy:

bigCollection :: MyPair [Int] (MyPair [String] (Map String Int))

But we can define a type operator that allows us to join these together!

infixr 8 +>>
type (t1 +>> t2) = MyPair t1 t2

And now we can get far cleaner signatures!

collection :: [Int] +>> [String]

bigCollection :: [Int] +>> [String] +>> Map String Int

Haskell lets us make complex recursive structures with many different type parameters. Type operators help us keep the signatures concise when we do this!

Tuple Sections

We've got one last trick for you. The TupleSections extension makes tuples easier to work with. Even without an extension can use the comma operator to build tuples like so:

combined :: (Int, String)
combined = (,) 5 "Hello"

combined3 :: (Int, String, Float)
combined3 = (,,) 5 "Hello" 2.3

But suppose we want to apply a function where we hardcode a particular value of a tuple. We'd need a separate definition of this function:

injectHello :: Int -> Float -> (Int, String, Float)
injectHello i f = (i, "Hello", f)

fetchInt :: IO Int

fetchFloat :: IO Float

combined :: IO (Int, String, Float)
combined = injectHello <$> fetchInt <*> fetchFloat

But with TupleSections, we can create a constructor that already has "Hello" built in! We can then apply it as a function with using another definition!

{-# LANGUAGE TupleSections #-}

combined :: IO (Int, String, Float)
combined = (,"Hello",) <$> fetchInt <*> fetchFloat

This is another useful little trick that let's us skip annoying in-between definitions. When you add up all these small things, it can go a long way towards cleaner code!

Conclusion

The ecosystem of Haskell compiler extensions is very large. As a beginner, it can be hard to know where to start. But many extensions are simple. In this article, we went over a couple simple ones and a couple more complicated ones. Once you get familiar with one or two, the concept starts making a lot more sense.

For some more ideas on taking your Haskell to the next level, check out our Production Checklist! It has a list of libraries for cool purposes like writing servers and using databases!

Modifying a Library!

Sometime last year, I wrote an article about advanced Stack techniques. We discussed one hypothetical case where a library had a bug. The solution here was to fork the repository and use a Github location in stack.yaml.

I recently came across an easy example of doing this and thought I'd share it. We can see how to incorporate the change without stressing about its complexity. Even if you're only a beginner, this is a good skill to learn now!

You'll need some background on Stack first though! If you've never used Stack before, take a look at our Stack mini-course to learn more!

Background

I've been doing a bit of work lately with the persistent-migration library. This library lets us set up manual migrations for a Persistent schema we've set up through template Haskell. See this article for more on that topic.

The migrations library has a couple functions that let us run some SQL operations. They live in the SqlPersistT monad, as we would expect. However, something's a little off about them:

getMigration ::
  MigrateSettings -> Migration -> SqlPersistT IO [MigrateSql]

runMigration ::
  MigrateSettings -> Migration -> SqlPersistT IO ()

We can see that these functions restrict us to using SqlPersistT on top of the normal IO monad. But in most cases with Persistent, I use the withPostgresqlConn function. This adds a MonadLogger constraint. Thus IO doesn't cut it. Most functions have a type signature looking like this:

databaseOp :: SqlPersistT (LoggingT IO) a

So we can't interoperate as easily as we'd like between our normal database operations, and these migration functions. The solution is that the migration functions should be more general in what monads they can use. This will be an easy fix, as we'll see. But first, we have to find a way to get our own version of the code.

Getting Started

The persistent-migration library is on Github here. So we can make a fork of the repository, and clone that to our machine:

git clone https://github.com/jhb563/peristent-migration

Now we'll follow the build instructions in the Developing.md file to get set up. Some of the tests fail on my machine, but we'll ignore that for this article.

Making Our Code Fixes

The code fixes turn out to be very easy. We can go into the relevant module and change the type signatures so they are more general:

module Database.Persistent.Migration.Postgres where

...

getMigration :: (MonadIO m) =>
  MigrateSettings -> Migration -> SqlPersistT m [MigrateSql]

runMigration :: (MonadIO m) =>
  MigrateSettings -> Migration -> SqlPersistT m ()

Even in the worst case, the only changes we would need to make here would be to add liftIO calls in various places. But it turns out that this change doesn't break anything! The library still builds, and all the tests that were passing before still pass.

So now we can commit this change to our fork and push it to the repository.

Incorporating the Fix

Now we have to use our own fork as an alternative to the version of the library on Hackage. Before, the extra-deps section in ourstack.yaml` looked like this:

extra-deps:
  - persistent-migration-0.1.0

This indicates we would grab the code from Hackage. But now we can use an alternative package format to reference our Github repository. Here's what we change it to:

extra-deps:
  - git: https://github.com/jhb563/persistent-migration.git
    commit: 9f9c5035efe

And now we've got our own fork as a dependency for our project! We can write code like so:

doMigrations :: SqlPersistT (LoggingT IO) a
doMigrations = do
  runMigration defaultSettings migration
  ...

And everything works! Our code builds!

Potential Issues

Now, an approach like this can lead to some possible issues. We're now disconnected from the original repository. So if there was a new release, we'd have to do a bit more work to pull those changes into our own repository. Still, this isn't too difficult. One solution to this is to submit a pull request with our changes. If it gets accepted, they'll be in the next release! Then we can go back to using the version on Hackage!

Conclusion

In this article, we did a quick overview of how to make our own changes to libraries. We cloned the repository, made a code change, and added our fork as a dependency. Obviously, most of the changes you'll want to make aren't as simple as this one was. But it's good to use an example where all we're doing is tackling the issue of getting the code into our code base!

For a broad overview of how to use the Stack program, make sure to check out of Stack Mini-course! If you've never written any Haskell before, you can also look at our Beginners Checklist!

Shareable Haskell with Jupyter!

In the last couple weeks, we've discussed a couple options for Haskell IDEs, like Atom and IntelliJ. But there's another option I'll talk about this week. Both our IDE setups are still most useful for fully-fledged projects. But if you're writing some quick and dirty one-off code, they can be a little cumbersome to work with.

This other option is Jupyter with IHaskell. It's like IPython, for those who have used that. I got the idea when the good folks at Tweag made a blog post with it. Jupyter was originally intended for making quick Python data science scripts. It allows a nice UI for making data visualizations. Thanks to the hard work of Andrew Gibiansky, there is a Haskell kernel for Jupyter! In this article, we'll discuss some quick approaches to using it.

IHaskell is actually a great tool when you're first learning Haskell! If you've never programmed in Haskell before, you can read our Liftoff Series and follow along with the code examples! You can write them using IHaskell instead of making a Stack project!

Installing

If you want to make a full-fledged Jupyter notebook, you'll need to install Jupyter first. The most heavy-duty but easiest way would be to use the Anaconda distribution. But there are also other options like pip.

After that, you'll need to install the Haskell kernel for it. Unfortunately, you can't do this on a Windows machine. You either need a Mac, Linux or a virtual box. The instructions for these systems are well documented in the README. In short, you need to sort out your Python dependencies, grab the Github repo, and build the project.

Now if you're on Windows, or you don't want to install the full Jupyter system, you can try out IHaskell online. Head to this Binder page, make a new notebook, and get cracking!

Making a Basic Example

In our notebook, we can write Haskell code as if we're in a file, but evaluate it as if we're in GHCI. A quick look at the .cabal file will reveal the libraries we have easy access to in this notebook setup. We can see for instance that we have stalwarts such as mtl, aeson, and split. Using this last library, we can write the following snippet:

Then we press shift+enter to finish the cell and it gets evaluated. Evaluations work as in GHCI. Anything you assign to a variable name will be usable later on in your notebook. Then the final expression you put will get printed. So we'll see output like so:

Then we can use the items we named in another snippet like this:

Since we also have access to the Aeson library, we can serialize our list like so:

As a final note it is easy to create multiline definitions and use those! This is a big improvement over GHCI. It would be very annoying to define a new data type, for instance:

Exporting the Notebook

Now one of the awesome things about Jupyter notebooks is that it's easy to share your work! There's an option off the file menu for downloading your notebooks. There are a great many options, including Haskell source files, pdfs, and HTML documents. These last two can be extremely useful if you want to make a presentation!

Conclusion

As I move forward with MMH, I'm definitely going to explore using notebooks like this more. It should provide a better reader experience than what I have now. I'll also be looking at migrating some of our existing permanent content to Jupyter. The lack of Windows functionality for Haskell is unfortunate, but I'll find a way around it.

Jupyter IHaskell is a great way to get familiar with the basics of Haskell without downloading any of the tools. But at some point, you'll need these! Read our Liftoff Series and download our Beginners Checklist to find out more!

Another IDEa: Haskell and IntelliJ!

Last week we explored one way to get a nice development environment for Haskell. We used the Atom text editor, which has a couple Haskell plugins and is quite hackable.

But there's another option I hadn't considered at all during that article. This is the IntelliJ IDE. It's primary use is Java and Android development. But like Atom, Visual Studio, and other IDEs, it has a rich library of plugins. And one of these is a Haskell environment!

This week, we'll see how to configure IntelliJ to work with Haskell. We'll see how we can get a nifty Haskell environment set up with the same features we had in Atom. I'm working on a Windows machine, but you should be able to do all these steps on a Mac as well.

An IDE is no substitute for basic knowledge though! If you're new to Haskell, getting a good dev setup will help. But you should also read our Liftoff Series and download our Beginners Checklist! These will give you some other tools you'll need!

Installation and Setup

Getting started with IntelliJ is quite easy. Installing the editor works through the normal wizard. You'll have a lot of options for different plugins to install immediately. A lot of these are Java specific so you won't need them. But once you've done that you can also install the IntelliJ-Haskell plugin. In my case, I also installed a Vim plugin for those keybindings.

There's a little bit of trickiness involved in setting your project up to build with Stack. When you first install the plugin, it will ask you what program to use to "build" a project. This means you'll need to locate your stack executable in the file finder so you can drag it in. On Windows this will mean showing hidden folders in the finder. You might also need to use the where command in the terminal to help (instead of which from Linux). Once you've done this though, you should be good!

Keyboard Shortcuts

When working with Atom, we stressed the importance of keyboard shortcuts. These can streamline our workflow a lot. IntelliJ also allows a good deal of customization options for these. The main thing to know is that you need to hit ctrl+alt+s to get to the settings menu. Then you can find the keymap on the side panel. From here you can customize pretty much anything. The big ones for me were building the project and manipulating panels.

The ability to search for commands is very useful. I found it a lot easier to alter commands for, say, splitting windows then I did in Atom. My current setup involves the following combinations:

Build Project: Ctrl+Alt+Shift+B
Split Screen Vertically: Ctrl+Alt+Shift+Right
Split Screen Horizontally: Ctrl+Alt+Shift+Down
Next/Previous Split: Ctrl+Shift+[Right/Left]
Unsplit: Ctrl+Alt+Shift+U
Toggle Bottom Terminal: Ctrl+Shift+Up

For what it's worth, I'll also note that the Vim keybindings are better than I had in Atom. Moving around with lines and saving files with :w work, for a couple examples.

Haskell Features

This is where the IntelliJ plugin shines. Lots of features work right out of the box. For instance, it knows to using hlint and highlights any code with lints. Compilation hints show up automatically. There's even a good deal of auto-completion from libraries for expressions and types. Integration with Hoogle is fairly straightforward.

Best of all, it seems to me that these features work across projects with different GHC versions. As far as I can tell you don't need to manually install ghc-mod and worry about it's version, as you did with Atom. Given the difficulties I had setting up Atom to work with these features, this was a major relief.

Git Integrations

We didn't go over version control last week. But it's another vital component in any developer's workflow, so IDE integration is a big plus. Both Atom and IntelliJ have good support for Github, which is excellent news! Both come with batteries included when it comes to all the common Git operations we want. You can make new branches, add commits, push and pull with ease. Both allow you to bind these to keys, allowing you the freedom to streamline your workflow even more.

Disadvantages

If I were to find one fault with my IntelliJ setup, it's that project setup can involve a lot of loading time. When you add a new library to the .cabal file, you need to run the Tools->Haskell->Update Settings command. The IDE will take a little while to reset everything to account for this. Having said that, a lot of that loading time goes into getting all the appropriate libraries to set up. This enables all the nice features I mentioned earlier. So I suppose that's the price you pay. Atom is also sometimes slow, for its part. But the program itself isn't quite as bulky as IntelliJ, which has a lot of extra features you probably won't need.

One last note is that IntelliJ will add a .idea folder to your project directory. Make sure to add this to your .gitignore!

Conclusion

All in all working with IntelliJ/HaskelIDE has been a good experience so far. It has all the features I'm looking for, and setup is a bit easier than Atom. Long loads can hold me back at times, but it's usually fine. Again, you can take a look at the Github page for the project for some more details. I highly recommend trying out this plugin! Much love to Rik van der Kleij, the author!

A full IDE setup will really help you get started learning Haskell! But you also need some other tools and knowledge. Download our Beginners Checklist for some other tools you'll need. Also take a look at our Stack mini-course to learn more about setting up a Haskell project!

Upgrading My Development Setup!

In the last year or so, I haven't actually written as much Haskell as I'd like to. There are a few reasons for this. First, I switched to a non-Haskell job, meaning I was now using my Windows laptop for all my Haskell coding. Even on my previous work laptop (a Mac), things weren't easy. Haskell doesn't have a real IDE, like IntelliJ for Java or XCode for iOS development.

Besides not having an IDE, Windows presents extra pains compared to the more developer-friendly Mac. And it finally dawned on me. If I, as an experienced developer, was having this much friction, it must be a nightmare for beginners. Many people must be trying to both learn the language AND fight against their dev setup. So I decided to take some time to improve how I program so that it'll be easier for me to actually do it.

I wanted good general functionality, but also some Haskell-specific functions. I did a decent amount of research and settled on Atom as my editor of choice. In this article, we'll explore the basics of setting up Atom, what it offers, and the Haskell tools we can use within it. If you're just starting out with Haskell, I hope you can take these tips to make your Haskell Journey easier.

Note that many tips in this article won't work without the Haskell platform! To start with Haskell, download our Beginners Checklist, or read our Liftoff Series!

Goals

It's always good to begin with the end in mind. So before we start out, let's establish some goals for our development environment. A lot of these are basic items we should have regardless of what language we're using.

1. Autocomplete. Must have for terms within the file. Nice to have for extra library functions and types.
2. Syntax highlighting.
3. Should be able to display at least two code files side-by-side, should also be able to open extra files in tabs.
4. Basic file actions should only need the keyboard. These include opening new files to new tabs or splitting the window and opening a new file in the pane.
5. Should be able to build code using the keyboard only. Should be able to examine terminal output and code at the same time.
6. Should be able to format code automatically (using, for instance, Hindent)
7. Some amount of help filling in library functions and basic types. Should be able to coordinate types from other files.
8. Partial compilation. If I make an obvious mistake, the IDE should let me know immediately.
9. Vim keybindings (depends on your preference of course)

With these goals in mind, let's go ahead and see how Atom can help us.

Basics of Atom

Luckily, the installation process for Atom is pretty painless. Using the Windows installer comes off without a hitch for me. Out of the box, Atom fulfills most of the basic requirements we'd have for an IDE. In fact, we get all our 1-4 goals without putting in any effort. The trick is that we have to learn a few keybindings. The following are what you'll need to open files.

1. Ctrl+P - Open a new tab with a file using fuzzy find
2. Ctrl+K + Direction (left/right/up/down arrow) - Open a new pane (will initially have the same file as before).
3. Ctrl+K + Ctrl+Direction - Switch pane focus

Those commands solve requirements 3 and 4 from our goals list.

Another awesome thing about Atom is the extensive network of easy-to-install plugins. We'll look at some Haskell specific items below. But to start, we can use the package manager to install vim-mode-improved. This allows most Vim keybindings, fulfilling requirement 9 from above. There are a few things to re-learn with different keystrokes, but it works all right.

Adding Our Own Keybindings

Since Atom is so Hackable, you can also add your own keybindings and change ones you don't like. We'll do one simple example here, but you can also check out the documentation for some more ideas. One thing we'll need for goal #5 is to make it easier to bring up the bottom panel within atom. This is where terminal output goes when we run a command. You'll first want to open up keymap.cson, which you can do by going to the file menu and click Keymap….

Then you can add the following lines at the bottom:

'atom-workspace':
  'ctrl-shift-down': 'window:toggle-bottom-dock'
  'ctrl-shift-up': 'window:toggle-bottom-dock'

First, we scope the command to the entire atom workspace. (We'll see an example below of a command with a more limited scope). Then we assign the Ctrl+Shift+Down Arrow key combination to toggle the bottom dock. Since it's a toggle command, we could repeat the command to move it both up and down. But this isn't very intuitive, so we add the second line so that we can also use the up arrow to bring it up.

A super helpful tool is the key binding resolver. At any point, you can use ctrl+. (control key plus the period key) to bring up the resolver. Then pressing any key combination will bring up the commands Atom will run for it. It will highlight the one it will pick in case of conflicts. This is great for finding unassigned key combinations!

Haskell Mode in Atom

Now let's start looking at adding some Haskell functionality to our editor. We'll start by installing a few different Haskell-related packages in Atom. You don't need all these, but this is a list of the core packages suggested in the Atom documentation.

language-haskell
ide-haskell
ide-haskell-cabal
haskell-ghc-mod
autocomplete-haskel

The trickier part of getting Haskell functionality is the binary dependencies. A couple of the packages we added depend on having a couple programs installed. The most prominent of these is ghc-mod, which exposes some functionality of GHC. You'll also want a code formatter, such as hindent, or stylish-haskell installed.

At the most basic level, it's easy to install these programs with Stack. You can run the command:

stack install ghc-mod stylish-haskell

However, ghc-mod matches up with a specific version of GHC. The command above installs the binaries at a system-wide level. This means you can only have the version for one GHC version installed at a time. So imagine you have one project using GHC 8.0, and another project using GHC 8.2. You won't be able to get Haskell features for each one at the same time using this approach. You would need to re-install the proper version whenever you switched projects.

As a note, there are a couple ways to ensure you know what version you've installed. First, you can run the stack install ghc-mod command from within the particular project directory. This will use that project's LTS to resolve which version you need. You can also modify the install command like so:

stack --resolver lts-9 install ghc-mod

There is an approach where you can install different, compiler specific versions of the binary on your system, and have Atom pick the correct one. I haven't been able to make this approach work yet. But you can read about that approach on Alexis King's blog post here.

Keybinding for Builds

Once we have that working, we'll have met most of our feature goals. We'll have partial compilation and some Haskell specific autocompletion. There are other packages, such as haskell-hoogle that you can install for even more features.

There's one more feature we want though, which is to be able to build our project from the keyboard. When we installed our Haskell packages, Atom added a "Haskell IDE" menu at the top. We can use this to build our project with "Haskell IDE" -> "Builder" -> "Build Project". We can add a keybinding for this command like so.

'atom-text-editor[data-grammer~/"haskell"]':
  ...
  'ctrl-alt-shift-b': 'ide-haskell-cabal:build'

Notice that we added a namespace here, so this command will only run on Haskell files. Now we can build our project at any time with Ctrl+Shift+Alt+B, which will really streamline our development!

Weaknesses

The biggest weakness with Atom Haskell-mode is binary dependencies and GHC versions. The idea behind Stack is that switching to a different project with a different compiler shouldn't be hard. But there are a lot of hoops to jump through to get editor support. To be fair though, these problems are not exclusive to Atom.

Another weakness is that the Haskell plugins for Atom currently only support up through LTS 9 (GHC 8). This is a big weakness if you're looking to use new features from the cutting edge of GHC development. So Atom Haskell-mode might not be fully-featured for industry projects or experimental work.

As a further note, the Vim mode in Atom doesn't give all the keybindings you might expect from Vim. For example, I could no longer use the colon key plus a number to jump to a line. Of course, Atom has its own bindings for these things. But it takes a little while to re-learn the muscle memory.

Alternatives

There are, of course, alternatives to the approach I've laid out in this article. Many plugins/packages exist enabling you to get good Haskell features with Emacs and Vim. For Emacs, you should look at haskell-mode. For Vim, I made the most progress following this article from Stephen Diehl. I'll say for my part that I haven't tried the Emacs approach, and ran into problems a couple times with Vim. But with enough time and effort, you can get them to work!

If you use Visual Studio, there are a couple packages for Haskell: Haskelly and Haskero. I haven't used either of these, but they both seem provide a lot of nice features.

Conclusion

Having a good development environment is one of the keys to programming success. More popular languages have full-featured IDE's that make programming a lot easier. Haskell doesn't have this level of support. But there's enough community help that you can use a hackable editor like Atom to get most of what you want. Since I fixed this glaring weakness, I've been able to write Haskell much more efficiently. If you're starting out with the language, this can make or break your experience! So it's worth investing at least a little bit of time and effort to ensure you've got a smooth system to work with.

Of course, having an editor setup for Haskell is meaningless if you've never used the language! Download our Beginners Checklist or read our Liftoff Series to get going!

Haskell Data Types Review!

This week we're taking a quick break from new content. We've added our new series on Haskell's data system to our permanent collection. You can find it under the beginners panel or check it out here! This series had five parts. Let's take a quick review:

1. In part 1 we reviewed the basic way to construct data types in Haskell. We compared this to the syntax of other langauges like Java and Python.
2. Part 2 showed the simple way we can extend our Haskell types to make them sum types! We saw that this is a more difficult process in other languages. In fact, we resorted to making different inherited types in object oriented languages.
3. Next, we demonstrated the concept of parametric types in part 3. We saw how little we needed to add to Haskell's definitions to make this work. Again, we looked at comparable examples in other languages as well.
4. In part 4, we delved into Haskell's typeclasses. We compared them against inherited types from OO languages and noted some pros and cons.
5. Finally, in part 5 we concluded the series by exploring the idea of type families. Our code was more complicated than we'd need in other languages. And yet, our code contains a lot more behavioral guarantees in Haskell than it does elsewhere. And we achieved this while still having a good deal of flexibility. Type families have a definite learning curve, but they're a useful concept to know.

As always keeping coming back every Monday morning for some new Haskell content! For more updates and our monthly newsletter, make sure you Subscribe! This will also give you access to our Subscriber Resources!