General TicTacToe in Haskell

Question

I decided to take a more general approach while implementing the TicTacToe game in Haskell.

Util

module Data.List.Utils where 
import Data.List (intersperse)
surround :: a -> [a] -> [a]
surround x ys = x : intersperse x ys ++ [x]
nth :: Int -> (a -> a) -> [a] -> [a]
nth _ _ [] = []
nth 0 f (x:xs) = f x : xs
nth n f (x:xs) = x : nth (n - 1) f xs

TicTacToe

module TicTacToe where
import Data.List (transpose)
import Data.Foldable (asum)
import Data.List.Utils (surround, nth)
data Tile = O | X | Empty deriving (Eq)
instance Show Tile where
 show Empty = " "
 show O = "O"
 show X = "X"
-- ======================
-- Board Helper Functions
-- ======================
type Board = [[ Tile ]]
showBoard :: Board -> String
showBoard xss = unlines
 . surround vtx
 . map (concat . surround mid . map show)
 $ xss
 where mid = "|"
 vtx = surround '+' $ replicate (length xss) '-' 
whoWon :: Board -> Maybe Player
whoWon xss = asum
 . map winner
 $ diag : anti : cols ++ xss
 where cols = transpose xss
 diag = zipWith (!!) xss [0..]
 anti = zipWith (!!) (reverse xss) [0..]
 winner (x:xs) = if all (==x) xs && x /= Empty
 then Just (toPlayer x)
 else Nothing
getCoords :: Int -> Board -> (Int, Int)
getCoords n = divMod (n - 1) . length
fillTile :: Board -> Int -> Tile -> Board
fillTile xss n tile = nth row (nth col (const tile)) xss
 where (row, col) = getCoords n xss
isOver :: Board -> Bool
isOver = all (notElem Empty)
-- ========================
-- Player related functions
-- ========================
data Player = Player1 | Player2 deriving (Eq)
instance Show Player where
 show Player1 = "1st Player"
 show Player2 = "2nd Player"
toPlayer :: Tile -> Player
toPlayer X = Player1
toPlayer O = Player2
fromPlayer :: Player -> Tile
fromPlayer Player1 = X
fromPlayer Player2 = O
changePlayer :: Player -> Player
changePlayer Player1 = Player2
changePlayer Player2 = Player1
-- ====================
-- Game logic functions
-- ====================
validateInput :: Board -> String -> Either String Int
validateInput xss s = case reads s of 
 [(n, "")] -> check n
 _ -> Left "Only integers allowed"
 where check n
 | n < 1 || n > length xss ^ 2 = Left "Out of range"
 | xss !! row !! col /= Empty = Left "Already filled"
 | otherwise = Right n
 where (row, col) = getCoords n xss
askInput :: Player -> Board -> IO ()
askInput player board = do
 putStrLn $ showBoard board
 putStrLn $ "Your turn, " ++ show player ++ "!"
 putStr $ "Tile number (1 - " ++ show (length board ^ 2) ++ "): "
 number <- getLine
 case validateInput board number of
 Left s -> putStrLn ("Invalid input: " ++ s) >> gameStep player board
 Right n -> let tile = fromPlayer player
 next = changePlayer player
 in gameStep next (fillTile board n tile)
gameStep :: Player -> Board -> IO ()
gameStep player board = case whoWon board of
 Just winner -> do
 putStrLn $ showBoard board
 putStrLn $ show winner ++ " won!"
 Nothing | isOver board -> putStrLn "Game ended in a draw"
 | otherwise -> askInput player board
startBoard :: Int -> Board
startBoard x = replicate x (replicate x Empty)
main :: IO ()
main = gameStep Player1 (startBoard 3) -- Change NxN

• zigazou: please, when editing a post, try not to change the source code or state which changes you have done. Writing an answer takes some time and it can quickly be out of phase and have no sense in the end ;-)

Answer 1

Do you use the '-Wall' options of GHC ? It is quite handy, especially when there are non-exhaustive pattern matches in your (non-exhaustive pattern matches are bad ;-) )

TicTacToe.hs:84:41: Warning:
 Defaulting the following constraint(s) to type ‘Integer’
 (Num b0) arising from the literal ‘2’ at TicTacToe.hs:84:41
 (Integral b0) arising from a use of ‘^’ at TicTacToe.hs:84:39
 In the second argument of ‘(^)’, namely ‘2’
 In the second argument of ‘(>)’, namely ‘length xss ^ 2’
 In the second argument of ‘(||)’, namely ‘n > length xss ^ 2’
TicTacToe.hs:96:58: Warning:
 Defaulting the following constraint(s) to type ‘Integer’
 (Num b0) arising from the literal ‘2’ at TicTacToe.hs:96:58
 (Integral b0) arising from a use of ‘^’ at TicTacToe.hs:96:56
 In the second argument of ‘(^)’, namely ‘2’
 In the first argument of ‘show’, namely ‘(length board ^ 2)’
 In the first argument of ‘(++)’, namely ‘show (length board ^ 2)’
TicTacToe.hs:37:11: Warning:
 Pattern match(es) are non-exhaustive
 In an equation for ‘winner’: Patterns not matched: []
TicTacToe.hs:62:1: Warning:
 Pattern match(es) are non-exhaustive
 In an equation for ‘toPlayer’: Patterns not matched: Empty
Linking dist/build/TicTacToe/TicTacToe ...

Note: you can also feed your source code into hlint. It will sometimes be able to find some smarter ways to write code (though it won’t give you anything special in your case).

Util module

Concerning the Util module, unless you want to distribute it apart from your project, it should not be placed in Data.Utils.

The nth function can be written using splitAt:

nth :: Int -> (a -> a) -> [a] -> [a]
nth i f l = case splitAt i l of
 (start, elm:end) -> start ++ [f elm] ++ end
 _ -> []

That way, just reading the code makes it clear the nth function applies a function to the nth element of a list.

TicTacToe

You still have problems with putStr and the buffering of ouput. You should put a hFlush stdout right after your putStr call (imported from System.IO). Here’s my terminal:

Turn: Player 1
1
Tile number (1-9): +-+-+-+
|X| | |
+-+-+-+
| | | |
+-+-+-+
| | | |
+-+-+-+
Turn: Player 2
2
Tile number (1-9): +-+-+-+
|X|O| |
+-+-+-+
| | | |
+-+-+-+
| | | |
+-+-+-+

You have placed validateInput and askInput in the "Game logic functions" block though they obviously are UI related.

In validateInput:

• "Only integers allowed" is a message that must be generated by the user interface since it converts a String to an Int (this has no direct link to the game and could be reused in other programs)
• "Out of range" and "Already filled" are messages that must be generated by the game itself

Note: as the error messages themselves are related to the user interface, the functions should not return them in plain english. One way to do this is to create a type : data ValidateError = OutOfRange | AlreadyFilled | OnlyInteger deriving (Eq) (or a class of types for more advanced error handling). With this, your functions do not deal with translation problems or with representation (an error could also be represented by a sound, an animation or a graphic).

You have a mutual recursion between askInput and gameStep. askInput should not call gameStep. askInput should just do one thing: ask the player a value and return it, nothing else. askInput also decides which player will play. Again, it is not its role. Try to apply the Single responsibility principle.

• Afonso Matos: In my terminal, it prints fine. What might be the problem?
• zigazou: you probably run your program with runhaskell. The output buffering between runhaskell and a compiled Haskell program are not the same. Even for small program, try to create a Cabal project.
• zigazou: Note: you can also use -Wall with runhaskell like this → runhaskell -Wall TicTacToe.hs
• Afonso Matos: When I use -Wall I get some default contraint warnings. To solve the first one I do ` ^ (2 :: Integer)`, but this is really annoying. Is it necessary / good practice ?
• Afonso Matos: I used hSetBuffering stdout NoBuffering to fix the awkard printing. Is this ok?