aztecs 0.16.1 → 0.17.0

raw patch · 15 files changed

+1423/−1454 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• aztecs.cabal +1/−1
• src/Aztecs.hs +8/−7
• src/Aztecs/ECS/Access.hs +110/−110
• src/Aztecs/ECS/Access/Internal.hs +76/−76
• src/Aztecs/ECS/Observer.hs +102/−102
• src/Aztecs/ECS/Query/Dynamic.hs +288/−288
• src/Aztecs/ECS/System/Dynamic.hs +145/−145
• src/Aztecs/ECS/World.hs +89/−89
• src/Aztecs/ECS/World/Archetype/Internal.hs +41/−41
• src/Aztecs/ECS/World/Archetypes.hs +204/−204
• src/Aztecs/ECS/World/Bundle/Dynamic.hs +39/−39
• src/Aztecs/ECS/World/Entities.hs +187/−187
• src/Aztecs/ECS/World/Internal.hs +26/−26
• src/Aztecs/ECS/World/Storage/Dynamic.hs +70/−70
• src/Aztecs/Hierarchy.hs +37/−69

@@ -1,6 +1,6 @@ cabal-version: 2.4
 name:          aztecs
-version:       0.16.1
+version:       0.17.0
 license:       BSD-3-Clause
 license-file:  LICENSE
 maintainer:    matt@hunzinger.me

@@ -1,7 +1,8 @@--- | Aztecs is a type-safe and friendly ECS for games and more.------ An ECS is a modern approach to organizing your application state as a database,--- providing patterns for data-oriented design and parallel processing.-module Aztecs (module Aztecs.ECS) where--import Aztecs.ECS+-- | Aztecs is a type-safe and friendly ECS for games and more.
+--
+-- An ECS is a modern approach to organizing your application state as a database,
+-- providing patterns for data-oriented design and parallel processing.
+module Aztecs (module Aztecs.ECS, module Aztecs.Hierarchy) where
+
+import Aztecs.ECS
+import Aztecs.Hierarchy

@@ -1,110 +1,110 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeSynonymInstances #-}---- |--- Module      : Aztecs.ECS.Access--- 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.Access-  ( Access (..),-    runAccess,-    runAccess_,-    spawn,-    spawn_,-    insert,-    insertUntracked,-    lookup,-    remove,-    despawn,-    system,-    triggerEvent,-    triggerEntityEvent,-  )-where--import Aztecs.ECS.Access.Internal-import Aztecs.ECS.Component-import Aztecs.ECS.Entity-import Aztecs.ECS.System (System (..))-import qualified Aztecs.ECS.System as S-import Aztecs.ECS.World (World)-import qualified Aztecs.ECS.World as W-import Aztecs.ECS.World.Bundle-import qualified Aztecs.ECS.World.Entities as E-import Control.Monad-import Control.Monad.State-import Prelude hiding (all, filter, lookup, map, mapM)---- | Run an `Access` on a `World`, returning the output and updated `World`.-runAccess :: (Functor m) => Access m a -> World m -> m (a, World m)-runAccess a = runStateT $ unAccess a---- | Run an `Access` on an empty `World`.-runAccess_ :: (Monad m) => Access m a -> m a-runAccess_ a = fmap fst . runAccess a $ W.empty--spawn :: (Monad m) => BundleT m -> Access m EntityID-spawn b = Access $ do-  !w <- get-  let (e, w', hook) = W.spawn b w-  put w'-  unAccess hook-  return e--spawn_ :: (Monad m) => BundleT m -> Access m ()-spawn_ = void . spawn--insert :: (Monad m) => EntityID -> BundleT m -> Access m ()-insert e c = Access $ do-  !w <- get-  let (w', hook) = W.insert e c w-  put w'-  unAccess hook---- | Insert a component into an entity without running lifecycle hooks.-insertUntracked :: (Monad m) => EntityID -> BundleT m -> Access m ()-insertUntracked e c = Access $ do-  !w <- get-  let w' = W.insertUntracked e c w-  put w'--lookup :: forall m a. (Monad m, Component m a) => EntityID -> Access m (Maybe a)-lookup e = Access $ do-  !w <- get-  return $ W.lookup @m e w--remove :: forall m a. (Monad m, Component m a) => EntityID -> Access m (Maybe a)-remove e = Access $ do-  !w <- get-  let (a, w', hook) = W.remove @m e w-  put w'-  unAccess hook-  return a--despawn :: (Monad m) => EntityID -> Access m ()-despawn e = Access $ do-  !w <- get-  let !(_, w') = W.despawn e w-  put w'---- | Run a `System` on the `World`.-system :: (Monad m) => System m a -> Access m a-system sys = Access $ do-  !w <- get-  let !es = W.entities w-      !(cs', dynSys) = S.runSystem sys $ E.components es-  (a, es', hook) <- lift $ S.runDynamicSystem dynSys es-  put w {W.entities = es' {E.components = cs'}}-  unAccess hook-  return a-{-# INLINE system #-}+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+-- |
+-- Module      : Aztecs.ECS.Access
+-- 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.Access
+  ( Access (..),
+    runAccess,
+    runAccess_,
+    spawn,
+    spawn_,
+    insert,
+    insertUntracked,
+    lookup,
+    remove,
+    despawn,
+    system,
+    triggerEvent,
+    triggerEntityEvent,
+  )
+where
+
+import Aztecs.ECS.Access.Internal
+import Aztecs.ECS.Component
+import Aztecs.ECS.Entity
+import Aztecs.ECS.System (System (..))
+import qualified Aztecs.ECS.System as S
+import Aztecs.ECS.World (World)
+import qualified Aztecs.ECS.World as W
+import Aztecs.ECS.World.Bundle
+import qualified Aztecs.ECS.World.Entities as E
+import Control.Monad
+import Control.Monad.State
+import Prelude hiding (all, filter, lookup, map, mapM)
+
+-- | Run an `Access` on a `World`, returning the output and updated `World`.
+runAccess :: (Functor m) => Access m a -> World m -> m (a, World m)
+runAccess a = runStateT $ unAccess a
+
+-- | Run an `Access` on an empty `World`.
+runAccess_ :: (Monad m) => Access m a -> m a
+runAccess_ a = fmap fst . runAccess a $ W.empty
+
+spawn :: (Monad m) => BundleT m -> Access m EntityID
+spawn b = Access $ do
+  !w <- get
+  let (e, w', hook) = W.spawn b w
+  put w'
+  unAccess hook
+  return e
+
+spawn_ :: (Monad m) => BundleT m -> Access m ()
+spawn_ = void . spawn
+
+insert :: (Monad m) => EntityID -> BundleT m -> Access m ()
+insert e c = Access $ do
+  !w <- get
+  let (w', hook) = W.insert e c w
+  put w'
+  unAccess hook
+
+-- | Insert a component into an entity without running lifecycle hooks.
+insertUntracked :: (Monad m) => EntityID -> BundleT m -> Access m ()
+insertUntracked e c = Access $ do
+  !w <- get
+  let w' = W.insertUntracked e c w
+  put w'
+
+lookup :: forall m a. (Monad m, Component m a) => EntityID -> Access m (Maybe a)
+lookup e = Access $ do
+  !w <- get
+  return $ W.lookup @m e w
+
+remove :: forall m a. (Monad m, Component m a) => EntityID -> Access m (Maybe a)
+remove e = Access $ do
+  !w <- get
+  let (a, w', hook) = W.remove @m e w
+  put w'
+  unAccess hook
+  return a
+
+despawn :: (Monad m) => EntityID -> Access m ()
+despawn e = Access $ do
+  !w <- get
+  let !(_, w') = W.despawn e w
+  put w'
+
+-- | Run a `System` on the `World`.
+system :: (Monad m) => System m a -> Access m a
+system sys = Access $ do
+  !w <- get
+  let !es = W.entities w
+      !(cs', dynSys) = S.runSystem sys $ E.components es
+  (a, es', hook) <- lift $ S.runDynamicSystem dynSys es
+  put w {W.entities = es' {E.components = cs'}}
+  unAccess hook
+  return a
+{-# INLINE system #-}

@@ -1,76 +1,76 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}---- |--- Module      : Aztecs.ECS.Access.Internal--- 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.Access.Internal-  ( Access (..),-    runAccessWith,-    evalAccess,-    triggerEvent,-    triggerEntityEvent,-  )-where--import Aztecs.ECS.Entity-import Aztecs.ECS.Event-import Aztecs.ECS.World.Internal-import qualified Aztecs.ECS.World.Observers as O-import Aztecs.ECS.World.Observers.Internal-import Control.Monad-import Control.Monad.Fix-import Control.Monad.State-import Data.Dynamic-import Data.Maybe-import qualified Data.Set as Set-import Data.Typeable---- | Access into a `World`.-newtype Access m a = Access {unAccess :: StateT (World m) m a}-  deriving (Functor, Applicative, Monad, MonadFix, MonadIO)---- | Run an `Access` with a given `World`, returning the result and updated world.-runAccessWith :: Access m a -> World m -> m (a, World m)-runAccessWith a = runStateT (unAccess a)---- | Run an `Access` with a given `World`, returning only the result.-evalAccess :: (Monad m) => Access m a -> World m -> m a-evalAccess a = evalStateT (unAccess a)---- | Trigger an event.-triggerEvent :: forall m e. (Monad m, Event e) => e -> Access m ()-triggerEvent evt = Access $ do-  !w <- get-  let eventTypeRep = typeOf (Proxy @e)-      globalOs = O.lookupGlobalObservers eventTypeRep $ observers w-      callbacks = mapMaybe (\oId -> O.lookupCallback oId (observers w)) $ Set.toList globalOs-      dynEvt = toDyn evt-  forM_ callbacks $ \cb -> case cb of-    DynEventObserver f -> f dynEvt-    DynEntityObserver _ -> pure ()---- | Trigger an event for a specific entity.-triggerEntityEvent ::-  forall m e.-  (Monad m, Event e) =>-  EntityID ->-  e ->-  Access m ()-triggerEntityEvent targetEntity evt = Access $ do-  !w <- get-  let eventTypeRep = typeOf $ Proxy @e-      entityOs = O.lookupEntityObservers eventTypeRep targetEntity $ observers w-      callbacks = mapMaybe (\oId -> O.lookupCallback oId (observers w)) $ Set.toList entityOs-      dynEvt = toDyn evt-  forM_ callbacks $ \cb -> case cb of-    DynEntityObserver f -> f targetEntity dynEvt-    DynEventObserver _ -> pure ()+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+-- |
+-- Module      : Aztecs.ECS.Access.Internal
+-- 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.Access.Internal
+  ( Access (..),
+    runAccessWith,
+    evalAccess,
+    triggerEvent,
+    triggerEntityEvent,
+  )
+where
+
+import Aztecs.ECS.Entity
+import Aztecs.ECS.Event
+import Aztecs.ECS.World.Internal
+import qualified Aztecs.ECS.World.Observers as O
+import Aztecs.ECS.World.Observers.Internal
+import Control.Monad
+import Control.Monad.Fix
+import Control.Monad.State
+import Data.Dynamic
+import Data.Maybe
+import qualified Data.Set as Set
+import Data.Typeable
+
+-- | Access into a `World`.
+newtype Access m a = Access {unAccess :: StateT (World m) m a}
+  deriving (Functor, Applicative, Monad, MonadFix, MonadIO)
+
+-- | Run an `Access` with a given `World`, returning the result and updated world.
+runAccessWith :: Access m a -> World m -> m (a, World m)
+runAccessWith a = runStateT (unAccess a)
+
+-- | Run an `Access` with a given `World`, returning only the result.
+evalAccess :: (Monad m) => Access m a -> World m -> m a
+evalAccess a = evalStateT (unAccess a)
+
+-- | Trigger an event.
+triggerEvent :: forall m e. (Monad m, Event e) => e -> Access m ()
+triggerEvent evt = Access $ do
+  !w <- get
+  let eventTypeRep = typeOf (Proxy @e)
+      globalOs = O.lookupGlobalObservers eventTypeRep $ observers w
+      callbacks = mapMaybe (\oId -> O.lookupCallback oId (observers w)) $ Set.toList globalOs
+      dynEvt = toDyn evt
+  forM_ callbacks $ \cb -> case cb of
+    DynEventObserver f -> f dynEvt
+    DynEntityObserver _ -> pure ()
+
+-- | Trigger an event for a specific entity.
+triggerEntityEvent ::
+  forall m e.
+  (Monad m, Event e) =>
+  EntityID ->
+  e ->
+  Access m ()
+triggerEntityEvent targetEntity evt = Access $ do
+  !w <- get
+  let eventTypeRep = typeOf $ Proxy @e
+      entityOs = O.lookupEntityObservers eventTypeRep targetEntity $ observers w
+      callbacks = mapMaybe (\oId -> O.lookupCallback oId (observers w)) $ Set.toList entityOs
+      dynEvt = toDyn evt
+  forM_ callbacks $ \cb -> case cb of
+    DynEntityObserver f -> f targetEntity dynEvt
+    DynEventObserver _ -> pure ()

@@ -1,102 +1,102 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}---- |--- Module      : Aztecs.ECS.Observer--- 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.Observer-  ( Observer (..),-    ObserverID (..),-    ObserverKind (..),-    observer,-    observerFor,-    observerGlobal,-  )-where--import Aztecs.ECS.Access.Internal-import Aztecs.ECS.Component-import Aztecs.ECS.Entity-import Aztecs.ECS.Event-import qualified Aztecs.ECS.World as W-import Aztecs.ECS.World.Bundle-import Aztecs.ECS.World.Internal (World (..))-import qualified Aztecs.ECS.World.Observers as O-import Aztecs.ECS.World.Observers.Internal-import Control.Monad.State-import Data.Set (Set)-import qualified Data.Set as Set-import Data.Typeable-import Data.Vector (Vector)---- | The kind of observer - either entity-specific or global.-data ObserverKind m e-  = -- | Observe events on specific entities (callback receives EntityID and event).-    EntityObserver !(Set EntityID) !(EntityID -> e -> Access m ())-  | -- | Observe all events of this type globally (callback receives just the event).-    EventObserver !(e -> Access m ())---- | Observer component-data Observer m e = Observer-  { -- | The kind and callback for this observer.-    observerKind :: !(ObserverKind m e),-    -- | The ObserverID assigned after registration (Nothing before registration).-    observerId :: !(Maybe ObserverID)-  }--instance Show (ObserverKind m e) where-  show (EntityObserver targets _) = "EntityObserver " ++ show targets-  show (EventObserver _) = "EventObserver"--instance Show (Observer m e) where-  show o = "Observer { kind = " ++ show (observerKind o) ++ ", id = " ++ show (observerId o) ++ " }"--instance (Monad m, Typeable m, Event e) => Component m (Observer m e) where-  type StorageT (Observer m e) = Vector (Observer m e)--  componentOnInsert ownerEntity o = Access $ do-    !w <- get-    (oId, observers') <- case observerKind o of-      EntityObserver targets f -> do-        let f' eId evt = unAccess $ f eId evt-            (oId, observers') = O.insertEntityObserver @e f' $ observers w-            observers'' = foldr (\e os -> O.addEntityObserver @_ @e e oId os) observers' targets-        return (oId, observers'')-      EventObserver callback -> do-        let wrappedCallback evt = unAccess $ callback evt-            (oId, observers') = O.insertEventObserver @e wrappedCallback (observers w)-            observers'' = O.addGlobalObserver @_ @e oId observers'-        return (oId, observers'')-    let o' = o {observerId = Just oId}-        w' = W.insertUntracked ownerEntity (bundleUntracked o') w {observers = observers'}-    put w'--  componentOnRemove _ownerEntity o = Access $ case observerId o of-    Just oId -> do-      !w <- get-      put w {observers = O.removeObserver oId (observers w)}-    Nothing -> pure ()---- | Create an observer for specific entities.-observerFor :: forall m e. (Event e) => Set EntityID -> (EntityID -> e -> Access m ()) -> Observer m e-observerFor targets callback = Observer {observerKind = EntityObserver targets callback, observerId = Nothing}---- | Create a global observer (observes all events of this type).-observerGlobal :: forall m e. (Event e) => (e -> Access m ()) -> Observer m e-observerGlobal callback = Observer {observerKind = EventObserver callback, observerId = Nothing}---- | Create an observer for a single entity.-observer :: forall m e. (Event e) => EntityID -> (EntityID -> e -> Access m ()) -> Observer m e-observer e = observerFor (Set.singleton e)+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- |
+-- Module      : Aztecs.ECS.Observer
+-- 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.Observer
+  ( Observer (..),
+    ObserverID (..),
+    ObserverKind (..),
+    observer,
+    observerFor,
+    observerGlobal,
+  )
+where
+
+import Aztecs.ECS.Access.Internal
+import Aztecs.ECS.Component
+import Aztecs.ECS.Entity
+import Aztecs.ECS.Event
+import qualified Aztecs.ECS.World as W
+import Aztecs.ECS.World.Bundle
+import Aztecs.ECS.World.Internal (World (..))
+import qualified Aztecs.ECS.World.Observers as O
+import Aztecs.ECS.World.Observers.Internal
+import Control.Monad.State
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Typeable
+import Data.Vector (Vector)
+
+-- | The kind of observer - either entity-specific or global.
+data ObserverKind m e
+  = -- | Observe events on specific entities (callback receives EntityID and event).
+    EntityObserver !(Set EntityID) !(EntityID -> e -> Access m ())
+  | -- | Observe all events of this type globally (callback receives just the event).
+    EventObserver !(e -> Access m ())
+
+-- | Observer component
+data Observer m e = Observer
+  { -- | The kind and callback for this observer.
+    observerKind :: !(ObserverKind m e),
+    -- | The ObserverID assigned after registration (Nothing before registration).
+    observerId :: !(Maybe ObserverID)
+  }
+
+instance Show (ObserverKind m e) where
+  show (EntityObserver targets _) = "EntityObserver " ++ show targets
+  show (EventObserver _) = "EventObserver"
+
+instance Show (Observer m e) where
+  show o = "Observer { kind = " ++ show (observerKind o) ++ ", id = " ++ show (observerId o) ++ " }"
+
+instance (Monad m, Typeable m, Event e) => Component m (Observer m e) where
+  type StorageT (Observer m e) = Vector (Observer m e)
+
+  componentOnInsert ownerEntity o = Access $ do
+    !w <- get
+    (oId, observers') <- case observerKind o of
+      EntityObserver targets f -> do
+        let f' eId evt = unAccess $ f eId evt
+            (oId, observers') = O.insertEntityObserver @e f' $ observers w
+            observers'' = foldr (\e os -> O.addEntityObserver @_ @e e oId os) observers' targets
+        return (oId, observers'')
+      EventObserver callback -> do
+        let wrappedCallback evt = unAccess $ callback evt
+            (oId, observers') = O.insertEventObserver @e wrappedCallback (observers w)
+            observers'' = O.addGlobalObserver @_ @e oId observers'
+        return (oId, observers'')
+    let o' = o {observerId = Just oId}
+        w' = W.insertUntracked ownerEntity (bundleUntracked o') w {observers = observers'}
+    put w'
+
+  componentOnRemove _ownerEntity o = Access $ case observerId o of
+    Just oId -> do
+      !w <- get
+      put w {observers = O.removeObserver oId (observers w)}
+    Nothing -> pure ()
+
+-- | Create an observer for specific entities.
+observerFor :: forall m e. (Event e) => Set EntityID -> (EntityID -> e -> Access m ()) -> Observer m e
+observerFor targets callback = Observer {observerKind = EntityObserver targets callback, observerId = Nothing}
+
+-- | Create a global observer (observes all events of this type).
+observerGlobal :: forall m e. (Event e) => (e -> Access m ()) -> Observer m e
+observerGlobal callback = Observer {observerKind = EventObserver callback, observerId = Nothing}
+
+-- | Create an observer for a single entity.
+observer :: forall m e. (Event e) => EntityID -> (EntityID -> e -> Access m ()) -> Observer m e
+observer e = observerFor (Set.singleton e)

@@ -1,288 +1,288 @@-{-# LANGUAGE ApplicativeDo #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}---- |--- Module      : Aztecs.ECS.Query.Dynamic--- 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.Query.Dynamic-  ( -- * Dynamic queries-    DynamicQuery (..),-    DynamicQueryF (..),--    -- ** Running-    readQueryDyn,-    readQueryFilteredDyn,-    readQuerySingleDyn,-    readQuerySingleMaybeDyn,-    runQueryDyn,-    runQueryFilteredDyn,-    runQuerySingleDyn,-    runQuerySingleMaybeDyn,--    -- * Dynamic query filters-    DynamicQueryFilter (..),-  )-where--import Aztecs.ECS.Access.Internal (Access)-import Aztecs.ECS.Component-import Aztecs.ECS.Query.Dynamic.Class-import Aztecs.ECS.World.Archetype (Archetype)-import qualified Aztecs.ECS.World.Archetype as A-import Aztecs.ECS.World.Archetypes (Node (..))-import qualified Aztecs.ECS.World.Archetypes as AS-import Aztecs.ECS.World.Entities (Entities (..))-import Aztecs.ECS.World.Storage.Dynamic-import Data.Foldable-import qualified Data.IntMap.Strict as IntMap-import qualified Data.Map as Map-import Data.Set (Set)-import qualified Data.Set as Set-import Data.Vector (Vector)-import qualified Data.Vector as V-import GHC.Stack---- | Dynamic query for components by ID.-newtype DynamicQuery m a-  = DynamicQuery-  { -- | Run a dynamic query.-    ---    -- @since 0.10-    runDynQuery :: Archetype m -> m (Vector a, Archetype m, Access m ())-  }-  deriving (Functor)--instance (Monad m) => Applicative (DynamicQuery m) where-  pure a = DynamicQuery $ \arch -> pure (V.replicate (length $ A.entities arch) a, arch, return ())-  {-# INLINE pure #-}--  f <*> g = DynamicQuery $ \arch -> do-    x <- runDynQuery g arch-    y <- runDynQuery f arch-    return $-      let (as, arch', hook1) = x-          (bs, arch'', hook2) = y-       in (V.zipWith ($) bs as, arch' <> arch'', hook1 >> hook2)-  {-# INLINE (<*>) #-}--instance (Monad m) => DynamicQueryF m (DynamicQuery m) where-  entity = DynamicQuery $ \arch -> pure (V.fromList . Set.toList $ A.entities arch, arch, return ())-  {-# INLINE entity #-}--  queryDyn cId = DynamicQuery $ \arch -> pure (A.lookupComponentsAsc cId arch, arch, return ())-  {-# INLINE queryDyn #-}--  queryMaybeDyn cId = DynamicQuery $ \arch -> case A.lookupComponentsAscMaybe cId arch of-    Just as -> pure (V.map Just as, arch, return ())-    Nothing -> pure (V.replicate (length $ A.entities arch) Nothing, arch, return ())-  {-# INLINE queryMaybeDyn #-}--  queryMapDyn f cId = DynamicQuery $ \arch -> do-    let (cs, arch', hook) = A.zipWith (V.replicate (length $ A.entities arch) ()) (const f) cId arch-    return (cs, arch', hook)-  {-# INLINE queryMapDyn #-}--  queryMapDyn_ f cId = DynamicQuery $ \arch -> do-    let (arch', hook) = A.zipWith_ (V.replicate (length $ A.entities arch) ()) (const f) cId arch-    return (V.replicate (length $ A.entities arch) (), arch', hook)-  {-# INLINE queryMapDyn_ #-}--  queryMapDynM f cId = DynamicQuery $ \arch -> do-    (cs, arch', hook) <- A.zipWithM (V.replicate (length $ A.entities arch) ()) (const f) cId arch-    return (cs, arch', hook)-  {-# INLINE queryMapDynM #-}--  queryMapDynWith f cId q = DynamicQuery $ \arch -> do-    (as, arch', hook1) <- runDynQuery q arch-    let (cs, arch'', hook2) = A.zipWith as f cId arch'-    return (cs, arch'', hook1 >> hook2)-  {-# INLINE queryMapDynWith #-}--  queryMapDynWith_ f cId q = DynamicQuery $ \arch -> do-    (as, arch', hook1) <- runDynQuery q arch-    let (arch'', hook2) = A.zipWith_ as f cId arch'-    return (V.map (const ()) as, arch'', hook1 >> hook2)-  {-# INLINE queryMapDynWith_ #-}--  queryMapDynWithM f cId q = DynamicQuery $ \arch -> do-    (as, arch', hook1) <- runDynQuery q arch-    (cs, arch'', hook2) <- A.zipWithM as f cId arch'-    return (cs, arch'', hook1 >> hook2)-  {-# INLINE queryMapDynWithM #-}--  queryMapDynWithAccum f cId q = DynamicQuery $ \arch -> do-    (bs, arch', hook1) <- runDynQuery q arch-    let (pairs, arch'', hook2) = A.zipWithAccum bs f cId arch'-    return (pairs, arch'', hook1 >> hook2)-  {-# INLINE queryMapDynWithAccum #-}--  queryMapDynWithAccumM f cId q = DynamicQuery $ \arch -> do-    (bs, arch', hook1) <- runDynQuery q arch-    (pairs, arch'', hook2) <- A.zipWithAccumM bs f cId arch'-    return (pairs, arch'', hook1 >> hook2)-  {-# INLINE queryMapDynWithAccumM #-}--  queryUntracked q = DynamicQuery $ \arch -> do-    (as, arch', _hooks) <- runDynQuery q arch-    return (as, arch', return ())-  {-# INLINE queryUntracked #-}--  queryFilterMap p q = DynamicQuery $ \arch -> do-    (as, _, _) <- runDynQuery q arch-    let eIds = V.fromList . Set.toList $ A.entities arch-        mapped = V.map p as-        (filteredEIds, indices, filteredBs) = V.unzip3 . V.imapMaybe (\i (e, mb) -> (\b -> (e, i, b)) <$> mb) $ V.zip eIds mapped-        filteredArch = filterArchetype indices arch-    (_, filteredArch', hook) <- runDynQuery q filteredArch {A.entities = Set.fromList $ V.toList filteredEIds}-    let resultArch = unfilterArchetype indices arch filteredArch'-    return (filteredBs, resultArch, hook)-    where-      filterArchetype indices arch =-        arch {A.storages = IntMap.map (filterStorage indices) $ A.storages arch}-      filterStorage indices s =-        let allVec = toAscVectorDyn s-            filteredVec = V.map (allVec V.!) indices-         in fromAscVectorDyn filteredVec s-      unfilterArchetype indices original filtered =-        original {A.storages = IntMap.mapWithKey go $ A.storages original}-        where-          go cId s = case IntMap.lookup cId (A.storages filtered) of-            Just filteredStorage ->-              let origVec = toAscVectorDyn s-                  filteredVec = toAscVectorDyn filteredStorage-                  mergedVec = V.accum (\_ new -> new) origVec (V.toList $ V.zip indices filteredVec)-               in fromAscVectorDyn mergedVec s-            Nothing -> s-  {-# INLINE queryFilterMap #-}---- | Match all entities.-readQueryDyn :: (Monad m) => Set ComponentID -> DynamicQuery m a -> Entities m -> m (Vector a)-readQueryDyn cIds q es =-  if Set.null cIds-    then (\(a, _, _) -> a) <$> runDynQuery q A.empty {A.entities = Map.keysSet $ entities es}-    else do-      let go n = (\(a, _, _) -> a) <$> runDynQuery q (AS.nodeArchetype n)-      results <- mapM go . Map.elems $ AS.find cIds $ archetypes es-      return $ V.concat results---- | Match all entities with a filter.-readQueryFilteredDyn :: (Monad m) => Set ComponentID -> (Node m -> Bool) -> DynamicQuery m a -> Entities m -> m (Vector a)-readQueryFilteredDyn cIds f q es =-  if Set.null cIds-    then (\(a, _, _) -> a) <$> runDynQuery q A.empty {A.entities = Map.keysSet $ entities es}-    else do-      let go n = (\(a, _, _) -> a) <$> runDynQuery q (AS.nodeArchetype n)-      results <- mapM go . Map.elems . Map.filter f $ AS.find cIds $ archetypes es-      return $ V.concat results---- | Match a single entity.-readQuerySingleDyn :: (HasCallStack, Monad m) => Set ComponentID -> DynamicQuery m a -> Entities m -> m a-readQuerySingleDyn cIds q es = do-  res <- readQuerySingleMaybeDyn cIds q es-  case res of-    Just a -> return a-    _ -> error "readQuerySingleDyn: expected a single entity"---- | Match a single entity, or `Nothing`.-readQuerySingleMaybeDyn :: (Monad m) => Set ComponentID -> DynamicQuery m a -> Entities m -> m (Maybe a)-readQuerySingleMaybeDyn cIds q es =-  if Set.null cIds-    then case Map.keys $ entities es of-      [eId] -> do-        (v, _, _) <- runDynQuery q $ A.singleton eId-        return $ if V.length v == 1 then Just (V.head v) else Nothing-      _ -> return Nothing-    else case Map.elems $ AS.find cIds $ archetypes es of-      [n] -> do-        (v, _, _) <- runDynQuery q $ AS.nodeArchetype n-        return $ if V.length v == 1 then Just (V.head v) else Nothing-      _ -> return Nothing---- | Map all matched entities.-runQueryDyn :: (Monad m) => Set ComponentID -> DynamicQuery m a -> Entities m -> m (Vector a, Entities m, Access m ())-runQueryDyn cIds q es =-  let go = runDynQuery q-   in if Set.null cIds-        then do-          (as, _, hook) <- go A.empty {A.entities = Map.keysSet $ entities es}-          return (as, es, hook)-        else-          let go' (acc, esAcc, hooks) (aId, n) = do-                (as', arch', hook) <- go $ nodeArchetype n-                let !nodes = Map.insert aId n {nodeArchetype = arch' <> nodeArchetype n} . AS.nodes $ archetypes esAcc-                return (as' V.++ acc, esAcc {archetypes = (archetypes esAcc) {AS.nodes = nodes}}, hooks >> hook)-           in foldlM go' (V.empty, es, return ()) $ Map.toList . AS.find cIds $ archetypes es-{-# INLINE runQueryDyn #-}---- | Map all matched entities.-runQueryFilteredDyn :: (Monad m) => Set ComponentID -> (Node m -> Bool) -> DynamicQuery m a -> Entities m -> m (Vector a, Entities m, Access m ())-runQueryFilteredDyn cIds f q es =-  let go = runDynQuery q-   in if Set.null cIds-        then do-          (as, _, hook) <- go A.empty {A.entities = Map.keysSet $ entities es}-          return (as, es, hook)-        else-          let go' (acc, esAcc, hooks) (aId, n) = do-                (as', arch', hook) <- go $ nodeArchetype n-                let !nodes = Map.insert aId n {nodeArchetype = arch' <> nodeArchetype n} . AS.nodes $ archetypes esAcc-                return (as' V.++ acc, esAcc {archetypes = (archetypes esAcc) {AS.nodes = nodes}}, hooks >> hook)-           in foldlM go' (V.empty, es, return ()) $ Map.toList . Map.filter f . AS.find cIds $ archetypes es-{-# INLINE runQueryFilteredDyn #-}---- | Map a single matched entity.-runQuerySingleDyn :: (HasCallStack, Monad m) => Set ComponentID -> DynamicQuery m a -> Entities m -> m (a, Entities m, Access m ())-runQuerySingleDyn cIds q es = do-  res <- runQuerySingleMaybeDyn cIds q es-  return $ case res of-    (Just a, es', hook) -> (a, es', hook)-    _ -> error "querySingleDyn: expected single matching entity"---- | Map a single matched entity, or @Nothing@.-runQuerySingleMaybeDyn :: (Monad m) => Set ComponentID -> DynamicQuery m a -> Entities m -> m (Maybe a, Entities m, Access m ())-runQuerySingleMaybeDyn cIds q es =-  if Set.null cIds-    then case Map.keys $ entities es of-      [eId] -> do-        res <- runDynQuery q $ A.singleton eId-        return $ case res of-          (v, _, hook) | V.length v == 1 -> (Just (V.head v), es, hook)-          _ -> (Nothing, es, return ())-      _ -> pure (Nothing, es, return ())-    else case Map.toList $ AS.find cIds $ archetypes es of-      [(aId, n)] -> do-        res <- runDynQuery q $ AS.nodeArchetype n-        return $ case res of-          (v, arch', hook)-            | V.length v == 1 ->-                let nodes = Map.insert aId n {nodeArchetype = arch' <> nodeArchetype n} . AS.nodes $ archetypes es-                 in (Just (V.head v), es {archetypes = (archetypes es) {AS.nodes = nodes}}, hook)-          _ -> (Nothing, es, return ())-      _ -> pure (Nothing, es, return ())-{-# INLINE runQuerySingleMaybeDyn #-}---- | Dynamic query filter.-data DynamicQueryFilter = DynamicQueryFilter-  { -- | `ComponentID`s to include.-    filterWith :: !(Set ComponentID),-    -- | `ComponentID`s to exclude.-    filterWithout :: !(Set ComponentID)-  }--instance Semigroup DynamicQueryFilter where-  DynamicQueryFilter withA withoutA <> DynamicQueryFilter withB withoutB =-    DynamicQueryFilter (withA <> withB) (withoutA <> withoutB)-  {-# INLINE (<>) #-}--instance Monoid DynamicQueryFilter where-  mempty = DynamicQueryFilter mempty mempty-  {-# INLINE mempty #-}+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- |
+-- Module      : Aztecs.ECS.Query.Dynamic
+-- 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.Query.Dynamic
+  ( -- * Dynamic queries
+    DynamicQuery (..),
+    DynamicQueryF (..),
+
+    -- ** Running
+    readQueryDyn,
+    readQueryFilteredDyn,
+    readQuerySingleDyn,
+    readQuerySingleMaybeDyn,
+    runQueryDyn,
+    runQueryFilteredDyn,
+    runQuerySingleDyn,
+    runQuerySingleMaybeDyn,
+
+    -- * Dynamic query filters
+    DynamicQueryFilter (..),
+  )
+where
+
+import Aztecs.ECS.Access.Internal (Access)
+import Aztecs.ECS.Component
+import Aztecs.ECS.Query.Dynamic.Class
+import Aztecs.ECS.World.Archetype (Archetype)
+import qualified Aztecs.ECS.World.Archetype as A
+import Aztecs.ECS.World.Archetypes (Node (..))
+import qualified Aztecs.ECS.World.Archetypes as AS
+import Aztecs.ECS.World.Entities (Entities (..))
+import Aztecs.ECS.World.Storage.Dynamic
+import Data.Foldable
+import qualified Data.IntMap.Strict as IntMap
+import qualified Data.Map as Map
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Vector (Vector)
+import qualified Data.Vector as V
+import GHC.Stack
+
+-- | Dynamic query for components by ID.
+newtype DynamicQuery m a
+  = DynamicQuery
+  { -- | Run a dynamic query.
+    --
+    -- @since 0.10
+    runDynQuery :: Archetype m -> m (Vector a, Archetype m, Access m ())
+  }
+  deriving (Functor)
+
+instance (Monad m) => Applicative (DynamicQuery m) where
+  pure a = DynamicQuery $ \arch -> pure (V.replicate (length $ A.entities arch) a, arch, return ())
+  {-# INLINE pure #-}
+
+  f <*> g = DynamicQuery $ \arch -> do
+    x <- runDynQuery g arch
+    y <- runDynQuery f arch
+    return $
+      let (as, arch', hook1) = x
+          (bs, arch'', hook2) = y
+       in (V.zipWith ($) bs as, arch' <> arch'', hook1 >> hook2)
+  {-# INLINE (<*>) #-}
+
+instance (Monad m) => DynamicQueryF m (DynamicQuery m) where
+  entity = DynamicQuery $ \arch -> pure (V.fromList . Set.toList $ A.entities arch, arch, return ())
+  {-# INLINE entity #-}
+
+  queryDyn cId = DynamicQuery $ \arch -> pure (A.lookupComponentsAsc cId arch, arch, return ())
+  {-# INLINE queryDyn #-}
+
+  queryMaybeDyn cId = DynamicQuery $ \arch -> case A.lookupComponentsAscMaybe cId arch of
+    Just as -> pure (V.map Just as, arch, return ())
+    Nothing -> pure (V.replicate (length $ A.entities arch) Nothing, arch, return ())
+  {-# INLINE queryMaybeDyn #-}
+
+  queryMapDyn f cId = DynamicQuery $ \arch -> do
+    let (cs, arch', hook) = A.zipWith (V.replicate (length $ A.entities arch) ()) (const f) cId arch
+    return (cs, arch', hook)
+  {-# INLINE queryMapDyn #-}
+
+  queryMapDyn_ f cId = DynamicQuery $ \arch -> do
+    let (arch', hook) = A.zipWith_ (V.replicate (length $ A.entities arch) ()) (const f) cId arch
+    return (V.replicate (length $ A.entities arch) (), arch', hook)
+  {-# INLINE queryMapDyn_ #-}
+
+  queryMapDynM f cId = DynamicQuery $ \arch -> do
+    (cs, arch', hook) <- A.zipWithM (V.replicate (length $ A.entities arch) ()) (const f) cId arch
+    return (cs, arch', hook)
+  {-# INLINE queryMapDynM #-}
+
+  queryMapDynWith f cId q = DynamicQuery $ \arch -> do
+    (as, arch', hook1) <- runDynQuery q arch
+    let (cs, arch'', hook2) = A.zipWith as f cId arch'
+    return (cs, arch'', hook1 >> hook2)
+  {-# INLINE queryMapDynWith #-}
+
+  queryMapDynWith_ f cId q = DynamicQuery $ \arch -> do
+    (as, arch', hook1) <- runDynQuery q arch
+    let (arch'', hook2) = A.zipWith_ as f cId arch'
+    return (V.map (const ()) as, arch'', hook1 >> hook2)
+  {-# INLINE queryMapDynWith_ #-}
+
+  queryMapDynWithM f cId q = DynamicQuery $ \arch -> do
+    (as, arch', hook1) <- runDynQuery q arch
+    (cs, arch'', hook2) <- A.zipWithM as f cId arch'
+    return (cs, arch'', hook1 >> hook2)
+  {-# INLINE queryMapDynWithM #-}
+
+  queryMapDynWithAccum f cId q = DynamicQuery $ \arch -> do
+    (bs, arch', hook1) <- runDynQuery q arch
+    let (pairs, arch'', hook2) = A.zipWithAccum bs f cId arch'
+    return (pairs, arch'', hook1 >> hook2)
+  {-# INLINE queryMapDynWithAccum #-}
+
+  queryMapDynWithAccumM f cId q = DynamicQuery $ \arch -> do
+    (bs, arch', hook1) <- runDynQuery q arch
+    (pairs, arch'', hook2) <- A.zipWithAccumM bs f cId arch'
+    return (pairs, arch'', hook1 >> hook2)
+  {-# INLINE queryMapDynWithAccumM #-}
+
+  queryUntracked q = DynamicQuery $ \arch -> do
+    (as, arch', _hooks) <- runDynQuery q arch
+    return (as, arch', return ())
+  {-# INLINE queryUntracked #-}
+
+  queryFilterMap p q = DynamicQuery $ \arch -> do
+    (as, _, _) <- runDynQuery q arch
+    let eIds = V.fromList . Set.toList $ A.entities arch
+        mapped = V.map p as
+        (filteredEIds, indices, filteredBs) = V.unzip3 . V.imapMaybe (\i (e, mb) -> (\b -> (e, i, b)) <$> mb) $ V.zip eIds mapped
+        filteredArch = filterArchetype indices arch
+    (_, filteredArch', hook) <- runDynQuery q filteredArch {A.entities = Set.fromList $ V.toList filteredEIds}
+    let resultArch = unfilterArchetype indices arch filteredArch'
+    return (filteredBs, resultArch, hook)
+    where
+      filterArchetype indices arch =
+        arch {A.storages = IntMap.map (filterStorage indices) $ A.storages arch}
+      filterStorage indices s =
+        let allVec = toAscVectorDyn s
+            filteredVec = V.map (allVec V.!) indices
+         in fromAscVectorDyn filteredVec s
+      unfilterArchetype indices original filtered =
+        original {A.storages = IntMap.mapWithKey go $ A.storages original}
+        where
+          go cId s = case IntMap.lookup cId (A.storages filtered) of
+            Just filteredStorage ->
+              let origVec = toAscVectorDyn s
+                  filteredVec = toAscVectorDyn filteredStorage
+                  mergedVec = V.accum (\_ new -> new) origVec (V.toList $ V.zip indices filteredVec)
+               in fromAscVectorDyn mergedVec s
+            Nothing -> s
+  {-# INLINE queryFilterMap #-}
+
+-- | Match all entities.
+readQueryDyn :: (Monad m) => Set ComponentID -> DynamicQuery m a -> Entities m -> m (Vector a)
+readQueryDyn cIds q es =
+  if Set.null cIds
+    then (\(a, _, _) -> a) <$> runDynQuery q A.empty {A.entities = Map.keysSet $ entities es}
+    else do
+      let go n = (\(a, _, _) -> a) <$> runDynQuery q (AS.nodeArchetype n)
+      results <- mapM go . Map.elems $ AS.find cIds $ archetypes es
+      return $ V.concat results
+
+-- | Match all entities with a filter.
+readQueryFilteredDyn :: (Monad m) => Set ComponentID -> (Node m -> Bool) -> DynamicQuery m a -> Entities m -> m (Vector a)
+readQueryFilteredDyn cIds f q es =
+  if Set.null cIds
+    then (\(a, _, _) -> a) <$> runDynQuery q A.empty {A.entities = Map.keysSet $ entities es}
+    else do
+      let go n = (\(a, _, _) -> a) <$> runDynQuery q (AS.nodeArchetype n)
+      results <- mapM go . Map.elems . Map.filter f $ AS.find cIds $ archetypes es
+      return $ V.concat results
+
+-- | Match a single entity.
+readQuerySingleDyn :: (HasCallStack, Monad m) => Set ComponentID -> DynamicQuery m a -> Entities m -> m a
+readQuerySingleDyn cIds q es = do
+  res <- readQuerySingleMaybeDyn cIds q es
+  case res of
+    Just a -> return a
+    _ -> error "readQuerySingleDyn: expected a single entity"
+
+-- | Match a single entity, or `Nothing`.
+readQuerySingleMaybeDyn :: (Monad m) => Set ComponentID -> DynamicQuery m a -> Entities m -> m (Maybe a)
+readQuerySingleMaybeDyn cIds q es =
+  if Set.null cIds
+    then case Map.keys $ entities es of
+      [eId] -> do
+        (v, _, _) <- runDynQuery q $ A.singleton eId
+        return $ if V.length v == 1 then Just (V.head v) else Nothing
+      _ -> return Nothing
+    else case Map.elems $ AS.find cIds $ archetypes es of
+      [n] -> do
+        (v, _, _) <- runDynQuery q $ AS.nodeArchetype n
+        return $ if V.length v == 1 then Just (V.head v) else Nothing
+      _ -> return Nothing
+
+-- | Map all matched entities.
+runQueryDyn :: (Monad m) => Set ComponentID -> DynamicQuery m a -> Entities m -> m (Vector a, Entities m, Access m ())
+runQueryDyn cIds q es =
+  let go = runDynQuery q
+   in if Set.null cIds
+        then do
+          (as, _, hook) <- go A.empty {A.entities = Map.keysSet $ entities es}
+          return (as, es, hook)
+        else
+          let go' (acc, esAcc, hooks) (aId, n) = do
+                (as', arch', hook) <- go $ nodeArchetype n
+                let !nodes = Map.insert aId n {nodeArchetype = arch' <> nodeArchetype n} . AS.nodes $ archetypes esAcc
+                return (as' V.++ acc, esAcc {archetypes = (archetypes esAcc) {AS.nodes = nodes}}, hooks >> hook)
+           in foldlM go' (V.empty, es, return ()) $ Map.toList . AS.find cIds $ archetypes es
+{-# INLINE runQueryDyn #-}
+
+-- | Map all matched entities.
+runQueryFilteredDyn :: (Monad m) => Set ComponentID -> (Node m -> Bool) -> DynamicQuery m a -> Entities m -> m (Vector a, Entities m, Access m ())
+runQueryFilteredDyn cIds f q es =
+  let go = runDynQuery q
+   in if Set.null cIds
+        then do
+          (as, _, hook) <- go A.empty {A.entities = Map.keysSet $ entities es}
+          return (as, es, hook)
+        else
+          let go' (acc, esAcc, hooks) (aId, n) = do
+                (as', arch', hook) <- go $ nodeArchetype n
+                let !nodes = Map.insert aId n {nodeArchetype = arch' <> nodeArchetype n} . AS.nodes $ archetypes esAcc
+                return (as' V.++ acc, esAcc {archetypes = (archetypes esAcc) {AS.nodes = nodes}}, hooks >> hook)
+           in foldlM go' (V.empty, es, return ()) $ Map.toList . Map.filter f . AS.find cIds $ archetypes es
+{-# INLINE runQueryFilteredDyn #-}
+
+-- | Map a single matched entity.
+runQuerySingleDyn :: (HasCallStack, Monad m) => Set ComponentID -> DynamicQuery m a -> Entities m -> m (a, Entities m, Access m ())
+runQuerySingleDyn cIds q es = do
+  res <- runQuerySingleMaybeDyn cIds q es
+  return $ case res of
+    (Just a, es', hook) -> (a, es', hook)
+    _ -> error "querySingleDyn: expected single matching entity"
+
+-- | Map a single matched entity, or @Nothing@.
+runQuerySingleMaybeDyn :: (Monad m) => Set ComponentID -> DynamicQuery m a -> Entities m -> m (Maybe a, Entities m, Access m ())
+runQuerySingleMaybeDyn cIds q es =
+  if Set.null cIds
+    then case Map.keys $ entities es of
+      [eId] -> do
+        res <- runDynQuery q $ A.singleton eId
+        return $ case res of
+          (v, _, hook) | V.length v == 1 -> (Just (V.head v), es, hook)
+          _ -> (Nothing, es, return ())
+      _ -> pure (Nothing, es, return ())
+    else case Map.toList $ AS.find cIds $ archetypes es of
+      [(aId, n)] -> do
+        res <- runDynQuery q $ AS.nodeArchetype n
+        return $ case res of
+          (v, arch', hook)
+            | V.length v == 1 ->
+                let nodes = Map.insert aId n {nodeArchetype = arch' <> nodeArchetype n} . AS.nodes $ archetypes es
+                 in (Just (V.head v), es {archetypes = (archetypes es) {AS.nodes = nodes}}, hook)
+          _ -> (Nothing, es, return ())
+      _ -> pure (Nothing, es, return ())
+{-# INLINE runQuerySingleMaybeDyn #-}
+
+-- | Dynamic query filter.
+data DynamicQueryFilter = DynamicQueryFilter
+  { -- | `ComponentID`s to include.
+    filterWith :: !(Set ComponentID),
+    -- | `ComponentID`s to exclude.
+    filterWithout :: !(Set ComponentID)
+  }
+
+instance Semigroup DynamicQueryFilter where
+  DynamicQueryFilter withA withoutA <> DynamicQueryFilter withB withoutB =
+    DynamicQueryFilter (withA <> withB) (withoutA <> withoutB)
+  {-# INLINE (<>) #-}
+
+instance Monoid DynamicQueryFilter where
+  mempty = DynamicQueryFilter mempty mempty
+  {-# INLINE mempty #-}

@@ -1,145 +1,145 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeSynonymInstances #-}---- |--- Module      : Aztecs.ECS.System--- 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.System.Dynamic-  ( -- * Dynamic systems-    DynamicSystem (..),-    runDynamicSystem,--    -- ** Queries-    runQuery,-    runQueryFiltered,-    runQuerySingle,-    runQuerySingleMaybe,-    readQuery,-    readQueryFiltered,-    readQuerySingle,-    readQuerySingleMaybe,-  )-where--import Aztecs.ECS.Access.Internal (Access)-import Aztecs.ECS.Component-import Aztecs.ECS.Query.Dynamic (DynamicQuery)-import qualified Aztecs.ECS.Query.Dynamic as DQ-import Aztecs.ECS.World.Archetypes (Node (..))-import Aztecs.ECS.World.Entities (Entities)-import Data.Set (Set)-import Data.Vector (Vector)-import Prelude hiding (all, filter, map, mapM)---- | Query operation.-data Op m a where-  RunQuery :: DynamicQuery m a -> Op m (Vector a)-  RunFiltered :: (Node m -> Bool) -> DynamicQuery m a -> Op m (Vector a)-  RunQuerySingle :: DynamicQuery m a -> Op m a-  RunQuerySingleMaybe :: DynamicQuery m a -> Op m (Maybe a)-  ReadQuery :: DynamicQuery m a -> Op m (Vector a)-  ReadQueryFiltered :: DynamicQuery m a -> (Node m -> Bool) -> Op m (Vector a)-  ReadQuerySingle :: DynamicQuery m a -> Op m a-  ReadQuerySingleMaybe :: DynamicQuery m a -> Op m (Maybe a)---- | Run a query operation on entities.-runOp :: (Monad m) => Set ComponentID -> Op m a -> Entities m -> m (a, Entities m, Access m ())-runOp cIds (RunQuery q) es = DQ.runQueryDyn cIds q es-runOp cIds (RunFiltered flt q) es = DQ.runQueryFilteredDyn cIds flt q es-runOp cIds (RunQuerySingle q) es = DQ.runQuerySingleDyn cIds q es-runOp cIds (RunQuerySingleMaybe q) es = DQ.runQuerySingleMaybeDyn cIds q es-runOp cIds (ReadQuery q) es = do-  as <- DQ.readQueryDyn cIds q es-  return (as, es, return ())-runOp cIds (ReadQueryFiltered q flt) es = do-  as <- DQ.readQueryFilteredDyn cIds flt q es-  return (as, es, return ())-runOp cIds (ReadQuerySingle q) es = do-  a <- DQ.readQuerySingleDyn cIds q es-  return (a, es, return ())-runOp cIds (ReadQuerySingleMaybe q) es = do-  a <- DQ.readQuerySingleMaybeDyn cIds q es-  return (a, es, return ())-{-# INLINE runOp #-}---- | Dynamic system.-data DynamicSystem m a where-  -- | Pure value.-  Pure :: a -> DynamicSystem m a-  -- | Functor map.-  Map :: (b -> a) -> DynamicSystem m b -> DynamicSystem m a-  -- | Applicative apply.-  Ap :: DynamicSystem m (b -> a) -> DynamicSystem m b -> DynamicSystem m a-  -- | Query operation.-  Op :: Set ComponentID -> Op m a -> DynamicSystem m a--instance Functor (DynamicSystem m) where-  fmap f (Pure a) = Pure (f a)-  fmap f s = Map f s-  {-# INLINE fmap #-}--instance Applicative (DynamicSystem m) where-  pure = Pure-  {-# INLINE pure #-}--  Pure f <*> s = fmap f s-  f <*> Pure a = fmap ($ a) f-  f <*> s = Ap f s-  {-# INLINE (<*>) #-}---- | Run a dynamic system on entities, returning results, updated entities, and hooks to run.-runDynamicSystem :: (Monad m) => DynamicSystem m a -> Entities m -> m (a, Entities m, Access m ())-runDynamicSystem (Pure a) es = return (a, es, return ())-runDynamicSystem (Map f s) es = do-  (b, es', hook) <- runDynamicSystem s es-  return (f b, es', hook)-runDynamicSystem (Ap sf sa) es = do-  (f, es', hook1) <- runDynamicSystem sf es-  (a, es'', hook2) <- runDynamicSystem sa es'-  return (f a, es'', hook1 >> hook2)-runDynamicSystem (Op cIds op) es = runOp cIds op es-{-# INLINE runDynamicSystem #-}--runQuery :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m (Vector a)-runQuery cIds q = Op cIds (RunQuery q)-{-# INLINE runQuery #-}--runQueryFiltered :: Set ComponentID -> DynamicQuery m a -> (Node m -> Bool) -> DynamicSystem m (Vector a)-runQueryFiltered cIds q flt = Op cIds (RunFiltered flt q)-{-# INLINE runQueryFiltered #-}--runQuerySingle :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m a-runQuerySingle cIds q = Op cIds (RunQuerySingle q)-{-# INLINE runQuerySingle #-}--runQuerySingleMaybe :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m (Maybe a)-runQuerySingleMaybe cIds q = Op cIds (RunQuerySingleMaybe q)-{-# INLINE runQuerySingleMaybe #-}--readQuery :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m (Vector a)-readQuery cIds q = Op cIds (ReadQuery q)-{-# INLINE readQuery #-}--readQueryFiltered :: Set ComponentID -> (Node m -> Bool) -> DynamicQuery m a -> DynamicSystem m (Vector a)-readQueryFiltered cIds flt q = Op cIds (ReadQueryFiltered q flt)-{-# INLINE readQueryFiltered #-}--readQuerySingle :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m a-readQuerySingle cIds q = Op cIds (ReadQuerySingle q)--readQuerySingleMaybe :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m (Maybe a)-readQuerySingleMaybe cIds q = Op cIds (ReadQuerySingleMaybe q)-{-# INLINE readQuerySingleMaybe #-}+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+-- |
+-- Module      : Aztecs.ECS.System
+-- 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.System.Dynamic
+  ( -- * Dynamic systems
+    DynamicSystem (..),
+    runDynamicSystem,
+
+    -- ** Queries
+    runQuery,
+    runQueryFiltered,
+    runQuerySingle,
+    runQuerySingleMaybe,
+    readQuery,
+    readQueryFiltered,
+    readQuerySingle,
+    readQuerySingleMaybe,
+  )
+where
+
+import Aztecs.ECS.Access.Internal (Access)
+import Aztecs.ECS.Component
+import Aztecs.ECS.Query.Dynamic (DynamicQuery)
+import qualified Aztecs.ECS.Query.Dynamic as DQ
+import Aztecs.ECS.World.Archetypes (Node (..))
+import Aztecs.ECS.World.Entities (Entities)
+import Data.Set (Set)
+import Data.Vector (Vector)
+import Prelude hiding (all, filter, map, mapM)
+
+-- | Query operation.
+data Op m a where
+  RunQuery :: DynamicQuery m a -> Op m (Vector a)
+  RunFiltered :: (Node m -> Bool) -> DynamicQuery m a -> Op m (Vector a)
+  RunQuerySingle :: DynamicQuery m a -> Op m a
+  RunQuerySingleMaybe :: DynamicQuery m a -> Op m (Maybe a)
+  ReadQuery :: DynamicQuery m a -> Op m (Vector a)
+  ReadQueryFiltered :: DynamicQuery m a -> (Node m -> Bool) -> Op m (Vector a)
+  ReadQuerySingle :: DynamicQuery m a -> Op m a
+  ReadQuerySingleMaybe :: DynamicQuery m a -> Op m (Maybe a)
+
+-- | Run a query operation on entities.
+runOp :: (Monad m) => Set ComponentID -> Op m a -> Entities m -> m (a, Entities m, Access m ())
+runOp cIds (RunQuery q) es = DQ.runQueryDyn cIds q es
+runOp cIds (RunFiltered flt q) es = DQ.runQueryFilteredDyn cIds flt q es
+runOp cIds (RunQuerySingle q) es = DQ.runQuerySingleDyn cIds q es
+runOp cIds (RunQuerySingleMaybe q) es = DQ.runQuerySingleMaybeDyn cIds q es
+runOp cIds (ReadQuery q) es = do
+  as <- DQ.readQueryDyn cIds q es
+  return (as, es, return ())
+runOp cIds (ReadQueryFiltered q flt) es = do
+  as <- DQ.readQueryFilteredDyn cIds flt q es
+  return (as, es, return ())
+runOp cIds (ReadQuerySingle q) es = do
+  a <- DQ.readQuerySingleDyn cIds q es
+  return (a, es, return ())
+runOp cIds (ReadQuerySingleMaybe q) es = do
+  a <- DQ.readQuerySingleMaybeDyn cIds q es
+  return (a, es, return ())
+{-# INLINE runOp #-}
+
+-- | Dynamic system.
+data DynamicSystem m a where
+  -- | Pure value.
+  Pure :: a -> DynamicSystem m a
+  -- | Functor map.
+  Map :: (b -> a) -> DynamicSystem m b -> DynamicSystem m a
+  -- | Applicative apply.
+  Ap :: DynamicSystem m (b -> a) -> DynamicSystem m b -> DynamicSystem m a
+  -- | Query operation.
+  Op :: Set ComponentID -> Op m a -> DynamicSystem m a
+
+instance Functor (DynamicSystem m) where
+  fmap f (Pure a) = Pure (f a)
+  fmap f s = Map f s
+  {-# INLINE fmap #-}
+
+instance Applicative (DynamicSystem m) where
+  pure = Pure
+  {-# INLINE pure #-}
+
+  Pure f <*> s = fmap f s
+  f <*> Pure a = fmap ($ a) f
+  f <*> s = Ap f s
+  {-# INLINE (<*>) #-}
+
+-- | Run a dynamic system on entities, returning results, updated entities, and hooks to run.
+runDynamicSystem :: (Monad m) => DynamicSystem m a -> Entities m -> m (a, Entities m, Access m ())
+runDynamicSystem (Pure a) es = return (a, es, return ())
+runDynamicSystem (Map f s) es = do
+  (b, es', hook) <- runDynamicSystem s es
+  return (f b, es', hook)
+runDynamicSystem (Ap sf sa) es = do
+  (f, es', hook1) <- runDynamicSystem sf es
+  (a, es'', hook2) <- runDynamicSystem sa es'
+  return (f a, es'', hook1 >> hook2)
+runDynamicSystem (Op cIds op) es = runOp cIds op es
+{-# INLINE runDynamicSystem #-}
+
+runQuery :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m (Vector a)
+runQuery cIds q = Op cIds (RunQuery q)
+{-# INLINE runQuery #-}
+
+runQueryFiltered :: Set ComponentID -> DynamicQuery m a -> (Node m -> Bool) -> DynamicSystem m (Vector a)
+runQueryFiltered cIds q flt = Op cIds (RunFiltered flt q)
+{-# INLINE runQueryFiltered #-}
+
+runQuerySingle :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m a
+runQuerySingle cIds q = Op cIds (RunQuerySingle q)
+{-# INLINE runQuerySingle #-}
+
+runQuerySingleMaybe :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m (Maybe a)
+runQuerySingleMaybe cIds q = Op cIds (RunQuerySingleMaybe q)
+{-# INLINE runQuerySingleMaybe #-}
+
+readQuery :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m (Vector a)
+readQuery cIds q = Op cIds (ReadQuery q)
+{-# INLINE readQuery #-}
+
+readQueryFiltered :: Set ComponentID -> (Node m -> Bool) -> DynamicQuery m a -> DynamicSystem m (Vector a)
+readQueryFiltered cIds flt q = Op cIds (ReadQueryFiltered q flt)
+{-# INLINE readQueryFiltered #-}
+
+readQuerySingle :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m a
+readQuerySingle cIds q = Op cIds (ReadQuerySingle q)
+
+readQuerySingleMaybe :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m (Maybe a)
+readQuerySingleMaybe cIds q = Op cIds (ReadQuerySingleMaybe q)
+{-# INLINE readQuerySingleMaybe #-}

@@ -1,89 +1,89 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}---- |--- Module      : Aztecs.ECS.World--- 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-  ( World (..),-    empty,-    spawn,-    spawnEmpty,-    insert,-    insertUntracked,-    lookup,-    remove,-    removeWithId,-    despawn,-  )-where--import Aztecs.ECS.Access.Internal (Access)-import Aztecs.ECS.Component-import Aztecs.ECS.Entity-import Aztecs.ECS.World.Bundle-import qualified Aztecs.ECS.World.Entities as E-import Aztecs.ECS.World.Internal (World (..))-import qualified Aztecs.ECS.World.Observers as O-import Data.Dynamic-import Data.IntMap (IntMap)-import Prelude hiding (lookup)---- | Empty `World`.-empty :: World m-empty =-  World-    { entities = E.empty,-      nextEntityId = EntityID 0,-      observers = O.empty-    }---- | Spawn a `Bundle` into the `World`. Returns the entity ID, updated world, and onInsert hook.-spawn :: (Monad m) => BundleT m -> World m -> (EntityID, World m, Access m ())-spawn b w =-  let e = nextEntityId w-      (es', hook) = E.spawn e b $ entities w-   in (e, w {entities = es', nextEntityId = EntityID $ unEntityId e + 1}, hook)---- | Spawn an empty entity.-spawnEmpty :: World m -> (EntityID, World m)-spawnEmpty w = let e = nextEntityId w in (e, w {nextEntityId = EntityID $ unEntityId e + 1})---- | Insert a `Bundle` into an entity. Returns updated world and onInsert hook.-insert :: (Monad m) => EntityID -> BundleT m -> World m -> (World m, Access m ())-insert e c w =-  let (es', hook) = E.insert e c (entities w)-   in (w {entities = es'}, hook)---- | Insert a `Bundle` into an entity without running lifecycle hooks.-insertUntracked :: (Monad m) => EntityID -> BundleT m -> World m -> World m-insertUntracked e c w =-  let es' = E.insertUntracked e c (entities w)-   in w {entities = es'}---- | Lookup a component in an entity.-lookup :: forall m a. (Component m a) => EntityID -> World m -> Maybe a-lookup e w = E.lookup e $ entities w---- | Remove a component from an entity. Returns the component (if found), updated world, and onRemove hook.-remove :: forall m a. (Component m a) => EntityID -> World m -> (Maybe a, World m, Access m ())-remove e w =-  let (a, es, hook) = E.remove e (entities w)-   in (a, w {entities = es}, hook)---- | Remove a component from an entity with its `ComponentID`. Returns the component (if found), updated world, and onRemove hook.-removeWithId :: forall m a. (Component m a) => EntityID -> ComponentID -> World m -> (Maybe a, World m, Access m ())-removeWithId e cId w =-  let (a, es, hook) = E.removeWithId e cId (entities w)-   in (a, w {entities = es}, hook)---- | Despawn an entity, returning its components.-despawn :: EntityID -> World m -> (IntMap Dynamic, World m)-despawn e w = let (a, es) = E.despawn e (entities w) in (a, w {entities = es})+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- |
+-- Module      : Aztecs.ECS.World
+-- 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
+  ( World (..),
+    empty,
+    spawn,
+    spawnEmpty,
+    insert,
+    insertUntracked,
+    lookup,
+    remove,
+    removeWithId,
+    despawn,
+  )
+where
+
+import Aztecs.ECS.Access.Internal (Access)
+import Aztecs.ECS.Component
+import Aztecs.ECS.Entity
+import Aztecs.ECS.World.Bundle
+import qualified Aztecs.ECS.World.Entities as E
+import Aztecs.ECS.World.Internal (World (..))
+import qualified Aztecs.ECS.World.Observers as O
+import Data.Dynamic
+import Data.IntMap (IntMap)
+import Prelude hiding (lookup)
+
+-- | Empty `World`.
+empty :: World m
+empty =
+  World
+    { entities = E.empty,
+      nextEntityId = EntityID 0,
+      observers = O.empty
+    }
+
+-- | Spawn a `Bundle` into the `World`. Returns the entity ID, updated world, and onInsert hook.
+spawn :: (Monad m) => BundleT m -> World m -> (EntityID, World m, Access m ())
+spawn b w =
+  let e = nextEntityId w
+      (es', hook) = E.spawn e b $ entities w
+   in (e, w {entities = es', nextEntityId = EntityID $ unEntityId e + 1}, hook)
+
+-- | Spawn an empty entity.
+spawnEmpty :: World m -> (EntityID, World m)
+spawnEmpty w = let e = nextEntityId w in (e, w {nextEntityId = EntityID $ unEntityId e + 1})
+
+-- | Insert a `Bundle` into an entity. Returns updated world and onInsert hook.
+insert :: (Monad m) => EntityID -> BundleT m -> World m -> (World m, Access m ())
+insert e c w =
+  let (es', hook) = E.insert e c (entities w)
+   in (w {entities = es'}, hook)
+
+-- | Insert a `Bundle` into an entity without running lifecycle hooks.
+insertUntracked :: (Monad m) => EntityID -> BundleT m -> World m -> World m
+insertUntracked e c w =
+  let es' = E.insertUntracked e c (entities w)
+   in w {entities = es'}
+
+-- | Lookup a component in an entity.
+lookup :: forall m a. (Component m a) => EntityID -> World m -> Maybe a
+lookup e w = E.lookup e $ entities w
+
+-- | Remove a component from an entity. Returns the component (if found), updated world, and onRemove hook.
+remove :: forall m a. (Component m a) => EntityID -> World m -> (Maybe a, World m, Access m ())
+remove e w =
+  let (a, es, hook) = E.remove e (entities w)
+   in (a, w {entities = es}, hook)
+
+-- | Remove a component from an entity with its `ComponentID`. Returns the component (if found), updated world, and onRemove hook.
+removeWithId :: forall m a. (Component m a) => EntityID -> ComponentID -> World m -> (Maybe a, World m, Access m ())
+removeWithId e cId w =
+  let (a, es, hook) = E.removeWithId e cId (entities w)
+   in (a, w {entities = es}, hook)
+
+-- | Despawn an entity, returning its components.
+despawn :: EntityID -> World m -> (IntMap Dynamic, World m)
+despawn e w = let (a, es) = E.despawn e (entities w) in (a, w {entities = es})

@@ -1,41 +1,41 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE KindSignatures #-}---- |--- Module      : Aztecs.ECS.World.Archetype.Internal--- 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.Internal (Archetype (..), empty) where--import Aztecs.ECS.Entity (EntityID)-import Aztecs.ECS.World.Storage.Dynamic (DynamicStorage)-import Data.IntMap (IntMap)-import qualified Data.IntMap as IntMap-import Data.Kind (Type)-import Data.Set (Set)-import qualified Data.Set as Set-import GHC.Generics---- | Archetype of entities and components.--- An archetype is guranteed to contain one of each stored component per entity.-data Archetype (m :: Type -> Type) = Archetype-  { -- | Component storages.-    storages :: !(IntMap DynamicStorage),-    -- | Entities stored in this archetype.-    entities :: !(Set EntityID)-  }-  deriving (Show, Generic)--instance Semigroup (Archetype m) where-  a <> b = Archetype {storages = storages a <> storages b, entities = entities a <> entities b}--instance Monoid (Archetype m) where-  mempty = empty---- | Empty archetype.-empty :: Archetype m-empty = Archetype {storages = IntMap.empty, entities = Set.empty}+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE KindSignatures #-}
+
+-- |
+-- Module      : Aztecs.ECS.World.Archetype.Internal
+-- 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.Internal (Archetype (..), empty) where
+
+import Aztecs.ECS.Entity (EntityID)
+import Aztecs.ECS.World.Storage.Dynamic (DynamicStorage)
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+import Data.Kind (Type)
+import Data.Set (Set)
+import qualified Data.Set as Set
+import GHC.Generics
+
+-- | Archetype of entities and components.
+-- An archetype is guranteed to contain one of each stored component per entity.
+data Archetype (m :: Type -> Type) = Archetype
+  { -- | Component storages.
+    storages :: !(IntMap DynamicStorage),
+    -- | Entities stored in this archetype.
+    entities :: !(Set EntityID)
+  }
+  deriving (Show, Generic)
+
+instance Semigroup (Archetype m) where
+  a <> b = Archetype {storages = storages a <> storages b, entities = entities a <> entities b}
+
+instance Monoid (Archetype m) where
+  mempty = empty
+
+-- | Empty archetype.
+empty :: Archetype m
+empty = Archetype {storages = IntMap.empty, entities = Set.empty}

@@ -1,204 +1,204 @@-{-# 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 =-  Archetypes-    { nodes = mempty,-      archetypeIds = mempty,-      nextArchetypeId = ArchetypeID 0,-      componentIds = mempty-    }---- | Insert an archetype by its set of `ComponentID`s.-insertArchetype :: Set ComponentID -> Node m -> Archetypes m -> (ArchetypeID, Archetypes m)-insertArchetype cIds n arches =-  let aId = nextArchetypeId arches-   in ( aId,-        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 aId f arches =-  arches {nodes = Map.adjust (\node -> 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 cIds arches = case mapMaybe (\cId -> Map.lookup cId (componentIds arches)) (Set.elems cIds) of-  (aId : aIds') -> foldl' Set.intersection aId aIds'-  [] -> Set.empty---- | Lookup `Archetype`s containing a set of `ComponentID`s.-find :: Set ComponentID -> Archetypes m -> Map ArchetypeID (Node m)-find cIds arches = Map.fromSet (\aId -> nodes arches Map.! aId) (findArchetypeIds cIds 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 cIds f arches =-  let go (acc, archAcc) aId =-        let !node = nodes archAcc Map.! aId-            !(a, arch') = f (nodeArchetype node)-            nodes' = Map.insert aId (node {nodeArchetype = arch'}) (nodes archAcc)-         in (a : acc, archAcc {nodes = nodes'})-   in foldl' go ([], arches) $ findArchetypeIds cIds arches---- | Lookup an `ArchetypeID` by its set of `ComponentID`s.-lookupArchetypeId :: Set ComponentID -> Archetypes m -> Maybe ArchetypeID-lookupArchetypeId cIds arches = Map.lookup cIds (archetypeIds arches)---- | Lookup an `Archetype` by its `ArchetypeID`.-lookup :: ArchetypeID -> Archetypes m -> Maybe (Node m)-lookup aId arches = Map.lookup aId (nodes 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 e aId cIds b arches = case lookup aId arches of-  Just node ->-    if Set.isSubsetOf cIds $ nodeComponentIds node-      then-        let go n =-              let (arch', hook) = runDynamicBundle b e $ nodeArchetype n-               in (n {nodeArchetype = arch'}, hook)-            (hooks, nodes') =-              Map.alterF-                ( \maybeN -> case maybeN of-                    Just n -> let (n', hook) = go n in (hook, Just n')-                    Nothing -> (return (), Nothing)-                )-                aId-                $ nodes arches-         in (Nothing, arches {nodes = nodes'}, hooks)-      else-        let cIds' = cIds <> nodeComponentIds node-         in case lookupArchetypeId cIds' arches of-              Just nextAId ->-                let !(cs, arch) = A.remove e $ nodeArchetype node-                    node' = node {nodeArchetype = arch}-                    !nodes' = Map.insert aId node' $ nodes arches-                    adjustNode nextNode =-                      let nextArch = nodeArchetype nextNode-                          nextArch' = nextArch {A.entities = Set.insert e $ A.entities nextArch}-                          !nextArch'' = A.insertComponents e cs nextArch'-                          (finalArch, hook) = runDynamicBundle b e nextArch''-                       in (nextNode {nodeArchetype = finalArch}, hook)-                    (hooks, nodes'') =-                      Map.alterF-                        ( \maybeN -> case maybeN of-                            Just n -> let (n', hook) = adjustNode n in (hook, Just n')-                            Nothing -> (return (), Nothing)-                        )-                        nextAId-                        nodes'-                 in (Just nextAId, arches {nodes = nodes''}, hooks)-              Nothing ->-                let !(s, arch) = A.removeStorages e $ nodeArchetype node-                    nodes' = Map.insert aId node {nodeArchetype = arch} $ nodes arches-                    (nextArch, hook) = runDynamicBundle b e Archetype {storages = s, entities = Set.singleton e}-                    !n = Node {nodeComponentIds = cIds', nodeArchetype = nextArch}-                    !(nextAId, arches') = insertArchetype cIds' n arches {nodes = nodes'}-                 in (Just nextAId, arches', hook)-  Nothing -> (Nothing, arches, 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 e aId cId arches = case lookup aId arches of-  Just node -> case lookupArchetypeId (Set.delete cId (nodeComponentIds node)) arches of-    Just nextAId ->-      let !(cs, arch') = A.remove e (nodeArchetype node)-          !arches' = arches {nodes = Map.insert aId node {nodeArchetype = arch'} (nodes arches)}-          (a, cs') = IntMap.updateLookupWithKey (\_ _ -> Nothing) (unComponentId cId) cs-          go' archAcc (itemCId, dyn) =-            let adjustStorage s = fromAscVectorDyn (V.fromList . Map.elems . Map.insert e dyn . Map.fromAscList . zip (Set.toList $ entities archAcc) . V.toList $ toAscVectorDyn s) s-             in archAcc {storages = IntMap.adjust adjustStorage itemCId (storages archAcc)}-          go nextNode =-            nextNode {nodeArchetype = foldl' go' (nodeArchetype nextNode) (IntMap.toList cs')}-          maybeA = a >>= fromDynamic-          hook = maybe (return ()) (\comp -> componentOnRemove e comp >> triggerEntityEvent e (OnRemove comp)) maybeA-       in ( (,nextAId) <$> maybeA,-            arches' {nodes = Map.adjust go nextAId (nodes arches')},-            hook-          )-    Nothing ->-      let !(cs, arch') = A.removeStorages e (nodeArchetype node)-          (a, cs') = IntMap.updateLookupWithKey (\_ _ -> Nothing) (unComponentId cId) cs-          destCIds = Set.delete cId (nodeComponentIds node)-          !n =-            Node-              { nodeComponentIds = destCIds,-                nodeArchetype = Archetype {storages = cs', entities = Set.singleton e}-              }-          !(nextAId, arches') = insertArchetype destCIds n arches-          node' = node {nodeArchetype = arch'}-          maybeA = a >>= (\dynS -> V.headM (toAscVectorDyn dynS) >>= fromDynamic)-          hook = maybe (return ()) (\comp -> componentOnRemove e comp >> triggerEntityEvent e (OnRemove comp)) maybeA-       in ( (,nextAId) <$> maybeA,-            arches' {nodes = Map.insert aId node' (nodes arches')},-            hook-          )-  Nothing -> (Nothing, arches, return ())+{-# 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 =
+  Archetypes
+    { nodes = mempty,
+      archetypeIds = mempty,
+      nextArchetypeId = ArchetypeID 0,
+      componentIds = mempty
+    }
+
+-- | Insert an archetype by its set of `ComponentID`s.
+insertArchetype :: Set ComponentID -> Node m -> Archetypes m -> (ArchetypeID, Archetypes m)
+insertArchetype cIds n arches =
+  let aId = nextArchetypeId arches
+   in ( aId,
+        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 aId f arches =
+  arches {nodes = Map.adjust (\node -> 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 cIds arches = case mapMaybe (\cId -> Map.lookup cId (componentIds arches)) (Set.elems cIds) of
+  (aId : aIds') -> foldl' Set.intersection aId aIds'
+  [] -> Set.empty
+
+-- | Lookup `Archetype`s containing a set of `ComponentID`s.
+find :: Set ComponentID -> Archetypes m -> Map ArchetypeID (Node m)
+find cIds arches = Map.fromSet (\aId -> nodes arches Map.! aId) (findArchetypeIds cIds 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 cIds f arches =
+  let go (acc, archAcc) aId =
+        let !node = nodes archAcc Map.! aId
+            !(a, arch') = f (nodeArchetype node)
+            nodes' = Map.insert aId (node {nodeArchetype = arch'}) (nodes archAcc)
+         in (a : acc, archAcc {nodes = nodes'})
+   in foldl' go ([], arches) $ findArchetypeIds cIds arches
+
+-- | Lookup an `ArchetypeID` by its set of `ComponentID`s.
+lookupArchetypeId :: Set ComponentID -> Archetypes m -> Maybe ArchetypeID
+lookupArchetypeId cIds arches = Map.lookup cIds (archetypeIds arches)
+
+-- | Lookup an `Archetype` by its `ArchetypeID`.
+lookup :: ArchetypeID -> Archetypes m -> Maybe (Node m)
+lookup aId arches = Map.lookup aId (nodes 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 e aId cIds b arches = case lookup aId arches of
+  Just node ->
+    if Set.isSubsetOf cIds $ nodeComponentIds node
+      then
+        let go n =
+              let (arch', hook) = runDynamicBundle b e $ nodeArchetype n
+               in (n {nodeArchetype = arch'}, hook)
+            (hooks, nodes') =
+              Map.alterF
+                ( \maybeN -> case maybeN of
+                    Just n -> let (n', hook) = go n in (hook, Just n')
+                    Nothing -> (return (), Nothing)
+                )
+                aId
+                $ nodes arches
+         in (Nothing, arches {nodes = nodes'}, hooks)
+      else
+        let cIds' = cIds <> nodeComponentIds node
+         in case lookupArchetypeId cIds' arches of
+              Just nextAId ->
+                let !(cs, arch) = A.remove e $ nodeArchetype node
+                    node' = node {nodeArchetype = arch}
+                    !nodes' = Map.insert aId node' $ nodes arches
+                    adjustNode nextNode =
+                      let nextArch = nodeArchetype nextNode
+                          nextArch' = nextArch {A.entities = Set.insert e $ A.entities nextArch}
+                          !nextArch'' = A.insertComponents e cs nextArch'
+                          (finalArch, hook) = runDynamicBundle b e nextArch''
+                       in (nextNode {nodeArchetype = finalArch}, hook)
+                    (hooks, nodes'') =
+                      Map.alterF
+                        ( \maybeN -> case maybeN of
+                            Just n -> let (n', hook) = adjustNode n in (hook, Just n')
+                            Nothing -> (return (), Nothing)
+                        )
+                        nextAId
+                        nodes'
+                 in (Just nextAId, arches {nodes = nodes''}, hooks)
+              Nothing ->
+                let !(s, arch) = A.removeStorages e $ nodeArchetype node
+                    nodes' = Map.insert aId node {nodeArchetype = arch} $ nodes arches
+                    (nextArch, hook) = runDynamicBundle b e Archetype {storages = s, entities = Set.singleton e}
+                    !n = Node {nodeComponentIds = cIds', nodeArchetype = nextArch}
+                    !(nextAId, arches') = insertArchetype cIds' n arches {nodes = nodes'}
+                 in (Just nextAId, arches', hook)
+  Nothing -> (Nothing, arches, 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 e aId cId arches = case lookup aId arches of
+  Just node -> case lookupArchetypeId (Set.delete cId (nodeComponentIds node)) arches of
+    Just nextAId ->
+      let !(cs, arch') = A.remove e (nodeArchetype node)
+          !arches' = arches {nodes = Map.insert aId node {nodeArchetype = arch'} (nodes arches)}
+          (a, cs') = IntMap.updateLookupWithKey (\_ _ -> Nothing) (unComponentId cId) cs
+          go' archAcc (itemCId, dyn) =
+            let adjustStorage s = fromAscVectorDyn (V.fromList . Map.elems . Map.insert e dyn . Map.fromAscList . zip (Set.toList $ entities archAcc) . V.toList $ toAscVectorDyn s) s
+             in archAcc {storages = IntMap.adjust adjustStorage itemCId (storages archAcc)}
+          go nextNode =
+            nextNode {nodeArchetype = foldl' go' (nodeArchetype nextNode) (IntMap.toList cs')}
+          maybeA = a >>= fromDynamic
+          hook = maybe (return ()) (\comp -> componentOnRemove e comp >> triggerEntityEvent e (OnRemove comp)) maybeA
+       in ( (,nextAId) <$> maybeA,
+            arches' {nodes = Map.adjust go nextAId (nodes arches')},
+            hook
+          )
+    Nothing ->
+      let !(cs, arch') = A.removeStorages e (nodeArchetype node)
+          (a, cs') = IntMap.updateLookupWithKey (\_ _ -> Nothing) (unComponentId cId) cs
+          destCIds = Set.delete cId (nodeComponentIds node)
+          !n =
+            Node
+              { nodeComponentIds = destCIds,
+                nodeArchetype = Archetype {storages = cs', entities = Set.singleton e}
+              }
+          !(nextAId, arches') = insertArchetype destCIds n arches
+          node' = node {nodeArchetype = arch'}
+          maybeA = a >>= (\dynS -> V.headM (toAscVectorDyn dynS) >>= fromDynamic)
+          hook = maybe (return ()) (\comp -> componentOnRemove e comp >> triggerEntityEvent e (OnRemove comp)) maybeA
+       in ( (,nextAId) <$> maybeA,
+            arches' {nodes = Map.insert aId node' (nodes arches')},
+            hook
+          )
+  Nothing -> (Nothing, arches, return ())

@@ -1,39 +1,39 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}---- |--- Module      : Aztecs.ECS.World.Bundle.Dynamic--- 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.Bundle.Dynamic (DynamicBundle (..), MonoidDynamicBundle (..)) where--import Aztecs.ECS.Access.Internal (Access)-import Aztecs.ECS.Entity-import Aztecs.ECS.World.Archetype-import Aztecs.ECS.World.Bundle.Dynamic.Class---- | Dynamic bundle of components.-newtype DynamicBundle m = DynamicBundle-  { -- | Insert components into an archetype.-    runDynamicBundle :: EntityID -> Archetype m -> (Archetype m, Access m ())-  }--instance (Monad m) => Semigroup (DynamicBundle m) where-  DynamicBundle d1 <> DynamicBundle d2 = DynamicBundle go-    where-      go eId arch =-        let (arch', hook1) = d1 eId arch-            (arch'', hook2) = d2 eId arch'-         in (arch'', hook1 >> hook2)--instance (Monad m) => Monoid (DynamicBundle m) where-  mempty = DynamicBundle (\_ arch -> (arch, return ()))--instance (Monad m) => MonoidDynamicBundle m (DynamicBundle m) where-  dynBundle cId a = DynamicBundle (\eId arch -> insertComponent eId cId a arch)-  dynBundleUntracked cId a = DynamicBundle (\eId arch -> (insertComponentUntracked eId cId a arch, return ()))+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+-- |
+-- Module      : Aztecs.ECS.World.Bundle.Dynamic
+-- 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.Bundle.Dynamic (DynamicBundle (..), MonoidDynamicBundle (..)) where
+
+import Aztecs.ECS.Access.Internal (Access)
+import Aztecs.ECS.Entity
+import Aztecs.ECS.World.Archetype
+import Aztecs.ECS.World.Bundle.Dynamic.Class
+
+-- | Dynamic bundle of components.
+newtype DynamicBundle m = DynamicBundle
+  { -- | Insert components into an archetype.
+    runDynamicBundle :: EntityID -> Archetype m -> (Archetype m, Access m ())
+  }
+
+instance (Monad m) => Semigroup (DynamicBundle m) where
+  DynamicBundle d1 <> DynamicBundle d2 = DynamicBundle go
+    where
+      go eId arch =
+        let (arch', hook1) = d1 eId arch
+            (arch'', hook2) = d2 eId arch'
+         in (arch'', hook1 >> hook2)
+
+instance (Monad m) => Monoid (DynamicBundle m) where
+  mempty = DynamicBundle (\_ arch -> (arch, return ()))
+
+instance (Monad m) => MonoidDynamicBundle m (DynamicBundle m) where
+  dynBundle cId a = DynamicBundle (\eId arch -> insertComponent eId cId a arch)
+  dynBundleUntracked cId a = DynamicBundle (\eId arch -> (insertComponentUntracked eId cId a arch, return ()))

@@ -1,187 +1,187 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}---- |--- Module      : Aztecs.ECS.World.Entities--- 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.Entities-  ( Entities (..),-    empty,-    spawn,-    spawnWithArchetypeId,-    insert,-    insertDyn,-    insertUntracked,-    lookup,-    remove,-    removeWithId,-    despawn,-  )-where--import Aztecs.ECS.Access.Internal (Access)-import Aztecs.ECS.Component-import Aztecs.ECS.Entity-import qualified Aztecs.ECS.World.Archetype as A-import Aztecs.ECS.World.Archetypes (ArchetypeID, Node (..))-import qualified Aztecs.ECS.World.Archetypes as AS-import Aztecs.ECS.World.Bundle-import Aztecs.ECS.World.Bundle.Dynamic-import qualified Aztecs.ECS.World.Components as CS-import Aztecs.ECS.World.Entities.Internal (Entities (..))-import Data.Dynamic-import Data.IntMap (IntMap)-import qualified Data.IntMap as IntMap-import qualified Data.Map as Map-import Data.Maybe-import Data.Set (Set)-import qualified Data.Set as Set-import Prelude hiding (lookup)---- | Empty `World`.-empty :: Entities m-empty =-  Entities-    { archetypes = AS.empty,-      components = CS.empty,-      entities = mempty-    }---- | Spawn a `Bundle`. Returns the updated entities and the onInsert hook to run.-spawn :: (Monad m) => EntityID -> BundleT m -> Entities m -> (Entities m, Access m ())-spawn eId b w =-  let (cIds, components', dynB) = unBundle b (components w)-   in case AS.lookupArchetypeId cIds (archetypes w) of-        Just aId -> case AS.lookup aId $ archetypes w of-          Just node ->-            let (arch', hook) =-                  runDynamicBundle-                    dynB-                    eId-                    ( (nodeArchetype node)-                        { A.entities = Set.insert eId . A.entities $ nodeArchetype node-                        }-                    )-             in ( w-                    { archetypes = (archetypes w) {AS.nodes = Map.insert aId node {nodeArchetype = arch'} (AS.nodes $ archetypes w)},-                      components = components',-                      entities = Map.insert eId aId (entities w)-                    },-                  hook-                )-          Nothing -> (w, return ())-        Nothing ->-          let (arch', hook) = runDynamicBundle dynB eId $ A.singleton eId-              node' = Node {nodeComponentIds = cIds, nodeArchetype = arch'}-              (aId, arches) = AS.insertArchetype cIds node' $ archetypes w-           in ( w-                  { archetypes = arches,-                    entities = Map.insert eId aId (entities w),-                    components = components'-                  },-                hook-              )---- | Spawn a `DynamicBundle` with a specified `ArchetypeID`. Returns the updated entities and the onInsert hook.-spawnWithArchetypeId ::-  (Monad m) =>-  EntityID ->-  ArchetypeID ->-  DynamicBundle m ->-  Entities m ->-  (Entities m, Access m ())-spawnWithArchetypeId e aId b w =-  let f n =-        let (arch', hook) = runDynamicBundle b e ((nodeArchetype n) {A.entities = Set.insert e . A.entities $ nodeArchetype n})-         in (n {nodeArchetype = arch'}, hook)-      (hooks, nodes') =-        Map.alterF-          ( \maybeN -> case maybeN of-              Just n -> let (n', hook) = f n in (hook, Just n')-              Nothing -> (return (), Nothing)-          )-          aId-          (AS.nodes $ archetypes w)-   in ( w-          { archetypes = (archetypes w) {AS.nodes = nodes'},-            entities = Map.insert e aId (entities w)-          },-        hooks-      )---- | Insert a component into an entity. Returns the updated entities and the onInsert hook.-insert :: (Monad m) => EntityID -> BundleT m -> Entities m -> (Entities m, Access m ())-insert e b w =-  let !(cIds, components', dynB) = unBundle b (components w)-   in insertDyn e cIds dynB w {components = components'}---- | Insert a component into an entity with its `ComponentID`. Returns the updated entities and the onInsert hook.-insertDyn :: (Monad m) => EntityID -> Set ComponentID -> DynamicBundle m -> Entities m -> (Entities m, Access m ())-insertDyn e cIds b w = case Map.lookup e $ entities w of-  Just aId ->-    let (maybeNextAId, arches, hook) = AS.insert e aId cIds b $ archetypes w-        es = case maybeNextAId of-          Just nextAId -> Map.insert e nextAId $ entities w-          Nothing -> entities w-     in (w {archetypes = arches, entities = es}, hook)-  Nothing -> case AS.lookupArchetypeId cIds $ archetypes w of-    Just aId -> spawnWithArchetypeId e aId b w-    Nothing ->-      let (arch, hook) = runDynamicBundle b e $ A.singleton e-          node = Node {nodeComponentIds = cIds, nodeArchetype = arch}-          (aId, arches) = AS.insertArchetype cIds node $ archetypes w-       in (w {archetypes = arches, entities = Map.insert e aId (entities w)}, hook)---- | Insert a component into an entity without running lifecycle hooks.-insertUntracked :: (Monad m) => EntityID -> BundleT m -> Entities m -> Entities m-insertUntracked e b w = fst $ insert e b w---- | Lookup a component in an entity.-lookup :: forall m a. (Component m a) => EntityID -> Entities m -> Maybe a-lookup e w = do-  !cId <- CS.lookup @a $ components w-  !aId <- Map.lookup e $ entities w-  !node <- AS.lookup aId $ archetypes w-  A.lookupComponent e cId $ nodeArchetype node---- | Remove a component from an entity. Returns the component (if found), updated entities, and the onRemove hook.-remove :: forall m a. (Component m a) => EntityID -> Entities m -> (Maybe a, Entities m, Access m ())-remove e w =-  let !(cId, components') = CS.insert @a @m (components w)-   in removeWithId e cId w {components = components'}---- | Remove a component from an entity with its `ComponentID`. Returns the component (if found), updated entities, and the onRemove hook.-removeWithId :: forall m a. (Component m a) => EntityID -> ComponentID -> Entities m -> (Maybe a, Entities m, Access m ())-removeWithId e cId w = case Map.lookup e (entities w) of-  Just aId ->-    let (res, as, hook) = AS.remove @m @a e aId cId $ archetypes w-        (maybeA, es) = case res of-          Just (a, nextAId) -> (Just a, Map.insert e nextAId (entities w))-          Nothing -> (Nothing, entities w)-     in (maybeA, w {archetypes = as, entities = es}, hook)-  Nothing -> (Nothing, w, return ())---- | Despawn an entity, returning its components.-despawn :: EntityID -> Entities m -> (IntMap Dynamic, Entities m)-despawn e w =-  let res = do-        !aId <- Map.lookup e $ entities w-        !node <- AS.lookup aId $ archetypes w-        return (aId, node)-   in case res of-        Just (aId, node) ->-          let !(dynAcc, arch') = A.remove e (nodeArchetype node)-           in ( dynAcc,-                w-                  { archetypes = (archetypes w) {AS.nodes = Map.insert aId node {nodeArchetype = arch'} (AS.nodes $ archetypes w)},-                    entities = Map.delete e (entities w)-                  }-              )-        Nothing -> (IntMap.empty, w)+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- |
+-- Module      : Aztecs.ECS.World.Entities
+-- 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.Entities
+  ( Entities (..),
+    empty,
+    spawn,
+    spawnWithArchetypeId,
+    insert,
+    insertDyn,
+    insertUntracked,
+    lookup,
+    remove,
+    removeWithId,
+    despawn,
+  )
+where
+
+import Aztecs.ECS.Access.Internal (Access)
+import Aztecs.ECS.Component
+import Aztecs.ECS.Entity
+import qualified Aztecs.ECS.World.Archetype as A
+import Aztecs.ECS.World.Archetypes (ArchetypeID, Node (..))
+import qualified Aztecs.ECS.World.Archetypes as AS
+import Aztecs.ECS.World.Bundle
+import Aztecs.ECS.World.Bundle.Dynamic
+import qualified Aztecs.ECS.World.Components as CS
+import Aztecs.ECS.World.Entities.Internal (Entities (..))
+import Data.Dynamic
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+import qualified Data.Map as Map
+import Data.Maybe
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Prelude hiding (lookup)
+
+-- | Empty `World`.
+empty :: Entities m
+empty =
+  Entities
+    { archetypes = AS.empty,
+      components = CS.empty,
+      entities = mempty
+    }
+
+-- | Spawn a `Bundle`. Returns the updated entities and the onInsert hook to run.
+spawn :: (Monad m) => EntityID -> BundleT m -> Entities m -> (Entities m, Access m ())
+spawn eId b w =
+  let (cIds, components', dynB) = unBundle b (components w)
+   in case AS.lookupArchetypeId cIds (archetypes w) of
+        Just aId -> case AS.lookup aId $ archetypes w of
+          Just node ->
+            let (arch', hook) =
+                  runDynamicBundle
+                    dynB
+                    eId
+                    ( (nodeArchetype node)
+                        { A.entities = Set.insert eId . A.entities $ nodeArchetype node
+                        }
+                    )
+             in ( w
+                    { archetypes = (archetypes w) {AS.nodes = Map.insert aId node {nodeArchetype = arch'} (AS.nodes $ archetypes w)},
+                      components = components',
+                      entities = Map.insert eId aId (entities w)
+                    },
+                  hook
+                )
+          Nothing -> (w, return ())
+        Nothing ->
+          let (arch', hook) = runDynamicBundle dynB eId $ A.singleton eId
+              node' = Node {nodeComponentIds = cIds, nodeArchetype = arch'}
+              (aId, arches) = AS.insertArchetype cIds node' $ archetypes w
+           in ( w
+                  { archetypes = arches,
+                    entities = Map.insert eId aId (entities w),
+                    components = components'
+                  },
+                hook
+              )
+
+-- | Spawn a `DynamicBundle` with a specified `ArchetypeID`. Returns the updated entities and the onInsert hook.
+spawnWithArchetypeId ::
+  (Monad m) =>
+  EntityID ->
+  ArchetypeID ->
+  DynamicBundle m ->
+  Entities m ->
+  (Entities m, Access m ())
+spawnWithArchetypeId e aId b w =
+  let f n =
+        let (arch', hook) = runDynamicBundle b e ((nodeArchetype n) {A.entities = Set.insert e . A.entities $ nodeArchetype n})
+         in (n {nodeArchetype = arch'}, hook)
+      (hooks, nodes') =
+        Map.alterF
+          ( \maybeN -> case maybeN of
+              Just n -> let (n', hook) = f n in (hook, Just n')
+              Nothing -> (return (), Nothing)
+          )
+          aId
+          (AS.nodes $ archetypes w)
+   in ( w
+          { archetypes = (archetypes w) {AS.nodes = nodes'},
+            entities = Map.insert e aId (entities w)
+          },
+        hooks
+      )
+
+-- | Insert a component into an entity. Returns the updated entities and the onInsert hook.
+insert :: (Monad m) => EntityID -> BundleT m -> Entities m -> (Entities m, Access m ())
+insert e b w =
+  let !(cIds, components', dynB) = unBundle b (components w)
+   in insertDyn e cIds dynB w {components = components'}
+
+-- | Insert a component into an entity with its `ComponentID`. Returns the updated entities and the onInsert hook.
+insertDyn :: (Monad m) => EntityID -> Set ComponentID -> DynamicBundle m -> Entities m -> (Entities m, Access m ())
+insertDyn e cIds b w = case Map.lookup e $ entities w of
+  Just aId ->
+    let (maybeNextAId, arches, hook) = AS.insert e aId cIds b $ archetypes w
+        es = case maybeNextAId of
+          Just nextAId -> Map.insert e nextAId $ entities w
+          Nothing -> entities w
+     in (w {archetypes = arches, entities = es}, hook)
+  Nothing -> case AS.lookupArchetypeId cIds $ archetypes w of
+    Just aId -> spawnWithArchetypeId e aId b w
+    Nothing ->
+      let (arch, hook) = runDynamicBundle b e $ A.singleton e
+          node = Node {nodeComponentIds = cIds, nodeArchetype = arch}
+          (aId, arches) = AS.insertArchetype cIds node $ archetypes w
+       in (w {archetypes = arches, entities = Map.insert e aId (entities w)}, hook)
+
+-- | Insert a component into an entity without running lifecycle hooks.
+insertUntracked :: (Monad m) => EntityID -> BundleT m -> Entities m -> Entities m
+insertUntracked e b w = fst $ insert e b w
+
+-- | Lookup a component in an entity.
+lookup :: forall m a. (Component m a) => EntityID -> Entities m -> Maybe a
+lookup e w = do
+  !cId <- CS.lookup @a $ components w
+  !aId <- Map.lookup e $ entities w
+  !node <- AS.lookup aId $ archetypes w
+  A.lookupComponent e cId $ nodeArchetype node
+
+-- | Remove a component from an entity. Returns the component (if found), updated entities, and the onRemove hook.
+remove :: forall m a. (Component m a) => EntityID -> Entities m -> (Maybe a, Entities m, Access m ())
+remove e w =
+  let !(cId, components') = CS.insert @a @m (components w)
+   in removeWithId e cId w {components = components'}
+
+-- | Remove a component from an entity with its `ComponentID`. Returns the component (if found), updated entities, and the onRemove hook.
+removeWithId :: forall m a. (Component m a) => EntityID -> ComponentID -> Entities m -> (Maybe a, Entities m, Access m ())
+removeWithId e cId w = case Map.lookup e (entities w) of
+  Just aId ->
+    let (res, as, hook) = AS.remove @m @a e aId cId $ archetypes w
+        (maybeA, es) = case res of
+          Just (a, nextAId) -> (Just a, Map.insert e nextAId (entities w))
+          Nothing -> (Nothing, entities w)
+     in (maybeA, w {archetypes = as, entities = es}, hook)
+  Nothing -> (Nothing, w, return ())
+
+-- | Despawn an entity, returning its components.
+despawn :: EntityID -> Entities m -> (IntMap Dynamic, Entities m)
+despawn e w =
+  let res = do
+        !aId <- Map.lookup e $ entities w
+        !node <- AS.lookup aId $ archetypes w
+        return (aId, node)
+   in case res of
+        Just (aId, node) ->
+          let !(dynAcc, arch') = A.remove e (nodeArchetype node)
+           in ( dynAcc,
+                w
+                  { archetypes = (archetypes w) {AS.nodes = Map.insert aId node {nodeArchetype = arch'} (AS.nodes $ archetypes w)},
+                    entities = Map.delete e (entities w)
+                  }
+              )
+        Nothing -> (IntMap.empty, w)

@@ -1,26 +1,26 @@-{-# LANGUAGE DeriveGeneric #-}---- |--- Module      : Aztecs.ECS.World.Internal--- 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.Internal (World (..)) where--import Aztecs.ECS.Entity-import Aztecs.ECS.World.Entities.Internal-import Aztecs.ECS.World.Observers.Internal-import Control.Monad.State---- | World of entities and their components.-data World m = World-  { -- | Entities and their components.-    entities :: !(Entities m),-    -- | Next unique entity identifier.-    nextEntityId :: !EntityID,-    -- | Observers for events.-    observers :: !(Observers (StateT (World m) m))-  }+{-# LANGUAGE DeriveGeneric #-}
+
+-- |
+-- Module      : Aztecs.ECS.World.Internal
+-- 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.Internal (World (..)) where
+
+import Aztecs.ECS.Entity
+import Aztecs.ECS.World.Entities.Internal
+import Aztecs.ECS.World.Observers.Internal
+import Control.Monad.State
+
+-- | World of entities and their components.
+data World m = World
+  { -- | Entities and their components.
+    entities :: !(Entities m),
+    -- | Next unique entity identifier.
+    nextEntityId :: !EntityID,
+    -- | Observers for events.
+    observers :: !(Observers (StateT (World m) m))
+  }

@@ -1,70 +1,70 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}---- |--- Module      : Aztecs.ECS.World.Storage.Dynamic--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.ECS.World.Storage.Dynamic-  ( DynamicStorage (..),-    dynStorage,-    singletonDyn,-    fromAscVectorDyn,-    toAscVectorDyn,-  )-where--import qualified Aztecs.ECS.World.Storage as S-import Data.Dynamic-import Data.Maybe-import Data.Vector (Vector)-import qualified Data.Vector as V---- | Dynamic storage of components.-data DynamicStorage = DynamicStorage-  { -- | Dynamic storage.-    storageDyn :: !Dynamic,-    -- | Singleton storage.-    singletonDyn' :: !(Dynamic -> Dynamic),-    -- | Convert this storage to an ascending vector.-    toAscVectorDyn' :: !(Dynamic -> Vector Dynamic),-    -- | Convert from an ascending vector.-    fromAscVectorDyn' :: !(Vector Dynamic -> Dynamic)-  }--instance Show DynamicStorage where-  show s = "DynamicStorage " ++ show (storageDyn s)---- | Create a dynamic storage from a storage.-dynStorage :: forall a s. (S.Storage a s) => s -> DynamicStorage-dynStorage s =-  DynamicStorage-    { storageDyn = toDyn s,-      singletonDyn' = toDyn . S.singleton @a @s . fromMaybe (error "TODO") . fromDynamic,-      toAscVectorDyn' = \d -> V.map toDyn (S.toAscVector @a @s (fromMaybe (error "TODO") $ fromDynamic d)),-      fromAscVectorDyn' = toDyn . S.fromAscVector @a @s . V.map (fromMaybe (error "TODO") . fromDynamic)-    }-{-# INLINE dynStorage #-}---- | Singleton dynamic storage.-singletonDyn :: Dynamic -> DynamicStorage -> DynamicStorage-singletonDyn dyn s = s {storageDyn = singletonDyn' s dyn}---- | Convert from an ascending vector.-fromAscVectorDyn :: Vector Dynamic -> DynamicStorage -> DynamicStorage-fromAscVectorDyn dyns s = s {storageDyn = fromAscVectorDyn' s dyns}---- | Convert this storage to an ascending vector.-toAscVectorDyn :: DynamicStorage -> Vector Dynamic-toAscVectorDyn = toAscVectorDyn' <*> storageDyn+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- |
+-- Module      : Aztecs.ECS.World.Storage.Dynamic
+-- Copyright   : (c) Matt Hunzinger, 2025
+-- License     : BSD-style (see the LICENSE file in the distribution)
+--
+-- Maintainer  : matt@hunzinger.me
+-- Stability   : provisional
+-- Portability : non-portable (GHC extensions)
+module Aztecs.ECS.World.Storage.Dynamic
+  ( DynamicStorage (..),
+    dynStorage,
+    singletonDyn,
+    fromAscVectorDyn,
+    toAscVectorDyn,
+  )
+where
+
+import qualified Aztecs.ECS.World.Storage as S
+import Data.Dynamic
+import Data.Maybe
+import Data.Vector (Vector)
+import qualified Data.Vector as V
+
+-- | Dynamic storage of components.
+data DynamicStorage = DynamicStorage
+  { -- | Dynamic storage.
+    storageDyn :: !Dynamic,
+    -- | Singleton storage.
+    singletonDyn' :: !(Dynamic -> Dynamic),
+    -- | Convert this storage to an ascending vector.
+    toAscVectorDyn' :: !(Dynamic -> Vector Dynamic),
+    -- | Convert from an ascending vector.
+    fromAscVectorDyn' :: !(Vector Dynamic -> Dynamic)
+  }
+
+instance Show DynamicStorage where
+  show s = "DynamicStorage " ++ show (storageDyn s)
+
+-- | Create a dynamic storage from a storage.
+dynStorage :: forall a s. (S.Storage a s) => s -> DynamicStorage
+dynStorage s =
+  DynamicStorage
+    { storageDyn = toDyn s,
+      singletonDyn' = toDyn . S.singleton @a @s . fromMaybe (error "TODO") . fromDynamic,
+      toAscVectorDyn' = \d -> V.map toDyn (S.toAscVector @a @s (fromMaybe (error "TODO") $ fromDynamic d)),
+      fromAscVectorDyn' = toDyn . S.fromAscVector @a @s . V.map (fromMaybe (error "TODO") . fromDynamic)
+    }
+{-# INLINE dynStorage #-}
+
+-- | Singleton dynamic storage.
+singletonDyn :: Dynamic -> DynamicStorage -> DynamicStorage
+singletonDyn dyn s = s {storageDyn = singletonDyn' s dyn}
+
+-- | Convert from an ascending vector.
+fromAscVectorDyn :: Vector Dynamic -> DynamicStorage -> DynamicStorage
+fromAscVectorDyn dyns s = s {storageDyn = fromAscVectorDyn' s dyns}
+
+-- | Convert this storage to an ascending vector.
+toAscVectorDyn :: DynamicStorage -> Vector Dynamic
+toAscVectorDyn = toAscVectorDyn' <*> storageDyn

@@ -24,7 +24,6 @@ module Aztecs.Hierarchy
   ( Parent (..),
     Children (..),
-    update,
     Hierarchy (..),
     toList,
     foldWithKey,
@@ -32,8 +31,6 @@     mapWithAccum,
     hierarchy,
     hierarchies,
-    ParentState (..),
-    ChildState (..),
   )
 where
 
@@ -41,7 +38,6 @@ import qualified Aztecs.ECS.Access as A
 import qualified Aztecs.ECS.Query as Q
 import qualified Aztecs.ECS.System as S
-import Control.Monad
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe
@@ -58,80 +54,52 @@   }
   deriving (Eq, Ord, Show, Generic)
 
-instance (Monad m) => Component m Parent
+instance (Monad m) => Component m Parent where
+  componentOnInsert e (Parent parent) = do
+    -- Add this entity to the parent's children.
+    maybeChildren <- A.lookup parent
+    let parentChildren = maybe mempty unChildren maybeChildren
+    A.insertUntracked parent . bundle . Children $ Set.insert e parentChildren
 
--- | Parent internal state component.
-newtype ParentState = ParentState {unParentState :: EntityID}
-  deriving (Show, Generic)
+  componentOnChange e (Parent oldParent) (Parent newParent) = do
+    -- Remove this entity from the old parent's children.
+    maybeOldChildren <- A.lookup oldParent
+    let oldChildren = maybe mempty unChildren maybeOldChildren
+    let oldChildren' = Set.filter (/= e) oldChildren
+    A.insertUntracked oldParent . bundle . Children $ oldChildren'
 
-instance (Monad m) => Component m ParentState
+    -- Add this entity to the new parent's children.
+    maybeNewChildren <- A.lookup newParent
+    let newChildren = maybe mempty unChildren maybeNewChildren
+    A.insertUntracked newParent . bundle . Children $ Set.insert e newChildren
 
+  componentOnRemove e (Parent parent) = do
+    -- Remove this entity from the parent's children.
+    maybeChildren <- A.lookup parent
+    let parentChildren = maybe mempty unChildren maybeChildren
+    let parentChildren' = Set.filter (/= e) parentChildren
+    A.insertUntracked parent . bundle . Children $ parentChildren'
+
 -- | Children component.
 newtype Children = Children {unChildren :: Set EntityID}
   deriving (Eq, Ord, Show, Semigroup, Monoid, Generic)
 
-instance (Monad m) => Component m Children
-
--- | Child internal state component.
-newtype ChildState = ChildState {unChildState :: Set EntityID}
-  deriving (Show, Generic)
-
-instance (Monad m) => Component m ChildState
-
--- | Update the parent-child relationships.
-update :: (Monad m) => Access m ()
-update = do
-  parents <- A.system . S.readQuery $ do
-    e <- Q.entity
-    parent <- Q.query
-    maybeParentState <- Q.queryMaybe @_ @ParentState
-    return (e, unParent parent, maybeParentState)
-
-  children <- A.system . S.readQuery $ do
-    e <- Q.entity
-    cs <- Q.query
-    maybeChildState <- Q.queryMaybe @_ @ChildState
-    return (e, unChildren cs, maybeChildState)
-
-  let go = do
-        mapM_
-          ( \(e, parent, maybeParentState) -> case maybeParentState of
-              Just (ParentState parentState) -> do
-                when (parent /= parentState) $ do
-                  A.insert parent . bundle $ ParentState parent
+instance (Monad m) => Component m Children where
+  componentOnInsert e (Children cs) = do
+    -- Set parent on all children.
+    mapM_ (\child -> A.insertUntracked child . bundle $ Parent e) cs
 
-                  -- Remove this entity from the previous parent's children.
-                  maybeLastChildren <- A.lookup parentState
-                  let lastChildren = maybe mempty unChildren maybeLastChildren
-                  let lastChildren' = Set.filter (/= e) lastChildren
-                  A.insert parentState . bundle . Children $ lastChildren'
+  componentOnChange e (Children oldCs) (Children newCs) = do
+    let added = Set.difference newCs oldCs
+        removed = Set.difference oldCs newCs
+    -- Set parent on added children.
+    mapM_ (\child -> A.insertUntracked child . bundle $ Parent e) added
+    -- Remove parent from removed children.
+    mapM_ (\child -> A.remove @_ @Parent child) removed
 
-                  -- Add this entity to the new parent's children.
-                  maybeChildren <- A.lookup parent
-                  let parentChildren = maybe mempty unChildren maybeChildren
-                  A.insert parent . bundle . Children $ Set.insert e parentChildren
-              Nothing -> do
-                A.spawn_ . bundle $ ParentState parent
-                maybeChildren <- A.lookup parent
-                let parentChildren = maybe mempty unChildren maybeChildren
-                A.insert parent . bundle . Children $ Set.insert e parentChildren
-          )
-          parents
-        mapM_
-          ( \(e, children', maybeChildState) -> case maybeChildState of
-              Just (ChildState childState) -> do
-                when (children' /= childState) $ do
-                  A.insert e . bundle $ ChildState children'
-                  let added = Set.difference children' childState
-                      removed = Set.difference childState children'
-                  mapM_ (\e' -> A.insert e' . bundle . Parent $ e') added
-                  mapM_ (A.remove @_ @Parent) removed
-              Nothing -> do
-                A.insert e . bundle $ ChildState children'
-                mapM_ (\e' -> A.insert e' . bundle . Parent $ e') children'
-          )
-          children
-  go
+  componentOnRemove _ (Children cs) = do
+    -- Remove parent from all children.
+    mapM_ (\child -> A.remove @_ @Parent child) cs
 
 -- | Hierarchy of entities.
 data Hierarchy a = Node