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 current board and player
  deriving (Eq,Show)

newEmptyBoard :: Int -> Board
newEmptyBoard dim = replicate dim (replicate dim E)

-- 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

-- get a given field of a board
field :: Board -> Pos -> Field
field board (r, c) = row board r !! c

-- get current board
getBoard :: Game -> Board
getBoard (Game b _) = b

-- get current player
currentPlayer :: Game -> Player
currentPlayer (Game _ p) = p

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

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

{-H10.1.1-}
prettyShowRow :: Row -> String
prettyShowRow [] = "\n"
prettyShowRow (x:xs) = case x of
  E    -> "+" ++ prettyShowRow xs
  P V  -> "V" ++ prettyShowRow xs
  P H  -> "H" ++ prettyShowRow xs

prettyShowBoard :: Board -> String
prettyShowBoard [] = ""
prettyShowBoard (r:rs) = (prettyShowRow r) ++ (prettyShowBoard rs)

{-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 g (r, c) = case currentPlayer g of
  H -> and [valid pos | pos <- [(r, c), (r, c+1)]]
  V -> and [valid pos | pos <- [(r, c), (r+1, c)]]
  where
    b = getBoard g
    valid :: Pos -> Bool
    valid (r, c) =
      r >= 0 && c >= 0
      && r < height b && c < width b
      && field b (r, c) == E

{-H10.1.3-}
canMove' :: Board -> Bool
canMove' []     = False
canMove' (r:rs) = validSpotRow r || canMove' rs

validSpotRow :: Row -> Bool
validSpotRow (a:b:xs) = if   a == E && b == E
                        then True
                        else validSpotRow (b:xs)
validSpotRow _        = False

canMove :: Game -> Bool
canMove g = case currentPlayer g of
  H -> (canMove' . getBoard) g
  V -> (canMove' . transpose . getBoard) g


{-H10.1.4-}
updateRow :: Row -> Int -> Field -> Row
updateRow [_] _ p = [p]
updateRow r i p   = (take i r) ++ [p] ++ (drop (i+1) r)

updateBoard :: Board -> Pos -> Field -> Board
updateBoard board (r, c) f =
  (take r board)
  ++ [(updateRow (board!!r) c f)]
  ++ (drop (r+1) board)

{-H10.1.5-}
playMove :: Game -> Pos -> Game
playMove (Game board player) (r, c) = case player of
  H -> Game (updateBoard (updateBoard board (r, c) (P H)) (r, c+1) (P H)) V
  V -> Game (updateBoard (updateBoard board (r, c) (P V)) (r+1, c) (P V)) H

{-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-}
possibleMoves :: Game -> [Pos]
possibleMoves (Game board player) =
  [(r, c) | r <- [0..(length board)-1], c <- [0..(width board)-1], isValidMove (Game board player) (r, c)]

christmasAI :: Strategy -- receives a game and plays a move for the next player
christmasAI _ game = snd $ minimumBy (comparing fst) [(length $ possibleMoves $ playMove game pos, pos) | pos <- possibleMoves game]
{-TTEW-}

{-H10.1.7-}
play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
play rss dim sv sh = play' rss sv sh [newEmptyBoard dim] V
  where
    play' [] _ _ _ _ = error "not enough random values provided"
    play' (rs:rss) sv sh hist V
      | null $ possibleMoves (Game (last hist) V) = (drop 1 hist, H)
      | otherwise = let game = Game (last hist) V
                        pos  = sv rs game in
        if isValidMove game pos
        then play' rss sv sh (hist++[(getBoard $ playMove game pos)]) H
        else (drop 1 hist, H)
    play' (rs:rss) sv sh hist H
      | null $ possibleMoves (Game (last hist) H) = (drop 1 hist, V)
      | otherwise = let game = Game (last hist) H
                        pos  = sh rs game in
        if isValidMove game pos
        then play' rss sv sh (hist++[(getBoard $ playMove game pos)]) V
        else (drop 1 hist, V)



-- 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"