{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module      : Aztecs.ECS.World.Storage
-- Copyright   : (c) Matt Hunzinger, 2025
-- License     : BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  : matt@hunzinger.me
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Aztecs.ECS.World.Storage (Storage (..)) where

import Control.DeepSeq
import qualified Control.Monad
import Data.Data
import Prelude hiding (zipWith)
import qualified Prelude

-- | Component storage, containing zero or many components of the same type.
--
-- @since 0.9
class (Typeable s, NFData s, Typeable a) => Storage a s where
  -- | Storage with a single component.
  --
  -- @since 0.9
  singleton :: a -> s

  -- | List of all components in the storage in ascending order.
  --
  -- @since 0.9
  toAscList :: s -> [a]

  -- | Convert a sorted list of components (in ascending order) into a storage.
  --
  -- @since 0.9
  fromAscList :: [a] -> s

  -- | Map a function over all components in the storage.
  --
  --
  -- @since 0.9
  map :: (a -> a) -> s -> s

  -- | Map a function with some input over all components in the storage.
  --
  -- @since 0.9
  zipWith :: (i -> a -> a) -> [i] -> s -> ([a], s)

  -- | Map an applicative functor with some input over all components in the storage.
  --
  -- @since 0.9
  zipWithM :: (Applicative m) => (i -> a -> m a) -> [i] -> s -> m ([a], s)

  -- | Map a function with some input over all components in the storage.
  --
  -- @since 0.9
  zipWith_ :: (i -> a -> a) -> [i] -> s -> s
  zipWith_ i -> a -> a
f [i]
is s
as = ([a], s) -> s
forall a b. (a, b) -> b
snd (([a], s) -> s) -> ([a], s) -> s
forall a b. (a -> b) -> a -> b
$ (i -> a -> a) -> [i] -> s -> ([a], s)
forall i. (i -> a -> a) -> [i] -> s -> ([a], s)
forall a s i. Storage a s => (i -> a -> a) -> [i] -> s -> ([a], s)
zipWith i -> a -> a
f [i]
is s
as

-- | @since 0.9
instance (Typeable a, NFData a) => Storage a [a] where
  {-# INLINE singleton #-}
  singleton :: a -> [a]
singleton a
a = [a
a]
  {-# INLINE toAscList #-}
  toAscList :: [a] -> [a]
toAscList = [a] -> [a]
forall a. a -> a
id
  {-# INLINE fromAscList #-}
  fromAscList :: [a] -> [a]
fromAscList = [a] -> [a]
forall a. a -> a
id
  {-# INLINE map #-}
  map :: (a -> a) -> [a] -> [a]
map = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  {-# INLINE zipWith #-}
  zipWith :: forall i. (i -> a -> a) -> [i] -> [a] -> ([a], [a])
zipWith i -> a -> a
f [i]
is [a]
as = let as' :: [a]
as' = (i -> a -> a) -> [i] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
Prelude.zipWith i -> a -> a
f [i]
is [a]
as in ([a]
as', [a]
as')
  {-# INLINE zipWith_ #-}
  zipWith_ :: forall i. (i -> a -> a) -> [i] -> [a] -> [a]
zipWith_ = (i -> a -> a) -> [i] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
Prelude.zipWith
  {-# INLINE zipWithM #-}
  zipWithM :: forall (m :: * -> *) i.
Applicative m =>
(i -> a -> m a) -> [i] -> [a] -> m ([a], [a])
zipWithM i -> a -> m a
f [i]
is [a]
as = (\[a]
as' -> ([a]
as', [a]
as')) ([a] -> ([a], [a])) -> m [a] -> m ([a], [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (i -> a -> m a) -> [i] -> [a] -> m [a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
Control.Monad.zipWithM i -> a -> m a
f [i]
is [a]
as