第一回 オフラインリアルタイムどう書くの回答例(2)

import Test.HUnit
import TickTackToe

parseLine :: String -> (String, String, String)
parseLine line = let (num, left) = break (== '\t') line
                     (input, output) = break (== '\t') $ tail left
                 in (num, input, tail output)

runAllTest :: [(String, String, String)] -> IO ()
runAllTest testCases = do
  let tests = TestList $ fmap testLabel testCases
  runTestTT tests
  return ()
    where testLabel (num, input, output) =
              TestCase $ assertEqual num output (solve input)

main :: IO ()
main = do
  contents <- readFile "tick_tack_toe_test_case.tsv"
  let testCases = fmap parseLine $ lines contents
  runAllTest testCases

module TickTackToe (solve) where

data Player = Player { name :: String }
              deriving (Eq, Show)
data Cell = Empty | Owned Player
            deriving (Eq, Show)
data Result = Draw | Winner Player | Faul Player
              deriving (Eq, Show)
type Point = (Int, Int)
type Board = [[Cell]]

solve :: String -> String
solve input = case process input' (head players) (initialBoard size) of
                Draw -> "Draw game."
                Winner p -> (name p) ++ " won."
                Faul p -> "Foul : " ++ (name $ nextPlayer p) ++ " won."
    where
      input' = take (size * size) input
      process :: String -> Player -> Board -> Result
      process [] _ _ = Draw
      process (x:xs) player board =
          let pt = numberToPoint (read $ x : "") size
          in
            case checkBoard board pt of
              Owned _ -> Faul player
              Empty -> let nextBoard = putBoard board pt player
                       in if (checkHorizontal nextBoard pt ||
                              checkVertical nextBoard pt ||
                              checkDiagonal nextBoard pt)
                          then Winner player
                          else process xs (nextPlayer player) nextBoard

size :: Int
size = 3

initialBoard :: Int -> Board
initialBoard s = replicate s $ replicate s Empty

numberToPoint :: Int -> Int -> Point
numberToPoint n s = (n' `div` s, n' `mod` s)
    where n' = n - 1

putBoard :: Board -> Point -> Player -> Board
putBoard board pt player = fmap processRow $ zip board [0..]
    where processRow (row, y) = fmap ( \(cell, x) ->
                                           if (x, y) == pt
                                           then Owned player
                                           else cell ) $
                                zip row [0..]

checkBoard :: Board -> Point -> Cell
checkBoard board (x, y) = (board !! y) !! x

players :: [Player]
players = [Player "o", Player "x"]

nextPlayer :: Player -> Player
nextPlayer player = nextPlayer' players player
    where nextPlayer' (x:y:ys) p =
              if x == p then y else nextPlayer' (y:ys) p
          nextPlayer' _ _ = head players

checkHorizontal :: Board -> Point -> Bool
checkHorizontal board (_, y) = isOccupied line
    where line = board !! y

checkVertical :: Board -> Point -> Bool
checkVertical board (x, _) =  isOccupied line
    where line = fmap (!! x) board

checkDiagonal :: Board -> Point -> Bool
checkDiagonal board (x, y) = x == y && isOccupied diagonalA
                             || x == (bSize - y - 1) && isOccupied diagonalB
    where diagonalA = fmap (\i -> checkBoard board (i, i)) [0..2]
          diagonalB = fmap (\i -> checkBoard board (i, bSize - i - 1)) [0..2]
          bSize = length board

isOccupied :: [Cell] -> Bool
isOccupied line = isOccupied' (head line) line
    where isOccupied' _ [] = True
          isOccupied' cell (x:xs) =
              if cell /= x then False else isOccupied' cell xs