TicTacToe.hs

import qualified Data.Sequence as Sequence
import Control.Monad
import Data.Maybe
import System.Random

data Move = Move Position Space

newtype Position = Position (Int, Int)

newtype Board = Board (Sequence.Seq Space)

data Space = Empty | X | O deriving Eq

data Player = PlayerOne | PlayerTwo

data Outcome = Winner PlayerData | Tie | ContinueGame

data PlayerData = PlayerData {
                              player :: Player,
                              space :: Space,
                              playerString :: String,
                              other :: PlayerData,
                              isAutomated :: Bool
                             }

data GameState = GameState {
                             playerWithTurn :: PlayerData,
                             board :: Board,
                             numberOfMoves :: Int,
                             randomGen :: StdGen,
                             playerOne :: PlayerData,
                             playerTwo :: PlayerData
                           }

main = do
  putStrLn welcomeMessage
  option <- getIndexInRange (1, 2)
  let isAutomated = option == 1
  gen <- getStdGen
  gameStep $ initialGameState gen isAutomated
  putStrLn "The Game is over"
  where welcomeMessage = "Welcome to Tic Tac Toe.\n" ++ 
                         "Would you like to play against:\n" ++
                         "[1] An automated player\n" ++
                         "Or\n" ++
                         "[2] A human player" 

initialGameState :: StdGen -> Bool -> GameState
initialGameState gen isAutomated =
  let startingBoard = Board $ Sequence.fromList $ replicate 9  Empty
      playerOne = PlayerData {
        player = PlayerOne,
        space = O,
        playerString = "Player One [O]",
        other = playerTwo,
        isAutomated = False
        }
      playerTwo = PlayerData {
        player = PlayerTwo,
        space = X,
        playerString = "Player Two [X]",
        other = playerOne,
        isAutomated = isAutomated
        }
  in GameState {
                 playerWithTurn = playerOne,
                 board = startingBoard,
                 numberOfMoves = 0,
                 randomGen = gen,
                 playerOne = playerOne,
                 playerTwo = playerTwo
               }
                         
gameStep :: GameState -> IO ()
gameStep gameState@ GameState {board=board, playerWithTurn=player, numberOfMoves=numberOfMoves} = do
  putStrLn $ showBoard board
  playersMove <- getMove gameState
  let eitherBoard = move board playersMove
  case eitherBoard of
    Right board -> continueOrEndGame gameState {board=board, numberOfMoves= numberOfMoves + 1}
    Left warning -> do putStrLn warning
                       gameStep gameState

getMove :: GameState -> IO Move
getMove gameState@ GameState {playerWithTurn=player} =
  if isAutomated player
     then getRandomMove gameState   
     else getUserMove player

getUserMove :: PlayerData -> IO Move
getUserMove player = do
  putStrLn $ playerString player ++ "\nPlease enter your move: "
  putStrLn "Row (0, 1, 2)"
  row <- getIndexInRange (0,2)
  putStrLn "Column (0, 1, 2)"
  col <- getIndexInRange (0,2)
  return $ Move (Position (row, col)) (space player)

getRandomMove :: GameState -> IO Move
getRandomMove GameState {numberOfMoves=numberOfMoves,randomGen=gen, board=(Board board), playerWithTurn=player} =
  let getRandomEmpty = snd $ Sequence.index emptiesWithIndices randomIndex
      emptiesWithIndices = Sequence.filter (\space -> fst space == Empty) $ Sequence.zip board $ Sequence.fromList [0..8]
      randomIndex = randomRs (0, numberOfEmpties-1) gen !! numberOfMoves
      numberOfEmpties = 9 - numberOfMoves
  in do putStrLn "Player two is calculating it's move ..."
        return $ Move (indexToPosition getRandomEmpty) (space player) 
        
move :: Board -> Move -> Either String Board
move (Board board) (Move position space) =
  case Sequence.index board (positionToIndex position) of
    X -> Left spaceTakenWarning
    O -> Left spaceTakenWarning
    Empty -> Right $ Board $ Sequence.update (positionToIndex position) space board
  where spaceTakenWarning = "There is already a piece there"
        
continueOrEndGame :: GameState -> IO ()
continueOrEndGame gameState@ GameState {board=board, playerWithTurn=player} =
  let outcome = gameOutcome gameState
  in case outcome of
    Winner winner -> do putStrLn $ showBoard board
                        putStrLn $ playerString winner ++ " has won the game!"
    Tie -> do putStrLn $ showBoard board
              putStrLn "The game is a tie!"
    ContinueGame -> gameStep $ gameState {board=board, playerWithTurn = other player}
                                           
gameOutcome :: GameState -> Outcome
gameOutcome gameState@ GameState {board=board} =
  fromMaybe ContinueGame checkEndConditions
  where checkEndConditions =
          checkRowsForWinner gameState `mplus`
          checkColumnsForWinner gameState `mplus`
          checkDiagonalsForWinner gameState `mplus`
          isTie gameState

checkRowsForWinner :: GameState -> Maybe Outcome
checkRowsForWinner gs =
  checkThreeForWinner gs 0 1 2 `mplus`
  checkThreeForWinner gs 3 4 5 `mplus`
  checkThreeForWinner gs 6 7 8

checkColumnsForWinner :: GameState -> Maybe Outcome
checkColumnsForWinner gs =
  checkThreeForWinner gs 0 3 6 `mplus`
  checkThreeForWinner gs 1 4 7 `mplus`
  checkThreeForWinner gs 2 5 8

checkDiagonalsForWinner :: GameState -> Maybe Outcome
checkDiagonalsForWinner gs =
  checkThreeForWinner gs 0 4 8 `mplus`
  checkThreeForWinner gs 2 4 6

isTie :: GameState -> Maybe Outcome
isTie GameState {numberOfMoves=numberOfMoves} =
  if numberOfMoves == 9
     then Just Tie
     else Nothing
     
checkThreeForWinner :: GameState -> Int -> Int -> Int -> Maybe Outcome
checkThreeForWinner GameState {board=Board board, playerWithTurn=player} i j k =
  if existsWinner
  then Just $ Winner player
  else Nothing
  where existsWinner =
          (Sequence.index board i == Sequence.index board j) &&
          (Sequence.index board i == Sequence.index board k) &&
          (Sequence.index board i == X || Sequence.index board i == O) 

positionToIndex :: Position -> Int
positionToIndex (Position (row, col)) = (row * 3) + col

indexToPosition :: Int -> Position
indexToPosition i =
  let row = i `quot` 3
      col = i `mod` 3
  in Position (row, col)

showBoard :: Board -> String
showBoard (Board board) =
  "Board:\n" ++
  Sequence.foldrWithIndex (\i space acc -> printSpace space ++ newlineIfEndOfRow i ++ acc) "" board
  where newlineIfEndOfRow i =
          case i `mod` 3 of
            2 -> "\n"
            _ -> ""

printSpace :: Space -> String
printSpace Empty = "-"
printSpace X = "x"
printSpace O = "o"

readMaybe :: (Read a) => String -> Maybe a
readMaybe s = case reads s of
              [(x, "")] -> Just x
              _ -> Nothing

getIndexInRange :: (Int, Int) ->  IO Int
getIndexInRange range@ (low, high) = do
  desiredIndex <- getLine
  case readMaybe desiredIndex of
    Nothing -> do putStrLn errorMessage  
                  getIndexInRange range
    Just i -> if i `elem` [low..high]
              then return i
              else do putStrLn errorMessage
                      getIndexInRange range
  where errorMessage = "Please be sure to enter a number between " ++ show low ++ " and " ++ show high ++ "!"