-- | A two dimensional type, based on Vectors...

-- -------------------------------------------------------------------
-- Copyright (C) 2017 by Sascha Wilde <wilde@sha-bang.de>

-- This program is free software under the GNU GPL (>=v2)
-- Read the file COPYING coming with the software for details.
-- -------------------------------------------------------------------

module TwoD (TwoD, Direction (..), fromLists, toLists,
             TwoD.map, mapTwoDXY, foldrTwoDXY,
             getSize, getXY, getN, getS, getW, getE,
             callOnDirection, getFromDirection,
             isInAny, isInAll)
where

import Control.Monad (join)
import qualified Data.Vector as V

newtype TwoD a = TwoD (V.Vector (V.Vector a))
type GetTwoD a = TwoD a -> Int -> Int -> Maybe a

instance Functor TwoD where
  fmap = TwoD.map

instance Foldable TwoD where
  foldr f b (TwoD t) = V.foldr f b $ V.concat $ V.toList t

instance Show a => Show (TwoD a) where
  show (TwoD t) = show t

fromLists :: [[a]] -> TwoD a
fromLists ls = TwoD (V.fromList $ V.fromList <$> ls)

toLists :: TwoD a -> [[a]]
toLists (TwoD t) = V.toList $ V.toList <$> t

map :: (a -> b) -> TwoD a -> TwoD b
map f (TwoD t)= TwoD (V.map (V.map f) t)

getSize :: TwoD a -> (Int,Int)
getSize (TwoD t) = (maximum $ V.map V.length t, V.length t)

getXY :: GetTwoD a
getXY (TwoD t) x y = join $ (V.!? x) <$> (t V.!? y)
data Direction = N | S | W | E
  deriving Show

callOnDirection :: (Int -> Int -> a) -> Direction -> Int -> Int -> a
callOnDirection f N x y = f x (y-1)
callOnDirection f S x y = f x (y+1)
callOnDirection f W x y = f (x-1) y
callOnDirection f E x y = f (x+1) y

getFromDirection :: Direction -> GetTwoD a
getFromDirection d td = callOnDirection (getXY td) d

getN :: GetTwoD a
getN = getFromDirection N
getS = getFromDirection S
getW = getFromDirection W
getE = getFromDirection E

mapTwoDXY :: (a -> TwoD a -> Int -> Int -> b) -> TwoD a -> TwoD b
mapTwoDXY f td@(TwoD t) = TwoD (V.imap (\y -> V.imap (\x e -> f e td x y)) t)

foldrTwoDXY :: (a -> b -> TwoD a -> Int -> Int -> b) -> b -> TwoD a -> b
foldrTwoDXY f i td = foldr f' i $ mapTwoDXY injectXY td
  where
    injectXY :: a -> TwoD a -> Int -> Int -> (Int, Int, a)
    injectXY a _ x y = (x,y,a)
    f' (x,y,a) b = f a b td x y

elemF :: (Eq a, Foldable f) => f a -> [a] -> Bool
elemF e es = any (`elem` es) e

isInAny :: Eq a => [GetTwoD a] -> Int -> Int -> TwoD a -> [a] -> Bool
isInAny fs x y t es = any (\f -> elemF (f t x y) es) fs

isInAll :: Eq a => [GetTwoD a] -> Int -> Int -> TwoD a -> [a] -> Bool
isInAll fs x y t es = all (\f -> elemF (f t x y) es) fs