module Board(Board
            ,emptyBoard,swipe,setValue,getValue,opposite,maxValue,boardSize,prettyPrint
            ,emptyCells,isPossible,fromList,mostMerges,numberOfMerges
            ,Direction(..),Value)
where
import Data.Maybe
import Data.Map(Map,(!))
import qualified Data.Map as M
import Data.List
import qualified Data.List as L
import System.Random

type Value = Int

--instance Show [Value] where
--  show v = if v < 100 then "  " ++ show v else show v

type Coordinate = (Int,Int)

row, col :: Coordinate -> Int
row = fst 
col = snd 



nextRow,prevRow,nextCol,prevCol :: Coordinate -> Coordinate
nextRow c = (fst c + 1,snd c)
prevRow c = (fst c - 1,snd c)
nextCol c = (fst c,snd c + 1)
prevCol c = (fst c,snd c - 1)


data Board = Board 
  { board :: Map Coordinate Value -- TODO: an array would be more efficient
  , boardSize :: Int
  }
  deriving (Eq,Ord,Show)

--instance Show Board where
--  show b = 
--    let cells = sort (toList b ++ (zip (emptyCells b) [0,0..])) in
--    if cells ==[]
--      then []
--      else let ls = L.groupBy (\(c1,_) (c2,_) -> row c1 == row c2) cells in
--           unlines $ map (show . map snd) ls

--prettyPrint :: Board -> String
prettyPrint b = 
    let cells = sort (toList b ++ (zip (emptyCells b) [0,0..])) in
    if cells ==[]
      then []
      else let ls = L.groupBy (\(c1,_) (c2,_) -> row c1 == row c2) cells in
           let valuelists = unlines $ map concat $ map (map (printCell (maxValue b))) (map (map snd) ls) in
           valuelists
  where printCell n v = 
          let maxDigits = length (show n) in
          let digits = length (show v) in
          (replicate (maxDigits-digits+2) ' ') ++ show v
                        

emptyBoard :: Int -> Board
emptyBoard = Board $ M.fromList [] 

isEmpty :: Board -> Bool
isEmpty b = toList b == []

maxValue :: Board -> Value
maxValue b | isEmpty b = 0
           | otherwise = maximum . map snd . toList $ b

fromList :: Int -> [(Coordinate,Value)] -> Board
fromList n ls = Board (M.fromList ls) n

toList :: Board -> [(Coordinate,Value)] 
toList = M.toList . board

getValue :: Coordinate -> Board -> Maybe Value
getValue c b = M.lookup c (board b) 

setValue :: Coordinate -> Value -> Board -> Board
setValue c v b = b { board = M.insert c v (board b) }

emptyCells :: Board -> [Coordinate]
emptyCells b = 
  catMaybes [ maybe (Just (i,j))
                    (\v -> if v==0 then Just (i,j) else Nothing)
                    (getValue (i,j) b) 
            | i <- [1..boardSize b], j <- [1..boardSize b] ] 
  

reflect :: Board -> Board
reflect b = fromList (boardSize b) $ map (\(c,v) -> ((col c,row c),v)) $ toList b

data Direction = LEFT | RIGHT | UP | DOWN
  deriving (Show,Eq,Ord,Read,Bounded,Enum)

instance Random Direction where
  randomR (a,b) g = 
      case (randomR (fromEnum a, fromEnum b) g) of
        (x, g') -> (toEnum x, g')
{-       where

          fromInt :: Int -> Direction
          fromInt 1 = UP
          fromInt 2 = RIGHT
          fromInt 3 = DOWN
          fromInt 4 = LEFT
          fromInt _ = error "fromInt: Cannot parse int to Direction"
  
          toInt :: Direction -> Int
          toInt UP = 1
          toInt RIGHT = 2
          toInt DOWN = 3
          toInt LEFT = 4
-}
  random g	  = randomR (minBound,maxBound) g


directions :: [Direction]
directions = [UP,LEFT,RIGHT,DOWN]

  
opposite :: Direction -> Direction
opposite LEFT = RIGHT
opposite RIGHT = LEFT
opposite UP = DOWN
opposite DOWN = UP

data Orientation = East | West
  deriving (Show,Eq,Ord)


swipe :: Direction -> Board -> Board
swipe dir b = 
  let (b',dir') = case dir of
                    UP   -> (reflect b,West)
                    DOWN -> (reflect b,East)
                    LEFT -> (b,West) 
                    RIGHT-> (b,East) in

  let boardLists = [ catMaybes [ do v <- getValue (i,j) b'  
                                    return ((i,j),v)
                               | j <- [1..boardSize b'] ] 
                   | i <- [1..boardSize b'] ] in

  let newBoard = fromList (boardSize b) $ 
                              concatMap (fillGapsIn (boardSize b) dir' . merge 
                                . if dir'==East then reverse else id) 
                              boardLists in
  if dir `elem` [UP,DOWN]
      then reflect newBoard 
      else newBoard
  
  where
    merge []  = []
    merge [c] = [c]
    merge ((c,v):((c',v'):cs)) 
      = if v == v' then (c,2*v) : merge cs
                   else (c,v)   : merge ((c',v'):cs)

    fillGapsIn :: Int -> Orientation ->  [(Coordinate,Value)] -> [(Coordinate,Value)]
    fillGapsIn bs dir cs 
      | filter ((/=0) . snd) cs == [] = []
      | otherwise = 
        let ((c',v):cs')  = filter ((/=0) . snd) cs in
        let c'' = case dir of 
                    East  -> ((row c',bs),v) 
                    West  -> ((row c',1),v) 
        in
        fillGapsIn' (c'':cs')
        where
          fillGapsIn' []     = []
          fillGapsIn' (d:[]) = [d]
          fillGapsIn' ((d,v):((_,v')):ds)
            = let newCoord = case dir of 
                               East -> prevCol d 
                               West -> nextCol d
              in
              (d,v) : fillGapsIn' ((newCoord,v'):ds)


isPossible :: Direction -> Board -> Bool
isPossible dir b = swipe dir b /= b

numberOfMerges :: Direction -> Board -> Int
numberOfMerges dir b = 
  let l = length $ toList b in
  let l' = length $ toList $ swipe dir b in
  l - l'
   
-- | The swipe direction(s) that yield(s) the most empty cells. 
-- Returns '[]' if no merges are possible.
mostMerges :: Board -> [Direction]
mostMerges b = 
  let nms = [ (numberOfMerges dir b,dir) | dir <- directions ] in
  let maxval = fst $ maximum nms in
  map snd $ filter ((\v -> (v /=0) && (v==maxval)) . fst) nms
  
  

