# Tic Tac Toe game in Haskell

import System.Random (randomRIO)
import System.IO (hFlush, stdout, getLine)

data Tile   = EmptyTile | X | O
data Player = Player1 | Player2

instance Show Tile where
show EmptyTile = " "
show X         = "X"
show O         = "O"

type Board    = (Tile, Tile, Tile, Tile, Tile, Tile, Tile, Tile, Tile)

emptyBoard :: Board
emptyBoard = (EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile)

put :: Board -> Tile -> Int -> Maybe Board
put (EmptyTile,b,c,d,e,f,g,h,i) t 0 = Just (t,b,c,d,e,f,g,h,i)
put (a,EmptyTile,c,d,e,f,g,h,i) t 1 = Just (a,t,c,d,e,f,g,h,i)
put (a,b,EmptyTile,d,e,f,g,h,i) t 2 = Just (a,b,t,d,e,f,g,h,i)
put (a,b,c,EmptyTile,e,f,g,h,i) t 3 = Just (a,b,c,t,e,f,g,h,i)
put (a,b,c,d,EmptyTile,f,g,h,i) t 4 = Just (a,b,c,d,t,f,g,h,i)
put (a,b,c,d,e,EmptyTile,g,h,i) t 5 = Just (a,b,c,d,e,t,g,h,i)
put (a,b,c,d,e,f,EmptyTile,h,i) t 6 = Just (a,b,c,d,e,f,t,h,i)
put (a,b,c,d,e,f,g,EmptyTile,i) t 7 = Just (a,b,c,d,e,f,g,t,i)
put (a,b,c,d,e,f,g,h,EmptyTile) t 8 = Just (a,b,c,d,e,f,g,h,t)
put _ _ _ = Nothing

checkWinner :: Board -> Maybe Player
checkWinner (X,X,X,_,_,_,_,_,_) = Just Player1
checkWinner (_,_,_,X,X,X,_,_,_) = Just Player1
checkWinner (_,_,_,_,_,_,X,X,X) = Just Player1
checkWinner (X,_,_,X,_,_,X,_,_) = Just Player1
checkWinner (_,X,_,_,X,_,_,X,_) = Just Player1
checkWinner (_,_,X,_,_,X,_,_,X) = Just Player1
checkWinner (X,_,_,_,X,_,_,_,X) = Just Player1
checkWinner (_,_,X,_,X,_,X,_,_) = Just Player1
checkWinner (O,O,O,_,_,_,_,_,_) = Just Player2
checkWinner (_,_,_,O,O,O,_,_,_) = Just Player2
checkWinner (O,_,_,O,_,_,O,_,_) = Just Player2
checkWinner (_,O,_,_,O,_,_,O,_) = Just Player2
checkWinner (_,_,O,_,_,O,_,_,O) = Just Player2
checkWinner (_,_,_,_,_,_,O,O,O) = Just Player2
checkWinner (O,_,_,_,O,_,_,_,O) = Just Player2
checkWinner (_,_,O,_,O,_,O,_,_) = Just Player2
checkWinner _ = Nothing

checkFull :: Board -> Bool
checkFull (EmptyTile,_,_,_,_,_,_,_,_) = False
checkFull (_,EmptyTile,_,_,_,_,_,_,_) = False
checkFull (_,_,EmptyTile,_,_,_,_,_,_) = False
checkFull (_,_,_,EmptyTile,_,_,_,_,_) = False
checkFull (_,_,_,_,EmptyTile,_,_,_,_) = False
checkFull (_,_,_,_,_,EmptyTile,_,_,_) = False
checkFull (_,_,_,_,_,_,EmptyTile,_,_) = False
checkFull (_,_,_,_,_,_,_,EmptyTile,_) = False
checkFull (_,_,_,_,_,_,_,_,EmptyTile) = False
checkFull _= True

getTile :: Board -> Int -> Tile
getTile (a,b,c,d,e,f,g,h,i) 0 = a
getTile (a,b,c,d,e,f,g,h,i) 1 = b
getTile (a,b,c,d,e,f,g,h,i) 2 = c
getTile (a,b,c,d,e,f,g,h,i) 3 = d
getTile (a,b,c,d,e,f,g,h,i) 4 = e
getTile (a,b,c,d,e,f,g,h,i) 5 = f
getTile (a,b,c,d,e,f,g,h,i) 6 = g
getTile (a,b,c,d,e,f,g,h,i) 7 = h
getTile (a,b,c,d,e,f,g,h,i) 8 = i

compMove :: Board -> IO (Board)
compMove b = do
pos <- getRandomEmpty b
let (Just b') = put b O pos
return b'

getRandomEmpty :: Board -> IO Int
getRandomEmpty b = do
pos <- randomRIO (0,8)
let t = getTile b pos
case t of
EmptyTile -> return pos
_         -> getRandomEmpty b

printBoard :: Board -> IO ()
printBoard (a,b,c,d,e,f,g,h,i) = do
putStrLn ("|" ++ show a ++ "|" ++ show b ++ "|" ++ show c ++ "|")
putStrLn ("|" ++ show d ++ "|" ++ show e ++ "|" ++ show f ++ "|")
putStrLn ("|" ++ show g ++ "|" ++ show h ++ "|" ++ show i ++ "|")
putStrLn "---------"

printTileNumbers :: IO ()
printTileNumbers  = do
putStrLn "|0|1|2|"
putStrLn "|3|4|5|"
putStrLn "|6|7|8|"
putStrLn ""

prompt :: String -> IO String
prompt s = do
putStr s
hFlush stdout
getLine

main = do
putStrLn "This is classic tic tac toe game."
putStrLn "In order to play, you need to put a number between 0 and 8"
putStrLn "This table shows tile numbers"
printTileNumbers
printBoard emptyBoard
playGame emptyBoard
where
playGame b = do
playerchoice <- prompt "Make a move: "
let newboard = put b X (read playerchoice)
case newboard of
Nothing -> do
putStrLn "Invalid move."
playGame b
Just b' ->
case checkWinner b' of
Just Player1 -> putStrLn "You win!"
_            -> if checkFull b' then
putStrLn "Tie"
else do
b'' <- compMove b'
printBoard b''
case checkWinner b'' of
Just Player2 -> putStrLn "You Lose!"
_            -> if checkFull b'' then
putStrLn "Tie"
else
playGame b''

• Is it suppose to be indented that way ? or did it occur when you pasted the code ? Apr 30 '15 at 19:46
• @JaDogg It is supposed to be indented that way. But it is possible to decrease the indentation a little bit, I will fix that now. Apr 30 '15 at 19:50
• Follow-up question May 2 '15 at 6:25

I have only written Haskell once before, and then I did not write anything nearly as complicated as Tic Tac Toe. I can only give you certain suggestions, I am not able to tell you exactly how to do it in Haskell.

### The type

type Board    = (Tile, Tile, Tile, Tile, Tile, Tile, Tile, Tile, Tile)


In most of the code I write, I try to write it as flexible as possible. Here you have hard-coded nine tiles. What if you wanted to make a 4x4 Tic Tac Toe game instead? Or a 5x5? Or a NxN and let the user decide the size?

### put

put :: Board -> Tile -> Int -> Maybe Board
put (EmptyTile,b,c,d,e,f,g,h,i) t 0 = Just (t,b,c,d,e,f,g,h,i)
put (a,EmptyTile,c,d,e,f,g,h,i) t 1 = Just (a,t,c,d,e,f,g,h,i)
put (a,b,EmptyTile,d,e,f,g,h,i) t 2 = Just (a,b,t,d,e,f,g,h,i)
...
put (a,b,c,d,e,f,g,EmptyTile,i) t 7 = Just (a,b,c,d,e,f,g,t,i)
put (a,b,c,d,e,f,g,h,EmptyTile) t 8 = Just (a,b,c,d,e,f,g,h,t)
put _ _ _ = Nothing


Again, if using a 2D-array, you should be able to loop through all the tiles here and check the put for each position. Or better yet, as the Int tells you exactly what index to change, you should only change the value on that specific index. Study up on arrays in Haskell and you should be able to make it better by only changing one index in the array.

### checkWinner

First of all, this contains duplicated logic. Once for X and once for Y, that part can be extracted.

Additionally, there's a little trick that can be used when checking for winners in Tic-Tac-Toe. The idea is to start at a certain position, and then loop and change the row and column indices by 1 and check the next position, repeatedly until you go outside of the board range.

### checkFull

Again, use a for-loop.

### getTile

Again, use an array and grab a specific index.

### The last part of your code

That's a lot of indentation! A looooot of indentation! Try to find a way to reduce that. Put more if-statements on the same indentation level? Switch if's with else's? Sorry I can't provide detailed help here. All I can say is: Yes, that is a code smell.

• Thanks for your input. Just a little note, Haskell doesn't have for-loops, it only have recursions. Apr 30 '15 at 20:32
• @yasar Then use recursions :) Apr 30 '15 at 20:46

## User experience

When someone wins, print the winning board configuration before exiting. Just accepting the input and printing "You win!" leaves an unsatisfactory feeling.

Regardless of how it is represented internally, for the user interface, the board should be indexed in a way that mimics a computer number keypad:

7 8 9
4 5 6
1 2 3


## Implementation

There's a lot of brute-force enumeration of all the cases. I suppose a 3 × 3 board is small enough to allow that.

data Tile and data Player feel redundant. I would just define type Tile = Maybe Player. In addition, Player should derive Eq (and possibly Show as well).

data Player = Player1 | Player2 deriving (Eq, Show)

type Tile   = Maybe Player

tile :: Tile -> String
tile (Just Player1) = "X"
tile (Just Player2) = "O"
tile Nothing        = " "


A few of your functions are too procedural. For example, instead of printBoard :: Board -> IO(), it would be better to make Board an instance of Show, such that show board produces a String.

data Board  = Board [Tile]
instance Show Board where
show (Board b) = intercalate "\n" $map ((extercalate "|") . (map tile))$ reverse $rows (Board b) where extercalate delim list = delim ++ (intercalate delim list) ++ delim emptyBoard :: Board emptyBoard = Board$ replicate (size^2) Nothing
where size = 3

-- indexing scheme for get and put
tileGuide :: String
tileGuide =
intercalate "\n" ["|7|8|9|",
"|4|5|6|",
"|1|2|3|"]


Another example of procedural thinking is in the name checkFull. A better name would be isFull.

isFull :: Board -> Bool
isFull (Board b) = not $any isNothing b  There's a bit of asymmetry in the names getTile and put. Personally, I would just choose get and put. For put, the board parameter should go last. That lets you write a chained expression like fromJust$ put Player2 3 $fromJust$ put Player1 6 emptyBoard. In your original form, such an expression would be nasty.

get :: Int -> Board -> Tile
get pos (Board board)
| pos < 1 || pos > 9 = Nothing
| otherwise          = board !! (pos - 1)

put :: Player -> Int -> Board -> Maybe Board
put player pos (Board board)
| pos < 1 || pos > 9                = Nothing
| isNothing $get pos (Board board) = Just newBoard | otherwise = Nothing where update i (x:xs) y | i == 0 = y:xs | otherwise = x : update (i - 1) xs y newBoard = Board$ update (pos - 1) board $Just player rows :: Board -> [[Tile]] rows (Board b) = chunk 3 b where -- Or use chunk from Data.List.Split chunk _ [] = [] chunk n xs = (take n xs) : (chunk n$ drop n xs)


As with checkFullisFull, you should rename checkWinner to winner.

Something suspicious happened with your copy-and-paste code: the cases for O are in a weird order.

With a list representation, you can use !! indexing.

winner :: Board -> Maybe Player
winner (Board board) = winner' $streaks board where allSame [_] = True allSame (x:y:zs) = (x == y) && allSame (y:zs) streaks b = map (map (b !!)) [ [0, 1, 2], [3, 4, 5], [6, 7, 8], -- rows [0, 3, 6], [1, 4, 7], [2, 5, 8], -- columns [0, 4, 8], [2, 4, 6] ] -- diagonals winner' xs | isNothing w = Nothing | otherwise = head$ fromJust w
where w = find allSame xs


To finish, here are the additional imports to make the code above work:

import Data.List (find, intercalate)
import Data.Maybe (fromJust, isNothing)


… and some minor modifications to main:

main = do
putStrLn "This is classic tic tac toe game."
putStrLn "In order to play, you need to put a number between 1 and 9"
putStrLn "This table shows tile numbers"
putStrLn $tileGuide putStrLn "" putStrLn$ show $emptyBoard playGame$ emptyBoard
where
playGame b = do
playerchoice <- prompt "Make a move: "
let newboard = put Player1 (read playerchoice) b
case newboard of
Nothing -> do
putStrLn "Invalid move."
playGame b
Just b' ->
case winner b' of
Just Player1 -> do
putStrLn $show b' putStrLn "You win!" _ -> if isFull b' then putStrLn "Tie" else do b'' <- compMove b' putStrLn$ show b''
case winner b'' of
Just Player2 -> putStrLn "You Lose!"
_            -> if isFull b'' then
putStrLn "Tie"
else
playGame b''

• In my opinion, if there is a clear pattern, then no board is "small enough" to allow a brute-force enumeration of all the cases. I'd always go with using the pattern to enumerate the cases. May 2 '15 at 15:26
• @SimonAndréForsberg The streaks list in my proposed code, for example, is still a kind of brute-force enumeration. I challenge you to write simpler code to look for streaks in the horizontal, vertical, and diagonal cases. It isn't worth the trouble for 3x3. May 17 '15 at 14:47
• I never said my way would be simpler. I'd still prefer it though. You have your right to disagree. May 17 '15 at 15:56