{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- |

-- Module      : Aztecs.ECS.World.Archetype

-- 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.Archetype
  ( Archetype (..),
    empty,
    singleton,
    lookupComponent,
    lookupComponents,
    lookupComponentsAsc,
    lookupComponentsAscMaybe,
    lookupStorage,
    member,
    remove,
    removeStorages,
    insertComponent,
    insertComponentUntracked,
    insertComponents,
    insertAscVector,
    zipWith,
    zipWith_,
    zipWithM,
    zipWithAccum,
    zipWithAccumM,
  )
where

import Aztecs.ECS.Access.Internal
import Aztecs.ECS.Component
import Aztecs.ECS.Entity
import Aztecs.ECS.Event
import Aztecs.ECS.World.Archetype.Internal
import qualified Aztecs.ECS.World.Storage as S
import Aztecs.ECS.World.Storage.Dynamic
import qualified Aztecs.ECS.World.Storage.Dynamic as S
import Control.Monad.Writer
import Data.Dynamic
import Data.Foldable
import Data.IntMap (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Set as Set
import Data.Vector (Vector)
import qualified Data.Vector as V
import Prelude hiding (map, zipWith)

-- | Archetype with a single entity.

singleton :: EntityID -> Archetype m
singleton :: forall (m :: * -> *). EntityID -> Archetype m
singleton EntityID
e = Archetype {storages :: IntMap DynamicStorage
storages = IntMap DynamicStorage
forall a. IntMap a
IntMap.empty, entities :: Set EntityID
entities = EntityID -> Set EntityID
forall a. a -> Set a
Set.singleton EntityID
e}

-- | Lookup a component `Storage` by its `ComponentID`.

lookupStorage :: (Component m a) => ComponentID -> Archetype m -> Maybe (StorageT a)
lookupStorage :: forall (m :: * -> *) a.
Component m a =>
ComponentID -> Archetype m -> Maybe (StorageT a)
lookupStorage ComponentID
cId Archetype m
w = do
  !DynamicStorage
dynS <- Key -> IntMap DynamicStorage -> Maybe DynamicStorage
forall a. Key -> IntMap a -> Maybe a
IntMap.lookup (ComponentID -> Key
unComponentId ComponentID
cId) (IntMap DynamicStorage -> Maybe DynamicStorage)
-> IntMap DynamicStorage -> Maybe DynamicStorage
forall a b. (a -> b) -> a -> b
$ Archetype m -> IntMap DynamicStorage
forall (m :: * -> *). Archetype m -> IntMap DynamicStorage
storages Archetype m
w
  Dynamic -> Maybe (StorageT a)
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic (Dynamic -> Maybe (StorageT a)) -> Dynamic -> Maybe (StorageT a)
forall a b. (a -> b) -> a -> b
$ DynamicStorage -> Dynamic
storageDyn DynamicStorage
dynS
{-# INLINE lookupStorage #-}

-- | Lookup a component by its `EntityID` and `ComponentID`.

lookupComponent :: forall m a. (Component m a) => EntityID -> ComponentID -> Archetype m -> Maybe a
lookupComponent :: forall (m :: * -> *) a.
Component m a =>
EntityID -> ComponentID -> Archetype m -> Maybe a
lookupComponent EntityID
e ComponentID
cId Archetype m
w = ComponentID -> Archetype m -> Map EntityID a
forall (m :: * -> *) a.
Component m a =>
ComponentID -> Archetype m -> Map EntityID a
lookupComponents ComponentID
cId Archetype m
w Map EntityID a -> EntityID -> Maybe a
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? EntityID
e
{-# INLINE lookupComponent #-}

-- | Lookup all components by their `ComponentID`.

lookupComponents :: forall m a. (Component m a) => ComponentID -> Archetype m -> Map EntityID a
lookupComponents :: forall (m :: * -> *) a.
Component m a =>
ComponentID -> Archetype m -> Map EntityID a
lookupComponents ComponentID
cId Archetype m
arch = case ComponentID -> Archetype m -> Maybe (Vector a)
forall (m :: * -> *) a.
Component m a =>
ComponentID -> Archetype m -> Maybe (Vector a)
lookupComponentsAscMaybe ComponentID
cId Archetype m
arch of
  Just Vector a
as -> [(EntityID, a)] -> Map EntityID a
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList ([(EntityID, a)] -> Map EntityID a)
-> [(EntityID, a)] -> Map EntityID a
forall a b. (a -> b) -> a -> b
$ [EntityID] -> [a] -> [(EntityID, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set EntityID -> [EntityID]
forall a. Set a -> [a]
Set.toList (Set EntityID -> [EntityID]) -> Set EntityID -> [EntityID]
forall a b. (a -> b) -> a -> b
$ Archetype m -> Set EntityID
forall (m :: * -> *). Archetype m -> Set EntityID
entities Archetype m
arch) (Vector a -> [a]
forall a. Vector a -> [a]
V.toList Vector a
as)
  Maybe (Vector a)
Nothing -> Map EntityID a
forall k a. Map k a
Map.empty
{-# INLINE lookupComponents #-}

-- | Lookup all components by their `ComponentID`, in ascending order by their `EntityID`.

lookupComponentsAsc :: forall m a. (Component m a) => ComponentID -> Archetype m -> Vector a
lookupComponentsAsc :: forall (m :: * -> *) a.
Component m a =>
ComponentID -> Archetype m -> Vector a
lookupComponentsAsc ComponentID
cId = Vector a -> Maybe (Vector a) -> Vector a
forall a. a -> Maybe a -> a
fromMaybe Vector a
forall a. Vector a
V.empty (Maybe (Vector a) -> Vector a)
-> (Archetype m -> Maybe (Vector a)) -> Archetype m -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
Component m a =>
ComponentID -> Archetype m -> Maybe (Vector a)
lookupComponentsAscMaybe @m @a ComponentID
cId
{-# INLINE lookupComponentsAsc #-}

-- | Lookup all components by their `ComponentID`, in ascending order by their `EntityID`.

lookupComponentsAscMaybe :: forall m a. (Component m a) => ComponentID -> Archetype m -> Maybe (Vector a)
lookupComponentsAscMaybe :: forall (m :: * -> *) a.
Component m a =>
ComponentID -> Archetype m -> Maybe (Vector a)
lookupComponentsAscMaybe ComponentID
cId Archetype m
arch = forall a s. Storage a s => s -> Vector a
S.toAscVector @a @(StorageT a) (StorageT a -> Vector a) -> Maybe (StorageT a) -> Maybe (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Component m a =>
ComponentID -> Archetype m -> Maybe (StorageT a)
lookupStorage @m @a ComponentID
cId Archetype m
arch
{-# INLINE lookupComponentsAscMaybe #-}

-- | Insert a component into the archetype.

insertComponent ::
  forall m a. (Component m a) => EntityID -> ComponentID -> a -> Archetype m -> (Archetype m, Access m ())
insertComponent :: forall (m :: * -> *) a.
Component m a =>
EntityID
-> ComponentID -> a -> Archetype m -> (Archetype m, Access m ())
insertComponent EntityID
e ComponentID
cId a
c Archetype m
arch =
  let !storage :: StorageT a
storage =
        forall a s. Storage a s => Vector a -> s
S.fromAscVector @a @(StorageT a) (Vector a -> StorageT a)
-> (Map EntityID a -> Vector a) -> Map EntityID a -> StorageT a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Vector a
forall a. [a] -> Vector a
V.fromList ([a] -> Vector a)
-> (Map EntityID a -> [a]) -> Map EntityID a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map EntityID a -> [a]
forall k a. Map k a -> [a]
Map.elems (Map EntityID a -> [a])
-> (Map EntityID a -> Map EntityID a) -> Map EntityID a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityID -> a -> Map EntityID a -> Map EntityID a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert EntityID
e a
c (Map EntityID a -> StorageT a) -> Map EntityID a -> StorageT a
forall a b. (a -> b) -> a -> b
$ ComponentID -> Archetype m -> Map EntityID a
forall (m :: * -> *) a.
Component m a =>
ComponentID -> Archetype m -> Map EntityID a
lookupComponents ComponentID
cId Archetype m
arch
      hook :: Access m ()
hook = do
        EntityID -> a -> Access m ()
forall (m :: * -> *) a.
Component m a =>
EntityID -> a -> Access m ()
componentOnInsert EntityID
e a
c
        EntityID -> OnInsert a -> Access m ()
forall (m :: * -> *) e.
(Monad m, Event e) =>
EntityID -> e -> Access m ()
triggerEntityEvent EntityID
e (a -> OnInsert a
forall a. a -> OnInsert a
OnInsert a
c)
   in (Archetype m
arch {storages = IntMap.insert (unComponentId cId) (dynStorage @a storage) (storages arch)}, Access m ()
hook)

-- | Insert a component into an archetype without running lifecycle hooks.

insertComponentUntracked ::
  forall m a. (Component m a) => EntityID -> ComponentID -> a -> Archetype m -> Archetype m
insertComponentUntracked :: forall (m :: * -> *) a.
Component m a =>
EntityID -> ComponentID -> a -> Archetype m -> Archetype m
insertComponentUntracked EntityID
e ComponentID
cId a
c Archetype m
arch =
  let !storage :: StorageT a
storage =
        forall a s. Storage a s => Vector a -> s
S.fromAscVector @a @(StorageT a) (Vector a -> StorageT a)
-> (Map EntityID a -> Vector a) -> Map EntityID a -> StorageT a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Vector a
forall a. [a] -> Vector a
V.fromList ([a] -> Vector a)
-> (Map EntityID a -> [a]) -> Map EntityID a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map EntityID a -> [a]
forall k a. Map k a -> [a]
Map.elems (Map EntityID a -> [a])
-> (Map EntityID a -> Map EntityID a) -> Map EntityID a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityID -> a -> Map EntityID a -> Map EntityID a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert EntityID
e a
c (Map EntityID a -> StorageT a) -> Map EntityID a -> StorageT a
forall a b. (a -> b) -> a -> b
$ ComponentID -> Archetype m -> Map EntityID a
forall (m :: * -> *) a.
Component m a =>
ComponentID -> Archetype m -> Map EntityID a
lookupComponents ComponentID
cId Archetype m
arch
   in Archetype m
arch {storages = IntMap.insert (unComponentId cId) (dynStorage @a storage) (storages arch)}

-- | @True@ if this archetype contains an entity with the provided `ComponentID`.

member :: ComponentID -> Archetype m -> Bool
member :: forall (m :: * -> *). ComponentID -> Archetype m -> Bool
member ComponentID
cId = Key -> IntMap DynamicStorage -> Bool
forall a. Key -> IntMap a -> Bool
IntMap.member (ComponentID -> Key
unComponentId ComponentID
cId) (IntMap DynamicStorage -> Bool)
-> (Archetype m -> IntMap DynamicStorage) -> Archetype m -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archetype m -> IntMap DynamicStorage
forall (m :: * -> *). Archetype m -> IntMap DynamicStorage
storages

-- | Zip a vector of components with a function and a component storage.

-- Returns the result vector, updated archetype, and the onChange hooks to run.

zipWith ::
  forall m a c. (Monad m, Component m c) => Vector a -> (a -> c -> c) -> ComponentID -> Archetype m -> (Vector c, Archetype m, Access m ())
zipWith :: forall (m :: * -> *) a c.
(Monad m, Component m c) =>
Vector a
-> (a -> c -> c)
-> ComponentID
-> Archetype m
-> (Vector c, Archetype m, Access m ())
zipWith Vector a
as a -> c -> c
f ComponentID
cId Archetype m
arch =
  let go :: Maybe DynamicStorage
-> WriterT (Vector c) Identity (Maybe DynamicStorage)
go Maybe DynamicStorage
maybeDyn = case Maybe DynamicStorage
maybeDyn of
        Just DynamicStorage
dyn -> case Dynamic -> Maybe (StorageT c)
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic (Dynamic -> Maybe (StorageT c)) -> Dynamic -> Maybe (StorageT c)
forall a b. (a -> b) -> a -> b
$ DynamicStorage -> Dynamic
storageDyn DynamicStorage
dyn of
          Just StorageT c
s -> do
            let !(Vector c
cs', StorageT c
s') = forall a s i.
Storage a s =>
(i -> a -> a) -> Vector i -> s -> (Vector a, s)
S.zipWith @c @(StorageT c) a -> c -> c
f Vector a
as StorageT c
s
            Vector c -> WriterT (Vector c) Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Vector c
cs'
            return $ DynamicStorage -> Maybe DynamicStorage
forall a. a -> Maybe a
Just (DynamicStorage -> Maybe DynamicStorage)
-> DynamicStorage -> Maybe DynamicStorage
forall a b. (a -> b) -> a -> b
$ DynamicStorage
dyn {storageDyn = toDyn s'}
          Maybe (StorageT c)
Nothing -> Maybe DynamicStorage
-> WriterT (Vector c) Identity (Maybe DynamicStorage)
forall a. a -> WriterT (Vector c) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DynamicStorage
maybeDyn
        Maybe DynamicStorage
Nothing -> Maybe DynamicStorage
-> WriterT (Vector c) Identity (Maybe DynamicStorage)
forall a. a -> WriterT (Vector c) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DynamicStorage
forall a. Maybe a
Nothing
      (IntMap DynamicStorage
storages', Vector c
cs) = Writer (Vector c) (IntMap DynamicStorage)
-> (IntMap DynamicStorage, Vector c)
forall w a. Writer w a -> (a, w)
runWriter (Writer (Vector c) (IntMap DynamicStorage)
 -> (IntMap DynamicStorage, Vector c))
-> Writer (Vector c) (IntMap DynamicStorage)
-> (IntMap DynamicStorage, Vector c)
forall a b. (a -> b) -> a -> b
$ (Maybe DynamicStorage
 -> WriterT (Vector c) Identity (Maybe DynamicStorage))
-> Key
-> IntMap DynamicStorage
-> Writer (Vector c) (IntMap DynamicStorage)
forall (f :: * -> *) a.
Functor f =>
(Maybe a -> f (Maybe a)) -> Key -> IntMap a -> f (IntMap a)
IntMap.alterF Maybe DynamicStorage
-> WriterT (Vector c) Identity (Maybe DynamicStorage)
go (ComponentID -> Key
unComponentId ComponentID
cId) (IntMap DynamicStorage
 -> Writer (Vector c) (IntMap DynamicStorage))
-> IntMap DynamicStorage
-> Writer (Vector c) (IntMap DynamicStorage)
forall a b. (a -> b) -> a -> b
$ Archetype m -> IntMap DynamicStorage
forall (m :: * -> *). Archetype m -> IntMap DynamicStorage
storages Archetype m
arch
      eIds :: Vector EntityID
eIds = [EntityID] -> Vector EntityID
forall a. [a] -> Vector a
V.fromList ([EntityID] -> Vector EntityID)
-> (Set EntityID -> [EntityID]) -> Set EntityID -> Vector EntityID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set EntityID -> [EntityID]
forall a. Set a -> [a]
Set.toList (Set EntityID -> Vector EntityID)
-> Set EntityID -> Vector EntityID
forall a b. (a -> b) -> a -> b
$ Archetype m -> Set EntityID
forall (m :: * -> *). Archetype m -> Set EntityID
entities Archetype m
arch
      hooks :: Access m ()
hooks = (Access m () -> (EntityID, c) -> Access m ())
-> Access m () -> Vector (EntityID, c) -> Access m ()
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl (\Access m ()
acc (EntityID
e, c
c) -> Access m ()
acc Access m () -> Access m () -> Access m ()
forall a b. Access m a -> Access m b -> Access m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EntityID -> c -> Access m ()
forall (m :: * -> *) a.
Component m a =>
EntityID -> a -> Access m ()
componentOnChange EntityID
e c
c Access m () -> Access m () -> Access m ()
forall a b. Access m a -> Access m b -> Access m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EntityID -> OnChange c -> Access m ()
forall (m :: * -> *) e.
(Monad m, Event e) =>
EntityID -> e -> Access m ()
triggerEntityEvent EntityID
e (c -> OnChange c
forall a. a -> OnChange a
OnChange c
c)) (() -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Vector EntityID -> Vector c -> Vector (EntityID, c)
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip Vector EntityID
eIds Vector c
cs)
   in (Vector c
cs, Archetype m
arch {storages = storages'}, Access m ()
hooks)
{-# INLINE zipWith #-}

-- | Zip a vector of components with a monadic function and a component storage.

-- Returns the result vector, updated archetype, and the onChange hooks to run.

zipWithM ::
  forall m a c. (Monad m, Component m c) => Vector a -> (a -> c -> m c) -> ComponentID -> Archetype m -> m (Vector c, Archetype m, Access m ())
zipWithM :: forall (m :: * -> *) a c.
(Monad m, Component m c) =>
Vector a
-> (a -> c -> m c)
-> ComponentID
-> Archetype m
-> m (Vector c, Archetype m, Access m ())
zipWithM Vector a
as a -> c -> m c
f ComponentID
cId Archetype m
arch = do
  let go :: Maybe DynamicStorage -> WriterT (Vector c) m (Maybe DynamicStorage)
go Maybe DynamicStorage
maybeDyn = case Maybe DynamicStorage
maybeDyn of
        Just DynamicStorage
dyn -> case Dynamic -> Maybe (StorageT c)
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic (Dynamic -> Maybe (StorageT c)) -> Dynamic -> Maybe (StorageT c)
forall a b. (a -> b) -> a -> b
$ DynamicStorage -> Dynamic
storageDyn DynamicStorage
dyn of
          Just StorageT c
s ->
            m (Maybe DynamicStorage, Vector c)
-> WriterT (Vector c) m (Maybe DynamicStorage)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m (Maybe DynamicStorage, Vector c)
 -> WriterT (Vector c) m (Maybe DynamicStorage))
-> m (Maybe DynamicStorage, Vector c)
-> WriterT (Vector c) m (Maybe DynamicStorage)
forall a b. (a -> b) -> a -> b
$
              ((Vector c, StorageT c) -> (Maybe DynamicStorage, Vector c))
-> m (Vector c, StorageT c) -> m (Maybe DynamicStorage, Vector c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                (\(Vector c
cs, StorageT c
s') -> (DynamicStorage -> Maybe DynamicStorage
forall a. a -> Maybe a
Just DynamicStorage
dyn {storageDyn = toDyn s'}, Vector c
cs))
                (forall a s (m :: * -> *) i.
(Storage a s, Monad m) =>
(i -> a -> m a) -> Vector i -> s -> m (Vector a, s)
S.zipWithM @c @(StorageT c) a -> c -> m c
f Vector a
as StorageT c
s)
          Maybe (StorageT c)
Nothing -> Maybe DynamicStorage -> WriterT (Vector c) m (Maybe DynamicStorage)
forall a. a -> WriterT (Vector c) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe DynamicStorage
maybeDyn
        Maybe DynamicStorage
Nothing -> Maybe DynamicStorage -> WriterT (Vector c) m (Maybe DynamicStorage)
forall a. a -> WriterT (Vector c) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe DynamicStorage
forall a. Maybe a
Nothing
  (IntMap DynamicStorage, Vector c)
res <- WriterT (Vector c) m (IntMap DynamicStorage)
-> m (IntMap DynamicStorage, Vector c)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT (Vector c) m (IntMap DynamicStorage)
 -> m (IntMap DynamicStorage, Vector c))
-> WriterT (Vector c) m (IntMap DynamicStorage)
-> m (IntMap DynamicStorage, Vector c)
forall a b. (a -> b) -> a -> b
$ (Maybe DynamicStorage
 -> WriterT (Vector c) m (Maybe DynamicStorage))
-> Key
-> IntMap DynamicStorage
-> WriterT (Vector c) m (IntMap DynamicStorage)
forall (f :: * -> *) a.
Functor f =>
(Maybe a -> f (Maybe a)) -> Key -> IntMap a -> f (IntMap a)
IntMap.alterF Maybe DynamicStorage -> WriterT (Vector c) m (Maybe DynamicStorage)
go (ComponentID -> Key
unComponentId ComponentID
cId) (IntMap DynamicStorage
 -> WriterT (Vector c) m (IntMap DynamicStorage))
-> IntMap DynamicStorage
-> WriterT (Vector c) m (IntMap DynamicStorage)
forall a b. (a -> b) -> a -> b
$ Archetype m -> IntMap DynamicStorage
forall (m :: * -> *). Archetype m -> IntMap DynamicStorage
storages Archetype m
arch
  let cs :: Vector c
cs = (IntMap DynamicStorage, Vector c) -> Vector c
forall a b. (a, b) -> b
snd (IntMap DynamicStorage, Vector c)
res
      eIds :: Vector EntityID
eIds = [EntityID] -> Vector EntityID
forall a. [a] -> Vector a
V.fromList ([EntityID] -> Vector EntityID)
-> (Set EntityID -> [EntityID]) -> Set EntityID -> Vector EntityID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set EntityID -> [EntityID]
forall a. Set a -> [a]
Set.toList (Set EntityID -> Vector EntityID)
-> Set EntityID -> Vector EntityID
forall a b. (a -> b) -> a -> b
$ Archetype m -> Set EntityID
forall (m :: * -> *). Archetype m -> Set EntityID
entities Archetype m
arch
      hooks :: Access m ()
hooks = (Access m () -> (EntityID, c) -> Access m ())
-> Access m () -> Vector (EntityID, c) -> Access m ()
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl (\Access m ()
acc (EntityID
e, c
c) -> Access m ()
acc Access m () -> Access m () -> Access m ()
forall a b. Access m a -> Access m b -> Access m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EntityID -> c -> Access m ()
forall (m :: * -> *) a.
Component m a =>
EntityID -> a -> Access m ()
componentOnChange EntityID
e c
c Access m () -> Access m () -> Access m ()
forall a b. Access m a -> Access m b -> Access m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EntityID -> OnChange c -> Access m ()
forall (m :: * -> *) e.
(Monad m, Event e) =>
EntityID -> e -> Access m ()
triggerEntityEvent EntityID
e (c -> OnChange c
forall a. a -> OnChange a
OnChange c
c)) (() -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Vector EntityID -> Vector c -> Vector (EntityID, c)
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip Vector EntityID
eIds Vector c
cs)
  (Vector c, Archetype m, Access m ())
-> m (Vector c, Archetype m, Access m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
return (Vector c
cs, Archetype m
arch {storages = fst res}, Access m ()
hooks)

-- | Zip a vector of components with a function and a component storage.

-- Returns the updated archetype and the onChange hooks to run.

zipWith_ ::
  forall m a c. (Monad m, Component m c) => Vector a -> (a -> c -> c) -> ComponentID -> Archetype m -> (Archetype m, Access m ())
zipWith_ :: forall (m :: * -> *) a c.
(Monad m, Component m c) =>
Vector a
-> (a -> c -> c)
-> ComponentID
-> Archetype m
-> (Archetype m, Access m ())
zipWith_ Vector a
as a -> c -> c
f ComponentID
cId Archetype m
arch =
  let maybeStorage :: Maybe (Vector c, DynamicStorage)
maybeStorage = case Key -> IntMap DynamicStorage -> Maybe DynamicStorage
forall a. Key -> IntMap a -> Maybe a
IntMap.lookup (ComponentID -> Key
unComponentId ComponentID
cId) (IntMap DynamicStorage -> Maybe DynamicStorage)
-> IntMap DynamicStorage -> Maybe DynamicStorage
forall a b. (a -> b) -> a -> b
$ Archetype m -> IntMap DynamicStorage
forall (m :: * -> *). Archetype m -> IntMap DynamicStorage
storages Archetype m
arch of
        Just DynamicStorage
dyn -> case Dynamic -> Maybe (StorageT c)
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic (Dynamic -> Maybe (StorageT c)) -> Dynamic -> Maybe (StorageT c)
forall a b. (a -> b) -> a -> b
$ DynamicStorage -> Dynamic
storageDyn DynamicStorage
dyn of
          Just StorageT c
s ->
            let !(Vector c
cs, StorageT c
s') = forall a s i.
Storage a s =>
(i -> a -> a) -> Vector i -> s -> (Vector a, s)
S.zipWith @c @(StorageT c) a -> c -> c
f Vector a
as StorageT c
s in (Vector c, DynamicStorage) -> Maybe (Vector c, DynamicStorage)
forall a. a -> Maybe a
Just (Vector c
cs, DynamicStorage
dyn {storageDyn = toDyn s'})
          Maybe (StorageT c)
Nothing -> Maybe (Vector c, DynamicStorage)
forall a. Maybe a
Nothing
        Maybe DynamicStorage
Nothing -> Maybe (Vector c, DynamicStorage)
forall a. Maybe a
Nothing
   in case Maybe (Vector c, DynamicStorage)
maybeStorage of
        Just (Vector c
cs, DynamicStorage
s) ->
          let eIds :: Vector EntityID
eIds = [EntityID] -> Vector EntityID
forall a. [a] -> Vector a
V.fromList ([EntityID] -> Vector EntityID)
-> (Set EntityID -> [EntityID]) -> Set EntityID -> Vector EntityID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set EntityID -> [EntityID]
forall a. Set a -> [a]
Set.toList (Set EntityID -> Vector EntityID)
-> Set EntityID -> Vector EntityID
forall a b. (a -> b) -> a -> b
$ Archetype m -> Set EntityID
forall (m :: * -> *). Archetype m -> Set EntityID
entities Archetype m
arch
              hooks :: Access m ()
hooks = (Access m () -> (EntityID, c) -> Access m ())
-> Access m () -> Vector (EntityID, c) -> Access m ()
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl (\Access m ()
acc (EntityID
e, c
c) -> Access m ()
acc Access m () -> Access m () -> Access m ()
forall a b. Access m a -> Access m b -> Access m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EntityID -> c -> Access m ()
forall (m :: * -> *) a.
Component m a =>
EntityID -> a -> Access m ()
componentOnChange EntityID
e c
c Access m () -> Access m () -> Access m ()
forall a b. Access m a -> Access m b -> Access m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EntityID -> OnChange c -> Access m ()
forall (m :: * -> *) e.
(Monad m, Event e) =>
EntityID -> e -> Access m ()
triggerEntityEvent EntityID
e (c -> OnChange c
forall a. a -> OnChange a
OnChange c
c)) (() -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Vector EntityID -> Vector c -> Vector (EntityID, c)
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip Vector EntityID
eIds Vector c
cs)
           in (Archetype Any
forall (m :: * -> *). Archetype m
empty {storages = IntMap.singleton (unComponentId cId) s}, Access m ()
hooks)
        Maybe (Vector c, DynamicStorage)
Nothing -> (Archetype Any
forall (m :: * -> *). Archetype m
empty {storages = IntMap.empty}, () -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINE zipWith_ #-}

-- | Zip a vector of components with a function returning a tuple.

zipWithAccum ::
  forall m a c o. (Monad m, Component m c) => Vector a -> (a -> c -> (o, c)) -> ComponentID -> Archetype m -> (Vector (o, c), Archetype m, Access m ())
zipWithAccum :: forall (m :: * -> *) a c o.
(Monad m, Component m c) =>
Vector a
-> (a -> c -> (o, c))
-> ComponentID
-> Archetype m
-> (Vector (o, c), Archetype m, Access m ())
zipWithAccum Vector a
as a -> c -> (o, c)
f ComponentID
cId Archetype m
arch =
  let go :: Maybe DynamicStorage
-> WriterT (Vector (o, c)) Identity (Maybe DynamicStorage)
go Maybe DynamicStorage
maybeDyn = case Maybe DynamicStorage
maybeDyn of
        Just DynamicStorage
dyn -> case Dynamic -> Maybe (StorageT c)
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic (Dynamic -> Maybe (StorageT c)) -> Dynamic -> Maybe (StorageT c)
forall a b. (a -> b) -> a -> b
$ DynamicStorage -> Dynamic
storageDyn DynamicStorage
dyn of
          Just StorageT c
s -> do
            let !(Vector (o, c)
pairs', StorageT c
s') = forall a s i o.
Storage a s =>
(i -> a -> (o, a)) -> Vector i -> s -> (Vector (o, a), s)
S.zipWithAccum @c @(StorageT c) a -> c -> (o, c)
f Vector a
as StorageT c
s
            Vector (o, c) -> WriterT (Vector (o, c)) Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Vector (o, c)
pairs'
            return $ DynamicStorage -> Maybe DynamicStorage
forall a. a -> Maybe a
Just (DynamicStorage -> Maybe DynamicStorage)
-> DynamicStorage -> Maybe DynamicStorage
forall a b. (a -> b) -> a -> b
$ DynamicStorage
dyn {storageDyn = toDyn s'}
          Maybe (StorageT c)
Nothing -> Maybe DynamicStorage
-> WriterT (Vector (o, c)) Identity (Maybe DynamicStorage)
forall a. a -> WriterT (Vector (o, c)) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DynamicStorage
maybeDyn
        Maybe DynamicStorage
Nothing -> Maybe DynamicStorage
-> WriterT (Vector (o, c)) Identity (Maybe DynamicStorage)
forall a. a -> WriterT (Vector (o, c)) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DynamicStorage
forall a. Maybe a
Nothing
      (IntMap DynamicStorage
storages', Vector (o, c)
pairs) = Writer (Vector (o, c)) (IntMap DynamicStorage)
-> (IntMap DynamicStorage, Vector (o, c))
forall w a. Writer w a -> (a, w)
runWriter (Writer (Vector (o, c)) (IntMap DynamicStorage)
 -> (IntMap DynamicStorage, Vector (o, c)))
-> Writer (Vector (o, c)) (IntMap DynamicStorage)
-> (IntMap DynamicStorage, Vector (o, c))
forall a b. (a -> b) -> a -> b
$ (Maybe DynamicStorage
 -> WriterT (Vector (o, c)) Identity (Maybe DynamicStorage))
-> Key
-> IntMap DynamicStorage
-> Writer (Vector (o, c)) (IntMap DynamicStorage)
forall (f :: * -> *) a.
Functor f =>
(Maybe a -> f (Maybe a)) -> Key -> IntMap a -> f (IntMap a)
IntMap.alterF Maybe DynamicStorage
-> WriterT (Vector (o, c)) Identity (Maybe DynamicStorage)
go (ComponentID -> Key
unComponentId ComponentID
cId) (IntMap DynamicStorage
 -> Writer (Vector (o, c)) (IntMap DynamicStorage))
-> IntMap DynamicStorage
-> Writer (Vector (o, c)) (IntMap DynamicStorage)
forall a b. (a -> b) -> a -> b
$ Archetype m -> IntMap DynamicStorage
forall (m :: * -> *). Archetype m -> IntMap DynamicStorage
storages Archetype m
arch
      eIds :: Vector EntityID
eIds = [EntityID] -> Vector EntityID
forall a. [a] -> Vector a
V.fromList ([EntityID] -> Vector EntityID)
-> (Set EntityID -> [EntityID]) -> Set EntityID -> Vector EntityID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set EntityID -> [EntityID]
forall a. Set a -> [a]
Set.toList (Set EntityID -> Vector EntityID)
-> Set EntityID -> Vector EntityID
forall a b. (a -> b) -> a -> b
$ Archetype m -> Set EntityID
forall (m :: * -> *). Archetype m -> Set EntityID
entities Archetype m
arch
      hooks :: Access m ()
hooks = (Access m () -> (EntityID, (o, c)) -> Access m ())
-> Access m () -> Vector (EntityID, (o, c)) -> Access m ()
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl (\Access m ()
acc (EntityID
e, (o
_, c
c)) -> Access m ()
acc Access m () -> Access m () -> Access m ()
forall a b. Access m a -> Access m b -> Access m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EntityID -> c -> Access m ()
forall (m :: * -> *) a.
Component m a =>
EntityID -> a -> Access m ()
componentOnChange EntityID
e c
c Access m () -> Access m () -> Access m ()
forall a b. Access m a -> Access m b -> Access m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EntityID -> OnChange c -> Access m ()
forall (m :: * -> *) e.
(Monad m, Event e) =>
EntityID -> e -> Access m ()
triggerEntityEvent EntityID
e (c -> OnChange c
forall a. a -> OnChange a
OnChange c
c)) (() -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Vector EntityID -> Vector (o, c) -> Vector (EntityID, (o, c))
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip Vector EntityID
eIds Vector (o, c)
pairs)
   in (Vector (o, c)
pairs, Archetype m
arch {storages = storages'}, Access m ()
hooks)
{-# INLINE zipWithAccum #-}

-- | Zip a vector of components with a monadic function returning a tuple.

zipWithAccumM ::
  forall m a c o. (Monad m, Component m c) => Vector a -> (a -> c -> m (o, c)) -> ComponentID -> Archetype m -> m (Vector (o, c), Archetype m, Access m ())
zipWithAccumM :: forall (m :: * -> *) a c o.
(Monad m, Component m c) =>
Vector a
-> (a -> c -> m (o, c))
-> ComponentID
-> Archetype m
-> m (Vector (o, c), Archetype m, Access m ())
zipWithAccumM Vector a
as a -> c -> m (o, c)
f ComponentID
cId Archetype m
arch = do
  let go :: Maybe DynamicStorage
-> WriterT (Vector (o, c)) m (Maybe DynamicStorage)
go Maybe DynamicStorage
maybeDyn = case Maybe DynamicStorage
maybeDyn of
        Just DynamicStorage
dyn -> case Dynamic -> Maybe (StorageT c)
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic (Dynamic -> Maybe (StorageT c)) -> Dynamic -> Maybe (StorageT c)
forall a b. (a -> b) -> a -> b
$ DynamicStorage -> Dynamic
storageDyn DynamicStorage
dyn of
          Just StorageT c
s ->
            m (Maybe DynamicStorage, Vector (o, c))
-> WriterT (Vector (o, c)) m (Maybe DynamicStorage)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m (Maybe DynamicStorage, Vector (o, c))
 -> WriterT (Vector (o, c)) m (Maybe DynamicStorage))
-> m (Maybe DynamicStorage, Vector (o, c))
-> WriterT (Vector (o, c)) m (Maybe DynamicStorage)
forall a b. (a -> b) -> a -> b
$
              ((Vector (o, c), StorageT c)
 -> (Maybe DynamicStorage, Vector (o, c)))
-> m (Vector (o, c), StorageT c)
-> m (Maybe DynamicStorage, Vector (o, c))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                (\(Vector (o, c)
pairs, StorageT c
s') -> (DynamicStorage -> Maybe DynamicStorage
forall a. a -> Maybe a
Just DynamicStorage
dyn {storageDyn = toDyn s'}, Vector (o, c)
pairs))
                (forall a s (m :: * -> *) i o.
(Storage a s, Monad m) =>
(i -> a -> m (o, a)) -> Vector i -> s -> m (Vector (o, a), s)
S.zipWithAccumM @c @(StorageT c) a -> c -> m (o, c)
f Vector a
as StorageT c
s)
          Maybe (StorageT c)
Nothing -> Maybe DynamicStorage
-> WriterT (Vector (o, c)) m (Maybe DynamicStorage)
forall a. a -> WriterT (Vector (o, c)) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe DynamicStorage
maybeDyn
        Maybe DynamicStorage
Nothing -> Maybe DynamicStorage
-> WriterT (Vector (o, c)) m (Maybe DynamicStorage)
forall a. a -> WriterT (Vector (o, c)) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe DynamicStorage
forall a. Maybe a
Nothing
  (IntMap DynamicStorage, Vector (o, c))
res <- WriterT (Vector (o, c)) m (IntMap DynamicStorage)
-> m (IntMap DynamicStorage, Vector (o, c))
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT (Vector (o, c)) m (IntMap DynamicStorage)
 -> m (IntMap DynamicStorage, Vector (o, c)))
-> WriterT (Vector (o, c)) m (IntMap DynamicStorage)
-> m (IntMap DynamicStorage, Vector (o, c))
forall a b. (a -> b) -> a -> b
$ (Maybe DynamicStorage
 -> WriterT (Vector (o, c)) m (Maybe DynamicStorage))
-> Key
-> IntMap DynamicStorage
-> WriterT (Vector (o, c)) m (IntMap DynamicStorage)
forall (f :: * -> *) a.
Functor f =>
(Maybe a -> f (Maybe a)) -> Key -> IntMap a -> f (IntMap a)
IntMap.alterF Maybe DynamicStorage
-> WriterT (Vector (o, c)) m (Maybe DynamicStorage)
go (ComponentID -> Key
unComponentId ComponentID
cId) (IntMap DynamicStorage
 -> WriterT (Vector (o, c)) m (IntMap DynamicStorage))
-> IntMap DynamicStorage
-> WriterT (Vector (o, c)) m (IntMap DynamicStorage)
forall a b. (a -> b) -> a -> b
$ Archetype m -> IntMap DynamicStorage
forall (m :: * -> *). Archetype m -> IntMap DynamicStorage
storages Archetype m
arch
  let pairs :: Vector (o, c)
pairs = (IntMap DynamicStorage, Vector (o, c)) -> Vector (o, c)
forall a b. (a, b) -> b
snd (IntMap DynamicStorage, Vector (o, c))
res
      eIds :: Vector EntityID
eIds = [EntityID] -> Vector EntityID
forall a. [a] -> Vector a
V.fromList ([EntityID] -> Vector EntityID)
-> (Set EntityID -> [EntityID]) -> Set EntityID -> Vector EntityID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set EntityID -> [EntityID]
forall a. Set a -> [a]
Set.toList (Set EntityID -> Vector EntityID)
-> Set EntityID -> Vector EntityID
forall a b. (a -> b) -> a -> b
$ Archetype m -> Set EntityID
forall (m :: * -> *). Archetype m -> Set EntityID
entities Archetype m
arch
      hooks :: Access m ()
hooks = (Access m () -> (EntityID, (o, c)) -> Access m ())
-> Access m () -> Vector (EntityID, (o, c)) -> Access m ()
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl (\Access m ()
acc (EntityID
e, (o
_, c
c)) -> Access m ()
acc Access m () -> Access m () -> Access m ()
forall a b. Access m a -> Access m b -> Access m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EntityID -> c -> Access m ()
forall (m :: * -> *) a.
Component m a =>
EntityID -> a -> Access m ()
componentOnChange EntityID
e c
c Access m () -> Access m () -> Access m ()
forall a b. Access m a -> Access m b -> Access m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EntityID -> OnChange c -> Access m ()
forall (m :: * -> *) e.
(Monad m, Event e) =>
EntityID -> e -> Access m ()
triggerEntityEvent EntityID
e (c -> OnChange c
forall a. a -> OnChange a
OnChange c
c)) (() -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Vector EntityID -> Vector (o, c) -> Vector (EntityID, (o, c))
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip Vector EntityID
eIds Vector (o, c)
pairs)
  (Vector (o, c), Archetype m, Access m ())
-> m (Vector (o, c), Archetype m, Access m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
return (Vector (o, c)
pairs, Archetype m
arch {storages = fst res}, Access m ()
hooks)
{-# INLINE zipWithAccumM #-}

-- | Insert a vector of components into the archetype, sorted in ascending order by their `EntityID`.

insertAscVector :: forall m a. (Component m a) => ComponentID -> Vector a -> Archetype m -> Archetype m
insertAscVector :: forall (m :: * -> *) a.
Component m a =>
ComponentID -> Vector a -> Archetype m -> Archetype m
insertAscVector ComponentID
cId Vector a
as Archetype m
arch =
  let !storage :: DynamicStorage
storage = forall a s. Storage a s => s -> DynamicStorage
dynStorage @a (StorageT a -> DynamicStorage) -> StorageT a -> DynamicStorage
forall a b. (a -> b) -> a -> b
$ forall a s. Storage a s => Vector a -> s
S.fromAscVector @a @(StorageT a) Vector a
as
   in Archetype m
arch {storages = IntMap.insert (unComponentId cId) storage $ storages arch}
{-# INLINE insertAscVector #-}

-- | Remove an entity from an archetype, returning its components.

remove :: EntityID -> Archetype m -> (IntMap Dynamic, Archetype m)
remove :: forall (m :: * -> *).
EntityID -> Archetype m -> (IntMap Dynamic, Archetype m)
remove EntityID
e Archetype m
arch =
  let go :: (IntMap Dynamic, Archetype m)
-> (Key, DynamicStorage) -> (IntMap Dynamic, Archetype m)
go (IntMap Dynamic
dynAcc, Archetype m
archAcc) (Key
cId, DynamicStorage
dynS) =
        let cs :: Map EntityID Dynamic
cs = [(EntityID, Dynamic)] -> Map EntityID Dynamic
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList ([(EntityID, Dynamic)] -> Map EntityID Dynamic)
-> (Vector Dynamic -> [(EntityID, Dynamic)])
-> Vector Dynamic
-> Map EntityID Dynamic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EntityID] -> [Dynamic] -> [(EntityID, Dynamic)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set EntityID -> [EntityID]
forall a. Set a -> [a]
Set.toList (Set EntityID -> [EntityID]) -> Set EntityID -> [EntityID]
forall a b. (a -> b) -> a -> b
$ Archetype m -> Set EntityID
forall (m :: * -> *). Archetype m -> Set EntityID
entities Archetype m
arch) ([Dynamic] -> [(EntityID, Dynamic)])
-> (Vector Dynamic -> [Dynamic])
-> Vector Dynamic
-> [(EntityID, Dynamic)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Dynamic -> [Dynamic]
forall a. Vector a -> [a]
V.toList (Vector Dynamic -> Map EntityID Dynamic)
-> Vector Dynamic -> Map EntityID Dynamic
forall a b. (a -> b) -> a -> b
$ DynamicStorage -> Vector Dynamic
toAscVectorDyn DynamicStorage
dynS
            !(Maybe Dynamic
dynA, Map EntityID Dynamic
cs') = (EntityID -> Dynamic -> Maybe Dynamic)
-> EntityID
-> Map EntityID Dynamic
-> (Maybe Dynamic, Map EntityID Dynamic)
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey (\EntityID
_ Dynamic
_ -> Maybe Dynamic
forall a. Maybe a
Nothing) EntityID
e Map EntityID Dynamic
cs
            dynS' :: DynamicStorage
dynS' = Vector Dynamic -> DynamicStorage -> DynamicStorage
S.fromAscVectorDyn ([Dynamic] -> Vector Dynamic
forall a. [a] -> Vector a
V.fromList ([Dynamic] -> Vector Dynamic) -> [Dynamic] -> Vector Dynamic
forall a b. (a -> b) -> a -> b
$ Map EntityID Dynamic -> [Dynamic]
forall k a. Map k a -> [a]
Map.elems Map EntityID Dynamic
cs') DynamicStorage
dynS
            !dynAcc' :: IntMap Dynamic
dynAcc' = case Maybe Dynamic
dynA of
              Just Dynamic
d -> Key -> Dynamic -> IntMap Dynamic -> IntMap Dynamic
forall a. Key -> a -> IntMap a -> IntMap a
IntMap.insert Key
cId Dynamic
d IntMap Dynamic
dynAcc
              Maybe Dynamic
Nothing -> IntMap Dynamic
dynAcc
         in (IntMap Dynamic
dynAcc', Archetype m
archAcc {storages = IntMap.insert cId dynS' $ storages archAcc})
      arch' :: Archetype m
arch' = Archetype m
arch {entities = Set.delete e $ entities arch}
   in ((IntMap Dynamic, Archetype m)
 -> (Key, DynamicStorage) -> (IntMap Dynamic, Archetype m))
-> (IntMap Dynamic, Archetype m)
-> [(Key, DynamicStorage)]
-> (IntMap Dynamic, Archetype m)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (IntMap Dynamic, Archetype m)
-> (Key, DynamicStorage) -> (IntMap Dynamic, Archetype m)
go (IntMap Dynamic
forall a. IntMap a
IntMap.empty, Archetype m
arch') ([(Key, DynamicStorage)] -> (IntMap Dynamic, Archetype m))
-> (IntMap DynamicStorage -> [(Key, DynamicStorage)])
-> IntMap DynamicStorage
-> (IntMap Dynamic, Archetype m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap DynamicStorage -> [(Key, DynamicStorage)]
forall a. IntMap a -> [(Key, a)]
IntMap.toList (IntMap DynamicStorage -> (IntMap Dynamic, Archetype m))
-> IntMap DynamicStorage -> (IntMap Dynamic, Archetype m)
forall a b. (a -> b) -> a -> b
$ Archetype m -> IntMap DynamicStorage
forall (m :: * -> *). Archetype m -> IntMap DynamicStorage
storages Archetype m
arch'

-- | Remove an entity from an archetype, returning its component storages.

removeStorages :: EntityID -> Archetype m -> (IntMap DynamicStorage, Archetype m)
removeStorages :: forall (m :: * -> *).
EntityID -> Archetype m -> (IntMap DynamicStorage, Archetype m)
removeStorages EntityID
e Archetype m
arch =
  let go :: (IntMap DynamicStorage, Archetype m)
-> (Key, DynamicStorage) -> (IntMap DynamicStorage, Archetype m)
go (IntMap DynamicStorage
dynAcc, Archetype m
archAcc) (Key
cId, DynamicStorage
dynS) =
        let cs :: Map EntityID Dynamic
cs = [(EntityID, Dynamic)] -> Map EntityID Dynamic
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList ([(EntityID, Dynamic)] -> Map EntityID Dynamic)
-> (Vector Dynamic -> [(EntityID, Dynamic)])
-> Vector Dynamic
-> Map EntityID Dynamic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EntityID] -> [Dynamic] -> [(EntityID, Dynamic)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set EntityID -> [EntityID]
forall a. Set a -> [a]
Set.toList (Set EntityID -> [EntityID]) -> Set EntityID -> [EntityID]
forall a b. (a -> b) -> a -> b
$ Archetype m -> Set EntityID
forall (m :: * -> *). Archetype m -> Set EntityID
entities Archetype m
arch) ([Dynamic] -> [(EntityID, Dynamic)])
-> (Vector Dynamic -> [Dynamic])
-> Vector Dynamic
-> [(EntityID, Dynamic)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Dynamic -> [Dynamic]
forall a. Vector a -> [a]
V.toList (Vector Dynamic -> Map EntityID Dynamic)
-> Vector Dynamic -> Map EntityID Dynamic
forall a b. (a -> b) -> a -> b
$ DynamicStorage -> Vector Dynamic
toAscVectorDyn DynamicStorage
dynS
            !(Maybe Dynamic
dynA, Map EntityID Dynamic
cs') = (EntityID -> Dynamic -> Maybe Dynamic)
-> EntityID
-> Map EntityID Dynamic
-> (Maybe Dynamic, Map EntityID Dynamic)
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey (\EntityID
_ Dynamic
_ -> Maybe Dynamic
forall a. Maybe a
Nothing) EntityID
e Map EntityID Dynamic
cs
            dynS' :: DynamicStorage
dynS' = Vector Dynamic -> DynamicStorage -> DynamicStorage
S.fromAscVectorDyn ([Dynamic] -> Vector Dynamic
forall a. [a] -> Vector a
V.fromList ([Dynamic] -> Vector Dynamic) -> [Dynamic] -> Vector Dynamic
forall a b. (a -> b) -> a -> b
$ Map EntityID Dynamic -> [Dynamic]
forall k a. Map k a -> [a]
Map.elems Map EntityID Dynamic
cs') DynamicStorage
dynS
            !dynAcc' :: IntMap DynamicStorage
dynAcc' = case Maybe Dynamic
dynA of
              Just Dynamic
d -> Key
-> DynamicStorage -> IntMap DynamicStorage -> IntMap DynamicStorage
forall a. Key -> a -> IntMap a -> IntMap a
IntMap.insert Key
cId (Dynamic -> DynamicStorage -> DynamicStorage
S.singletonDyn Dynamic
d DynamicStorage
dynS') IntMap DynamicStorage
dynAcc
              Maybe Dynamic
Nothing -> IntMap DynamicStorage
dynAcc
         in (IntMap DynamicStorage
dynAcc', Archetype m
archAcc {storages = IntMap.insert cId dynS' $ storages archAcc})
      arch' :: Archetype m
arch' = Archetype m
arch {entities = Set.delete e $ entities arch}
   in ((IntMap DynamicStorage, Archetype m)
 -> (Key, DynamicStorage) -> (IntMap DynamicStorage, Archetype m))
-> (IntMap DynamicStorage, Archetype m)
-> [(Key, DynamicStorage)]
-> (IntMap DynamicStorage, Archetype m)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (IntMap DynamicStorage, Archetype m)
-> (Key, DynamicStorage) -> (IntMap DynamicStorage, Archetype m)
go (IntMap DynamicStorage
forall a. IntMap a
IntMap.empty, Archetype m
arch') ([(Key, DynamicStorage)] -> (IntMap DynamicStorage, Archetype m))
-> (IntMap DynamicStorage -> [(Key, DynamicStorage)])
-> IntMap DynamicStorage
-> (IntMap DynamicStorage, Archetype m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap DynamicStorage -> [(Key, DynamicStorage)]
forall a. IntMap a -> [(Key, a)]
IntMap.toList (IntMap DynamicStorage -> (IntMap DynamicStorage, Archetype m))
-> IntMap DynamicStorage -> (IntMap DynamicStorage, Archetype m)
forall a b. (a -> b) -> a -> b
$ Archetype m -> IntMap DynamicStorage
forall (m :: * -> *). Archetype m -> IntMap DynamicStorage
storages Archetype m
arch'

-- | Insert a map of component storages and their `EntityID` into the archetype.

insertComponents :: EntityID -> IntMap Dynamic -> Archetype m -> Archetype m
insertComponents :: forall (m :: * -> *).
EntityID -> IntMap Dynamic -> Archetype m -> Archetype m
insertComponents EntityID
e IntMap Dynamic
cs Archetype m
arch =
  let f :: Archetype m -> (Key, Dynamic) -> Archetype m
f Archetype m
archAcc (Key
itemCId, Dynamic
dyn) =
        let storages' :: IntMap DynamicStorage
storages' = (DynamicStorage -> DynamicStorage)
-> Key -> IntMap DynamicStorage -> IntMap DynamicStorage
forall a. (a -> a) -> Key -> IntMap a -> IntMap a
IntMap.adjust DynamicStorage -> DynamicStorage
go Key
itemCId (Archetype m -> IntMap DynamicStorage
forall (m :: * -> *). Archetype m -> IntMap DynamicStorage
storages Archetype m
archAcc)
            es :: [EntityID]
es = Set EntityID -> [EntityID]
forall a. Set a -> [a]
Set.toList (Set EntityID -> [EntityID]) -> Set EntityID -> [EntityID]
forall a b. (a -> b) -> a -> b
$ Archetype m -> Set EntityID
forall (m :: * -> *). Archetype m -> Set EntityID
entities Archetype m
archAcc
            go :: DynamicStorage -> DynamicStorage
go DynamicStorage
s =
              let ecs :: Vector Dynamic
ecs = [Dynamic] -> Vector Dynamic
forall a. [a] -> Vector a
V.fromList ([Dynamic] -> Vector Dynamic)
-> (Vector Dynamic -> [Dynamic])
-> Vector Dynamic
-> Vector Dynamic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map EntityID Dynamic -> [Dynamic]
forall k a. Map k a -> [a]
Map.elems (Map EntityID Dynamic -> [Dynamic])
-> (Vector Dynamic -> Map EntityID Dynamic)
-> Vector Dynamic
-> [Dynamic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityID -> Dynamic -> Map EntityID Dynamic -> Map EntityID Dynamic
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert EntityID
e Dynamic
dyn (Map EntityID Dynamic -> Map EntityID Dynamic)
-> (Vector Dynamic -> Map EntityID Dynamic)
-> Vector Dynamic
-> Map EntityID Dynamic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(EntityID, Dynamic)] -> Map EntityID Dynamic
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList ([(EntityID, Dynamic)] -> Map EntityID Dynamic)
-> (Vector Dynamic -> [(EntityID, Dynamic)])
-> Vector Dynamic
-> Map EntityID Dynamic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EntityID] -> [Dynamic] -> [(EntityID, Dynamic)]
forall a b. [a] -> [b] -> [(a, b)]
zip [EntityID]
es ([Dynamic] -> [(EntityID, Dynamic)])
-> (Vector Dynamic -> [Dynamic])
-> Vector Dynamic
-> [(EntityID, Dynamic)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Dynamic -> [Dynamic]
forall a. Vector a -> [a]
V.toList (Vector Dynamic -> Vector Dynamic)
-> Vector Dynamic -> Vector Dynamic
forall a b. (a -> b) -> a -> b
$ DynamicStorage -> Vector Dynamic
toAscVectorDyn DynamicStorage
s
               in Vector Dynamic -> DynamicStorage -> DynamicStorage
fromAscVectorDyn Vector Dynamic
ecs DynamicStorage
s
         in Archetype m
archAcc {storages = storages', entities = Set.insert e $ entities archAcc}
   in (Archetype m -> (Key, Dynamic) -> Archetype m)
-> Archetype m -> [(Key, Dynamic)] -> Archetype m
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Archetype m -> (Key, Dynamic) -> Archetype m
f Archetype m
arch (IntMap Dynamic -> [(Key, Dynamic)]
forall a. IntMap a -> [(Key, a)]
IntMap.toList IntMap Dynamic
cs)