{-# LANGUAGE TupleSections #-}
module Board where
import Data.List
import Data.Maybe
import Data.Function
import Data.Monoid
import Control.Arrow
import Control.Monad
import qualified Data.Map.Strict as Map
import Data.Easy (monoidToMaybe)
import qualified Stone


type Position = (Char, Char)  -- (X, Y)

type Board = Map.Map Position Stone.Cell

-- | succ / id / pred
type Direction = (Char -> Char, Char -> Char)

-- | If the cell is Nothing or the position is out of range, return Nothing
lookup' :: Position -> Board -> Maybe Stone.Stone
lookup' = (join.) . Map.lookup

render :: Board -> String
render =
  unlines .
  map (concatMap $ Stone.render . snd) .  -- Show stones
  transpose .  -- Group by the digit of the position
  groupBy ((==) `on` (fst . fst)) .  -- Group by the alphabet of the position
  Map.toAscList  -- Sort by the position

renderWithRuler :: Board -> String
renderWithRuler = unlines . (:) ("  " ++ intersperse ' ' xRange) . zipWith ((++) . (:" ")) yRange . lines . render

xRange = ['a'..'h']

yRange = ['1'..'8']

initial :: Board
initial = Map.fromListWith const $ [((x, y), Nothing) | x <- xRange, y <- yRange] ++ map (second Just)
  [ (('d', '4'), Stone.White)
  , (('d', '5'), Stone.Black)
  , (('e', '4'), Stone.Black)
  , (('e', '5'), Stone.White)
  ]

-- | Is it out of range?
validate :: Position -> Bool
validate = flip Map.member initial

-- | If there are no stones that can take, return Nothing or Just [].
canTakeStones :: Position -> Stone.Stone -> Board -> Direction -> Maybe [Position]
canTakeStones position turn board direction
  | stone == Just turn = Just []
  | stone == Just (Stone.turnOver turn) = (pos:) <$> canTakeStones pos turn board direction
  | otherwise = Nothing
  where
    pos = uncurry (***) direction position  -- A position that moved to the direction.
    stone = lookup' pos board

-- | Search 8 directions.
canTakeStonesAll :: Position -> Stone.Stone -> Board -> [Position]
canTakeStonesAll position turn board =
  concat $
  mapMaybe (canTakeStones position turn board)
  (join (liftM2 (,)) [succ, id, pred] :: [Direction])  -- 9 directions. (id, id) does nothing.

-- | If impossible to put the stone, return Nothing.
put :: Position -> Stone.Stone -> Board -> Maybe Board
put position turn board =
  (<>board) . Map.fromList . map (, Just turn) . (position:) <$> do
    -- ^ right-biased
    guard $ isNothing $ lookup' position board  -- If a stone already exists in the position, return Nothing
    monoidToMaybe $ canTakeStonesAll position turn board  -- If the player can't take any stones, return Nothing

count :: Board -> String
count =
  unwords .
  map (uncurry (++) <<< Stone.render . head &&& (' ':) . show . length) .
  group .  -- Group by stone
  sort .
  map snd .
  Map.toList
