{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}

-- |

-- 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,
    adjustArchetype,
    insert,
    remove,
  )
where

import Aztecs.ECS.Component
import Aztecs.ECS.Entity
import Aztecs.ECS.World.Archetype (Archetype (..))
import qualified Aztecs.ECS.World.Archetype as A
import Aztecs.ECS.World.Bundle.Dynamic
import Aztecs.ECS.World.Storage.Dynamic
import Control.DeepSeq (NFData (..))
import Data.Dynamic
import Data.Foldable (foldl')
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 GHC.Generics
import Prelude hiding (all, lookup, map)

-- | `Archetype` ID.

--

-- @since 0.9

newtype ArchetypeID = ArchetypeID
  { -- | Unique integer identifier.

    --

    -- @since 0.9

    ArchetypeID -> Int
unArchetypeId :: Int
  }
  deriving newtype (ArchetypeID -> ArchetypeID -> Bool
(ArchetypeID -> ArchetypeID -> Bool)
-> (ArchetypeID -> ArchetypeID -> Bool) -> Eq ArchetypeID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArchetypeID -> ArchetypeID -> Bool
== :: ArchetypeID -> ArchetypeID -> Bool
$c/= :: ArchetypeID -> ArchetypeID -> Bool
/= :: ArchetypeID -> ArchetypeID -> Bool
Eq, Eq ArchetypeID
Eq ArchetypeID =>
(ArchetypeID -> ArchetypeID -> Ordering)
-> (ArchetypeID -> ArchetypeID -> Bool)
-> (ArchetypeID -> ArchetypeID -> Bool)
-> (ArchetypeID -> ArchetypeID -> Bool)
-> (ArchetypeID -> ArchetypeID -> Bool)
-> (ArchetypeID -> ArchetypeID -> ArchetypeID)
-> (ArchetypeID -> ArchetypeID -> ArchetypeID)
-> Ord ArchetypeID
ArchetypeID -> ArchetypeID -> Bool
ArchetypeID -> ArchetypeID -> Ordering
ArchetypeID -> ArchetypeID -> ArchetypeID
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ArchetypeID -> ArchetypeID -> Ordering
compare :: ArchetypeID -> ArchetypeID -> Ordering
$c< :: ArchetypeID -> ArchetypeID -> Bool
< :: ArchetypeID -> ArchetypeID -> Bool
$c<= :: ArchetypeID -> ArchetypeID -> Bool
<= :: ArchetypeID -> ArchetypeID -> Bool
$c> :: ArchetypeID -> ArchetypeID -> Bool
> :: ArchetypeID -> ArchetypeID -> Bool
$c>= :: ArchetypeID -> ArchetypeID -> Bool
>= :: ArchetypeID -> ArchetypeID -> Bool
$cmax :: ArchetypeID -> ArchetypeID -> ArchetypeID
max :: ArchetypeID -> ArchetypeID -> ArchetypeID
$cmin :: ArchetypeID -> ArchetypeID -> ArchetypeID
min :: ArchetypeID -> ArchetypeID -> ArchetypeID
Ord, Int -> ArchetypeID -> ShowS
[ArchetypeID] -> ShowS
ArchetypeID -> String
(Int -> ArchetypeID -> ShowS)
-> (ArchetypeID -> String)
-> ([ArchetypeID] -> ShowS)
-> Show ArchetypeID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArchetypeID -> ShowS
showsPrec :: Int -> ArchetypeID -> ShowS
$cshow :: ArchetypeID -> String
show :: ArchetypeID -> String
$cshowList :: [ArchetypeID] -> ShowS
showList :: [ArchetypeID] -> ShowS
Show, ArchetypeID -> ()
(ArchetypeID -> ()) -> NFData ArchetypeID
forall a. (a -> ()) -> NFData a
$crnf :: ArchetypeID -> ()
rnf :: ArchetypeID -> ()
NFData)

-- | Node in `Archetypes`.

--

-- @since 0.9

data Node = Node
  { -- | Unique set of `ComponentID`s of this `Node`.

    --

    -- @since 0.9

    Node -> Set ComponentID
nodeComponentIds :: !(Set ComponentID),
    -- | `Archetype` of this `Node`.

    --

    -- @since 0.9

    Node -> Archetype
nodeArchetype :: !Archetype
  }
  deriving (Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Node -> ShowS
showsPrec :: Int -> Node -> ShowS
$cshow :: Node -> String
show :: Node -> String
$cshowList :: [Node] -> ShowS
showList :: [Node] -> ShowS
Show, (forall x. Node -> Rep Node x)
-> (forall x. Rep Node x -> Node) -> Generic Node
forall x. Rep Node x -> Node
forall x. Node -> Rep Node x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Node -> Rep Node x
from :: forall x. Node -> Rep Node x
$cto :: forall x. Rep Node x -> Node
to :: forall x. Rep Node x -> Node
Generic, Node -> ()
(Node -> ()) -> NFData Node
forall a. (a -> ()) -> NFData a
$crnf :: Node -> ()
rnf :: Node -> ()
NFData)

-- | `Archetype` map.

data Archetypes = Archetypes
  { -- | Archetype nodes in the map.

    --

    -- @since 0.9

    Archetypes -> Map ArchetypeID Node
nodes :: !(Map ArchetypeID Node),
    -- | Mapping of unique `ComponentID` sets to `ArchetypeID`s.

    --

    -- @since 0.9

    Archetypes -> Map (Set ComponentID) ArchetypeID
archetypeIds :: !(Map (Set ComponentID) ArchetypeID),
    -- | Next unique `ArchetypeID`.

    --

    -- @since 0.9

    Archetypes -> ArchetypeID
nextArchetypeId :: !ArchetypeID,
    -- | Mapping of `ComponentID`s to `ArchetypeID`s of `Archetypes` that contain them.

    --

    -- @since 0.9

    Archetypes -> Map ComponentID (Set ArchetypeID)
componentIds :: !(Map ComponentID (Set ArchetypeID))
  }
  deriving (Int -> Archetypes -> ShowS
[Archetypes] -> ShowS
Archetypes -> String
(Int -> Archetypes -> ShowS)
-> (Archetypes -> String)
-> ([Archetypes] -> ShowS)
-> Show Archetypes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Archetypes -> ShowS
showsPrec :: Int -> Archetypes -> ShowS
$cshow :: Archetypes -> String
show :: Archetypes -> String
$cshowList :: [Archetypes] -> ShowS
showList :: [Archetypes] -> ShowS
Show, (forall x. Archetypes -> Rep Archetypes x)
-> (forall x. Rep Archetypes x -> Archetypes) -> Generic Archetypes
forall x. Rep Archetypes x -> Archetypes
forall x. Archetypes -> Rep Archetypes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Archetypes -> Rep Archetypes x
from :: forall x. Archetypes -> Rep Archetypes x
$cto :: forall x. Rep Archetypes x -> Archetypes
to :: forall x. Rep Archetypes x -> Archetypes
Generic, Archetypes -> ()
(Archetypes -> ()) -> NFData Archetypes
forall a. (a -> ()) -> NFData a
$crnf :: Archetypes -> ()
rnf :: Archetypes -> ()
NFData)

-- | Empty `Archetypes`.

--

-- @since 0.9

empty :: Archetypes
empty :: Archetypes
empty =
  Archetypes
    { nodes :: Map ArchetypeID Node
nodes = Map ArchetypeID Node
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.

--

-- @since 0.9

insertArchetype :: Set ComponentID -> Node -> Archetypes -> (ArchetypeID, Archetypes)
insertArchetype :: Set ComponentID -> Node -> Archetypes -> (ArchetypeID, Archetypes)
insertArchetype Set ComponentID
cIds Node
n Archetypes
arches =
  let aId :: ArchetypeID
aId = Archetypes -> ArchetypeID
nextArchetypeId Archetypes
arches
   in ( ArchetypeID
aId,
        Archetypes
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`.

--

-- @since 0.9

adjustArchetype :: ArchetypeID -> (Archetype -> Archetype) -> Archetypes -> Archetypes
adjustArchetype :: ArchetypeID -> (Archetype -> Archetype) -> Archetypes -> Archetypes
adjustArchetype ArchetypeID
aId Archetype -> Archetype
f Archetypes
arches =
  Archetypes
arches {nodes = Map.adjust (\Node
node -> Node
node {nodeArchetype = f (nodeArchetype node)}) aId (nodes arches)}

-- | Find `ArchetypeID`s containing a set of `ComponentID`s.

--

-- @since 0.11

findArchetypeIds :: Set ComponentID -> Set ComponentID -> Archetypes -> Set ArchetypeID
findArchetypeIds :: Set ComponentID -> Set ComponentID -> Archetypes -> Set ArchetypeID
findArchetypeIds Set ComponentID
w Set ComponentID
wo Archetypes
arches =
  let !withIds :: [Set ArchetypeID]
withIds = (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 -> Map ComponentID (Set ArchetypeID)
componentIds Archetypes
arches)) (Set ComponentID -> [ComponentID]
forall a. Set a -> [a]
Set.elems Set ComponentID
w)
      !withoutIds :: [Set ArchetypeID]
withoutIds = (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 -> Map ComponentID (Set ArchetypeID)
componentIds Archetypes
arches)) (Set ComponentID -> [ComponentID]
forall a. Set a -> [a]
Set.elems Set ComponentID
wo)
      !withoutSet :: Set ArchetypeID
withoutSet = (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.union Set ArchetypeID
forall a. Set a
Set.empty [Set ArchetypeID]
withoutIds
   in case [Set ArchetypeID]
withIds 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 -> Set ArchetypeID -> Set ArchetypeID
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set ArchetypeID
withoutSet
        [] -> Set ArchetypeID
forall a. Set a
Set.empty

-- | Lookup `Archetype`s containing a set of `ComponentID`s.

--

-- @since 0.9

find :: Set ComponentID -> Set ComponentID -> Archetypes -> Map ArchetypeID Node
find :: Set ComponentID
-> Set ComponentID -> Archetypes -> Map ArchetypeID Node
find Set ComponentID
w Set ComponentID
wo Archetypes
arches = (ArchetypeID -> Node) -> Set ArchetypeID -> Map ArchetypeID Node
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (\ArchetypeID
aId -> Archetypes -> Map ArchetypeID Node
nodes Archetypes
arches Map ArchetypeID Node -> ArchetypeID -> Node
forall k a. Ord k => Map k a -> k -> a
Map.! ArchetypeID
aId) (Set ComponentID -> Set ComponentID -> Archetypes -> Set ArchetypeID
findArchetypeIds Set ComponentID
w Set ComponentID
wo Archetypes
arches)

-- | Lookup an `ArchetypeID` by its set of `ComponentID`s.

--

-- @since 0.9

lookupArchetypeId :: Set ComponentID -> Archetypes -> Maybe ArchetypeID
lookupArchetypeId :: Set ComponentID -> Archetypes -> Maybe ArchetypeID
lookupArchetypeId Set ComponentID
cIds Archetypes
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 -> Map (Set ComponentID) ArchetypeID
archetypeIds Archetypes
arches)

-- | Lookup an `Archetype` by its `ArchetypeID`.

--

-- @since 0.9

lookup :: ArchetypeID -> Archetypes -> Maybe Node
lookup :: ArchetypeID -> Archetypes -> Maybe Node
lookup ArchetypeID
aId Archetypes
arches = ArchetypeID -> Map ArchetypeID Node -> Maybe Node
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ArchetypeID
aId (Archetypes -> Map ArchetypeID Node
nodes Archetypes
arches)

-- | Insert a component into an entity with its `ComponentID`.

--

-- @since 0.9

insert ::
  EntityID ->
  ArchetypeID ->
  Set ComponentID ->
  DynamicBundle ->
  Archetypes ->
  (Maybe ArchetypeID, Archetypes)
insert :: EntityID
-> ArchetypeID
-> Set ComponentID
-> DynamicBundle
-> Archetypes
-> (Maybe ArchetypeID, Archetypes)
insert EntityID
e ArchetypeID
aId Set ComponentID
cIds DynamicBundle
b Archetypes
arches = case ArchetypeID -> Archetypes -> Maybe Node
lookup ArchetypeID
aId Archetypes
arches of
  Just Node
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 -> Set ComponentID
nodeComponentIds Node
node
      then
        let go :: Node -> Node
go Node
n = Node
n {nodeArchetype = runDynamicBundle b e $ nodeArchetype n}
         in (Maybe ArchetypeID
forall a. Maybe a
Nothing, Archetypes
arches {nodes = Map.adjust go aId $ nodes arches})
      else
        let cIds' :: Set ComponentID
cIds' = Set ComponentID
cIds Set ComponentID -> Set ComponentID -> Set ComponentID
forall a. Semigroup a => a -> a -> a
<> Node -> Set ComponentID
nodeComponentIds Node
node
         in case Set ComponentID -> Archetypes -> Maybe ArchetypeID
lookupArchetypeId Set ComponentID
cIds' Archetypes
arches of
              Just ArchetypeID
nextAId ->
                let !(IntMap Dynamic
cs, Archetype
arch) = EntityID -> Archetype -> (IntMap Dynamic, Archetype)
A.remove EntityID
e (Archetype -> (IntMap Dynamic, Archetype))
-> Archetype -> (IntMap Dynamic, Archetype)
forall a b. (a -> b) -> a -> b
$ Node -> Archetype
nodeArchetype Node
node
                    node' :: Node
node' = Node
node {nodeArchetype = arch}
                    !nodes' :: Map ArchetypeID Node
nodes' = ArchetypeID -> Node -> Map ArchetypeID Node -> Map ArchetypeID Node
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ArchetypeID
aId Node
node' (Map ArchetypeID Node -> Map ArchetypeID Node)
-> Map ArchetypeID Node -> Map ArchetypeID Node
forall a b. (a -> b) -> a -> b
$ Archetypes -> Map ArchetypeID Node
nodes Archetypes
arches
                    adjustNode :: Node -> Node
adjustNode Node
nextNode =
                      let nextArch :: Archetype
nextArch = Node -> Archetype
nodeArchetype Node
nextNode
                          nextArch' :: Archetype
nextArch' = Archetype
nextArch {A.entities = Set.insert e $ A.entities nextArch}
                          !nextArch'' :: Archetype
nextArch'' = EntityID -> IntMap Dynamic -> Archetype -> Archetype
A.insertComponents EntityID
e IntMap Dynamic
cs Archetype
nextArch'
                       in Node
nextNode {nodeArchetype = runDynamicBundle b e nextArch''}
                 in (ArchetypeID -> Maybe ArchetypeID
forall a. a -> Maybe a
Just ArchetypeID
nextAId, Archetypes
arches {nodes = Map.adjust adjustNode nextAId nodes'})
              Maybe ArchetypeID
Nothing ->
                let !(IntMap DynamicStorage
s, Archetype
arch) = EntityID -> Archetype -> (IntMap DynamicStorage, Archetype)
A.removeStorages EntityID
e (Archetype -> (IntMap DynamicStorage, Archetype))
-> Archetype -> (IntMap DynamicStorage, Archetype)
forall a b. (a -> b) -> a -> b
$ Node -> Archetype
nodeArchetype Node
node
                    nodes' :: Map ArchetypeID Node
nodes' = ArchetypeID -> Node -> Map ArchetypeID Node -> Map ArchetypeID Node
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ArchetypeID
aId Node
node {nodeArchetype = arch} (Map ArchetypeID Node -> Map ArchetypeID Node)
-> Map ArchetypeID Node -> Map ArchetypeID Node
forall a b. (a -> b) -> a -> b
$ Archetypes -> Map ArchetypeID Node
nodes Archetypes
arches
                    !nextArch :: Archetype
nextArch = DynamicBundle -> EntityID -> Archetype -> Archetype
runDynamicBundle DynamicBundle
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
n = Node {nodeComponentIds :: Set ComponentID
nodeComponentIds = Set ComponentID
cIds', nodeArchetype :: Archetype
nodeArchetype = Archetype
nextArch}
                    !(ArchetypeID
nextAId, Archetypes
arches') = Set ComponentID -> Node -> Archetypes -> (ArchetypeID, Archetypes)
insertArchetype Set ComponentID
cIds' Node
n Archetypes
arches {nodes = nodes'}
                 in (ArchetypeID -> Maybe ArchetypeID
forall a. a -> Maybe a
Just ArchetypeID
nextAId, Archetypes
arches')
  Maybe Node
Nothing -> (Maybe ArchetypeID
forall a. Maybe a
Nothing, Archetypes
arches)

-- | Remove a component from an entity with its `ComponentID`.

--

-- @since 0.9

remove ::
  (Component a) =>
  EntityID ->
  ArchetypeID ->
  ComponentID ->
  Archetypes ->
  (Maybe (a, ArchetypeID), Archetypes)
remove :: forall a.
Component a =>
EntityID
-> ArchetypeID
-> ComponentID
-> Archetypes
-> (Maybe (a, ArchetypeID), Archetypes)
remove EntityID
e ArchetypeID
aId ComponentID
cId Archetypes
arches = case ArchetypeID -> Archetypes -> Maybe Node
lookup ArchetypeID
aId Archetypes
arches of
  Just Node
node -> case Set ComponentID -> Archetypes -> Maybe ArchetypeID
lookupArchetypeId (ComponentID -> Set ComponentID -> Set ComponentID
forall a. Ord a => a -> Set a -> Set a
Set.delete ComponentID
cId (Node -> Set ComponentID
nodeComponentIds Node
node)) Archetypes
arches of
    Just ArchetypeID
nextAId ->
      let !(IntMap Dynamic
cs, Archetype
arch') = EntityID -> Archetype -> (IntMap Dynamic, Archetype)
A.remove EntityID
e (Node -> Archetype
nodeArchetype Node
node)
          !arches' :: Archetypes
arches' = Archetypes
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 -> (Int, Dynamic) -> Archetype
go' Archetype
archAcc (Int
itemCId, Dynamic
dyn) =
            let adjustStorage :: DynamicStorage -> DynamicStorage
adjustStorage DynamicStorage
s = [Dynamic] -> DynamicStorage -> DynamicStorage
fromAscListDyn (Map EntityID Dynamic -> [Dynamic]
forall k a. Map k a -> [a]
Map.elems (Map EntityID Dynamic -> [Dynamic])
-> ([Dynamic] -> Map EntityID Dynamic) -> [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)
-> ([Dynamic] -> Map EntityID Dynamic)
-> [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)
-> ([Dynamic] -> [(EntityID, Dynamic)])
-> [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 -> Set EntityID
entities Archetype
archAcc) ([Dynamic] -> [Dynamic]) -> [Dynamic] -> [Dynamic]
forall a b. (a -> b) -> a -> b
$ DynamicStorage -> [Dynamic]
toAscListDyn DynamicStorage
s) DynamicStorage
s
             in Archetype
archAcc {storages = IntMap.adjust adjustStorage itemCId (storages archAcc)}
          go :: Node -> Node
go Node
nextNode =
            Node
nextNode {nodeArchetype = foldl' go' (nodeArchetype nextNode) (IntMap.toList cs')}
       in ( (,ArchetypeID
nextAId) (a -> (a, ArchetypeID)) -> Maybe a -> Maybe (a, ArchetypeID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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),
            Archetypes
arches' {nodes = Map.adjust go nextAId (nodes arches')}
          )
    Maybe ArchetypeID
Nothing ->
      let !(IntMap DynamicStorage
cs, Archetype
arch') = EntityID -> Archetype -> (IntMap DynamicStorage, Archetype)
A.removeStorages EntityID
e (Node -> Archetype
nodeArchetype Node
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
          !n :: Node
n =
            Node
              { nodeComponentIds :: Set ComponentID
nodeComponentIds = ComponentID -> Set ComponentID -> Set ComponentID
forall a. Ord a => a -> Set a -> Set a
Set.insert ComponentID
cId (Node -> Set ComponentID
nodeComponentIds Node
node),
                nodeArchetype :: Archetype
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
arches') = Set ComponentID -> Node -> Archetypes -> (ArchetypeID, Archetypes)
insertArchetype (ComponentID -> Set ComponentID -> Set ComponentID
forall a. Ord a => a -> Set a -> Set a
Set.insert ComponentID
cId (Node -> Set ComponentID
nodeComponentIds Node
node)) Node
n Archetypes
arches
          node' :: Node
node' = Node
node {nodeArchetype = arch'}
          removeDyn :: DynamicStorage -> (Maybe Dynamic, DynamicStorage -> DynamicStorage)
removeDyn DynamicStorage
s =
            let (Maybe Dynamic
res, Map EntityID Dynamic
dyns) = (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 -> (Maybe Dynamic, Map EntityID Dynamic))
-> ([Dynamic] -> Map EntityID Dynamic)
-> [Dynamic]
-> (Maybe 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)
-> ([Dynamic] -> [(EntityID, Dynamic)])
-> [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 -> Set EntityID
entities Archetype
arch') ([Dynamic] -> (Maybe Dynamic, Map EntityID Dynamic))
-> [Dynamic] -> (Maybe Dynamic, Map EntityID Dynamic)
forall a b. (a -> b) -> a -> b
$ DynamicStorage -> [Dynamic]
toAscListDyn DynamicStorage
s
             in (Maybe Dynamic
res, [Dynamic] -> DynamicStorage -> DynamicStorage
fromAscListDyn ([Dynamic] -> DynamicStorage -> DynamicStorage)
-> [Dynamic] -> DynamicStorage -> DynamicStorage
forall a b. (a -> b) -> a -> b
$ Map EntityID Dynamic -> [Dynamic]
forall k a. Map k a -> [a]
Map.elems Map EntityID Dynamic
dyns)
       in ( (,ArchetypeID
nextAId) (a -> (a, ArchetypeID)) -> Maybe a -> Maybe (a, ArchetypeID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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
a' -> (Maybe Dynamic, DynamicStorage -> DynamicStorage) -> Maybe Dynamic
forall a b. (a, b) -> a
fst (DynamicStorage -> (Maybe Dynamic, DynamicStorage -> DynamicStorage)
removeDyn DynamicStorage
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)),
            Archetypes
arches' {nodes = Map.insert aId node' (nodes arches')}
          )
  Maybe Node
Nothing -> (Maybe (a, ArchetypeID)
forall a. Maybe a
Nothing, Archetypes
arches)