module Exercise_10 where
import Data.List
import Test.QuickCheck
import Data.Ord

{-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 [] = ""
prettyShowBoard (x:xs) = concat [prettyShowField f | f<-x] ++ "\n" ++ prettyShowBoard xs
  where prettyShowField f = case f of
                            E -> "+"
                            P V -> "V"
                            P H -> "H"

{-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 [] _) _ = False
isValidMove (Game board H) (r,c) | r<0 || c<0 || c>=(dim-1) || r>(dim-1) = False
    where
      dim = length board
isValidMove (Game board V) (r,c) | r<0 || c<0 || c>(dim-1) || r>=(dim-1) = False
      where
      dim = length board
isValidMove (Game board H) (r, c) = (r' !! c) == E && (r' !! (c+1)) == E
    where 
      r' = row board r
isValidMove (Game board V) (r, c) = (c' !! r) == E && (c' !! (r+1)) == E
    where
      c' = column board c

{-H10.1.3-}
canMove :: Game -> Bool
canMove (Game [] _) = False
canMove game@(Game board player) = or [isValidMove game (r,c) | r<- [0..(dim-1)], c<-[0..(dim-1)]]
  where
    dim = length board

{-H10.1.4-}
updateBoard :: Board -> Pos -> Field -> Board
updateBoard board (r,c) field = prevR++[prevC++[field]++nextC]++nextR
          where
            (prevR,repR:nextR) = splitAt r board
            (prevC,_:nextC) = splitAt c repR

{-H10.1.5-}
playMove :: Game -> Pos -> Game
playMove (Game board H) (r,c) = Game (updateBoard (updateBoard board (r,c+1) (P H)) (r, c) (P H)) V
playMove (Game board V) (r,c) = Game (updateBoard (updateBoard board (r+1,c) (P V)) (r, 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-}
christmasAI :: Strategy -- receives a game and plays a move for the next player
christmasAI rs game@(Game board _) = minimumBy (comparing nextGame) $  moves game
  where
    dim = length board
    nextGame (r, c) = length $ moves $ playMove game (r,c)
    moves g = [(r,c) | r<- [0..(dim-1)], c<-[0..(dim-1)], isValidMove g (r,c)]
{-TTEW-}

{-H10.1.7-}
play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
play _ 0 _ _ = ([], H)
play rss dim sv sh = (tail xs, last ys)
    where
      fstGame = Game (genEmpty dim) V
      (xs, ys) = unzip $ play' rss dim sv sh fstGame

play' rss dim sv sh game@(Game board V) = if not (canMove game) || not (isValidMove game svMove) then [(board, H)]
                                          else (board, V) : play' (tail rss) dim sv sh (playMove game svMove)
    where
          svMove = sv (head rss) game
play' rss dim sv sh game@(Game board H) = if not (canMove game) || not (isValidMove game shMove) then [(board, V)]
                                          else (board, H) : play' (tail rss) dim sv sh (playMove game shMove)
    where
          shMove = sh (head rss) game



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

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