{-|
    This module exports all the functions required by 'playGo'
    function in 'Go' game.
-}
module BoardGo(
    Point(Point),
    Stone(Black, White, Ko, Empty),
    getOppositeStone,
    Move(Pass, Move),
    getPiece,
    GameStatus(Alive, Dead, Over),
    Game(Game),
    createGame,
    killGame,
    seekBoard,
    removeKo,
    removePiece,
    playPass,
    validMove,
    playMove,
    finishGame,
    getWinner
) where

import Data.Map as Map
import Data.List as List

-- | This data type represents a 'Point' in Board of Go (i.e. intersection of two lines)
data Point = Point Int Int -- ^ Point constructor takes two coordinates x and y
           deriving (Ord, Eq)

-- | This data type represents 'Stone' placed on the board
data Stone = Black -- ^ To represent 'Black' stone
           | White -- ^ To represent 'White' stone
           | Ko -- ^ 'Ko' is not shown on the board. Placed when Ko situation occurs
           | Empty -- ^ To represent that nothing is placed on the point
           deriving (Eq, Show)

-- | 'getOppositeStone' returns opposite stone of given 'Stone'
getOppositeStone :: Stone -> Stone
getOppositeStone stone | stone == Black = White
                      | stone == White = Black
                      | otherwise = Empty

-- | This data type represents a 'Move' that can be performed on the board by a player
data Move = Pass Stone -- ^ Player with this 'Stone' plays pass
          | Move Point Stone -- ^ Player with this 'Stone' plays on a 'Point'
          deriving (Eq)

-- | 'getPiece' returns the 'Stone' from a given 'Move'
getPiece :: Move -> Stone
getPiece (Pass st) = st
getPiece (Move  _ st) = st

-- | This data type reprsents 'Game'
data Game = Game {
    board :: Map Point Stone, -- ^ Map from point to stone
    lastMove :: Move, -- ^ Last move that was played in the game
    boardSize :: Int, -- ^ Board size 9 or 13 or 19
    scoreBlack :: Int, -- ^ Score of Black stone
    scoreWhite :: Int, -- ^ Score of White stone
    status :: GameStatus -- ^ Status of the game whether game is running or over
}

-- | 'GameStatus' represents state of the game if game is alive or dead or over
data GameStatus = Alive -- ^ game is running
                | Dead -- ^ game is over and hopeless string is counted
                | Over -- ^ Game over and results are shown on the screen
                deriving (Eq)

-- | 'createGame' takes a size and returns a 'Game' object
createGame :: Int -> Game
createGame size = Game{
    board = addPieces (Map.empty) points,
    lastMove = Move (Point (-1) (-1)) White,
    boardSize = size,
    scoreBlack = 0,
    scoreWhite = 0,
    status = Alive
} where points = [(Point x y) | x <- [1..size], y <- [1..size]]

-- | 'addPieces' adds Empty to set of points in a map
addPieces :: (Map Point Stone) -> [Point] -> (Map Point Stone)
addPieces m [] = m
addPieces m (x:xs) = addPieces (Map.insert x Empty m) xs

-- | 'killGame' changes game status from 'Alive' to 'Dead' and increases the score of 'Black'
-- as 'White' plays the last 'Pass'.
killGame :: Game -> Game
killGame game@(Game m lm s sb sw Alive) = Game m lm s (sb+1) sw Dead
killGame game = game

-- | 'removeKo' removes 'Ko' from the 'Game'
removeKo :: Game -> Game
removeKo game@(Game m lm s b w status) = (Game newBoard lm s b w status)
    where pointsWithKo = List.filter (\(p, s) -> s == Ko) (assocs m)
          newBoard = if pointsWithKo == [] then m else addPiece m (fst (pointsWithKo !! 0)) Empty

-- | 'addPiece' adds a element of type t to map
addPiece :: (Map Point t) -> Point -> t -> (Map Point t)
addPiece m point stone = Map.insert point stone (Map.delete point m)

-- | 'removePiece' removes the stone from given point in the map
removePiece :: (Map Point Stone) -> Point -> (Map Point Stone)
removePiece m point = addPiece m point Empty

-- | 'playPass' adds 'Pass' move by the 'Stone' on the 'Game'
playPass :: Game -> Stone -> Game
playPass game@(Game board lm s sb sw status) stone = Game {
    board = board,
    lastMove = Pass stone,
    boardSize = s,
    scoreBlack = newsb,
    scoreWhite = newsw,
    status = status
} where
    -- | Increase score of opposite stone
    newsb = if stone == Black then sb else (sb+1)
    newsw = if stone == White then sw else (sw+1)

-- | 'playMove' adds 'Move' to 'Point' by 'Stone' on the 'Game'.
-- After playing the move, also removes the captured points of the opposite stone if present
playMove :: Game -> Point -> Stone -> Game
playMove game@(Game board lm s sb sw status) point stone = removeGroups Game {
    board = addPiece board point stone,
    lastMove = Move point stone,
    boardSize = s,
    scoreBlack = sb,
    scoreWhite = sw,
    status = status
} point ostone where ostone = getOppositeStone stone

-- | 'removeGroups' removes captured stones of 'Stone' from the 'Game' starting from
-- 'Point' and moving in all four directions
removeGroups :: Game -> Point -> Stone -> Game
removeGroups game@(Game board lm s sb sw status) point@(Point x y) stone
    -- If number of points captured is one then check if Ko is formed and add Ko to the board if neccesary
    | length pointsToBeRemoved == 1 && isKo = updateScore (addKo (removeStones game pointsToBeRemoved) (pointsToBeRemoved !! 0)) 1 stone'
    | otherwise = updateScore (removeStones game pointsToBeRemoved) (length pointsToBeRemoved) stone'
    where (up, down, left, right) = getAdj point
          removeUp = removeDead up stone game
          removeDown = removeDead down stone game
          removeLeft = removeDead left stone game
          removeRight = removeDead right stone game
          pointsToBeRemoved = removeUp ++ removeDown ++ removeLeft ++ removeRight
          point' = if length removeUp == 1 then up else if length removeDown == 1 then down else if length removeLeft == 1 then left else right
          (up', down', left', right') = getAdj point'
          stone' = getOppositeStone stone
          isKo = length ((removeDead up' stone' game) ++ (removeDead down' stone' game) ++ (removeDead left' stone' game) ++ (removeDead right' stone' game)) == 1

-- | 'getAdj' returns adjacent points of a given 'Point'
getAdj :: Point -> (Point, Point, Point, Point)
getAdj (Point x y) = (Point x (y+1), Point x (y-1), Point (x-1) y, Point (x+1) y)

-- | 'removeDead' returns dead groups of 'Stone' in 'Game' starting from 'Point'
removeDead :: Point -> Stone -> Game -> [Maybe Point]
removeDead point stone game | checkIfTrapped game point stone = removablePoints
                            | otherwise = []
                            where removablePoints = (findTrappedGroup game point stone [])

-- | 'updateScore' updates the score of 'Stone' by given 'Int'
updateScore :: Game -> Int -> Stone -> Game
updateScore game@(Game m lm s b w status) p st
    | st == Black = (Game m lm s (b+p) w status)
    | otherwise = (Game m lm s b (w+p) status)

-- | 'addKo' adds 'Ko' to the game at given point
addKo :: Game -> (Maybe Point) -> Game
addKo game@(Game m lm s b w status) (Just p) = (Game (addPiece m p Ko) lm s b w status)

-- | 'removeStones' given a list of points removes stones from all those pieces in the game
removeStones :: Game -> [Maybe Point] -> Game
removeStones game@(Game m lm _ _ _ status) [] = game
removeStones game@(Game m lm s b w status) (Nothing:xs) = game
removeStones game@(Game m lm s b w status) ((Just p):xs) = removeStones (Game (removePiece m p) lm s b w status) xs

-- | 'seekBoard' returns the 'Stone' at given 'Point' in the 'Game'
seekBoard :: Game -> Point -> Stone
seekBoard (Game m _ _ _ _ _) p = case Map.lookup p m of
    Just stone -> stone
    Nothing -> Empty

-- | This data type represents whether corresponding stone belongs to Black or White or None
data Status = Seen | Unseen | SeenW | SeenB | None deriving (Eq)

-- | 'seekMap' returns the 'Status' of 'Point' from a given map
seekMap :: (Map Point Status) -> Point -> Status
seekMap m p = case Map.lookup p m of
    Just s -> s
    Nothing -> Unseen

-- | 'findTrappedGroup' finds trapped group of stones in the game
-- starting from point and going in all directions
findTrappedGroup :: Game -> Point -> Stone -> [Maybe Point] -> [Maybe Point]
findTrappedGroup game@(Game m move@(Move pt st) boardSize _ _ _) point@(Point x y) stone seenPoints
    | x < 1 || x > boardSize || y < 1 || y > boardSize  = seenPoints
    | elem (pure point) seenPoints = seenPoints
    | seekBoard game point == Empty = Nothing:seenPoints
    | seekBoard game point == Ko = Nothing:seenPoints
    | seekBoard game point /= stone = seenPoints
    | otherwise = findTrappedGroup game left stone
        $ findTrappedGroup game right stone
        $ findTrappedGroup game up stone
        $ findTrappedGroup game down stone ((pure point):seenPoints)
    where up = Point x (y+1)
          down = Point x (y-1)
          right = Point (x+1) y
          left = Point (x-1) y

-- | 'findTerritory' finds territory of a given point in the game
-- starting from point and going in all directions
findTerritory :: Game -> Point -> Stone -> ((Map Point Status), [Maybe Point]) -> ((Map Point Status), [Maybe Point])
findTerritory game@(Game _ _ boardSize _ _ _) point@(Point x y) stone (m, points)
    | x < 1 || x > boardSize || y < 1 || y > boardSize = (m, points) -- If point is out of board
    | elem (pure point) points = (m, points) -- If we have already visited this point
    | seekBoard game point == getOppositeStone stone = (m, Nothing:points) -- If this point has opposite stone
    | seekBoard game point == stone = (m, points) -- If this point has current stone
    | otherwise = findTerritory game left stone
        $ findTerritory game right stone
        $ findTerritory game up stone
        $ findTerritory game down stone ((Map.insert point Seen m), ((pure point):points)) -- Otherwise recure on all adjacent points of the stone
    where (up, down, left, right) = getAdj point

-- | 'findTerritories' finds terrirtories of either Black or White stone from given Point
findTerritories :: Game -> Point -> (Map Point Status) -> (Map Point Status)
findTerritories game point m
    | seekBoard game point /= Empty && seekBoard game point /= Ko = addPiece m point None -- If point has Ko or Empty
    | seekMap m point == SeenW = m -- If point belongs to White's territory
    | seekMap m point == SeenB = m -- If point belongs to Black's territory
    | seekMap m point == None = m -- If point has been seen and belongs to none
    | otherwise = if elem Nothing (snd tw) then
                      if elem Nothing (snd tb) then setInMap m (snd tb) None
                      else setInMap m (snd tb) SeenB
                  else setInMap m (snd tw) SeenW
    where tb = findTerritory game point Black (m, [])
          tw = findTerritory game point White (m, [])

-- | 'setInMap' sets staus of points in the map
setInMap :: (Map Point Status) -> [Maybe Point] -> Status -> (Map Point Status)
setInMap m [] st = m
setInMap m (point:points) st | point /= Nothing = setInMap (addPiece m (purify point) st) points st
                             | otherwise = setInMap m points st

-- | 'findAllTerritoriesOfPoints' calulates all the territories of given list of points in Game
findAllTerritoriesOfPoints :: Game -> [Point] -> (Map Point Status) -> (Map Point Status)
findAllTerritoriesOfPoints game [] m = m
findAllTerritoriesOfPoints game (point:points) m = findAllTerritoriesOfPoints game points (findTerritories game point m)

-- | 'findTerritories' creates list of points and finds territories for all the points in the game
findAllTerritories :: Game -> (Map Point Status)
findAllTerritories game@(Game _ _ boardSize _ _ _) = findAllTerritoriesOfPoints game points Map.empty
    where points = [(Point x y) | x <- [1..boardSize], y <- [1..boardSize]]

-- | 'finishGame' finds all the captured territories in the 'Game' and updates the correspoing scores of the 'Stone'
finishGame :: Game -> Game
finishGame game@(Game m lm s sb sw status) = Game m lm s sb' sw' Over
    where sb' = sb + countSeenB t s
          sw' = sw + countSeenW t s
          t = findAllTerritories game

-- | 'countSeenB' counts the points that belong to territory of Black
countSeenB :: (Map Point Status) -> Int -> Int
countSeenB m size | l == size*size = 0 -- If board is empty then it cannot be territory
                  | otherwise = l
                  where l = length $ List.filter (\(p,s) -> s == SeenB) (assocs m)

-- | 'countSeenW' counts the points that belong to territory of White
countSeenW :: (Map Point Status) -> Int -> Int
countSeenW m size | l == size*size = 0 -- If board is empty then it cannot be territory
                  | otherwise = l
                  where l = length $ List.filter (\(p,s) -> s == SeenW) (assocs m)
-- | 'purify' changes Maybe Type to Type
purify :: Maybe a -> a
purify (Just a) = a

-- | 'validMove' checks if the move of given 'Point' to given 'Stone' is valid or not
validMove :: Game -> Point -> Stone -> Bool
validMove game@(Game m lm s _ _ _) p@(Point x y) st | x < 1 || x > s || y < 1 || y > s = False
    | seekBoard game p /= Empty = False -- If point is not empty
    | not $ checkIfTrapped game1 p st = True -- If point is not trapped then validmove
    -- If point is trapped then check if on placing the stone whether opposites stone sare captured or not
    | (seekBoard game up == ostone) && (checkIfTrapped game1 up ostone) = True
    | (seekBoard game down == ostone) && (checkIfTrapped game1 down ostone) = True
    | (seekBoard game left == ostone) && (checkIfTrapped game1 left ostone) = True
    | (seekBoard game right == ostone) && (checkIfTrapped game1 right ostone) = True
    | otherwise = False
    where game1 = playMove game p st
          ostone = getOppositeStone st
          up = Point x (y+1)
          down = Point x (y-1)
          right = Point (x+1) y
          left = Point (x-1) y

-- | 'checkIfTrapped' checks whether a stone is trapped or not
checkIfTrapped :: Game -> Point -> Stone -> Bool
checkIfTrapped game p st = not $ elem Nothing (findTrappedGroup game p st [])

-- | 'checkIfNothing' checks whether 'Maybe Point' is 'Nothing'
checkIfNothing :: (Maybe Point) -> Bool
checkIfNothing Nothing = True
checkIfNothing (Just point) = False

-- | 'getWinner' declares the winner depending on the scores of the stones
getWinner :: Game -> String
getWinner game@(Game _ _ _ sb sw _)
    | sb > sw = "Black wins." -- If 'Black' score is more than 'White' score
    | sw > sb = "White wins." -- If 'White' score is more than 'Black' score
    | otherwise = "Game Draws" -- If both the scores are equal