boardgame-0.0.0.1: executable/TicTacToe.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE CPP #-}

module TicTacToe where

import Data.List (intercalate)
  
import Data.Map (
    Map
  , insert
  , member
  , elems
  , lookup
  , (!)
  , fromDistinctAscList
  )

import Prelude hiding (lookup)

import Boardgame (
    Player(..)
  , Position(..)
  , PositionalGame(..)
  , patternMatchingGameOver
  )

#ifdef WASM
import qualified Data.Vector as V (fromList)
import Data.Aeson (
    ToJSON(..)
  , Value(Array)
  )
#endif

-------------------------------------------------------------------------------
-- * TicTacToe
-------------------------------------------------------------------------------

newtype TicTacToe = TicTacToe (Map (Integer, Integer) Position)

-- Creates an empty TicTacToe board with coordinates `(0..2, 0..2)`
emptyTicTacToe :: TicTacToe
emptyTicTacToe = TicTacToe $
  fromDistinctAscList $
    zip
      [(x, y) | x <- [0..2], y <- [0..2]]
      (repeat Empty)

instance Show TicTacToe where
  show (TicTacToe b) = intercalate "\n" [
      "╔═══╤═══╤═══╗"
    , "║ " ++ intercalate " │ " (row 0) ++ " ║"
    , "╟───┼───┼───╢"
    , "║ " ++ intercalate " │ " (row 1) ++ " ║"
    , "╟───┼───┼───╢"
    , "║ " ++ intercalate " │ " (row 2) ++ " ║"
    , "╚═══╧═══╧═══╝"
    ]
    where
      -- "Shows" the elements of the given row
      row y = map (\x -> showP $ b ! (x, y)) [0..2]
      showP (Occupied Player1) = "\ESC[34mo\ESC[0m"
      showP (Occupied Player2) = "\ESC[31mx\ESC[0m"
      showP Empty = " "

#ifdef WASM
-- Converts the game to a JSON array with three arrays with three integers
-- each. The integers correspond to
-- 0 → Nothing,
-- 1 → Just Player1, and
-- 2 → Just Player2.
instance ToJSON TicTacToe where
  toJSON (TicTacToe b) = Array $ V.fromList $ map row [0..2]
    where
      row y = Array $ V.fromList $ map (\x -> toJSON $ b ! (x, y)) [0..2]
#endif

instance PositionalGame TicTacToe (Integer, Integer) where
  -- Just looks up the coordinate in the underlying Map
  getPosition (TicTacToe b) = flip lookup b
  -- Just returns the elements in the underlying Map
  positions (TicTacToe b) = elems b
  -- If the underlying Map has the given coordinate, update it with the given player
  setPosition (TicTacToe b) c p = if member c b then Just $ TicTacToe $ insert c p b else Nothing
  -- "Creates" a `gameOver` function by supplying all the winning "patterns"
  gameOver = patternMatchingGameOver [
      [(0, 0), (0, 1), (0, 2)]
    , [(1, 0), (1, 1), (1, 2)]
    , [(2, 0), (2, 1), (2, 2)]
    , [(0, 0), (1, 0), (2, 0)]
    , [(0, 1), (1, 1), (2, 1)]
    , [(0, 2), (1, 2), (2, 2)]
    , [(0, 0), (1, 1), (2, 2)]
    , [(2, 0), (1, 1), (0, 2)]
    ]