{-# 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 qualified Control.Monad
import qualified Control.Monad as M
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, 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.11

  map :: (a -> a) -> s -> ([a], s)

  -- | Map a monadic function over all components in the storage.

  --

  -- @since 0.11

  mapM :: (Monad m) => (a -> m a) -> s -> m ([a], s)

  -- | Map a function with some input over all components in the storage.

  --

  -- @since 0.11

  zipWith :: (b -> a -> (c, a)) -> [b] -> s -> ([(c, a)], s)

  -- | Map an applicative functor with some input over all components in the storage.

  --

  -- @since 0.11

  zipWithM :: (Applicative m) => (b -> a -> m (c, a)) -> [b] -> s -> m ([(c, a)], s)

-- | @since 0.11

instance (Typeable 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], [a])
map a -> a
f [a]
as = let as' :: [a]
as' = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
f [a]
as in ([a]
as', [a]
as')
  {-# INLINE mapM #-}
  mapM :: forall (m :: * -> *). Monad m => (a -> m a) -> [a] -> m ([a], [a])
mapM a -> m a
f [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
<$> (a -> m a) -> [a] -> m [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]
M.mapM a -> m a
f [a]
as
  {-# INLINE zipWith #-}
  zipWith :: forall b c. (b -> a -> (c, a)) -> [b] -> [a] -> ([(c, a)], [a])
zipWith b -> a -> (c, a)
f [b]
is [a]
as = let as' :: [(c, a)]
as' = (b -> a -> (c, a)) -> [b] -> [a] -> [(c, a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
Prelude.zipWith b -> a -> (c, a)
f [b]
is [a]
as in ([(c, a)]
as', ((c, a) -> a) -> [(c, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (c, a) -> a
forall a b. (a, b) -> b
snd [(c, a)]
as')
  {-# INLINE zipWithM #-}
  zipWithM :: forall (m :: * -> *) b c.
Applicative m =>
(b -> a -> m (c, a)) -> [b] -> [a] -> m ([(c, a)], [a])
zipWithM b -> a -> m (c, a)
f [b]
is [a]
as = (\[(c, a)]
as' -> ([(c, a)]
as', ((c, a) -> a) -> [(c, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (c, a) -> a
forall a b. (a, b) -> b
snd [(c, a)]
as')) ([(c, a)] -> ([(c, a)], [a])) -> m [(c, a)] -> m ([(c, a)], [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (b -> a -> m (c, a)) -> [b] -> [a] -> m [(c, a)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
Control.Monad.zipWithM b -> a -> m (c, a)
f [b]
is [a]
as