module Exercise_10 where

import Data.List
import Data.Ord
import Test.QuickCheck

{-H10.1-}
data Player
  = V
  | H -- vertical or horizontal player
  deriving (Eq, Show)

data Field
  = P Player
  | E -- a field is occupied by a player or empty
  deriving (Eq, Show)

type Row = [Field]

type Column = [Field]

type Board = [Row] -- we assume that boards are squares and encode a board row by row

data Game =
  Game Board Player -- stores the currenty board and player
  deriving (Eq, Show)

-- get a given row of a board
row :: Board -> Int -> Row
row = (!!)

-- get a given column of a board
column :: Board -> Int -> Column
column = row . transpose

-- width of a board
width :: Board -> Int
width [] = 0
width (x:xs) = length x

-- height of a board
height :: Board -> Int
height = length

{-H10.1.1-}
prettyShowBoard :: Board -> String
prettyShowBoard = unlines . map (concatMap toSign)
  where
    toSign (P H) = "H"
    toSign (P V) = "V"
    toSign (E) = "+"

{-H10.1.2-}
-- position on a board (row, column)
-- (0,0) corresponds to the top left corner
type Pos = (Int, Int)

isValidMove :: Game -> Pos -> Bool
isValidMove (Game board player) p1@(r, c) =
  inBoard p1 && inBoard p2 && empty p1 && empty p2
  where
    p2 =
      if player == H
        then (r, c + 1)
        else (r + 1, c)
    inBoard (r, c) = r >= 0 && c >= 0 && r < height board && c < width board
    empty (r, c) = board !! r !! c == E

{-H10.1.3-}
canMove :: Game -> Bool
canMove (Game board player) =
  if player == H
    then twoSpots board
    else twoSpots (transpose board)
  where
    twoSpots rc = any (\x -> length x >= 2 && elem E x) $ concatMap group rc

{-H10.1.4-}
updateBoard :: Board -> Pos -> Field -> Board
updateBoard [] _ _ = []
updateBoard board (r, c) field =
  take r board ++ [modRow (row board r)] ++ drop (r + 1) board
  where
    modRow r = take c r ++ [field] ++ drop (c + 1) r

{-H10.1.5-}
playMove :: Game -> Pos -> Game
playMove (Game board player) p@(r, c) = Game uBoard nextPlayer
  where
    nextPlayer =
      if player == H
        then V
        else H
    uBoard = updateBoard (updateBoard board p field) p2 field
    field = P player
    p2 =
      if player == H
        then (r, c + 1)
        else (r + 1, c)

{-H10.1.6-}
-- the first paramter of a strategy is an infite list of
-- random values between (0,1) (in case you wanna go wild with
-- probabilistic methods)
type Strategy = [Double] -> Game -> Pos

{-WETT-}
getValidMoves :: Game -> [Pos]
getValidMoves game@(Game board player) =
  filter (isValidMove game) $
  concatMap (\r -> map (\c -> (r, c)) [0 .. width board]) [0 .. height board]

evaluate game@(Game board player) level isSelf pos
  | not (canMove nextGame) =
    if isSelf
      then 1000
      else -1000
  | level == 0 =
    if isSelf
      then negate possibleMoves
      else possibleMoves
  | otherwise =
    (sum $ map (evaluate nextGame (level - 1) (not isSelf)) nextMoves) `div`
    possibleMoves
  where
    nextGame = playMove game pos
    nextMoves = getValidMoves nextGame
    possibleMoves = length nextMoves

christmasAI :: Strategy -- receives a game and plays a move for the next player
christmasAI _ game@(Game board player)
  | null moves = (0, 0)
  | otherwise =
    fst $
    minimumBy (comparing snd) $
    zip moves $ map (length . getValidMoves . (playMove game)) moves
  where
    moves = getValidMoves game

{-TTEW-}
{-H10.1.7-}
play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board], Player)
play rss dim sv sh
  | null boards = ([], H)
  | otherwise = (boards, winningPlayer)
  where
    emptyBoard = replicate dim (replicate dim E)
    games = play' rss (Game emptyBoard V) sv sh
    boards = map (\(Game board player) -> board) games
    (Game _ lastPlayer) = last games
    winningPlayer =
      if lastPlayer == H
        then V
        else H

{-
H V H V --> H (no moves)
H V H V --> H (V invalid move)
-}
play' :: [[Double]] -> Game -> Strategy -> Strategy -> [Game]
play' (rs:rss) game@(Game board player) sv sh
  | not (isValidMove game pos) = []
  | canMove newGame = newGame : (play' rss newGame sv sh)
  | otherwise = [newGame]
  where
    newGame = playMove game pos
    pos = strat rs game
    strat =
      if player == H
        then sh
        else sv

-- generates infinite list of values between (0,1)
genRandomZeroOne :: Gen [Double]
genRandomZeroOne = mapM (const $ choose (0 :: Double, 1)) [1 ..]

-- plays a game and prints it to the console
playAndPrint :: Int -> Strategy -> Strategy -> IO ()
playAndPrint dim sh sv = do
  rss <- generate $ mapM (const $ genRandomZeroOne) [1 ..]
  let (bs, w) = play rss dim sh sv
  putStr $ (unlines $ map prettyShowBoard bs) ++ "\nWinner: " ++ show w ++ "\n"