Skip to content

Instantly share code, notes, and snippets.

@YakBarber
Last active April 12, 2024 20:23
Show Gist options
  • Save YakBarber/e12a99087dc75a4271d420631e26e463 to your computer and use it in GitHub Desktop.
Save YakBarber/e12a99087dc75a4271d420631e26e463 to your computer and use it in GitHub Desktop.
Tic Tac Toe in Haskell - Barry Van Tassell
module Main (main) where
-- build-depends: base, containers, mtl
import qualified Data.List as L
import Data.Maybe (fromJust)
import Data.Char (digitToInt, toLower)
import qualified Control.Monad.State.Lazy as S
----------------------
-- Types, constants --
----------------------
-- identifies a player, or a player's mark on the board. can be "Empty"
data Player = X | O | Empty deriving (Show)
-- a single play/move represented by (position, marker)
type Move = (Int, Player)
-- X wins is (Just X), tie is (Just Empty), not done is (Nothing)
type GameResult = Maybe Player
-- Each square has a list of possible "win conditions" it participates in.
-- Scores are calculated by adding up each player's possible win conditions (points).
-- Eg. A player with a total of 3 "H1" squares has a full horizontal row, and wins.
data Point = H1 | H2 | H3 | V1 | V2 | V3 | D1 | D2 deriving (Show, Eq, Enum, Ord)
-- assoc list mapping each square with the win conditions it participates in.
-- Eg. the top-left square (0) can assist in winning via the top row (H1) left column (V1)
-- or the "backslash" diagonal (D1).
-- TODO: this should be a Data.Map instead of assoc list
scoreValues :: [(Int, [Point])]
scoreValues = [ (0,[H1,V1,D1]), (1,[H1,V2]), (2,[H1,V3,D2])
, (3,[H2,V1]), (4,[H2,V2,D1,D2]), (5,[H2,V3])
, (6,[H3,V1,D2]), (7,[H3,V2]), (8,[H3,V3,D1])
]
-- The game state: the board and intermediate player win status.
-- Board state is stored as a[n] historic list of performed moves.
data GameState = GameState { move_hist :: [Move]
, x_score :: [Point]
, o_score :: [Point]
}
deriving (Show)
newState :: GameState
newState = GameState [] [] []
--------------------
-- Business logic --
--------------------
main :: IO ()
main = do
let state = newState
result <- fromJust <$> gameLoop X state
case result of
Empty -> putStrLn "\nIt's a tie!"
p -> putStrLn $ "\nPlayer " ++ colorSquare p (map toLower $ show p) ++ " wins!"
-- recursive "loop" that queries players, runs stateful operations
gameLoop :: Player -> GameState -> IO GameResult
gameLoop Empty _ = return Nothing
gameLoop player state = do
-- get available plays/moves
let available = S.evalState getAvailableMoves state
-- show board, query player
putStrLn "" -- for newline
printBoard state
putStrLn $ colorBlue "\n[Player "
++ colorSquare player (map toLower $ show player)
++ colorBlue "] Choose: "
++ colorBlue (show available)
putStr $ colorBlue "> "
choice <- digitToInt <$> getChar -- crashes if not digit. TODO: catch exception
-- check input, recurse if wrong
if choice `notElem` available
then putStrLn (colorBlue "\nInvalid choice\n") >> gameLoop player state
else do
putStrLn "" -- for newline
-- perform move
let (result, newstate) = S.runState (playOnce (choice, player)) state
-- recurse for next player if game not done
case result of
Just p -> printBoard newstate >> return (Just p)
Nothing ->
case player of
X -> gameLoop O newstate
O -> gameLoop X newstate
------------------------
-- Stateful functions --
------------------------
-- perform a single move and update/check score
playOnce :: Move -> S.State GameState GameResult
playOnce move = do
moves <- move_hist <$> S.get
S.modify (\s-> s{move_hist = move:moves})
addPoints move
scoreGame
-- update score state
addPoints :: Move -> S.State GameState ()
addPoints move = do
x_points <- x_score <$> S.get
o_points <- o_score <$> S.get
let new_points = fromJust $ L.lookup (fst move) scoreValues
case snd move of
X -> S.modify' (\s-> s{x_score = new_points++x_points})
O -> S.modify' (\s-> s{o_score = new_points++o_points})
Empty -> return ()
-- check score state and report game completion status
scoreGame :: S.State GameState GameResult
scoreGame = do
x_val <- pointsToScore . x_score <$> S.get
o_val <- pointsToScore . o_score <$> S.get
moves <- move_hist <$> S.get
if x_val == 3 then return $ Just X -- X wins
else if o_val == 3 then return $ Just O -- O wins
else if length moves == 9 then return $ Just Empty -- tie
else return Nothing -- game not over yet
-- which squares are left un-marked?
getAvailableMoves :: S.State GameState [Int]
getAvailableMoves = ([0..8] L.\\) <$> map fst <$> move_hist <$> S.get
-- transform Point list into an actual score (pure)
pointsToScore :: [Point] -> Int
pointsToScore points = if null points then 0
else L.maximum $ map length $ L.group $ L.sort points
---------------------------
-- output, visualization --
---------------------------
colorSquare :: Player -> String -> String
colorSquare X s = colorGreen s
colorSquare O s = colorRed s
colorSquare Empty s = colorWhite s
colorGreen :: String -> String
colorGreen s = "\ESC[92m"++s++"\ESC[0m"
colorRed :: String -> String
colorRed s = "\ESC[31m"++s++"\ESC[0m"
colorBlue :: String -> String
colorBlue s = "\ESC[94m"++s++"\ESC[0m"
colorWhite :: String -> String
colorWhite s = "\ESC[97m"++s++"\ESC[0m"
printBoard :: GameState -> IO ()
printBoard state =
let
moves = move_hist state
disp _ (Just p) = " " ++ colorSquare p (map toLower (show p)) ++ " "
disp n _ = colorWhite $ " " ++ show n ++ " "
horiz = replicate 11 '-'
prepRow :: [String] -> String
prepRow = L.intercalate "|"
splitRows :: [String] -> [[String]]
splitRows [] = []
splitRows xs = take 3 xs : splitRows (drop 3 xs)
createBoard = [disp i $ L.lookup i moves | i <- [0..8]]
in
mapM_ putStrLn $ L.intersperse horiz $ map prepRow $ splitRows createBoard
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment