Board.hs

{-
    Tabla de joc și mutările posibile.

    Modulul exportă numai funcțiile enumerate mai jos, ceea ce înseamnă
    că doar acestea vor fi vizibile din alte module. Justificarea vizează
    prevenirea accesului extern la structura obiectelor 'Board', și a eventualei
    coruperi a consistenței interne a acestora.
-}
module Board
    ( Board
    , Player (..)  -- Exportăm și constructorii de date 'You' și 'Opponent'.
    , House
    , build
    , yourSeeds
    , oppsSeeds
    , who
    , isOver
    , initialBoard
    , move
    , scores
    , successors
    ) where

import Consecutive
import Data.List (intersperse)
data Player = You | Opponent deriving (Eq, Show)
type House = Int
type Seeds = ([Int], Int)
data Board = Board { oppsSeeds :: Seeds, yourSeeds :: Seeds, who :: Player} deriving Eq

{-
    *** TODO ***

    Instanțiați clasa 'Show' cu tipul 'Board'. Exemplu de reprezentare,
    unde scorurile sunt aferent jucătorilor 'You', respectiv 'Opponent':

       4  4  4  4  4  4
     0                  0    Next: You, Playing, Score: (0,0)
       4  4  4  4  4  4
-}

instance Show Board where -- every line corresponds to one line of the result
    show (Board oppsSeeds yourSeeds who) = "  " ++ (concat $ intersperse " " (map show (fst oppsSeeds))) ++ "\n " ++
      (show $ snd oppsSeeds) ++ "             " ++ (show $ snd yourSeeds) ++ "    Next: " ++ show who ++ ", " ++ over ++ ", Score: (" ++ (show $ snd oppsSeeds) ++ "," ++ (show $ snd yourSeeds) ++ ")\n" ++
          "  " ++ (concat $ intersperse " " (map show  (fst yourSeeds)))
            where over | isOver (Board oppsSeeds yourSeeds who) = "Over"
                       | otherwise = "Playing"

{-
    *** TODO BONUS ***

    Instanțiați clasa 'Consecutive', pentru a putea determina dacă în două
    configurații ale tablei trebuie să mute același jucător.
-}
instance Consecutive Board where
    b1 >< b2 = undefined

build :: ([Int], Int)  -- Conținutul caselor și al depozitului utilizatorului
      -> ([Int], Int)  -- Conținutul caselor și al depozitului adversarului
      -> Player        -- Jucătorul aflat la rând
      -> Board         -- Tabla construită
build your opps who = Board opps your who

isOver :: Board -> Bool
isOver board = (sum $ fst $ yourSeeds board) == 0 || (sum $ fst $ oppsSeeds board) == 0

initialBoard :: Board
initialBoard = Board ([4,4,4,4,4,4],0) ([4,4,4,4,4,4],0) You

-----------------------------------------------------
--functions defined in that zone (between ----------) are used for move, so they could be defined in where clause
--
--let's make all houses numbered including kalahi, starting with your houses (that are in bottom)
--so in the counter-clockwise direction positions are 0,1,2,3,4,5,6,7,8...
--opponent kalahi has number 13, these numbers in the code are called positions
move :: House -> Board -> Board
move house board
  | house <1 || house >6 = board
  | seeds == 0 = board
  | otherwise = checkForSideEffects (last positions) $ foldr increment (nullHouse house board) positions
  where seeds = case who board of
            You -> (fst $ yourSeeds board) !! (house-1)
            Opponent -> (fst $ oppsSeeds board) !! (house-1)
        fullCircle = [0..13]
        positions = case who board of --here we make list of positions that should be incremented
            You -> take seeds $ filter (/= 13) $ drop house fullCircle ++ (concat . repeat) fullCircle
            Opponent -> take seeds $ filter (/= 6) $ drop (14-house) fullCircle ++ (concat . repeat) fullCircle

--if the last seed goes to the kalah or goes to empty house this function would make right behaviour
checkForSideEffects :: Int -> Board -> Board
checkForSideEffects position (Board oppsSeeds yourSeeds You) -- definition for bottom player
      | position > 6 = Board oppsSeeds yourSeeds Opponent
      | position == 6 = Board oppsSeeds yourSeeds You
      | ((fst oppsSeeds) !! position) == 0 = Board oppsSeeds yourSeeds Opponent
      | ((fst yourSeeds) !! position) /= 1 = Board oppsSeeds yourSeeds Opponent
      | otherwise = Board (replaceNth position 0 (fst oppsSeeds), snd oppsSeeds)
        (replaceNth position 0 $ fst yourSeeds, (fst yourSeeds !! position) + (fst oppsSeeds !! position) + snd yourSeeds) Opponent

checkForSideEffects position (Board oppsSeeds yourSeeds Opponent) -- definition for top player
      | position <= 6 = Board oppsSeeds yourSeeds You
      | position == 13 = Board oppsSeeds yourSeeds Opponent
      | (fst yourSeeds) !! normalisedPosition == 0 = Board oppsSeeds yourSeeds You
      | (fst oppsSeeds) !! normalisedPosition /= 1 = Board oppsSeeds yourSeeds You
      | otherwise = Board (replaceNth normalisedPosition 0 (fst oppsSeeds), ((fst oppsSeeds) !! normalisedPosition) + (fst yourSeeds) !! normalisedPosition + snd oppsSeeds)
        (replaceNth normalisedPosition 0 (fst yourSeeds), snd yourSeeds) You
          where normalisedPosition = ((-position) `mod` 6)

--this function increments a position at the board
increment position (Board oppsSeeds yourSeeds who)
  | position < 6  = Board oppsSeeds (incrementNth position $ fst yourSeeds, snd yourSeeds) who
  | position == 6  = Board oppsSeeds (fst yourSeeds, snd yourSeeds +1) who
  | position <13  = Board (incrementNth ((-position) `mod` 6) $ fst oppsSeeds, snd oppsSeeds) yourSeeds who
  | position == 13 = Board (fst oppsSeeds, snd oppsSeeds +1) yourSeeds who

--sets given house seeds to null
nullHouse house (Board oppsSeeds yourSeeds who) = case who of
                                                      You -> Board oppsSeeds (replaceNth (house-1) 0 (fst yourSeeds), snd yourSeeds) You
                                                      Opponent -> Board (replaceNth (house-1) 0 (fst oppsSeeds), snd oppsSeeds) yourSeeds Opponent

--generic function to increment nth element in list
incrementNth n (x:xs)
  | n == 0 = (x+1:xs)
  | otherwise  = x:incrementNth (n-1) xs

--generic function to change nth element in list
replaceNth n newVal (x:xs)
  | n == 0 = newVal:xs
  | otherwise = x:replaceNth (n-1) newVal xs
----------------------------------------------

--score of the game (it's eneded when on some side all the houses are empty)
scores :: Board -> (Int, Int)
scores board | isOver board = ((snd $ yourSeeds board) + sum (fst $ yourSeeds board), (snd $ oppsSeeds board) + sum (fst $ oppsSeeds board))
             | otherwise = (snd $ yourSeeds board, snd $ oppsSeeds board)


successors :: Board -> [(House, Board)]
successors board = filter (\(x,y) -> y /= board) $ map (\n -> (n,move n board)) [1..6]