------------------------------------------------------------------------
-- |
-- Module      :  Math.Geometry.GridMap.Lazy
-- Copyright   :  (c) Amy de Buitléir 2012-2019
-- License     :  BSD-style
-- Maintainer  :  amy@nualeargais.ie
-- Stability   :  experimental
-- Portability :  portable
--
-- Ordered maps from tiles on a grid to values.
-- This module is a wrapper around @'Math.Geometry.Grid'@ and
-- @'Data.Map'@, in order to combine the functionality of grids and maps
-- into a single type.
--
------------------------------------------------------------------------
{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances,
    MultiParamTypeClasses, UndecidableInstances, DeriveGeneric #-}

module Math.Geometry.GridMap.Lazy
  (
    LGridMap,
    lazyGridMap,
    lazyGridMapIndexed,
    empty
  ) where

import Prelude hiding (lookup, map, foldr, foldl, foldr1, foldl1, null)

import qualified Prelude as P (map)
import qualified Data.Foldable as F (Foldable(..))
import qualified Data.Map as M
--import qualified Data.Map.Strict as Strict (Map)
import Data.Maybe (fromMaybe)
import GHC.Generics (Generic)
import qualified Math.Geometry.GridInternal as G
import Math.Geometry.GridMap

-- | A map from tile positions in a grid to values.
data LGridMap g v =
  LGridMap { LGridMap g v -> g
lgmGrid :: g, LGridMap g v -> Map (Index g) v
lgmMap :: M.Map (G.Index g) v }
    deriving (forall x. LGridMap g v -> Rep (LGridMap g v) x)
-> (forall x. Rep (LGridMap g v) x -> LGridMap g v)
-> Generic (LGridMap g v)
forall x. Rep (LGridMap g v) x -> LGridMap g v
forall x. LGridMap g v -> Rep (LGridMap g v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall g v x. Rep (LGridMap g v) x -> LGridMap g v
forall g v x. LGridMap g v -> Rep (LGridMap g v) x
$cto :: forall g v x. Rep (LGridMap g v) x -> LGridMap g v
$cfrom :: forall g v x. LGridMap g v -> Rep (LGridMap g v) x
Generic

-- | Construct a grid map which is strict in the keys (tile positions),
--   but lazy in the values.
lazyGridMap :: (Ord (G.Index g), G.Grid g) => g -> [v] -> LGridMap g v
lazyGridMap :: g -> [v] -> LGridMap g v
lazyGridMap g
g [v]
vs = g -> Map (Index g) v -> LGridMap g v
forall g v. g -> Map (Index g) v -> LGridMap g v
LGridMap g
g ([(Index g, v)] -> Map (Index g) v
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Index g, v)]
kvs)
  where kvs :: [(Index g, v)]
kvs = [Index g] -> [v] -> [(Index g, v)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Index g]
ks [v]
vs
        ks :: [Index g]
ks = g -> [Index g]
forall g. Grid g => g -> [Index g]
G.indices g
g

lazyGridMapIndexed :: (Ord (G.Index g), G.Grid g) => g -> [((G.Index g), v)] -> LGridMap g v
lazyGridMapIndexed :: g -> [(Index g, v)] -> LGridMap g v
lazyGridMapIndexed g
g [(Index g, v)]
kvs = g -> Map (Index g) v -> LGridMap g v
forall g v. g -> Map (Index g) v -> LGridMap g v
LGridMap g
g ([(Index g, v)] -> Map (Index g) v
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Index g, v)]
kvs')
  where kvs' :: [(Index g, v)]
kvs' = ((Index g, v) -> Bool) -> [(Index g, v)] -> [(Index g, v)]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (Index g -> Bool
validIndex (Index g -> Bool)
-> ((Index g, v) -> Index g) -> (Index g, v) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Index g, v) -> Index g
forall a b. (a, b) -> a
fst) [(Index g, v)]
kvs
        validIndex :: Index g -> Bool
validIndex Index g
k = g
g g -> Index g -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`G.contains` Index g
k

empty :: g -> LGridMap g v
empty :: g -> LGridMap g v
empty g
g = g -> Map (Index g) v -> LGridMap g v
forall g v. g -> Map (Index g) v -> LGridMap g v
LGridMap g
g Map (Index g) v
forall k a. Map k a
M.empty

instance (G.Grid g, Ord (G.Index g)) => Functor (LGridMap g) where
  fmap :: (a -> b) -> LGridMap g a -> LGridMap g b
fmap a -> b
f LGridMap g a
gm = g -> [b] -> LGridMap g b
forall g v. (Ord (Index g), Grid g) => g -> [v] -> LGridMap g v
lazyGridMap (LGridMap g a -> g
forall g v. LGridMap g v -> g
lgmGrid LGridMap g a
gm) ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
P.map a -> b
f [a]
vs)
    where vs :: [a]
vs = Map (Index g) a -> [a]
forall k a. Map k a -> [a]
M.elems (LGridMap g a -> Map (Index g) a
forall g v. LGridMap g v -> Map (Index g) v
lgmMap LGridMap g a
gm)

instance F.Foldable (LGridMap g) where
  fold :: LGridMap g m -> m
fold = Map (Index g) m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold (Map (Index g) m -> m)
-> (LGridMap g m -> Map (Index g) m) -> LGridMap g m -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LGridMap g m -> Map (Index g) m
forall g v. LGridMap g v -> Map (Index g) v
lgmMap
  foldMap :: (a -> m) -> LGridMap g a -> m
foldMap a -> m
f LGridMap g a
g = (a -> m) -> Map (Index g) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap a -> m
f (LGridMap g a -> Map (Index g) a
forall g v. LGridMap g v -> Map (Index g) v
lgmMap LGridMap g a
g)
  foldr :: (a -> b -> b) -> b -> LGridMap g a -> b
foldr a -> b -> b
f b
x LGridMap g a
g = (a -> b -> b) -> b -> Map (Index g) a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr a -> b -> b
f b
x (LGridMap g a -> Map (Index g) a
forall g v. LGridMap g v -> Map (Index g) v
lgmMap LGridMap g a
g)
  foldr' :: (a -> b -> b) -> b -> LGridMap g a -> b
foldr' a -> b -> b
f b
x LGridMap g a
g = (a -> b -> b) -> b -> Map (Index g) a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr' a -> b -> b
f b
x (LGridMap g a -> Map (Index g) a
forall g v. LGridMap g v -> Map (Index g) v
lgmMap LGridMap g a
g)
  foldl :: (b -> a -> b) -> b -> LGridMap g a -> b
foldl b -> a -> b
f b
x LGridMap g a
g = (b -> a -> b) -> b -> Map (Index g) a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl b -> a -> b
f b
x (LGridMap g a -> Map (Index g) a
forall g v. LGridMap g v -> Map (Index g) v
lgmMap LGridMap g a
g)
  foldl' :: (b -> a -> b) -> b -> LGridMap g a -> b
foldl' b -> a -> b
f b
x LGridMap g a
g = (b -> a -> b) -> b -> Map (Index g) a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' b -> a -> b
f b
x (LGridMap g a -> Map (Index g) a
forall g v. LGridMap g v -> Map (Index g) v
lgmMap LGridMap g a
g)
--  foldr1 f x g = foldr1 f x (lgmMap g)
--  foldl1 f x g = foldl1 f x (lgmMap g)

instance G.Grid g => G.Grid (LGridMap g v) where
  type Index (LGridMap g v) = G.Index g
  type Direction (LGridMap g v) = G.Direction g
  indices :: LGridMap g v -> [Index (LGridMap g v)]
indices = g -> [Index g]
forall g. Grid g => g -> [Index g]
G.indices (g -> [Index g])
-> (LGridMap g v -> g) -> LGridMap g v -> [Index g]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LGridMap g v -> g
forall g v. LGridMap g v -> g
lgmGrid
  distance :: LGridMap g v -> Index (LGridMap g v) -> Index (LGridMap g v) -> Int
distance LGridMap g v
g = g -> Index g -> Index g -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
G.distance (LGridMap g v -> g
forall g v. LGridMap g v -> g
lgmGrid LGridMap g v
g)
  directionTo :: LGridMap g v
-> Index (LGridMap g v)
-> Index (LGridMap g v)
-> [Direction (LGridMap g v)]
directionTo LGridMap g v
g = g -> Index g -> Index g -> [Direction g]
forall g. Grid g => g -> Index g -> Index g -> [Direction g]
G.directionTo (LGridMap g v -> g
forall g v. LGridMap g v -> g
lgmGrid LGridMap g v
g)
  neighbours :: LGridMap g v -> Index (LGridMap g v) -> [Index (LGridMap g v)]
neighbours LGridMap g v
g Index (LGridMap g v)
k = LGridMap g v -> g
forall g v. LGridMap g v -> g
lgmGrid LGridMap g v
g g -> Index g -> [Index g]
forall g. (Grid g, Eq (Index g)) => g -> Index g -> [Index g]
`G.neighbours` Index g
Index (LGridMap g v)
k
  contains :: LGridMap g v -> Index (LGridMap g v) -> Bool
contains LGridMap g v
g Index (LGridMap g v)
k = LGridMap g v -> g
forall g v. LGridMap g v -> g
lgmGrid LGridMap g v
g g -> Index g -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`G.contains` Index g
Index (LGridMap g v)
k
--  viewpoint g k = lgmGrid g `G.viewpoint` k
  tileCount :: LGridMap g v -> Int
tileCount  = g -> Int
forall g. Grid g => g -> Int
G.tileCount (g -> Int) -> (LGridMap g v -> g) -> LGridMap g v -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LGridMap g v -> g
forall g v. LGridMap g v -> g
lgmGrid
  null :: LGridMap g v -> Bool
null = g -> Bool
forall g. Grid g => g -> Bool
G.null (g -> Bool) -> (LGridMap g v -> g) -> LGridMap g v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LGridMap g v -> g
forall g v. LGridMap g v -> g
lgmGrid
  nonNull :: LGridMap g v -> Bool
nonNull = g -> Bool
forall g. Grid g => g -> Bool
G.nonNull (g -> Bool) -> (LGridMap g v -> g) -> LGridMap g v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LGridMap g v -> g
forall g v. LGridMap g v -> g
lgmGrid

instance G.FiniteGrid g => G.FiniteGrid (LGridMap g v) where
  type Size (LGridMap g v) = G.Size g
  size :: LGridMap g v -> Size (LGridMap g v)
size (LGridMap g
g Map (Index g) v
_) = g -> Size g
forall g. FiniteGrid g => g -> Size g
G.size g
g
  maxPossibleDistance :: LGridMap g v -> Int
maxPossibleDistance (LGridMap g
g Map (Index g) v
_) = g -> Int
forall g. FiniteGrid g => g -> Int
G.maxPossibleDistance g
g

instance G.BoundedGrid g => G.BoundedGrid (LGridMap g v) where
  tileSideCount :: LGridMap g v -> Int
tileSideCount (LGridMap g
g Map (Index g) v
_) = g -> Int
forall g. BoundedGrid g => g -> Int
G.tileSideCount g
g

instance G.WrappedGrid g => G.WrappedGrid (LGridMap g v) where
  normalise :: LGridMap g v -> Index (LGridMap g v) -> Index (LGridMap g v)
normalise (LGridMap g
g Map (Index g) v
_) = g -> Index g -> Index g
forall g. WrappedGrid g => g -> Index g -> Index g
G.normalise g
g
  denormalise :: LGridMap g v -> Index (LGridMap g v) -> [Index (LGridMap g v)]
denormalise (LGridMap g
g Map (Index g) v
_) = g -> Index g -> [Index g]
forall g. WrappedGrid g => g -> Index g -> [Index g]
G.denormalise g
g

instance (G.Grid g) => GridMap (LGridMap g) v where
  type BaseGrid (LGridMap g) v = g
  (!) LGridMap g v
gm k
k = LGridMap g v -> Map k v
forall (gm :: * -> *) v k.
(GridMap gm v, k ~ Index (BaseGrid gm v)) =>
gm v -> Map k v
toMap LGridMap g v
gm Map k v -> k -> v
forall k a. Ord k => Map k a -> k -> a
M.! k
k
  toMap :: LGridMap g v -> Map k v
toMap = LGridMap g v -> Map k v
forall g v. LGridMap g v -> Map (Index g) v
lgmMap
  toGrid :: LGridMap g v -> BaseGrid (LGridMap g) v
toGrid = LGridMap g v -> BaseGrid (LGridMap g) v
forall g v. LGridMap g v -> g
lgmGrid
  lookup :: k -> LGridMap g v -> Maybe v
lookup k
k = k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k (Map k v -> Maybe v)
-> (LGridMap g v -> Map k v) -> LGridMap g v -> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LGridMap g v -> Map k v
forall (gm :: * -> *) v k.
(GridMap gm v, k ~ Index (BaseGrid gm v)) =>
gm v -> Map k v
toMap
  insertWithKey :: (k -> v -> v -> v) -> k -> v -> LGridMap g v -> LGridMap g v
insertWithKey k -> v -> v -> v
f k
k v
v LGridMap g v
gm = if LGridMap g v
gm LGridMap g v -> Index (LGridMap g v) -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`G.contains` k
Index (LGridMap g v)
k
                   then LGridMap g v
gm { lgmMap :: Map (Index g) v
lgmMap = (k -> v -> v -> v) -> k -> v -> Map k v -> Map k v
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWithKey k -> v -> v -> v
f k
k v
v (Map k v -> Map k v) -> Map k v -> Map k v
forall a b. (a -> b) -> a -> b
$ LGridMap g v -> Map (Index g) v
forall g v. LGridMap g v -> Map (Index g) v
lgmMap LGridMap g v
gm }
                   else LGridMap g v
gm
  delete :: k -> LGridMap g v -> LGridMap g v
delete k
k LGridMap g v
gm = if LGridMap g v
gm LGridMap g v -> Index (LGridMap g v) -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`G.contains` k
Index (LGridMap g v)
k
                   then LGridMap g v
gm { lgmMap :: Map (Index g) v
lgmMap = k -> Map k v -> Map k v
forall k a. Ord k => k -> Map k a -> Map k a
M.delete k
k (Map k v -> Map k v) -> Map k v -> Map k v
forall a b. (a -> b) -> a -> b
$ LGridMap g v -> Map (Index g) v
forall g v. LGridMap g v -> Map (Index g) v
lgmMap LGridMap g v
gm }
                   else LGridMap g v
gm
  adjustWithKey :: (k -> v -> v) -> k -> LGridMap g v -> LGridMap g v
adjustWithKey k -> v -> v
f k
k LGridMap g v
gm = LGridMap g v
gm { lgmMap :: Map (Index g) v
lgmMap = (k -> v -> v) -> k -> Map k v -> Map k v
forall k a. Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
M.adjustWithKey k -> v -> v
f k
k (LGridMap g v -> Map (Index g) v
forall g v. LGridMap g v -> Map (Index g) v
lgmMap LGridMap g v
gm)}
  alter :: (Maybe v -> Maybe v) -> k -> LGridMap g v -> LGridMap g v
alter Maybe v -> Maybe v
f k
k LGridMap g v
gm = if LGridMap g v
gm LGridMap g v -> Index (LGridMap g v) -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`G.contains` k
Index (LGridMap g v)
k
                   then LGridMap g v
gm { lgmMap :: Map (Index g) v
lgmMap = (Maybe v -> Maybe v) -> k -> Map k v -> Map k v
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe v -> Maybe v
f k
k (Map k v -> Map k v) -> Map k v -> Map k v
forall a b. (a -> b) -> a -> b
$ LGridMap g v -> Map (Index g) v
forall g v. LGridMap g v -> Map (Index g) v
lgmMap LGridMap g v
gm }
                   else LGridMap g v
gm
  findWithDefault :: v -> k -> LGridMap g v -> v
findWithDefault v
v k
k = v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe v
v (Maybe v -> v) -> (LGridMap g v -> Maybe v) -> LGridMap g v -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> LGridMap g v -> Maybe v
forall (gm :: * -> *) v k.
(GridMap gm v, k ~ Index (BaseGrid gm v), Ord k) =>
k -> gm v -> Maybe v
lookup k
k
  map :: (v -> v2) -> LGridMap g v -> LGridMap g v2
map v -> v2
f (LGridMap g
g Map (Index g) v
m) = g -> Map (Index g) v2 -> LGridMap g v2
forall g v. g -> Map (Index g) v -> LGridMap g v
LGridMap g
g ((v -> v2) -> Map (Index g) v -> Map (Index g) v2
forall a b k. (a -> b) -> Map k a -> Map k b
M.map v -> v2
f Map (Index g) v
m)
  mapWithKey :: (k -> v -> v2) -> LGridMap g v -> LGridMap g v2
mapWithKey k -> v -> v2
f (LGridMap g
g Map (Index g) v
m) = g -> Map (Index g) v2 -> LGridMap g v2
forall g v. g -> Map (Index g) v -> LGridMap g v
LGridMap g
g ((k -> v -> v2) -> Map k v -> Map k v2
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey k -> v -> v2
f Map k v
Map (Index g) v
m)
  filter :: (v -> Bool) -> LGridMap g v -> LGridMap g v
filter v -> Bool
f (LGridMap g
g Map (Index g) v
m) = g -> Map (Index g) v -> LGridMap g v
forall g v. g -> Map (Index g) v -> LGridMap g v
LGridMap g
g ((v -> Bool) -> Map (Index g) v -> Map (Index g) v
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter v -> Bool
f Map (Index g) v
m)
  filterWithKey :: (k -> v -> Bool) -> LGridMap g v -> LGridMap g v
filterWithKey k -> v -> Bool
f (LGridMap g
g Map (Index g) v
m) = g -> Map (Index g) v -> LGridMap g v
forall g v. g -> Map (Index g) v -> LGridMap g v
LGridMap g
g ((k -> v -> Bool) -> Map k v -> Map k v
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey k -> v -> Bool
f Map k v
Map (Index g) v
m)

instance (Eq g, Eq (G.Index g), Eq v) => Eq (LGridMap g v) where
  == :: LGridMap g v -> LGridMap g v -> Bool
(==) (LGridMap g
g1 Map (Index g) v
gm1) (LGridMap g
g2 Map (Index g) v
gm2) = g
g1 g -> g -> Bool
forall a. Eq a => a -> a -> Bool
== g
g2 Bool -> Bool -> Bool
&& Map (Index g) v
gm1 Map (Index g) v -> Map (Index g) v -> Bool
forall a. Eq a => a -> a -> Bool
== Map (Index g) v
gm2

instance (Show g, Show v) => Show (LGridMap g v) where
  show :: LGridMap g v -> String
show (LGridMap g
g Map (Index g) v
m) = String
"lazyGridMap (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ g -> String
forall a. Show a => a -> String
show g
g String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [v] -> String
forall a. Show a => a -> String
show (Map (Index g) v -> [v]
forall k a. Map k a -> [a]
M.elems Map (Index g) v
m)