Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Tic-tac-toe in Haskell
module TicTacToe where
import Control.Monad.State
import Data.Char
import Data.List
import qualified Data.Map as Map
import Data.Maybe
import qualified System.Process as Process
-- Cell
data Cell = X | O deriving (Eq, Ord)
-- Coord
data Coord =
C11
| C12
| C13
| C21
| C22
| C23
| C31
| C32
| C33 deriving (Eq, Ord)
nextCoord :: Coord -> Coord
nextCoord C11 = C12
nextCoord C12 = C13
nextCoord C13 = C21
nextCoord C21 = C22
nextCoord C22 = C23
nextCoord C23 = C31
nextCoord C31 = C32
nextCoord C32 = C33
nextCoord C33 = C11
nextCoordToEmpty :: Grid -> Coord -> Coord
nextCoordToEmpty grid coord =
let
next = nextCoord coord
in
case Map.lookup next grid of
Just _ ->
nextCoordToEmpty grid next
Nothing ->
next
-- Grid
type Grid = Map.Map Coord Cell
initGrid :: Grid
initGrid = Map.empty
isGridFull :: Grid -> Bool
isGridFull = (==) 9 . Map.size
-- Game state
data Game =
Game
{ grid :: Grid
, cursor :: Coord
}
initGame :: Game
initGame = Game initGrid C11
winner :: Grid -> Maybe (Maybe Cell)
winner grid =
case (winnerHelper winningCellCombinations grid, isGridFull grid) of
(Just mark, _) ->
Just (Just mark)
(Nothing, True) ->
Just Nothing
_ ->
Nothing
winnerHelper :: [[Coord]] -> Grid -> Maybe Cell
winnerHelper [] _ = Nothing
winnerHelper (head:tail) grid = maybe (winnerHelper tail grid) id $ extractIfAllIdentical $ fmap (flip Map.lookup $ grid) $ head
winningCellCombinations :: [[Coord]]
winningCellCombinations =
[ -- rows
[ C11, C12, C13 ]
, [ C21, C22, C23 ]
, [ C31, C32, C33 ]
-- columns
, [ C11, C21, C31 ]
, [ C12, C22, C32 ]
, [ C13, C23, C33 ]
-- diagonals
, [ C11, C22, C33 ]
, [ C31, C22, C13 ]
]
-- Update game
data Msg = Mark | Move
updateGame :: Msg -> Game -> Game
updateGame msg (Game grid cursor) =
case msg of
Mark ->
let
newGrid = (Map.insert cursor (currentMark grid) grid)
in
Game newGrid (nextCoordToEmpty newGrid cursor)
Move ->
Game grid (nextCoordToEmpty grid cursor)
currentMark :: Grid -> Cell
currentMark grid =
case rem (Map.size grid) 2 of
0 -> X
_ -> O
winnerText :: Maybe (Maybe Cell) -> String
winnerText cell =
case cell of
Just (Just X) -> "X wins"
Just (Just O) -> "O wins"
Just Nothing -> "Tie"
Nothing -> "Game is on"
-- View
viewGame :: Game -> String
viewGame (Game grid cursor) =
foldl (++) ""
. intersperse "\n"
. fmap (foldl (++) "" . fmap (viewCell cursor grid))
$ [
[ C11, C12, C13 ],
[ C21, C22, C23 ],
[ C31, C32, C33 ]
]
viewCell :: Coord -> Grid -> Coord -> String
viewCell cursor grid coord =
case (cursor == coord, Map.lookup coord grid) of
(True, _) -> "[*]"
(False, Just X) -> "[X]"
(False, Just O) -> "[O]"
(False, Nothing) -> "[ ]"
-- Entry point
main :: IO ()
main =
mainWithState initGame
mainWithState :: Game -> IO ()
mainWithState game = do
Process.system "clear"
winner <- return $ winner (grid game)
putStrLn $ padText 2 $ foldl (++) "" $ intersperse "\n" $
[ "Tic Tac Toe"
, ""
, winnerText winner
, ""
, padText 2 $ viewGame game
, ""
, "[space+enter] - draw mark"
, "[m+enter] - move cursor"
, "[x+enter] - exit"
, "[r+enter] - new game"
]
guess <- getChar
case (winner, guess) of
(Just _, 'r') -> mainWithState initGame
(Nothing, ' ') -> mainWithState (updateGame Mark game)
(Nothing, 'm') -> mainWithState (updateGame Move game)
(_, 'x') -> return ()
_ -> mainWithState game
-- Helpers
extractIfAllIdentical :: (Eq a) => [a] -> Maybe a
extractIfAllIdentical = extractIfAllIdenticalHelper Nothing
extractIfAllIdenticalHelper :: (Eq a) => Maybe a -> [a] -> Maybe a
extractIfAllIdenticalHelper res [] = res
extractIfAllIdenticalHelper res (head:tail) =
case res of
Just val ->
if val == head then extractIfAllIdenticalHelper res tail else Nothing
Nothing ->
extractIfAllIdenticalHelper (Just head) tail
padText :: Int -> String -> String
padText colPad =
foldl (++) ""
. intersperse "\n"
. fmap (\line -> replicate colPad ' ' ++ line)
. lines
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment