A tic-tac-toe game in Haskell.

Jan 5, 2019 00:00 · 2518 words · 12 minutes read

The game is implemented in Haskell.

Motivation: somebody requested me to do this in haskell

Base Configuration

  • The configuration is usually autogenerated by running ```stack init``` in the root dir
  • Do not touch these files. They are normally auto-generated
  • I used the simple template here.
  • You really don’t need this stuff since the stack will do everything for you

stack.yml:

# This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# http://docs.haskellstack.org/en/stable/yaml_configuration/

# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# resolver: lts-3.5
# resolver: nightly-2015-09-21
# resolver: ghc-7.10.2
# resolver: ghcjs-0.1.0_ghc-7.10.2
# resolver:
#  name: custom-snapshot
#  location: "./custom-snapshot.yaml"
resolver: lts-12.14

# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# - location:
#    git: https://github.com/commercialhaskell/stack.git
#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
#   extra-dep: true
#  subdirs:
#  - auto-update
#  - wai
#
# A package marked 'extra-dep: true' will only be built if demanded by a
# non-dependency (i.e. a user package), and its test suites and benchmarks
# will not be run. This is useful for tweaking upstream packages.
packages:
- '.'
# Dependency packages to be pulled from upstream that are not in the resolver
# (e.g., acme-missiles-0.3)
extra-deps: []

# Override default flag values for local packages and extra-deps
flags: {}

# Extra package databases containing global packages
extra-package-dbs: []

# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=1.4"
#
# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor
#nix:
#  enable: true
#  packages: [glpk, pcre]

Setup.hs:

import Distribution.Simple
main = defaultMain

tictactoe-hs.cabal:

You can change the executable to anything you want. Also ensure that you have random in the build-depends otherwise things won’t work

Things break if you don’t add the LICENSE and README file

name:                tictactoe-hs
version:             0.1.0.0
-- synopsis:
-- description:
homepage:            bonfacemunyoki.com
license:             BSD3
license-file:        LICENSE
author:              Bonface K. M.
maintainer:          [email protected]
copyright:           2018, BMK
category:            Game
build-type:          Simple
cabal-version:       >=1.10
extra-source-files:  README.md

executable ttt
  hs-source-dirs:      src
  main-is:             Main.hs
  default-language:    Haskell2010
  build-depends:       base >= 4.7 && < 5
                     , random
  other-modules:       TicTacToeLib

library
  hs-source-dirs:      src
  exposed-modules:     TicTacToeLib
  default-language:    Haskell2010
  build-depends:       base >= 4.7 && < 5
                     , random

LICENSE

Copyright Ben Lovy (c) 2018

All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of Ben Lovy nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README

# tictactoe-hs
TicTacToe in Haskell.

`stack install` to build and install `ttt` executable.  Remember to set an alarm.  You can't afford another TicTacToe all-nighter and you know it.

The game

Project dependencies

  • Note the aligning- it makes things easy to read
  • Stick to code guidelines

import Control.Monad (forever, when)
import Data.Bool     (bool)
import Data.Char     (digitToInt)
import Data.List     (isSubsequenceOf)
import Data.Maybe    (isJust, isNothing)
import System.Exit   (exitSuccess)
import System.IO     (hFlush, stdout)
import System.Random (randomRIO)

Create our data types

  • We need a board
  • We also need to describe how our board will be displayed
  • Something like this:
| 1 | 2 | 3 |
|---+---+---|
| 4 | 5 | 6 |
|---+---+---|
| 7 | 8 | 9 |

  • Each element in the board is a cell.

newtype Board = Board [Maybe Player]
data Player = Human | Computer deriving (Eq, Show)

instance Show Board where
  show (Board cs) = foldr spaceEachThird [] . withIndicesFrom 1 . fmap showCell $ withIndicesFrom 1 cs
    where spaceEachThird a = (++) (bool (snd a) (snd a ++ "\n") (fst a `rem` 3 == 0))

Win states

  • Earlier considerations:
    • Create function that checks diagonal, horizontal, and vertical for wins
    • Too much work
  • Instead, have a list with the win states
  • Lazy but efficient

    -- All the states that indicate a win in the game
    winStates :: [[Int]]
    winStates = [[0, 1, 2], [3, 4, 5], [6, 7, 8], [0, 3, 6], [1, 4, 7], [2, 5, 8], [0, 4, 8], [2, 4, 6]]
    

Cell Functions

  • We need to have functions that operate on a cell

  • Here all the functions that operate in a cell in a nutshell

-- An empty cell shows its number on the grid,
-- A play made by a human is represented with a: " X "
-- and that by a computer with a: " O "
showCell :: (Int, Maybe Player) -> String
showCell (n, Nothing)         = " " ++ show n ++ " "
showCell (_, (Just Human))    = " X "
showCell (_, (Just Computer)) = " O "

isCellOpen :: Board -> Int -> Bool
isCellOpen (Board b) n = isNothing $ b !! (n - 1)

playCell :: Board -> Int -> Player -> Board
playCell (Board b) n player = Board $ prePlayerCells ++ [Just player] ++ postPlayerCells
  where prePlayerCells = take (n - 1) b
        postPlayerCells = drop n b
  • Here’s an example of a board board(it won’t be displayed like that though):

    (1, Nothing) (2, (Just Human)) (3, Nothing) (4, Nothing) (5, Nothing) (6, Nothing) (7, Nothing) (8, Nothing) (9, (Just Computer))

  • So we need a function that can display cells. The above board would look sth like this: 1 X 3 4 5 6 7 8 O

-- An empty cell shows its number on the grid,
-- A play made by a human is represented with a: " X "
-- and that by a computer with a: " O "
showCell :: (Int, Maybe Player) -> String
showCell (n, Nothing)         = " " ++ show n ++ " "
showCell (_, (Just Human))    = " X "
showCell (_, (Just Computer)) = " O "
  • Before a player plays a cell, we need to check that the cell is free

isCellOpen :: Board -> Int -> Bool
isCellOpen (Board b) n = isNothing $ b !! (n - 1)
  • We need a fn that can play a cell. If you choose a num, it returns a board with the cell filled by the player

playCell :: Board -> Int -> Player -> Board
playCell (Board b) n player = Board $ prePlayerCells ++ [Just player] ++ postPlayerCells
  where prePlayerCells = take (n - 1) b
        postPlayerCells = drop n b

Board Functions

We need to be able to:

  • generate an empty board
  • enable a computer to play
  • enable a human to play and check the turns
  • check the wins
  • check for draws

When we put it all together:

freshBoard :: Board
freshBoard = Board $ replicate 9 Nothing

withIndicesFrom :: Int -> [a] -> [(Int, a)]
withIndicesFrom n = zip [n..]

compTurn :: Board -> IO Board
compTurn [email protected](Board b) = do
  let options = filter (isNothing . snd) . withIndicesFrom 1 $ b
  r <- randomRIO (0, length options - 1)
  let play = (fst $ options !! r)
  let b2 = playCell board play Computer
  putStrLn $ "Computer plays " ++ show play
  checkWin b2 Computer
  return b2

humanTurn :: Board -> Int -> IO Board
humanTurn board n = do
  let b = playCell board n Human
  checkWin b Human
  checkDraw b
  return b

checkWin :: Board -> Player -> IO ()
checkWin [email protected](Board b) m =
  let
    bi = withIndicesFrom 0 b
    plays = map fst . filter ((Just m ==) . snd) $ bi
  in
   when (foldr ((||) . flip isSubsequenceOf plays) False winStates) $ do
     print board
     putStrLn $ show m ++ " won!"
     exitSuccess

checkDraw :: Board -> IO ()
checkDraw [email protected](Board b) =
  when ( all isJust b) $ do
    print board
    putStrLn "Draw!"
    exitSuccess

First, we generate an empty board which has nothing. There’s also a generic function that will be used by the other board functions

freshBoard :: Board
freshBoard = Board $ replicate 9 Nothing

withIndicesFrom :: Int -> [a] -> [(Int, a)]
withIndicesFrom n = zip [n..]

The computer’s play is driven by a random number. You get all the free positions then randomly choose one. After the play, we check for a win. We return a board wrapped in a monad(a haskellish way of dealing with side fx)

compTurn :: Board -> IO Board
compTurn [email protected](Board b) = do
  let options = filter (isNothing . snd) . withIndicesFrom 1 $ b
  r <- randomRIO (0, length options - 1)
  let play = (fst $ options !! r)
  let b2 = playCell board play Computer
  putStrLn $ "Computer plays " ++ show play
  checkWin b2 Computer
  return b2

Same concept with a human play.

humanTurn :: Board -> Int -> IO Board
humanTurn board n = do
  let b = playCell board n Human
  checkWin b Human
  checkDraw b
  return b

To check a win, we check if there’s a sub-sequence of the win-states. If it exists, we end the game and declare the winner

checkWin :: Board -> Player -> IO ()
checkWin [email protected](Board b) m =
  let
    bi = withIndicesFrom 0 b
    plays = map fst . filter ((Just m ==) . snd) $ bi
  in
   when (foldr ((||) . flip isSubsequenceOf plays) False winStates) $ do
     print board
     putStrLn $ show m ++ " won!"
     exitSuccess

We really don’t need to check for losses. A win implies a loss to the other; Also checking for wins is really easier.

For draws, when all cells are filled with no wins declared, it’s a draw.

checkDraw :: Board -> IO ()
checkDraw [email protected](Board b) =
  when ( all isJust b) $ do
    print board
    putStrLn "Draw!"
    exitSuccess

Running the game

  • The game runs in an infinite loop
  • Here’s the algorithm for running this game:
    • check the draw
    • print the board
    • get the move from the human
    • if the move is valid, the comp plays
    • otherwise raise some warning

runGame :: Board -> IO ()
runGame board = forever $ do
  checkDraw board
  print board
  putStr "Your move: "
  hFlush stdout
  n <- getLine
  case n of
    [c] ->
      if [c] `elem` map show [(1::Integer)..9]
      then do
          let n' = digitToInt c
          if isCellOpen board n'
          then humanTurn board n' >>= compTurn >>= runGame
          else putStrLn "That's taken!"
      else putStrLn "1-9 only please"
    _   -> putStrLn "Only one digit allowed!"

The Game

  • I put the game logic in one file src/TicTacToe.hs
import Control.Monad (forever, when)
import Data.Bool     (bool)
import Data.Char     (digitToInt)
import Data.List     (isSubsequenceOf)
import Data.Maybe    (isJust, isNothing)
import System.Exit   (exitSuccess)
import System.IO     (hFlush, stdout)
import System.Random (randomRIO)

newtype Board = Board [Maybe Player]
data Player = Human | Computer deriving (Eq, Show)

instance Show Board where
  show (Board cs) = foldr spaceEachThird [] . withIndicesFrom 1 . fmap showCell $ withIndicesFrom 1 cs
    where spaceEachThird a = (++) (bool (snd a) (snd a ++ "\n") (fst a `rem` 3 == 0))

-- All the states that indicate a win in the game
winStates :: [[Int]]
winStates = [[0, 1, 2], [3, 4, 5], [6, 7, 8], [0, 3, 6], [1, 4, 7], [2, 5, 8], [0, 4, 8], [2, 4, 6]]

-- An empty cell shows its number on the grid,
-- A play made by a human is represented with a: " X "
-- and that by a computer with a: " O "
showCell :: (Int, Maybe Player) -> String
showCell (n, Nothing)         = " " ++ show n ++ " "
showCell (_, (Just Human))    = " X "
showCell (_, (Just Computer)) = " O "

isCellOpen :: Board -> Int -> Bool
isCellOpen (Board b) n = isNothing $ b !! (n - 1)

playCell :: Board -> Int -> Player -> Board
playCell (Board b) n player = Board $ prePlayerCells ++ [Just player] ++ postPlayerCells
  where prePlayerCells = take (n - 1) b
        postPlayerCells = drop n b

freshBoard :: Board
freshBoard = Board $ replicate 9 Nothing

withIndicesFrom :: Int -> [a] -> [(Int, a)]
withIndicesFrom n = zip [n..]

compTurn :: Board -> IO Board
compTurn [email protected](Board b) = do
  let options = filter (isNothing . snd) . withIndicesFrom 1 $ b
  r <- randomRIO (0, length options - 1)
  let play = (fst $ options !! r)
  let b2 = playCell board play Computer
  putStrLn $ "Computer plays " ++ show play
  checkWin b2 Computer
  return b2

humanTurn :: Board -> Int -> IO Board
humanTurn board n = do
  let b = playCell board n Human
  checkWin b Human
  checkDraw b
  return b

checkWin :: Board -> Player -> IO ()
checkWin [email protected](Board b) m =
  let
    bi = withIndicesFrom 0 b
    plays = map fst . filter ((Just m ==) . snd) $ bi
  in
   when (foldr ((||) . flip isSubsequenceOf plays) False winStates) $ do
     print board
     putStrLn $ show m ++ " won!"
     exitSuccess

checkDraw :: Board -> IO ()
checkDraw [email protected](Board b) =
  when ( all isJust b) $ do
    print board
    putStrLn "Draw!"
    exitSuccess

runGame :: Board -> IO ()
runGame board = forever $ do
  checkDraw board
  print board
  putStr "Your move: "
  hFlush stdout
  n <- getLine
  case n of
    [c] ->
      if [c] `elem` map show [(1::Integer)..9]
      then do
          let n' = digitToInt c
          if isCellOpen board n'
          then humanTurn board n' >>= compTurn >>= runGame
          else putStrLn "That's taken!"
      else putStrLn "1-9 only please"
    _   -> putStrLn "Only one digit allowed!"
  • The game will be run here:
module Main where

import TicTacToeLib

main :: IO ()
main = do
  let board = freshBoard
  runGame board