-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.Game.Scenario.Topography.Grid (
  Grid (..),
  gridToVec,
  mapIndexedMembers,
  allMembers,
  mapRows,
  getRows,
  mkGrid,
)
where

import Data.Aeson (ToJSON (..))
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NE
import Data.Maybe (fromMaybe)
import Data.Semigroup
import Data.Vector qualified as V
import Swarm.Game.World.Coords
import Prelude hiding (zipWith)

data Grid c
  = EmptyGrid
  | Grid (NonEmpty (NonEmpty c))
  deriving (Int -> Grid c -> ShowS
[Grid c] -> ShowS
Grid c -> String
(Int -> Grid c -> ShowS)
-> (Grid c -> String) -> ([Grid c] -> ShowS) -> Show (Grid c)
forall c. Show c => Int -> Grid c -> ShowS
forall c. Show c => [Grid c] -> ShowS
forall c. Show c => Grid c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> Grid c -> ShowS
showsPrec :: Int -> Grid c -> ShowS
$cshow :: forall c. Show c => Grid c -> String
show :: Grid c -> String
$cshowList :: forall c. Show c => [Grid c] -> ShowS
showList :: [Grid c] -> ShowS
Show, Grid c -> Grid c -> Bool
(Grid c -> Grid c -> Bool)
-> (Grid c -> Grid c -> Bool) -> Eq (Grid c)
forall c. Eq c => Grid c -> Grid c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c. Eq c => Grid c -> Grid c -> Bool
== :: Grid c -> Grid c -> Bool
$c/= :: forall c. Eq c => Grid c -> Grid c -> Bool
/= :: Grid c -> Grid c -> Bool
Eq, (forall a b. (a -> b) -> Grid a -> Grid b)
-> (forall a b. a -> Grid b -> Grid a) -> Functor Grid
forall a b. a -> Grid b -> Grid a
forall a b. (a -> b) -> Grid a -> Grid b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Grid a -> Grid b
fmap :: forall a b. (a -> b) -> Grid a -> Grid b
$c<$ :: forall a b. a -> Grid b -> Grid a
<$ :: forall a b. a -> Grid b -> Grid a
Functor, (forall m. Monoid m => Grid m -> m)
-> (forall m a. Monoid m => (a -> m) -> Grid a -> m)
-> (forall m a. Monoid m => (a -> m) -> Grid a -> m)
-> (forall a b. (a -> b -> b) -> b -> Grid a -> b)
-> (forall a b. (a -> b -> b) -> b -> Grid a -> b)
-> (forall b a. (b -> a -> b) -> b -> Grid a -> b)
-> (forall b a. (b -> a -> b) -> b -> Grid a -> b)
-> (forall a. (a -> a -> a) -> Grid a -> a)
-> (forall a. (a -> a -> a) -> Grid a -> a)
-> (forall a. Grid a -> [a])
-> (forall a. Grid a -> Bool)
-> (forall a. Grid a -> Int)
-> (forall a. Eq a => a -> Grid a -> Bool)
-> (forall a. Ord a => Grid a -> a)
-> (forall a. Ord a => Grid a -> a)
-> (forall a. Num a => Grid a -> a)
-> (forall a. Num a => Grid a -> a)
-> Foldable Grid
forall a. Eq a => a -> Grid a -> Bool
forall a. Num a => Grid a -> a
forall a. Ord a => Grid a -> a
forall m. Monoid m => Grid m -> m
forall a. Grid a -> Bool
forall a. Grid a -> Int
forall a. Grid a -> [a]
forall a. (a -> a -> a) -> Grid a -> a
forall m a. Monoid m => (a -> m) -> Grid a -> m
forall b a. (b -> a -> b) -> b -> Grid a -> b
forall a b. (a -> b -> b) -> b -> Grid a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Grid m -> m
fold :: forall m. Monoid m => Grid m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Grid a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Grid a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Grid a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Grid a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Grid a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Grid a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Grid a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Grid a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Grid a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Grid a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Grid a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Grid a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Grid a -> a
foldr1 :: forall a. (a -> a -> a) -> Grid a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Grid a -> a
foldl1 :: forall a. (a -> a -> a) -> Grid a -> a
$ctoList :: forall a. Grid a -> [a]
toList :: forall a. Grid a -> [a]
$cnull :: forall a. Grid a -> Bool
null :: forall a. Grid a -> Bool
$clength :: forall a. Grid a -> Int
length :: forall a. Grid a -> Int
$celem :: forall a. Eq a => a -> Grid a -> Bool
elem :: forall a. Eq a => a -> Grid a -> Bool
$cmaximum :: forall a. Ord a => Grid a -> a
maximum :: forall a. Ord a => Grid a -> a
$cminimum :: forall a. Ord a => Grid a -> a
minimum :: forall a. Ord a => Grid a -> a
$csum :: forall a. Num a => Grid a -> a
sum :: forall a. Num a => Grid a -> a
$cproduct :: forall a. Num a => Grid a -> a
product :: forall a. Num a => Grid a -> a
Foldable, Functor Grid
Foldable Grid
(Functor Grid, Foldable Grid) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Grid a -> f (Grid b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Grid (f a) -> f (Grid a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Grid a -> m (Grid b))
-> (forall (m :: * -> *) a. Monad m => Grid (m a) -> m (Grid a))
-> Traversable Grid
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Grid (m a) -> m (Grid a)
forall (f :: * -> *) a. Applicative f => Grid (f a) -> f (Grid a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Grid a -> m (Grid b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Grid a -> f (Grid b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Grid a -> f (Grid b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Grid a -> f (Grid b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Grid (f a) -> f (Grid a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Grid (f a) -> f (Grid a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Grid a -> m (Grid b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Grid a -> m (Grid b)
$csequence :: forall (m :: * -> *) a. Monad m => Grid (m a) -> m (Grid a)
sequence :: forall (m :: * -> *) a. Monad m => Grid (m a) -> m (Grid a)
Traversable)

mkGrid :: [[a]] -> Grid a
mkGrid :: forall a. [[a]] -> Grid a
mkGrid [[a]]
rows = Grid a -> Maybe (Grid a) -> Grid a
forall a. a -> Maybe a -> a
fromMaybe Grid a
forall c. Grid c
EmptyGrid (Maybe (Grid a) -> Grid a) -> Maybe (Grid a) -> Grid a
forall a b. (a -> b) -> a -> b
$ do
  NonEmpty (NonEmpty a)
rowsNE <- [NonEmpty a] -> Maybe (NonEmpty (NonEmpty a))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([NonEmpty a] -> Maybe (NonEmpty (NonEmpty a)))
-> Maybe [NonEmpty a] -> Maybe (NonEmpty (NonEmpty a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ([a] -> Maybe (NonEmpty a)) -> [[a]] -> Maybe [NonEmpty a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [[a]]
rows
  Grid a -> Maybe (Grid a)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Grid a -> Maybe (Grid a)) -> Grid a -> Maybe (Grid a)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty a) -> Grid a
forall c. NonEmpty (NonEmpty c) -> Grid c
Grid NonEmpty (NonEmpty a)
rowsNE

getRows :: Grid a -> [[a]]
getRows :: forall a. Grid a -> [[a]]
getRows Grid a
EmptyGrid = []
getRows (Grid NonEmpty (NonEmpty a)
g) = NonEmpty [a] -> [[a]]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty [a] -> [[a]])
-> (NonEmpty (NonEmpty a) -> NonEmpty [a])
-> NonEmpty (NonEmpty a)
-> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty a -> [a]) -> NonEmpty (NonEmpty a) -> NonEmpty [a]
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (NonEmpty a) -> [[a]]) -> NonEmpty (NonEmpty a) -> [[a]]
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty a)
g

-- | Since the derived 'Functor' instance applies to the
-- type parameter that is nested within lists, we define
-- an explicit function for mapping over the enclosing lists.
mapRows :: (NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty b)) -> Grid a -> Grid b
mapRows :: forall a b.
(NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty b))
-> Grid a -> Grid b
mapRows NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty b)
_ Grid a
EmptyGrid = Grid b
forall c. Grid c
EmptyGrid
mapRows NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty b)
f (Grid NonEmpty (NonEmpty a)
rows) = NonEmpty (NonEmpty b) -> Grid b
forall c. NonEmpty (NonEmpty c) -> Grid c
Grid (NonEmpty (NonEmpty b) -> Grid b)
-> NonEmpty (NonEmpty b) -> Grid b
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty b)
f NonEmpty (NonEmpty a)
rows

allMembers :: Grid a -> [a]
allMembers :: forall a. Grid a -> [a]
allMembers Grid a
EmptyGrid = []
allMembers Grid a
g = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> (Grid a -> [[a]]) -> Grid a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grid a -> [[a]]
forall a. Grid a -> [[a]]
getRows (Grid a -> [a]) -> Grid a -> [a]
forall a b. (a -> b) -> a -> b
$ Grid a
g

mapIndexedMembers :: (Coords -> a -> b) -> Grid a -> [b]
mapIndexedMembers :: forall a b. (Coords -> a -> b) -> Grid a -> [b]
mapIndexedMembers Coords -> a -> b
_ Grid a
EmptyGrid = []
mapIndexedMembers Coords -> a -> b
f (Grid NonEmpty (NonEmpty a)
g) =
  NonEmpty b -> [b]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty b -> [b]) -> NonEmpty b -> [b]
forall a b. (a -> b) -> a -> b
$
    NonEmpty (NonEmpty b) -> NonEmpty b
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty (NonEmpty b) -> NonEmpty b)
-> NonEmpty (NonEmpty b) -> NonEmpty b
forall a b. (a -> b) -> a -> b
$
      (Int32 -> NonEmpty a -> NonEmpty b)
-> NonEmpty Int32 -> NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty b)
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith (\Int32
i -> (Int32 -> a -> b) -> NonEmpty Int32 -> NonEmpty a -> NonEmpty b
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith (\Int32
j -> Coords -> a -> b
f ((Int32, Int32) -> Coords
Coords (Int32
i, Int32
j))) NonEmpty Int32
nonemptyCount) NonEmpty Int32
nonemptyCount NonEmpty (NonEmpty a)
g
 where
  nonemptyCount :: NonEmpty Int32
nonemptyCount = (Int32 -> Int32) -> Int32 -> NonEmpty Int32
forall a. (a -> a) -> a -> NonEmpty a
NE.iterate Int32 -> Int32
forall a. Enum a => a -> a
succ Int32
0

-- | Converts linked lists to vectors to facilitate
-- random access when assembling the image
gridToVec :: Grid a -> V.Vector (V.Vector a)
gridToVec :: forall a. Grid a -> Vector (Vector a)
gridToVec Grid a
EmptyGrid = Vector (Vector a)
forall a. Vector a
V.empty
gridToVec (Grid NonEmpty (NonEmpty a)
g) = [Vector a] -> Vector (Vector a)
forall a. [a] -> Vector a
V.fromList ([Vector a] -> Vector (Vector a))
-> ([NonEmpty a] -> [Vector a])
-> [NonEmpty a]
-> Vector (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty a -> Vector a) -> [NonEmpty a] -> [Vector a]
forall a b. (a -> b) -> [a] -> [b]
map ([a] -> Vector a
forall a. [a] -> Vector a
V.fromList ([a] -> Vector a) -> (NonEmpty a -> [a]) -> NonEmpty a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList) ([NonEmpty a] -> Vector (Vector a))
-> [NonEmpty a] -> Vector (Vector a)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty a) -> [NonEmpty a]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (NonEmpty a)
g

instance (ToJSON a) => ToJSON (Grid a) where
  toJSON :: Grid a -> Value
toJSON Grid a
EmptyGrid = [a] -> Value
forall a. ToJSON a => a -> Value
toJSON ([] :: [a])
  toJSON (Grid NonEmpty (NonEmpty a)
g) = NonEmpty (NonEmpty a) -> Value
forall a. ToJSON a => a -> Value
toJSON NonEmpty (NonEmpty a)
g