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
