{-# LANGUAGE LambdaCase #-}
module Exercise_10 where

import Control.Arrow
import Data.Function
import Data.Functor
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 (map $ \case P H -> 'H'; P V -> 'V'; 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 b p) (r, c) = r >= 0 && c >= 0 && r < length b && c < length (head b) && [E, E] == playFields
  where
    playFields = case p of
        H -> drop r b & take 1 & concat & drop c & take 2
        V -> transpose b & drop c & take 1 & concat & drop r & take 2

{-H10.1.3-}
canMove :: Game -> Bool
canMove g@(Game b _) = not (null b) && not (null (head b)) && any (isValidMove g) ((,) <$> [0..length b] <*> [0..length (head b)])

{-H10.1.4-}
updateBoard :: Board -> Pos -> Field -> Board
updateBoard b (r, c) f = rowsBefore ++ (fieldsBefore ++ f : fieldsAfter) : rowsAfter
  where
    (rowsBefore, row:rowsAfter) = splitAt r b
    (fieldsBefore, _:fieldsAfter) = splitAt c row

{-H10.1.5-}
playMove :: Game -> Pos -> Game
playMove (Game b p) pos@(r,c) = Game b'' $ flipPlayer p
  where
    b' = updateBoard b pos $ P p
    b'' = updateBoard b' pos' $ P p
    pos' = case p of H -> (r, c+1); V -> (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-}
flipPlayer :: Player -> Player
flipPlayer V = H
flipPlayer H = V

{-MCCOMMENT At the Tutorbesprechung I was bullied into writing a submission, so
here is my pointless entry. The approach is a simple destructive one, just pick
the move that leaves the least number of moves open for the opponent.-}
christmasAI :: Strategy
christmasAI _ g@(Game b p) =
    (,) <$> [0..11] <*> [0..11]
    & filter (isValidMove g)
    <&> (,) <*> numValidMoves . playMove g -- yay for obscure combinator usage
    & (((-1, -1), maxBound):) -- Giving up if no valid moves left
    & minimumBy (comparing snd)
    & fst
  where
    numValidMoves g' =
        (,) <$> [0..11] <*> [0..11]
        & filter (isValidMove g')
        & length
{-TTEW-}

{-H10.1.7-}
play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
play randomNumbers dim sv sh = 
    Game (replicate dim $ replicate dim E) V
    & step randomNumbers
  where
    step :: [[Double]] -> Game -> ([Board], Player)
    step (r:rs) g@(Game b p)
        | canMove g && isValidMove g pickedPos =
            first (b':) $ step rs g'
        | otherwise = ([], flipPlayer p)
      where
        strat = case p of H -> sh; V -> sv
        pickedPos = strat r g
        g'@(Game b' _) = playMove g pickedPos

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

-- vim: set et sw=4 :