{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

-- |
-- Module      : Aztecs.ECS.World.Archetypes
-- 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.Archetypes
  ( ArchetypeID (..),
    Node (..),
    Archetypes (..),
    empty,
    insertArchetype,
    lookupArchetypeId,
    findArchetypeIds,
    lookup,
    find,
    map,
    adjustArchetype,
    insert,
    remove,
  )
where

import Aztecs.ECS.Access.Internal
import Aztecs.ECS.Component
import Aztecs.ECS.Entity
import Aztecs.ECS.Event
import Aztecs.ECS.World.Archetype (Archetype (..))
import qualified Aztecs.ECS.World.Archetype as A
import Aztecs.ECS.World.Archetypes.Internal
import Aztecs.ECS.World.Bundle.Dynamic
import Aztecs.ECS.World.Storage.Dynamic
import Data.Dynamic
import Data.Foldable hiding (find)
import qualified Data.IntMap.Strict as IntMap
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Vector as V
import Prelude hiding (all, lookup, map)

-- | Empty `Archetypes`.
empty :: Archetypes m
empty :: forall (m :: * -> *). Archetypes m
empty =
  Archetypes
    { nodes :: Map ArchetypeID (Node m)
nodes = Map ArchetypeID (Node m)
forall a. Monoid a => a
mempty,
      archetypeIds :: Map (Set ComponentID) ArchetypeID
archetypeIds = Map (Set ComponentID) ArchetypeID
forall a. Monoid a => a
mempty,
      nextArchetypeId :: ArchetypeID
nextArchetypeId = Int -> ArchetypeID
ArchetypeID Int
0,
      componentIds :: Map ComponentID (Set ArchetypeID)
componentIds = Map ComponentID (Set ArchetypeID)
forall a. Monoid a => a
mempty
    }

-- | Insert an archetype by its set of `ComponentID`s.
insertArchetype :: Set ComponentID -> Node m -> Archetypes m -> (ArchetypeID, Archetypes m)
insertArchetype :: forall (m :: * -> *).
Set ComponentID
-> Node m -> Archetypes m -> (ArchetypeID, Archetypes m)
insertArchetype Set ComponentID
cIds Node m
n Archetypes m
arches =
  let aId :: ArchetypeID
aId = Archetypes m -> ArchetypeID
forall (m :: * -> *). Archetypes m -> ArchetypeID
nextArchetypeId Archetypes m
arches
   in ( ArchetypeID
aId,
        Archetypes m
arches
          { nodes = Map.insert aId n (nodes arches),
            archetypeIds = Map.insert cIds aId (archetypeIds arches),
            nextArchetypeId = ArchetypeID (unArchetypeId aId + 1),
            componentIds = Map.unionWith (<>) (Map.fromSet (const (Set.singleton aId)) cIds) (componentIds arches)
          }
      )

-- | Adjust an `Archetype` by its `ArchetypeID`.
adjustArchetype :: ArchetypeID -> (Archetype m -> Archetype m) -> Archetypes m -> Archetypes m
adjustArchetype :: forall (m :: * -> *).
ArchetypeID
-> (Archetype m -> Archetype m) -> Archetypes m -> Archetypes m
adjustArchetype ArchetypeID
aId Archetype m -> Archetype m
f Archetypes m
arches =
  Archetypes m
arches {nodes = Map.adjust (\Node m
node -> Node m
node {nodeArchetype = f (nodeArchetype node)}) aId (nodes arches)}

-- | Find `ArchetypeID`s containing a set of `ComponentID`s.
findArchetypeIds :: Set ComponentID -> Archetypes m -> Set ArchetypeID
findArchetypeIds :: forall (m :: * -> *).
Set ComponentID -> Archetypes m -> Set ArchetypeID
findArchetypeIds Set ComponentID
cIds Archetypes m
arches = case (ComponentID -> Maybe (Set ArchetypeID))
-> [ComponentID] -> [Set ArchetypeID]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\ComponentID
cId -> ComponentID
-> Map ComponentID (Set ArchetypeID) -> Maybe (Set ArchetypeID)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ComponentID
cId (Archetypes m -> Map ComponentID (Set ArchetypeID)
forall (m :: * -> *).
Archetypes m -> Map ComponentID (Set ArchetypeID)
componentIds Archetypes m
arches)) (Set ComponentID -> [ComponentID]
forall a. Set a -> [a]
Set.elems Set ComponentID
cIds) of
  (Set ArchetypeID
aId : [Set ArchetypeID]
aIds') -> (Set ArchetypeID -> Set ArchetypeID -> Set ArchetypeID)
-> Set ArchetypeID -> [Set ArchetypeID] -> Set ArchetypeID
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Set ArchetypeID -> Set ArchetypeID -> Set ArchetypeID
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set ArchetypeID
aId [Set ArchetypeID]
aIds'
  [] -> Set ArchetypeID
forall a. Set a
Set.empty

-- | Lookup `Archetype`s containing a set of `ComponentID`s.
find :: Set ComponentID -> Archetypes m -> Map ArchetypeID (Node m)
find :: forall (m :: * -> *).
Set ComponentID -> Archetypes m -> Map ArchetypeID (Node m)
find Set ComponentID
cIds Archetypes m
arches = (ArchetypeID -> Node m)
-> Set ArchetypeID -> Map ArchetypeID (Node m)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (\ArchetypeID
aId -> Archetypes m -> Map ArchetypeID (Node m)
forall (m :: * -> *). Archetypes m -> Map ArchetypeID (Node m)
nodes Archetypes m
arches Map ArchetypeID (Node m) -> ArchetypeID -> Node m
forall k a. Ord k => Map k a -> k -> a
Map.! ArchetypeID
aId) (Set ComponentID -> Archetypes m -> Set ArchetypeID
forall (m :: * -> *).
Set ComponentID -> Archetypes m -> Set ArchetypeID
findArchetypeIds Set ComponentID
cIds Archetypes m
arches)

-- | Map over `Archetype`s containing a set of `ComponentID`s.
map :: Set ComponentID -> (Archetype m -> (a, Archetype m)) -> Archetypes m -> ([a], Archetypes m)
map :: forall (m :: * -> *) a.
Set ComponentID
-> (Archetype m -> (a, Archetype m))
-> Archetypes m
-> ([a], Archetypes m)
map Set ComponentID
cIds Archetype m -> (a, Archetype m)
f Archetypes m
arches =
  let go :: ([a], Archetypes m) -> ArchetypeID -> ([a], Archetypes m)
go ([a]
acc, Archetypes m
archAcc) ArchetypeID
aId =
        let !node :: Node m
node = Archetypes m -> Map ArchetypeID (Node m)
forall (m :: * -> *). Archetypes m -> Map ArchetypeID (Node m)
nodes Archetypes m
archAcc Map ArchetypeID (Node m) -> ArchetypeID -> Node m
forall k a. Ord k => Map k a -> k -> a
Map.! ArchetypeID
aId
            !(a
a, Archetype m
arch') = Archetype m -> (a, Archetype m)
f (Node m -> Archetype m
forall (m :: * -> *). Node m -> Archetype m
nodeArchetype Node m
node)
            nodes' :: Map ArchetypeID (Node m)
nodes' = ArchetypeID
-> Node m -> Map ArchetypeID (Node m) -> Map ArchetypeID (Node m)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ArchetypeID
aId (Node m
node {nodeArchetype = arch'}) (Archetypes m -> Map ArchetypeID (Node m)
forall (m :: * -> *). Archetypes m -> Map ArchetypeID (Node m)
nodes Archetypes m
archAcc)
         in (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc, Archetypes m
archAcc {nodes = nodes'})
   in (([a], Archetypes m) -> ArchetypeID -> ([a], Archetypes m))
-> ([a], Archetypes m) -> Set ArchetypeID -> ([a], Archetypes m)
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([a], Archetypes m) -> ArchetypeID -> ([a], Archetypes m)
go ([], Archetypes m
arches) (Set ArchetypeID -> ([a], Archetypes m))
-> Set ArchetypeID -> ([a], Archetypes m)
forall a b. (a -> b) -> a -> b
$ Set ComponentID -> Archetypes m -> Set ArchetypeID
forall (m :: * -> *).
Set ComponentID -> Archetypes m -> Set ArchetypeID
findArchetypeIds Set ComponentID
cIds Archetypes m
arches

-- | Lookup an `ArchetypeID` by its set of `ComponentID`s.
lookupArchetypeId :: Set ComponentID -> Archetypes m -> Maybe ArchetypeID
lookupArchetypeId :: forall (m :: * -> *).
Set ComponentID -> Archetypes m -> Maybe ArchetypeID
lookupArchetypeId Set ComponentID
cIds Archetypes m
arches = Set ComponentID
-> Map (Set ComponentID) ArchetypeID -> Maybe ArchetypeID
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Set ComponentID
cIds (Archetypes m -> Map (Set ComponentID) ArchetypeID
forall (m :: * -> *).
Archetypes m -> Map (Set ComponentID) ArchetypeID
archetypeIds Archetypes m
arches)

-- | Lookup an `Archetype` by its `ArchetypeID`.
lookup :: ArchetypeID -> Archetypes m -> Maybe (Node m)
lookup :: forall (m :: * -> *). ArchetypeID -> Archetypes m -> Maybe (Node m)
lookup ArchetypeID
aId Archetypes m
arches = ArchetypeID -> Map ArchetypeID (Node m) -> Maybe (Node m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ArchetypeID
aId (Archetypes m -> Map ArchetypeID (Node m)
forall (m :: * -> *). Archetypes m -> Map ArchetypeID (Node m)
nodes Archetypes m
arches)

-- | Insert a component into an entity with its `ComponentID`.
insert ::
  (Monad m) =>
  EntityID ->
  ArchetypeID ->
  Set ComponentID ->
  DynamicBundle m ->
  Archetypes m ->
  (Maybe ArchetypeID, Archetypes m, Access m ())
insert :: forall (m :: * -> *).
Monad m =>
EntityID
-> ArchetypeID
-> Set ComponentID
-> DynamicBundle m
-> Archetypes m
-> (Maybe ArchetypeID, Archetypes m, Access m ())
insert EntityID
e ArchetypeID
aId Set ComponentID
cIds DynamicBundle m
b Archetypes m
arches = case ArchetypeID -> Archetypes m -> Maybe (Node m)
forall (m :: * -> *). ArchetypeID -> Archetypes m -> Maybe (Node m)
lookup ArchetypeID
aId Archetypes m
arches of
  Just Node m
node ->
    if Set ComponentID -> Set ComponentID -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set ComponentID
cIds (Set ComponentID -> Bool) -> Set ComponentID -> Bool
forall a b. (a -> b) -> a -> b
$ Node m -> Set ComponentID
forall (m :: * -> *). Node m -> Set ComponentID
nodeComponentIds Node m
node
      then
        let go :: Node m -> (Node m, Access m ())
go Node m
n =
              let (Archetype m
arch', Access m ()
hook) = DynamicBundle m
-> EntityID -> Archetype m -> (Archetype m, Access m ())
forall (m :: * -> *).
DynamicBundle m
-> EntityID -> Archetype m -> (Archetype m, Access m ())
runDynamicBundle DynamicBundle m
b EntityID
e (Archetype m -> (Archetype m, Access m ()))
-> Archetype m -> (Archetype m, Access m ())
forall a b. (a -> b) -> a -> b
$ Node m -> Archetype m
forall (m :: * -> *). Node m -> Archetype m
nodeArchetype Node m
n
               in (Node m
n {nodeArchetype = arch'}, Access m ()
hook)
            (Access m ()
hooks, Map ArchetypeID (Node m)
nodes') =
              (Maybe (Node m) -> (Access m (), Maybe (Node m)))
-> ArchetypeID
-> Map ArchetypeID (Node m)
-> (Access m (), Map ArchetypeID (Node m))
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
Map.alterF
                ( \Maybe (Node m)
maybeN -> case Maybe (Node m)
maybeN of
                    Just Node m
n -> let (Node m
n', Access m ()
hook) = Node m -> (Node m, Access m ())
go Node m
n in (Access m ()
hook, Node m -> Maybe (Node m)
forall a. a -> Maybe a
Just Node m
n')
                    Maybe (Node m)
Nothing -> (() -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return (), Maybe (Node m)
forall a. Maybe a
Nothing)
                )
                ArchetypeID
aId
                (Map ArchetypeID (Node m)
 -> (Access m (), Map ArchetypeID (Node m)))
-> Map ArchetypeID (Node m)
-> (Access m (), Map ArchetypeID (Node m))
forall a b. (a -> b) -> a -> b
$ Archetypes m -> Map ArchetypeID (Node m)
forall (m :: * -> *). Archetypes m -> Map ArchetypeID (Node m)
nodes Archetypes m
arches
         in (Maybe ArchetypeID
forall a. Maybe a
Nothing, Archetypes m
arches {nodes = nodes'}, Access m ()
hooks)
      else
        let cIds' :: Set ComponentID
cIds' = Set ComponentID
cIds Set ComponentID -> Set ComponentID -> Set ComponentID
forall a. Semigroup a => a -> a -> a
<> Node m -> Set ComponentID
forall (m :: * -> *). Node m -> Set ComponentID
nodeComponentIds Node m
node
         in case Set ComponentID -> Archetypes m -> Maybe ArchetypeID
forall (m :: * -> *).
Set ComponentID -> Archetypes m -> Maybe ArchetypeID
lookupArchetypeId Set ComponentID
cIds' Archetypes m
arches of
              Just ArchetypeID
nextAId ->
                let !(IntMap Dynamic
cs, Archetype m
arch) = EntityID -> Archetype m -> (IntMap Dynamic, Archetype m)
forall (m :: * -> *).
EntityID -> Archetype m -> (IntMap Dynamic, Archetype m)
A.remove EntityID
e (Archetype m -> (IntMap Dynamic, Archetype m))
-> Archetype m -> (IntMap Dynamic, Archetype m)
forall a b. (a -> b) -> a -> b
$ Node m -> Archetype m
forall (m :: * -> *). Node m -> Archetype m
nodeArchetype Node m
node
                    node' :: Node m
node' = Node m
node {nodeArchetype = arch}
                    !nodes' :: Map ArchetypeID (Node m)
nodes' = ArchetypeID
-> Node m -> Map ArchetypeID (Node m) -> Map ArchetypeID (Node m)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ArchetypeID
aId Node m
node' (Map ArchetypeID (Node m) -> Map ArchetypeID (Node m))
-> Map ArchetypeID (Node m) -> Map ArchetypeID (Node m)
forall a b. (a -> b) -> a -> b
$ Archetypes m -> Map ArchetypeID (Node m)
forall (m :: * -> *). Archetypes m -> Map ArchetypeID (Node m)
nodes Archetypes m
arches
                    adjustNode :: Node m -> (Node m, Access m ())
adjustNode Node m
nextNode =
                      let nextArch :: Archetype m
nextArch = Node m -> Archetype m
forall (m :: * -> *). Node m -> Archetype m
nodeArchetype Node m
nextNode
                          nextArch' :: Archetype m
nextArch' = Archetype m
nextArch {A.entities = Set.insert e $ A.entities nextArch}
                          !nextArch'' :: Archetype m
nextArch'' = EntityID -> IntMap Dynamic -> Archetype m -> Archetype m
forall (m :: * -> *).
EntityID -> IntMap Dynamic -> Archetype m -> Archetype m
A.insertComponents EntityID
e IntMap Dynamic
cs Archetype m
forall {m :: * -> *}. Archetype m
nextArch'
                          (Archetype m
finalArch, Access m ()
hook) = DynamicBundle m
-> EntityID -> Archetype m -> (Archetype m, Access m ())
forall (m :: * -> *).
DynamicBundle m
-> EntityID -> Archetype m -> (Archetype m, Access m ())
runDynamicBundle DynamicBundle m
b EntityID
e Archetype m
forall {m :: * -> *}. Archetype m
nextArch''
                       in (Node m
nextNode {nodeArchetype = finalArch}, Access m ()
hook)
                    (Access m ()
hooks, Map ArchetypeID (Node m)
nodes'') =
                      (Maybe (Node m) -> (Access m (), Maybe (Node m)))
-> ArchetypeID
-> Map ArchetypeID (Node m)
-> (Access m (), Map ArchetypeID (Node m))
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
Map.alterF
                        ( \Maybe (Node m)
maybeN -> case Maybe (Node m)
maybeN of
                            Just Node m
n -> let (Node m
n', Access m ()
hook) = Node m -> (Node m, Access m ())
forall {m :: * -> *}. Node m -> (Node m, Access m ())
adjustNode Node m
n in (Access m ()
hook, Node m -> Maybe (Node m)
forall a. a -> Maybe a
Just Node m
n')
                            Maybe (Node m)
Nothing -> (() -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return (), Maybe (Node m)
forall a. Maybe a
Nothing)
                        )
                        ArchetypeID
nextAId
                        Map ArchetypeID (Node m)
nodes'
                 in (ArchetypeID -> Maybe ArchetypeID
forall a. a -> Maybe a
Just ArchetypeID
nextAId, Archetypes m
arches {nodes = nodes''}, Access m ()
hooks)
              Maybe ArchetypeID
Nothing ->
                let !(IntMap DynamicStorage
s, Archetype m
arch) = EntityID -> Archetype m -> (IntMap DynamicStorage, Archetype m)
forall (m :: * -> *).
EntityID -> Archetype m -> (IntMap DynamicStorage, Archetype m)
A.removeStorages EntityID
e (Archetype m -> (IntMap DynamicStorage, Archetype m))
-> Archetype m -> (IntMap DynamicStorage, Archetype m)
forall a b. (a -> b) -> a -> b
$ Node m -> Archetype m
forall (m :: * -> *). Node m -> Archetype m
nodeArchetype Node m
node
                    nodes' :: Map ArchetypeID (Node m)
nodes' = ArchetypeID
-> Node m -> Map ArchetypeID (Node m) -> Map ArchetypeID (Node m)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ArchetypeID
aId Node m
node {nodeArchetype = arch} (Map ArchetypeID (Node m) -> Map ArchetypeID (Node m))
-> Map ArchetypeID (Node m) -> Map ArchetypeID (Node m)
forall a b. (a -> b) -> a -> b
$ Archetypes m -> Map ArchetypeID (Node m)
forall (m :: * -> *). Archetypes m -> Map ArchetypeID (Node m)
nodes Archetypes m
arches
                    (Archetype m
nextArch, Access m ()
hook) = DynamicBundle m
-> EntityID -> Archetype m -> (Archetype m, Access m ())
forall (m :: * -> *).
DynamicBundle m
-> EntityID -> Archetype m -> (Archetype m, Access m ())
runDynamicBundle DynamicBundle m
b EntityID
e Archetype {storages :: IntMap DynamicStorage
storages = IntMap DynamicStorage
s, entities :: Set EntityID
entities = EntityID -> Set EntityID
forall a. a -> Set a
Set.singleton EntityID
e}
                    !n :: Node m
n = Node {nodeComponentIds :: Set ComponentID
nodeComponentIds = Set ComponentID
cIds', nodeArchetype :: Archetype m
nodeArchetype = Archetype m
nextArch}
                    !(ArchetypeID
nextAId, Archetypes m
arches') = Set ComponentID
-> Node m -> Archetypes m -> (ArchetypeID, Archetypes m)
forall (m :: * -> *).
Set ComponentID
-> Node m -> Archetypes m -> (ArchetypeID, Archetypes m)
insertArchetype Set ComponentID
cIds' Node m
n Archetypes m
arches {nodes = nodes'}
                 in (ArchetypeID -> Maybe ArchetypeID
forall a. a -> Maybe a
Just ArchetypeID
nextAId, Archetypes m
arches', Access m ()
hook)
  Maybe (Node m)
Nothing -> (Maybe ArchetypeID
forall a. Maybe a
Nothing, Archetypes m
arches, () -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Remove a component from an entity with its `ComponentID`.
remove ::
  (Component m a) =>
  EntityID ->
  ArchetypeID ->
  ComponentID ->
  Archetypes m ->
  (Maybe (a, ArchetypeID), Archetypes m, Access m ())
remove :: forall (m :: * -> *) a.
Component m a =>
EntityID
-> ArchetypeID
-> ComponentID
-> Archetypes m
-> (Maybe (a, ArchetypeID), Archetypes m, Access m ())
remove EntityID
e ArchetypeID
aId ComponentID
cId Archetypes m
arches = case ArchetypeID -> Archetypes m -> Maybe (Node m)
forall (m :: * -> *). ArchetypeID -> Archetypes m -> Maybe (Node m)
lookup ArchetypeID
aId Archetypes m
arches of
  Just Node m
node -> case Set ComponentID -> Archetypes m -> Maybe ArchetypeID
forall (m :: * -> *).
Set ComponentID -> Archetypes m -> Maybe ArchetypeID
lookupArchetypeId (ComponentID -> Set ComponentID -> Set ComponentID
forall a. Ord a => a -> Set a -> Set a
Set.delete ComponentID
cId (Node m -> Set ComponentID
forall (m :: * -> *). Node m -> Set ComponentID
nodeComponentIds Node m
node)) Archetypes m
arches of
    Just ArchetypeID
nextAId ->
      let !(IntMap Dynamic
cs, Archetype m
arch') = EntityID -> Archetype m -> (IntMap Dynamic, Archetype m)
forall (m :: * -> *).
EntityID -> Archetype m -> (IntMap Dynamic, Archetype m)
A.remove EntityID
e (Node m -> Archetype m
forall (m :: * -> *). Node m -> Archetype m
nodeArchetype Node m
node)
          !arches' :: Archetypes m
arches' = Archetypes m
arches {nodes = Map.insert aId node {nodeArchetype = arch'} (nodes arches)}
          (Maybe Dynamic
a, IntMap Dynamic
cs') = (Int -> Dynamic -> Maybe Dynamic)
-> Int -> IntMap Dynamic -> (Maybe Dynamic, IntMap Dynamic)
forall a.
(Int -> a -> Maybe a) -> Int -> IntMap a -> (Maybe a, IntMap a)
IntMap.updateLookupWithKey (\Int
_ Dynamic
_ -> Maybe Dynamic
forall a. Maybe a
Nothing) (ComponentID -> Int
unComponentId ComponentID
cId) IntMap Dynamic
cs
          go' :: Archetype m -> (Int, Dynamic) -> Archetype m
go' Archetype m
archAcc (Int
itemCId, Dynamic
dyn) =
            let adjustStorage :: DynamicStorage -> DynamicStorage
adjustStorage DynamicStorage
s = Vector Dynamic -> DynamicStorage -> DynamicStorage
fromAscVectorDyn ([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 (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) ([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) DynamicStorage
s
             in Archetype m
archAcc {storages = IntMap.adjust adjustStorage itemCId (storages archAcc)}
          go :: Node m -> Node m
go Node m
nextNode =
            Node m
nextNode {nodeArchetype = foldl' go' (nodeArchetype nextNode) (IntMap.toList cs')}
          maybeA :: Maybe a
maybeA = Maybe Dynamic
a Maybe Dynamic -> (Dynamic -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Dynamic -> Maybe a
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic
          hook :: Access m ()
hook = Access m () -> (a -> Access m ()) -> Maybe a -> Access m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\a
comp -> EntityID -> a -> Access m ()
forall (m :: * -> *) a.
Component m a =>
EntityID -> a -> Access m ()
componentOnRemove EntityID
e a
comp 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 -> OnRemove a -> Access m ()
forall (m :: * -> *) e.
(Monad m, Event e) =>
EntityID -> e -> Access m ()
triggerEntityEvent EntityID
e (a -> OnRemove a
forall a. a -> OnRemove a
OnRemove a
comp)) Maybe a
maybeA
       in ( (,ArchetypeID
nextAId) (a -> (a, ArchetypeID)) -> Maybe a -> Maybe (a, ArchetypeID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
maybeA,
            Archetypes m
arches' {nodes = Map.adjust go nextAId (nodes arches')},
            Access m ()
hook
          )
    Maybe ArchetypeID
Nothing ->
      let !(IntMap DynamicStorage
cs, Archetype m
arch') = EntityID -> Archetype m -> (IntMap DynamicStorage, Archetype m)
forall (m :: * -> *).
EntityID -> Archetype m -> (IntMap DynamicStorage, Archetype m)
A.removeStorages EntityID
e (Node m -> Archetype m
forall (m :: * -> *). Node m -> Archetype m
nodeArchetype Node m
node)
          (Maybe DynamicStorage
a, IntMap DynamicStorage
cs') = (Int -> DynamicStorage -> Maybe DynamicStorage)
-> Int
-> IntMap DynamicStorage
-> (Maybe DynamicStorage, IntMap DynamicStorage)
forall a.
(Int -> a -> Maybe a) -> Int -> IntMap a -> (Maybe a, IntMap a)
IntMap.updateLookupWithKey (\Int
_ DynamicStorage
_ -> Maybe DynamicStorage
forall a. Maybe a
Nothing) (ComponentID -> Int
unComponentId ComponentID
cId) IntMap DynamicStorage
cs
          destCIds :: Set ComponentID
destCIds = ComponentID -> Set ComponentID -> Set ComponentID
forall a. Ord a => a -> Set a -> Set a
Set.delete ComponentID
cId (Node m -> Set ComponentID
forall (m :: * -> *). Node m -> Set ComponentID
nodeComponentIds Node m
node)
          !n :: Node m
n =
            Node
              { nodeComponentIds :: Set ComponentID
nodeComponentIds = Set ComponentID
destCIds,
                nodeArchetype :: Archetype m
nodeArchetype = Archetype {storages :: IntMap DynamicStorage
storages = IntMap DynamicStorage
cs', entities :: Set EntityID
entities = EntityID -> Set EntityID
forall a. a -> Set a
Set.singleton EntityID
e}
              }
          !(ArchetypeID
nextAId, Archetypes m
arches') = Set ComponentID
-> Node m -> Archetypes m -> (ArchetypeID, Archetypes m)
forall (m :: * -> *).
Set ComponentID
-> Node m -> Archetypes m -> (ArchetypeID, Archetypes m)
insertArchetype Set ComponentID
destCIds Node m
forall {m :: * -> *}. Node m
n Archetypes m
arches
          node' :: Node m
node' = Node m
node {nodeArchetype = arch'}
          maybeA :: Maybe a
maybeA = Maybe DynamicStorage
a Maybe DynamicStorage -> (DynamicStorage -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\DynamicStorage
dynS -> Vector Dynamic -> Maybe Dynamic
forall (m :: * -> *) a. Monad m => Vector a -> m a
V.headM (DynamicStorage -> Vector Dynamic
toAscVectorDyn DynamicStorage
dynS) Maybe Dynamic -> (Dynamic -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Dynamic -> Maybe a
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic)
          hook :: Access m ()
hook = Access m () -> (a -> Access m ()) -> Maybe a -> Access m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\a
comp -> EntityID -> a -> Access m ()
forall (m :: * -> *) a.
Component m a =>
EntityID -> a -> Access m ()
componentOnRemove EntityID
e a
comp 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 -> OnRemove a -> Access m ()
forall (m :: * -> *) e.
(Monad m, Event e) =>
EntityID -> e -> Access m ()
triggerEntityEvent EntityID
e (a -> OnRemove a
forall a. a -> OnRemove a
OnRemove a
comp)) Maybe a
maybeA
       in ( (,ArchetypeID
nextAId) (a -> (a, ArchetypeID)) -> Maybe a -> Maybe (a, ArchetypeID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
maybeA,
            Archetypes m
arches' {nodes = Map.insert aId node' (nodes arches')},
            Access m ()
hook
          )
  Maybe (Node m)
Nothing -> (Maybe (a, ArchetypeID)
forall a. Maybe a
Nothing, Archetypes m
arches, () -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())