packages feed

aztecs 0.12.0 → 0.13.0

raw patch · 29 files changed

+1317/−2841 lines, 29 filesdep +primitivedep +sparse-setdep −stm

Dependencies added: primitive, sparse-set

Dependencies removed: stm

Files

aztecs.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4
 name:          aztecs
-version:       0.12.0
+version:       0.13.0
 license:       BSD-3-Clause
 license-file:  LICENSE
 maintainer:    matt@hunzinger.me
@@ -27,31 +27,27 @@     exposed-modules:
         Aztecs.ECS
         Aztecs.ECS.Access
-        Aztecs.ECS.Component
-        Aztecs.ECS.Entity
+        Aztecs.ECS.Access.Internal
+        Aztecs.ECS.Class
+        Aztecs.ECS.Entities
+        Aztecs.ECS.HSet
         Aztecs.ECS.Query
-        Aztecs.ECS.Query.Dynamic
-        Aztecs.ECS.System
-        Aztecs.ECS.View
+        Aztecs.ECS.Queryable
+        Aztecs.ECS.Queryable.Internal
+        Aztecs.ECS.Queryable.R
+        Aztecs.ECS.Queryable.W
         Aztecs.ECS.World
-        Aztecs.ECS.World.Archetype
-        Aztecs.ECS.World.Archetypes
-        Aztecs.ECS.World.Bundle
-        Aztecs.ECS.World.Bundle.Dynamic
-        Aztecs.ECS.World.Components
-        Aztecs.ECS.World.Entities
-        Aztecs.ECS.World.Storage
-        Aztecs.ECS.World.Storage.Dynamic
+        Aztecs.ECS.System
 
     hs-source-dirs:   src
     default-language: Haskell2010
-    ghc-options:      -Wall
     build-depends:
         base >=4.2 && <5,
         containers >=0.6,
         deepseq >=1,
         mtl >=2,
-        stm >=2
+        primitive >=0.6,
+        sparse-set >=0.2
 
 executable ecs
     main-is:          examples/ECS.hs
@@ -59,8 +55,7 @@     ghc-options:      -Wall
     build-depends:
         base,
-        aztecs,
-        deepseq >=1
+        aztecs
 
 test-suite aztecs-test
     type:             exitcode-stdio-1.0
@@ -81,9 +76,12 @@     main-is:          Bench.hs
     hs-source-dirs:   bench
     default-language: Haskell2010
-    ghc-options:      -Wall
+    ghc-options:
+        -Wall -O2 -fspecialise-aggressively -fexpose-all-unfoldings
     build-depends:
         base >=4.2 && <5,
         aztecs,
         criterion >=1,
-        deepseq >=1
+        deepseq >=1,
+        primitive >=0.6,
+        sparse-set >=0.2
bench/Bench.hs view
@@ -1,33 +1,54 @@ {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 import Aztecs.ECS
-import qualified Aztecs.ECS.Query as Q
-import Aztecs.ECS.World
+import qualified Aztecs.ECS as ECS
 import qualified Aztecs.ECS.World as W
 import Control.DeepSeq
+import Control.Monad
 import Criterion.Main
-import Data.Function
-import Data.Functor.Identity
-import GHC.Generics
+import GHC.Generics (Generic)
 
-newtype Position = Position Int deriving (Show, Generic, NFData)
+newtype Position = Position Int deriving (Generic, NFData, Show)
 
-instance Component Position
+newtype Velocity = Velocity Int deriving (Generic, NFData, Show)
 
-newtype Velocity = Velocity Int deriving (Show, Generic, NFData)
+move :: Query IO (W IO Position, R Velocity) -> IO ()
+move q = do
+  results <- runQuery q
+  mapM_ go results
+  where
+    go (posRef, ECS.R (Velocity v)) = do
+      Position oldPos <- readW posRef
+      writeW posRef (Position (oldPos + v))
+    {-# INLINE go #-}
+{-# INLINE move #-}
 
-instance Component Velocity
+data MoveSystem = MoveSystem
 
-q :: Query Position
-q = fetch & zipFetchMap (\(Velocity v) (Position p) -> Position $ p + v)
+instance System IO MoveSystem where
+  type SystemInputs MoveSystem = Query IO (W IO Position, ECS.R Velocity)
+  runSystem MoveSystem q = move q
 
-run :: World -> [Position]
-run = fst . runIdentity . Q.query q . entities
+setup :: IO (W.World IO '[Position, Velocity])
+setup = do
+  w <- W.empty @_ @'[Position, Velocity]
+  foldM setupEntity w [0 :: Int .. 10000]
+  where
+    setupEntity w _ = do
+      (e, w') <- W.spawn (Position 0) w
+      W.insert e (Velocity 1) w'
 
 main :: IO ()
 main = do
-  let go wAcc = snd $ W.spawn (bundle (Position 0) <> bundle (Velocity 1)) wAcc
-      !w = foldr (const go) W.empty [0 :: Int .. 10000]
-  defaultMain [bench "iter" $ nf run w]
+  !w <- setup
+  defaultMain [bench "iter" $ whnfIO (runSystemWithWorld MoveSystem w)]
examples/ECS.hs view
@@ -1,30 +1,41 @@+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
 module Main where
 
 import Aztecs.ECS
-import Control.Monad
+import qualified Aztecs.ECS.Query as Q
+import qualified Aztecs.ECS.World as W
 import Control.Monad.IO.Class
-import Data.Function
 
-newtype Position = Position Int deriving (Show)
-
-instance Component Position
+newtype Position = Position Int
+  deriving (Show, Eq)
 
 newtype Velocity = Velocity Int
-
-instance Component Velocity
+  deriving (Show, Eq)
 
-move :: Query Position
-move = fetch & zipFetchMap (\(Velocity v) (Position p) -> Position $ p + v)
+data MoveSystem = MoveSystem
 
-run :: SystemT IO ()
-run = do
-  positions <- query move
-  liftIO $ print positions
+instance (PrimMonad m, MonadIO m) => System m MoveSystem where
+  type SystemInputs m MoveSystem = Query m (W m Position, R Velocity)
+  runSystem MoveSystem q = do
+    results <- Q.runQuery q
+    mapM_ go results
+    where
+      go (posRef, R (Velocity v)) = do
+        modifyW posRef $ \(Position p) -> Position (p + v)
 
-app :: AccessT IO ()
-app = do
-  _ <- spawn $ bundle (Position 0) <> bundle (Velocity 1)
-  forever $ system run
+        p <- readW posRef
+        liftIO $ putStrLn $ "Moved to: " ++ show p
 
 main :: IO ()
-main = runAccessT_ app
+main = do
+  world <- W.empty @_ @'[Position, Velocity]
+  runAztecsT_ go world
+  where
+    go = do
+      _ <- spawn (bundle (Position 0) <> bundle (Velocity 1))
+      runSystemWithWorld MoveSystem
src/Aztecs/ECS.hs view
@@ -1,58 +1,70 @@--- | 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.
---
--- The ECS architecture is composed of three main concepts:
---
--- === Entities
--- An entity is an object comprised of zero or more components.
--- In Aztecs, entities are represented by their `EntityID`, a unique identifier.
---
--- === Components
--- A `Component` holds the data for a particular aspect of an entity.
--- For example, a zombie entity might have a @Health@ and a @Transform@ component.
---
--- > newtype Position = Position Int deriving (Show)
--- > instance Component Position
--- >
--- > newtype Velocity = Velocity Int deriving (Show)
--- > instance Component Velocity
---
--- === Systems
--- A `System` is a pipeline that processes entities and their components.
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UnboxedTuples #-}
+
 module Aztecs.ECS
-  ( module Aztecs.ECS.System,
-    module Aztecs.ECS.Query,
-    Access,
-    AccessT,
-    runAccessT,
-    runAccessT_,
-    Bundle,
+  ( module Aztecs.ECS.Queryable,
+    module Aztecs.ECS.Queryable.R,
+    module Aztecs.ECS.Queryable.W,
+    PrimMonad (..),
     bundle,
-    fromDynBundle,
-    DynamicBundle,
-    dynBundle,
-    Component (..),
-    EntityID,
-    spawn,
-    system,
-    concurrently,
-    World,
+    Query (..),
+    System (..),
+    ECS (..),
+    AztecsT (..),
+    runAztecsT_,
   )
 where
 
-import Aztecs.ECS.Access
-import Aztecs.ECS.Component
-import Aztecs.ECS.Entity
-import Aztecs.ECS.Query hiding
-  ( query,
-    querySingle,
-    querySingleMaybe,
-    readQuery,
-    readQueryEntities,
-  )
-import Aztecs.ECS.System hiding (concurrently)
-import Aztecs.ECS.World (World)
-import Aztecs.ECS.World.Bundle
-import Aztecs.ECS.World.Bundle.Dynamic
+import qualified Aztecs.ECS.Access.Internal as A
+import Aztecs.ECS.Class
+import qualified Aztecs.ECS.Entities as E
+import Aztecs.ECS.Query
+import Aztecs.ECS.Queryable
+import Aztecs.ECS.Queryable.R
+import Aztecs.ECS.Queryable.W
+import Aztecs.ECS.System
+import Aztecs.ECS.World (World, bundle)
+import qualified Aztecs.ECS.World as W
+import Control.Monad.Primitive
+import Control.Monad.State.Strict
+
+newtype AztecsT cs m a = AztecsT {unAztecsT :: StateT (World m cs) m a}
+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)
+
+instance MonadTrans (AztecsT cs) where
+  lift = AztecsT . lift
+
+instance (PrimMonad m) => ECS (AztecsT cs m) where
+  type Entity (AztecsT cs m) = E.Entity
+  type Bundle (AztecsT cs m) = W.Bundle cs m
+  type Components (AztecsT cs m) = cs
+  type Task (AztecsT cs m) = m
+
+  spawn b = AztecsT $ do
+    w <- get
+    (e, w') <- lift $ W.spawn b w
+    put w'
+    return e
+  insert e b = AztecsT $ do
+    w <- get
+    w' <- lift $ W.insert e b w
+    put w'
+  remove e = AztecsT $ do
+    w <- get
+    w' <- lift $ W.remove e w
+    put w'
+  query = AztecsT $ do
+    w <- get
+    return $ W.query w
+  task = AztecsT . lift
+  access = AztecsT $ do
+    w <- get
+    return $ A.access w
+
+runAztecsT_ :: (Monad m) => AztecsT cs m a -> World m cs -> m a
+runAztecsT_ (AztecsT m) = evalStateT m
src/Aztecs/ECS/Access.hs view
@@ -1,150 +1,3 @@-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-
--- |
--- 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,
-    AccessT (..),
-    spawn,
-    insert,
-    lookup,
-    remove,
-    despawn,
-    runAccessT,
-    runAccessT_,
-    system,
-    concurrently,
-  )
-where
-
-import Aztecs.ECS.Component
-import Aztecs.ECS.Entity
-import Aztecs.ECS.System (SystemT (..), runSystemT)
-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 Control.Concurrent.STM
-import Control.DeepSeq
-import Control.Monad.Fix
-import Control.Monad.Identity
-import Control.Monad.Reader
-import Control.Monad.State.Strict
-import Prelude hiding (lookup)
-
--- | @since 0.9
-type Access = AccessT Identity
-
--- | Access into the `World`.
---
--- @since 0.9
-newtype AccessT m a = AccessT {unAccessT :: StateT World m a}
-  deriving (Functor, Applicative, MonadFix, MonadIO)
-
--- | @since 0.9
-instance (Monad m) => Monad (AccessT m) where
-  a >>= f = AccessT $ do
-    !w <- get
-    (a', w') <- lift $ runAccessT a w
-    put (rnf w' `seq` w')
-    unAccessT $ f a'
-
--- | Run an `Access` on a `World`, returning the output and updated `World`.
---
--- @since 0.9
-runAccessT :: (Functor m) => AccessT m a -> World -> m (a, World)
-runAccessT a = runStateT $ unAccessT a
-
--- | Run an `Access` on an empty `World`.
---
--- @since 0.9
-runAccessT_ :: (Functor m) => AccessT m a -> m a
-runAccessT_ a = fmap fst . runAccessT a $ W.empty
-
--- | Spawn an entity with a `Bundle`.
---
--- @since 0.11
-spawn :: (Monad m) => Bundle -> AccessT m EntityID
-spawn b = AccessT $ do
-  !w <- get
-  let !(e, w') = W.spawn b w
-  put w'
-  return e
-
--- | Insert a `Bundle` into an entity.
---
--- @since 0.11
-insert :: (Monad m) => EntityID -> Bundle -> AccessT m ()
-insert e c = AccessT $ do
-  !w <- get
-  let !w' = W.insert e c w
-  put w'
-
--- | Lookup a component by `EntityID`.
---
--- @since 0.11
-lookup :: (Monad m, Component a) => EntityID -> AccessT m (Maybe a)
-lookup e = AccessT $ do
-  !w <- get
-  return $ W.lookup e w
-
--- | Remove a component by `EntityID`.
---
--- @since 0.11
-remove :: (Monad m, Component a) => EntityID -> AccessT m (Maybe a)
-remove e = AccessT $ do
-  !w <- get
-  let !(a, w') = W.remove e w
-  put w'
-  return a
-
--- | Despawn an entity by `EntityID`.
---
--- @since 0.11
-despawn :: (Monad m) => EntityID -> AccessT m ()
-despawn e = AccessT $ do
-  !w <- get
-  let !(_, w') = W.despawn e w
-  put w'
-
--- | Run a `System`.
---
--- @since 0.11
-system :: (Monad m) => SystemT m a -> AccessT m a
-system s = AccessT $ do
-  !w <- get
-  let go f = do
-        es <- get
-        let es' = f es
-        put es'
-        return es'
-  (a, es) <- lift $ runStateT (runSystemT s go) (entities w)
-  put w {entities = es}
-  return a
+module Aztecs.ECS.Access (Access (..)) where
 
--- | Run a `System` concurrently.
---
--- @since 0.11
-concurrently :: SystemT IO a -> AccessT IO a
-concurrently s = AccessT $ do
-  !w <- get
-  esVar <- lift . newTVarIO $ entities w
-  let go f = atomically $ do
-        es <- readTVar esVar
-        let es' = f es
-        writeTVar esVar es'
-        return es'
-  a <- liftIO $ S.concurrently s go
-  es <- lift $ readTVarIO esVar
-  put w {entities = es}
-  return a
+import Aztecs.ECS.Access.Internal
+ src/Aztecs/ECS/Access/Internal.hs view
@@ -0,0 +1,370 @@+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Aztecs.ECS.Access.Internal where
+
+import Aztecs.ECS.HSet
+import Aztecs.ECS.Query
+import Aztecs.ECS.Queryable
+import Aztecs.ECS.Queryable.Internal
+import Aztecs.ECS.World
+import Control.Monad.Primitive
+import Data.Kind
+import GHC.Generics
+
+type family ValidAccessInput (accesses :: [Type]) :: Constraint where
+  ValidAccessInput accesses =
+    ( ValidAccess accesses,
+      NoOverlappingWrites accesses
+    )
+
+type family NoOverlappingWrites (accesses :: [Type]) :: Constraint where
+  NoOverlappingWrites accesses =
+    (HasDuplicateWrites (WriteComponents accesses) ~ 'False)
+
+type family HasDuplicateWrites (components :: [Type]) :: Bool where
+  HasDuplicateWrites '[] = 'False
+  HasDuplicateWrites (c ': rest) = Or (Contains c rest) (HasDuplicateWrites rest)
+
+class (PrimMonad m) => Access cs m a where
+  type AccessType a :: [Type]
+  access ::
+    ( Subset (AccessToComponents (AccessType a)) cs,
+      ValidAccessInput (AccessType a)
+    ) =>
+    World m cs ->
+    a
+  default access ::
+    ( Generic a,
+      GenericAccess cs m (Rep a),
+      Subset (AccessToComponents (GenericAccessType (Rep a))) cs,
+      ValidAccessInput (GenericAccessType (Rep a)),
+      AccessType a ~ GenericAccessType (Rep a)
+    ) =>
+    World m cs ->
+    a
+  access = deriveAccess
+  {-# INLINE access #-}
+
+class GenericAccess cs m f where
+  type GenericAccessType f :: [Type]
+  genericAccess ::
+    ( Subset (AccessToComponents (GenericAccessType f)) cs,
+      ValidAccessInput (GenericAccessType f)
+    ) =>
+    World m cs ->
+    f p
+
+instance GenericAccess cs m U1 where
+  type GenericAccessType U1 = '[]
+  genericAccess _ = U1
+  {-# INLINE genericAccess #-}
+
+instance (Access cs m c) => GenericAccess cs m (K1 i c) where
+  type GenericAccessType (K1 i c) = AccessType c
+  genericAccess world = K1 (access world)
+  {-# INLINE genericAccess #-}
+
+instance (GenericAccess cs m f) => GenericAccess cs m (M1 i c f) where
+  type GenericAccessType (M1 i c f) = GenericAccessType f
+  genericAccess world = M1 (genericAccess world)
+  {-# INLINE genericAccess #-}
+
+instance
+  ( GenericAccess cs m f,
+    GenericAccess cs m g,
+    Subset (AccessToComponents (GenericAccessType f)) cs,
+    ValidAccessInput (GenericAccessType f),
+    Subset (AccessToComponents (GenericAccessType g)) cs,
+    ValidAccessInput (GenericAccessType g)
+  ) =>
+  GenericAccess cs m (f :*: g)
+  where
+  type GenericAccessType (f :*: g) = GenericAccessType f ++ GenericAccessType g
+  genericAccess world = genericAccess world :*: genericAccess world
+  {-# INLINE genericAccess #-}
+
+instance (PrimMonad m, Queryable cs m a) => Access cs m (Query m a) where
+  type AccessType (Query m a) = QueryableAccess a
+  access = query
+  {-# INLINE access #-}
+
+instance (PrimMonad m) => Access cs m () where
+  type AccessType () = '[]
+  access _ = ()
+  {-# INLINE access #-}
+
+deriveAccess ::
+  forall a m cs.
+  ( Generic a,
+    GenericAccess cs m (Rep a),
+    Subset (AccessToComponents (GenericAccessType (Rep a))) cs,
+    ValidAccessInput (GenericAccessType (Rep a))
+  ) =>
+  World m cs ->
+  a
+deriveAccess world = to (genericAccess world)
+{-# INLINE deriveAccess #-}
+
+type family DeriveAccessType (rep :: Type -> Type) :: [Type] where
+  DeriveAccessType rep = GenericAccessType rep
+
+instance
+  ( Access cs m a,
+    Access cs m b,
+    ValidAccessInput (AccessType a),
+    ValidAccessInput (AccessType b),
+    Subset (AccessToComponents (AccessType a)) cs,
+    Subset (AccessToComponents (AccessType b)) cs
+  ) =>
+  Access cs m (a, b)
+  where
+  type AccessType (a, b) = AccessType a ++ AccessType b
+
+instance
+  ( Access cs m a,
+    Access cs m b,
+    Access cs m c,
+    ValidAccessInput (AccessType a),
+    ValidAccessInput (AccessType b),
+    ValidAccessInput (AccessType c),
+    ValidAccessInput (AccessType b ++ AccessType c),
+    Subset (AccessToComponents (AccessType a)) cs,
+    Subset (AccessToComponents (AccessType b)) cs,
+    Subset (AccessToComponents (AccessType c)) cs,
+    Subset (AccessToComponents (AccessType b ++ AccessType c)) cs,
+    Subset (AccessToComponents (AccessType a ++ (AccessType b ++ AccessType c))) cs
+  ) =>
+  Access cs m (a, b, c)
+  where
+  type AccessType (a, b, c) = AccessType a ++ (AccessType b ++ AccessType c)
+
+instance
+  ( Access cs m a,
+    Access cs m b,
+    Access cs m c,
+    Access cs m d,
+    ValidAccessInput (AccessType a),
+    ValidAccessInput (AccessType b),
+    ValidAccessInput (AccessType c),
+    ValidAccessInput (AccessType d),
+    ValidAccessInput (AccessType a ++ AccessType b),
+    ValidAccessInput (AccessType c ++ AccessType d),
+    Subset (AccessToComponents (AccessType a)) cs,
+    Subset (AccessToComponents (AccessType b)) cs,
+    Subset (AccessToComponents (AccessType c)) cs,
+    Subset (AccessToComponents (AccessType d)) cs,
+    Subset (AccessToComponents (AccessType a ++ AccessType b)) cs,
+    Subset (AccessToComponents (AccessType c ++ AccessType d)) cs
+  ) =>
+  Access cs m (a, b, c, d)
+  where
+  type
+    AccessType (a, b, c, d) =
+      ((AccessType a ++ AccessType b) ++ (AccessType c ++ AccessType d))
+
+instance
+  ( Access cs m a,
+    Access cs m b,
+    Access cs m c,
+    Access cs m d,
+    Access cs m e,
+    ValidAccessInput (AccessType a),
+    ValidAccessInput (AccessType b),
+    ValidAccessInput (AccessType c),
+    ValidAccessInput (AccessType d),
+    ValidAccessInput (AccessType e),
+    ValidAccessInput (AccessType a ++ AccessType b),
+    ValidAccessInput ((AccessType c ++ (AccessType d ++ AccessType e))),
+    ValidAccessInput (AccessType d ++ AccessType e),
+    Subset (AccessToComponents (AccessType a)) cs,
+    Subset (AccessToComponents (AccessType b)) cs,
+    Subset (AccessToComponents (AccessType c)) cs,
+    Subset (AccessToComponents (AccessType d)) cs,
+    Subset (AccessToComponents (AccessType e)) cs,
+    Subset (AccessToComponents (AccessType a ++ AccessType b)) cs,
+    Subset
+      (AccessToComponents (AccessType d ++ AccessType e))
+      cs,
+    Subset
+      ( AccessToComponents
+          (AccessType c ++ (AccessType d ++ AccessType e))
+      )
+      cs,
+    Subset
+      ( AccessToComponents
+          ( ( (AccessType a ++ AccessType b)
+                ++ (AccessType c ++ (AccessType d ++ AccessType e))
+            )
+          )
+      )
+      cs
+  ) =>
+  Access cs m (a, b, c, d, e)
+  where
+  type
+    AccessType (a, b, c, d, e) =
+      ( (AccessType a ++ AccessType b)
+          ++ (AccessType c ++ (AccessType d ++ AccessType e))
+      )
+
+instance
+  ( Access cs m a,
+    Access cs m b,
+    Access cs m c,
+    Access cs m d,
+    Access cs m e,
+    Access cs m f,
+    ValidAccessInput (AccessType a),
+    ValidAccessInput (AccessType b),
+    ValidAccessInput (AccessType c),
+    ValidAccessInput (AccessType d),
+    ValidAccessInput (AccessType e),
+    ValidAccessInput (AccessType f),
+    ValidAccessInput (AccessType e ++ AccessType f),
+    ValidAccessInput (AccessType d ++ (AccessType e ++ AccessType f)),
+    ValidAccessInput (AccessType a ++ (AccessType b ++ AccessType c)),
+    ValidAccessInput (AccessType b ++ AccessType c),
+    Subset (AccessToComponents (AccessType a)) cs,
+    Subset (AccessToComponents (AccessType b)) cs,
+    Subset (AccessToComponents (AccessType c)) cs,
+    Subset (AccessToComponents (AccessType d)) cs,
+    Subset (AccessToComponents (AccessType e)) cs,
+    Subset (AccessToComponents (AccessType f)) cs,
+    Subset (AccessToComponents (AccessType b ++ AccessType c)) cs,
+    Subset (AccessToComponents (AccessType e ++ AccessType f)) cs,
+    Subset
+      ( AccessToComponents
+          (AccessType a ++ (AccessType b ++ AccessType c))
+      )
+      cs,
+    Subset
+      ( AccessToComponents
+          (AccessType d ++ (AccessType e ++ AccessType f))
+      )
+      cs
+  ) =>
+  Access cs m (a, b, c, d, e, f)
+  where
+  type
+    AccessType (a, b, c, d, e, f) =
+      ( (AccessType a ++ (AccessType b ++ AccessType c))
+          ++ (AccessType d ++ (AccessType e ++ AccessType f))
+      )
+
+instance
+  ( Access cs m a,
+    Access cs m b,
+    Access cs m c,
+    Access cs m d,
+    Access cs m e,
+    Access cs m f,
+    Access cs m g,
+    ValidAccessInput (AccessType a),
+    ValidAccessInput (AccessType b),
+    ValidAccessInput (AccessType c),
+    ValidAccessInput (AccessType d),
+    ValidAccessInput (AccessType e),
+    ValidAccessInput (AccessType f),
+    ValidAccessInput (AccessType g),
+    ValidAccessInput (AccessType b ++ AccessType c),
+    ValidAccessInput (AccessType d ++ AccessType e),
+    ValidAccessInput (AccessType f ++ AccessType g),
+    ValidAccessInput (AccessType a ++ (AccessType b ++ AccessType c)),
+    ValidAccessInput ((AccessType d ++ AccessType e) ++ (AccessType f ++ AccessType g)),
+    Subset (AccessToComponents (AccessType a)) cs,
+    Subset (AccessToComponents (AccessType b)) cs,
+    Subset (AccessToComponents (AccessType c)) cs,
+    Subset (AccessToComponents (AccessType d)) cs,
+    Subset (AccessToComponents (AccessType e)) cs,
+    Subset (AccessToComponents (AccessType f)) cs,
+    Subset (AccessToComponents (AccessType g)) cs,
+    Subset (AccessToComponents (AccessType b ++ AccessType c)) cs,
+    Subset (AccessToComponents (AccessType d ++ AccessType e)) cs,
+    Subset (AccessToComponents (AccessType f ++ AccessType g)) cs,
+    Subset
+      ( AccessToComponents
+          (AccessType a ++ (AccessType b ++ AccessType c))
+      )
+      cs,
+    Subset
+      ( AccessToComponents
+          ((AccessType d ++ AccessType e) ++ (AccessType f ++ AccessType g))
+      )
+      cs
+  ) =>
+  Access cs m (a, b, c, d, e, f, g)
+  where
+  type
+    AccessType (a, b, c, d, e, f, g) =
+      ( (AccessType a ++ (AccessType b ++ AccessType c))
+          ++ ((AccessType d ++ AccessType e) ++ (AccessType f ++ AccessType g))
+      )
+
+instance
+  ( Access cs m a,
+    Access cs m b,
+    Access cs m c,
+    Access cs m d,
+    Access cs m e,
+    Access cs m f,
+    Access cs m g,
+    Access cs m h,
+    ValidAccessInput (AccessType a),
+    ValidAccessInput (AccessType b),
+    ValidAccessInput (AccessType c),
+    ValidAccessInput (AccessType d),
+    ValidAccessInput (AccessType e),
+    ValidAccessInput (AccessType f),
+    ValidAccessInput (AccessType g),
+    ValidAccessInput (AccessType h),
+    ValidAccessInput (AccessType a ++ AccessType b),
+    ValidAccessInput (AccessType c ++ AccessType d),
+    ValidAccessInput (AccessType e ++ AccessType f),
+    ValidAccessInput (AccessType g ++ AccessType h),
+    ValidAccessInput ((AccessType a ++ AccessType b) ++ (AccessType c ++ AccessType d)),
+    ValidAccessInput ((AccessType e ++ AccessType f) ++ (AccessType g ++ AccessType h)),
+    Subset (AccessToComponents (AccessType a)) cs,
+    Subset (AccessToComponents (AccessType b)) cs,
+    Subset (AccessToComponents (AccessType c)) cs,
+    Subset (AccessToComponents (AccessType d)) cs,
+    Subset (AccessToComponents (AccessType e)) cs,
+    Subset (AccessToComponents (AccessType f)) cs,
+    Subset (AccessToComponents (AccessType g)) cs,
+    Subset (AccessToComponents (AccessType h)) cs,
+    Subset (AccessToComponents (AccessType a ++ AccessType b)) cs,
+    Subset (AccessToComponents (AccessType c ++ AccessType d)) cs,
+    Subset (AccessToComponents (AccessType e ++ AccessType f)) cs,
+    Subset (AccessToComponents (AccessType g ++ AccessType h)) cs,
+    Subset
+      ( AccessToComponents
+          ((AccessType a ++ AccessType b) ++ (AccessType c ++ AccessType d))
+      )
+      cs,
+    Subset
+      ( AccessToComponents
+          ((AccessType e ++ AccessType f) ++ (AccessType g ++ AccessType h))
+      )
+      cs
+  ) =>
+  Access cs m (a, b, c, d, e, f, g, h)
+  where
+  type
+    AccessType (a, b, c, d, e, f, g, h) =
+      ( ((AccessType a ++ AccessType b) ++ (AccessType c ++ AccessType d))
+          ++ ((AccessType e ++ AccessType f) ++ (AccessType g ++ AccessType h))
+      )
+ src/Aztecs/ECS/Class.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Aztecs.ECS.Class (ECS (..)) where
+
+import Aztecs.ECS.Access.Internal hiding (access)
+import Aztecs.ECS.HSet
+import Aztecs.ECS.Query
+import Aztecs.ECS.Queryable
+import Aztecs.ECS.Queryable.Internal hiding (Components)
+import Aztecs.ECS.System
+import Data.Kind
+
+class ECS m where
+  type Entity m :: Type
+  type Components m :: [Type]
+  type Bundle m :: Type
+  type Task m :: Type -> Type
+
+  spawn :: Bundle m -> m (Entity m)
+
+  insert :: Entity m -> Bundle m -> m ()
+
+  remove :: Entity m -> m ()
+
+  query :: (Queryable (Components m) (Task m) a) => m (Query (Task m) a)
+
+  access ::
+    ( Access (Components m) (Task m) a,
+      ValidAccessInput (AccessType a),
+      Subset (AccessToComponents (AccessType a)) (Components m)
+    ) =>
+    m a
+
+  task :: (Task m) a -> m a
+
+  runSystemWithWorld ::
+    ( System (Task m) sys,
+      Access (Components m) (Task m) (SystemInputs (Task m) sys),
+      Subset (AccessToComponents (AccessType (SystemInputs (Task m) sys))) (Components m),
+      ValidAccessInput (AccessType (SystemInputs (Task m) sys)),
+      Monad m
+    ) =>
+    sys ->
+    m ()
+  runSystemWithWorld sys = access >>= task . runSystem sys
− src/Aztecs/ECS/Component.hs 
@@ -1,41 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE TypeFamilies #-}
-
--- |
--- Module      : Aztecs.ECS.Component
--- 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.Component where
-
-import Aztecs.ECS.World.Storage
-import Control.DeepSeq
-import Data.Typeable
-import GHC.Generics
-
--- | Unique component identifier.
---
--- @since 0.9
-newtype ComponentID = ComponentID
-  { -- | Unique integer identifier.
-    --
-    -- @since 0.9
-    unComponentId :: Int
-  }
-  deriving (Eq, Ord, Show, Generic, NFData)
-
--- | Component that can be stored in the `World`.
---
--- @since 0.9
-class (Typeable a, Storage a (StorageT a)) => Component a where
-  -- | `Storage` of this component.
-  --
-  -- @since 0.9
-  type StorageT a
-
-  type StorageT a = [a]
+ src/Aztecs/ECS/Entities.hs view
@@ -0,0 +1,45 @@+module Aztecs.ECS.Entities where
+
+import Data.Bits
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+import Data.Word
+
+newtype Entity = Entity {unEntity :: Word64}
+  deriving (Eq, Ord)
+
+instance Show Entity where
+  show e = "Entity {index = " ++ show (entityIndex e) ++ ", generation = " ++ show (entityGeneration e) ++ "}"
+
+mkEntity :: Word32 -> Word32 -> Entity
+mkEntity index generation = Entity $ (fromIntegral generation `shiftL` 32) .|. fromIntegral index
+
+entityIndex :: Entity -> Word32
+entityIndex (Entity e) = fromIntegral (e .&. 0xFFFFFFFF)
+
+entityGeneration :: Entity -> Word32
+entityGeneration (Entity e) = fromIntegral ((e `shiftR` 32) .&. 0xFFFFFFFF)
+
+data Entities = Entities
+  { entitiesNextGeneration :: Word32,
+    entitiesGenerations :: IntMap Word32,
+    entitiesNextIndex :: Word32,
+    entitiesFreeIndicies :: [Word32]
+  }
+
+emptyEntities :: Entities
+emptyEntities = Entities 0 IntMap.empty 0 []
+
+mkEntityWithCounter :: Entities -> (Entity, Entities)
+mkEntityWithCounter (Entities gen gens index free) =
+  let (i, nextIndex, free') = case free of
+        (i' : rest) -> (i', index, rest)
+        [] -> (index, index + 1, [])
+      nextGeneration = gen + 1
+      gens' = IntMap.insert (fromIntegral i) gen gens
+   in (mkEntity i gen, Entities nextGeneration gens' nextIndex free')
+
+entities :: Entities -> [Entity]
+entities (Entities _ gens _ _) = map go (IntMap.toList gens)
+  where
+    go (i, gen) = mkEntity (fromIntegral i) gen
− src/Aztecs/ECS/Entity.hs 
@@ -1,26 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
--- |
--- Module      : Aztecs.ECS.Entity
--- 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.Entity (EntityID (..)) where
-
-import Control.DeepSeq
-import GHC.Generics
-
--- | Unique entity identifier.
---
--- @since 0.9
-newtype EntityID = EntityID
-  { -- | Unique integer identifier.
-    --
-    -- @since 0.9
-    unEntityId :: Int
-  }
-  deriving (Eq, Ord, Show, Generic, NFData)
+ src/Aztecs/ECS/HSet.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Aztecs.ECS.HSet
+  ( HSet (..),
+    EmptyStorage (..),
+    Empty (..),
+    Lookup (..),
+    AdjustM (..),
+    Subset (..),
+  )
+where
+
+import Data.Kind
+import Data.SparseSet.Strict.Mutable (MSparseSet, PrimMonad (PrimState))
+import qualified Data.SparseSet.Strict.Mutable as MS
+import Data.Word
+import Prelude hiding (lookup)
+
+data HSet f ts where
+  HEmpty :: HSet f '[]
+  HCons :: f t -> HSet f ts -> HSet f (t ': ts)
+
+instance (ShowHSet f ts) => Show (HSet f ts) where
+  show = showHSet
+
+class ShowHSet f ts where
+  showHSet :: HSet f ts -> String
+
+instance ShowHSet f '[] where
+  showHSet _ = "HEmpty"
+
+instance (Show (f t), ShowHSet f ts) => ShowHSet f (t ': ts) where
+  showHSet (HCons x xs) = "HCons " ++ show x ++ " (" ++ showHSet xs ++ ")"
+
+class EmptyStorage m a where
+  emptyStorage :: m a
+
+instance (PrimMonad m, PrimState m ~ s) => EmptyStorage m (MSparseSet s Word32 a) where
+  emptyStorage = MS.empty
+
+class Empty m a where
+  empty :: m a
+
+instance (Applicative m) => Empty m (HSet f '[]) where
+  empty = pure HEmpty
+
+instance (Monad m, EmptyStorage m (f t), Empty m (HSet f ts)) => Empty m (HSet f (t ': ts)) where
+  empty = do
+    xs <- emptyStorage
+    rest <- empty
+    pure (HCons xs rest)
+
+type family Elem (t :: k) (ts :: [k]) :: Bool where
+  Elem t '[] = 'False
+  Elem t (t ': xs) = 'True
+  Elem t (_ ': xs) = Elem t xs
+
+class Lookup (t :: Type) (ts :: [Type]) where
+  lookup :: HSet f ts -> f t
+
+instance {-# OVERLAPPING #-} Lookup t (t ': ts) where
+  lookup (HCons x _) = x
+  {-# INLINE lookup #-}
+
+instance {-# OVERLAPPABLE #-} (Lookup t ts) => Lookup t (u ': ts) where
+  lookup (HCons _ xs) = lookup xs
+  {-# INLINE lookup #-}
+
+class AdjustM m f t ts where
+  adjustM :: (f t -> m (f t)) -> HSet f ts -> m (HSet f ts)
+
+instance {-# OVERLAPPING #-} (Applicative m) => AdjustM m f t (t ': ts) where
+  adjustM f (HCons x xs) = HCons <$> f x <*> pure xs
+  {-# INLINE adjustM #-}
+
+instance {-# OVERLAPPABLE #-} (Functor m, AdjustM m f t ts) => AdjustM m f t (u ': ts) where
+  adjustM f (HCons y xs) = HCons y <$> adjustM f xs
+  {-# INLINE adjustM #-}
+
+class Subset (subset :: [Type]) (superset :: [Type]) where
+  subset :: HSet f superset -> HSet f subset
+
+instance Subset '[] superset where
+  subset _ = HEmpty
+  {-# INLINE subset #-}
+
+instance
+  ( Lookup t superset,
+    Subset ts superset
+  ) =>
+  Subset (t ': ts) superset
+  where
+  subset hset = HCons (lookup hset) (subset @ts hset)
+  {-# INLINE subset #-}
src/Aztecs/ECS/Query.hs view
@@ -1,270 +1,37 @@-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-
--- |
--- Module      : Aztecs.ECS.Query
--- 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
-  ( -- * Queries
-    Query,
-    QueryT (..),
-
-    -- ** Operations
-    entity,
-    fetch,
-    fetchMaybe,
-    fetchMap,
-    fetchMapM,
-    zipFetchMap,
-    zipFetchMapAccum,
-    zipFetchMapM,
-    zipFetchMapAccumM,
-
-    -- ** Filters
-    with,
-    without,
-
-    -- ** Conversion
-    fromDyn,
-    liftQuery,
-
-    -- ** Running
-
-    -- *** Writing
-    query,
-    querySingle,
-    querySingleMaybe,
-    queryEntities,
-
-    -- *** Reading
-    readQueryEntities,
-    readQuery,
-    readQuerySingle,
-    readQuerySingleMaybe,
-  )
-where
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
 
-import Aztecs.ECS.Component
-import Aztecs.ECS.Entity
-import Aztecs.ECS.Query.Dynamic
-import Aztecs.ECS.World.Components (Components)
-import qualified Aztecs.ECS.World.Components as CS
-import Aztecs.ECS.World.Entities (Entities (..))
-import Control.Monad.Identity
-import Control.Monad.Trans
-import GHC.Stack
+module Aztecs.ECS.Query where
 
--- | @since 0.11
-type Query = QueryT Identity
+import Data.Maybe
+import Prelude hiding (Read)
 
--- | Query for matching entities.
---
--- @since 0.11
-newtype QueryT f a = Query
-  { -- | Run a query, producing a `DynamicQueryT`.
-    --
-    -- @since 0.11
-    runQuery :: Components -> (Components, DynamicQueryT f a)
-  }
+newtype Query m a = Query {unQuery :: m [Maybe a]}
   deriving (Functor)
 
--- | @since 0.11
-instance (Applicative f) => Applicative (QueryT f) where
+instance (Monad m) => Applicative (Query m) where
+  pure x = Query $ return [Just x]
   {-# INLINE pure #-}
-  pure a = Query (,pure a)
-
+  Query f <*> Query x = Query $ do
+    fs <- f
+    zipWith (<*>) fs <$> x
   {-# INLINE (<*>) #-}
-  (Query f) <*> (Query g) = Query $ \cs ->
-    let !(cs', aQS) = g cs
-        !(cs'', bQS) = f cs'
-     in (cs'', bQS <*> aQS)
 
--- | Fetch the current `EntityID`.
---
--- @since 0.11
-{-# INLINE entity #-}
-entity :: QueryT f EntityID
-entity = Query (,entityDyn)
-
--- | Fetch a component.
---
--- @since 0.11
-{-# INLINE fetch #-}
-fetch :: forall f a. (Component a) => QueryT f a
-fetch = fromDynInternal @f @a $ fetchDyn
-
--- | Fetch a component, or `Nothing`.
---
--- @since 0.12
-{-# INLINE fetchMaybe #-}
-fetchMaybe :: forall f a. (Component a) => QueryT f (Maybe a)
-fetchMaybe = fromDynInternal @f @a $ fetchMaybeDyn
-
--- | Fetch a component and map it, storing the result.
---
--- @since 0.11
-{-# INLINE fetchMap #-}
-fetchMap :: forall f a. (Component a) => (a -> a) -> QueryT f a
-fetchMap f = fromDynInternal @_ @a $ fetchMapDyn f
-
--- | Fetch a component and map it with a monadic function, storing the result.
---
--- @since 0.11
-{-# INLINE fetchMapM #-}
-fetchMapM :: forall f a. (Monad f, Component a) => (a -> f a) -> QueryT f a
-fetchMapM f = fromDynInternal @_ @a $ fetchMapDynM f
-
--- | Fetch a component and map it with some input, storing the result.
---
--- @since 0.11
-{-# INLINE zipFetchMap #-}
-zipFetchMap :: forall f a b. (Component a) => (b -> a -> a) -> QueryT f b -> QueryT f a
-zipFetchMap f = fromWriterInternal @a $ zipFetchMapDyn f
-
--- | Fetch a component and map it with some input, storing the result and returning some output.
---
--- @since 0.11
-{-# INLINE zipFetchMapAccum #-}
-zipFetchMapAccum ::
-  forall f a b c. (Component a) => (b -> a -> (c, a)) -> QueryT f b -> QueryT f (c, a)
-zipFetchMapAccum f = fromWriterInternal @a $ zipFetchMapAccumDyn f
-
--- | Fetch a component and map it with some input and a monadic function, storing the result.
---
--- @since 0.11
-{-# INLINE zipFetchMapM #-}
-zipFetchMapM :: forall f a b. (Monad f, Component a) => (b -> a -> f a) -> QueryT f b -> QueryT f a
-zipFetchMapM f = fromWriterInternal @a $ zipFetchMapDynM f
-
--- | Fetch a component and map it with some input and a monadic function,
--- storing the result and returning some output.
---
--- @since 0.11
-{-# INLINE zipFetchMapAccumM #-}
-zipFetchMapAccumM ::
-  forall f a b c. (Monad f, Component a) => (b -> a -> f (c, a)) -> QueryT f b -> QueryT f (c, a)
-zipFetchMapAccumM f = fromWriterInternal @a $ zipFetchMapAccumDynM f
-
--- | Filter for entities with a component.
---
--- @since 0.11
-{-# INLINE with #-}
-with :: forall f a. (Component a) => QueryT f ()
-with = fromDynInternal @f @a $ withDyn
-
--- | Filter for entities without a component.
---
--- @since 0.11
-{-# INLINE without #-}
-without :: forall f a. (Component a) => QueryT f ()
-without = fromDynInternal @f @a $ withDyn
-
--- | Convert a `DynamicQueryT` to a `QueryT`.
---
--- @since 0.11
-{-# INLINE fromDyn #-}
-fromDyn :: DynamicQueryT f a -> QueryT f a
-fromDyn q = Query (,q)
-
-{-# INLINE fromDynInternal #-}
-fromDynInternal ::
-  forall f a b.
-  (Component a) =>
-  (ComponentID -> DynamicQueryT f b) ->
-  QueryT f b
-fromDynInternal f = Query $ \cs ->
-  let !(cId, cs') = CS.insert @a cs in (cs', f cId)
-
-{-# INLINE fromWriterInternal #-}
-fromWriterInternal ::
-  forall c f a b.
-  (Component c) =>
-  (ComponentID -> DynamicQueryT f b -> DynamicQueryT f a) ->
-  QueryT f b ->
-  QueryT f a
-fromWriterInternal f q = Query $ \cs ->
-  let !(cId, cs') = CS.insert @c cs
-      !(cs'', dynQ) = runQuery q cs'
-   in (cs'', f cId dynQ)
-
-liftQuery :: (MonadTrans g, Monad (g f), Monad f) => QueryT f a -> QueryT (g f) a
-liftQuery q = Query $ \cs -> let !(cs', dynQ) = runQuery q cs in (cs', liftQueryDyn dynQ)
-
--- | Match and update all entities.
---
--- @since 0.11
-{-# INLINE query #-}
-query :: (Applicative f) => QueryT f a -> Entities -> f ([a], Entities)
-query = runQueryWithDyn queryDyn
-
--- | Match and update a single matched entity.
---
--- @since 0.12
-{-# INLINE querySingle #-}
-querySingle :: (HasCallStack, Applicative f) => QueryT f a -> Entities -> f (a, Entities)
-querySingle = runQueryWithDyn querySingleDyn
-
--- | Match and update a single matched entity, or `Nothing`.
---
--- @since 0.12
-{-# INLINE querySingleMaybe #-}
-querySingleMaybe :: (Applicative m) => QueryT m a -> Entities -> m (Maybe a, Entities)
-querySingleMaybe = runQueryWithDyn querySingleMaybeDyn
-
--- | Match and update the specified entities.
---
--- @since 0.12
-{-# INLINE queryEntities #-}
-queryEntities :: (Monad m) => [EntityID] -> QueryT m a -> Entities -> m ([a], Entities)
-queryEntities eIds = runQueryWithDyn $ queryEntitiesDyn eIds
-
--- | Match and update all entities.
---
--- @since 0.12
-{-# INLINE readQuery #-}
-readQuery :: (Applicative f) => QueryT f a -> Entities -> f ([a], Entities)
-readQuery = runQueryWithDyn $ \q es -> (,es) <$> readQueryDyn q es
-
--- | Match a single entity.
---
--- @since 0.12
-{-# INLINE readQuerySingle #-}
-readQuerySingle :: (HasCallStack, Applicative f) => QueryT f a -> Entities -> f (a, Entities)
-readQuerySingle = runQueryWithDyn $ \q es -> (,es) <$> readQuerySingleDyn q es
-
--- | Match a single entity, or `Nothing`.
---
--- @since 0.12
-{-# INLINE readQuerySingleMaybe #-}
-readQuerySingleMaybe :: (Applicative f) => QueryT f a -> Entities -> f (Maybe a, Entities)
-readQuerySingleMaybe = runQueryWithDyn $ \q es -> (,es) <$> readQuerySingleMaybeDyn q es
-
--- | Match the specified entities.
---
--- @since 0.12
-{-# INLINE readQueryEntities #-}
-readQueryEntities :: (Applicative f) => [EntityID] -> QueryT f a -> Entities -> f ([a], Entities)
-readQueryEntities eIds = runQueryWithDyn $ \q es -> (,es) <$> readQueryEntitiesDyn eIds q es
-
-{-# INLINE runQueryWithDyn #-}
-runQueryWithDyn ::
-  (Applicative f) =>
-  (DynamicQueryT f a -> Entities -> b) ->
-  QueryT f a ->
-  Entities ->
-  b
-runQueryWithDyn f q es =
-  let !(cs', dynQ) = runQuery q $ components es in f dynQ es {components = cs'}
+runQuery :: (Monad m) => Query m a -> m [a]
+runQuery (Query q) = catMaybes <$> q
+{-# INLINE runQuery #-}
− src/Aztecs/ECS/Query/Dynamic.hs 
@@ -1,502 +0,0 @@-{-# LANGUAGE ApplicativeDo #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE TupleSections #-}
-
--- |
--- 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,
-    DynamicQueryT (..),
-
-    -- ** Operations
-    entityDyn,
-    fetchDyn,
-    fetchMaybeDyn,
-    fetchMapDyn,
-    fetchMapDynM,
-    zipFetchMapDyn,
-    zipFetchMapAccumDyn,
-    zipFetchMapDynM,
-    zipFetchMapAccumDynM,
-
-    -- ** Filters
-    withDyn,
-    withoutDyn,
-
-    -- ** Conversion
-    liftQueryDyn,
-
-    -- ** Running
-    queryDyn,
-    readQuerySingleDyn,
-    readQuerySingleMaybeDyn,
-    queryEntitiesDyn,
-    readQueryDyn,
-    querySingleDyn,
-    querySingleMaybeDyn,
-    readQueryEntitiesDyn,
-
-    -- *** Internal
-    QueryFilter (..),
-    Operation (..),
-    queryFilter,
-    runDynQuery,
-    runDynQueryEntities,
-    readDynQuery,
-    readDynQueryEntities,
-  )
-where
-
-import Aztecs.ECS.Component
-import Aztecs.ECS.Entity
-import Aztecs.ECS.World.Archetype (Archetype)
-import qualified Aztecs.ECS.World.Archetype as A
-import Aztecs.ECS.World.Archetypes (Node (..))
-import qualified Aztecs.ECS.World.Archetypes as AS
-import Aztecs.ECS.World.Entities
-import Control.Applicative
-import Control.Monad
-import Control.Monad.Trans (MonadTrans (..))
-import Control.Monad.Identity
-import Data.Bifunctor
-import Data.Foldable
-import qualified Data.Map.Strict as Map
-import Data.Maybe
-import Data.Set (Set)
-import qualified Data.Set as Set
-import GHC.Stack
-import Prelude hiding (reads)
-
--- @since 0.9
-type DynamicQuery = DynamicQueryT Identity
-
--- | Dynamic query for components by ID.
---
--- @since 0.11
-data DynamicQueryT f a where
-  Entity :: DynamicQueryT f EntityID
-  Pure :: a -> DynamicQueryT f a
-  Map :: (a -> b) -> DynamicQueryT f a -> DynamicQueryT f b
-  Ap :: DynamicQueryT f (a -> b) -> DynamicQueryT f a -> DynamicQueryT f b
-  Lift :: (MonadTrans g, Monad (g f), Monad f) => DynamicQueryT f a -> DynamicQueryT (g f) a
-  Op :: ComponentID -> Operation f a -> DynamicQueryT f a
-
-instance Functor (DynamicQueryT f) where
-  {-# INLINE fmap #-}
-  fmap = Map
-
--- | @since 0.11
-instance Applicative (DynamicQueryT f) where
-  {-# INLINE pure #-}
-  pure = Pure
-
-  {-# INLINE (<*>) #-}
-  (<*>) = Ap
-
-{-# INLINE entityDyn #-}
-entityDyn :: DynamicQueryT f EntityID
-entityDyn = Entity
-
-{-# INLINE fetchDyn #-}
-fetchDyn :: (Component a) => ComponentID -> DynamicQueryT f a
-fetchDyn cId = Op cId Fetch
-
-{-# INLINE fetchMaybeDyn #-}
-fetchMaybeDyn :: (Component a) => ComponentID -> DynamicQueryT f (Maybe a)
-fetchMaybeDyn cId = Op cId FetchMaybe
-
-{-# INLINE fetchMapDyn #-}
-fetchMapDyn :: (Component a) => (a -> a) -> ComponentID -> DynamicQueryT f a
-fetchMapDyn f cId = Op cId $ FetchMap f
-
-{-# INLINE fetchMapDynM #-}
-fetchMapDynM :: (Monad f, Component a) => (a -> f a) -> ComponentID -> DynamicQueryT f a
-fetchMapDynM f cId = Op cId $ FetchMapM f
-
-{-# INLINE zipFetchMapDyn #-}
-zipFetchMapDyn ::
-  (Component a) => (b -> a -> a) -> ComponentID -> DynamicQueryT f b -> DynamicQueryT f a
-zipFetchMapDyn f cId q = snd <$> Op cId (ZipFetchMap (\b a -> ((), f b a)) q)
-
-{-# INLINE zipFetchMapAccumDyn #-}
-zipFetchMapAccumDyn ::
-  (Component a) => (b -> a -> (c, a)) -> ComponentID -> DynamicQueryT f b -> DynamicQueryT f (c, a)
-zipFetchMapAccumDyn f cId q = Op cId $ ZipFetchMap f q
-
-{-# INLINE zipFetchMapDynM #-}
-zipFetchMapDynM ::
-  (Monad f, Component a) =>
-  (b -> a -> f a) ->
-  ComponentID ->
-  DynamicQueryT f b ->
-  DynamicQueryT f a
-zipFetchMapDynM f cId q = snd <$> zipFetchMapAccumDynM (\b a -> ((),) <$> f b a) cId q
-
-{-# INLINE zipFetchMapAccumDynM #-}
-zipFetchMapAccumDynM ::
-  (Monad f, Component a) =>
-  (b -> a -> f (c, a)) ->
-  ComponentID ->
-  DynamicQueryT f b ->
-  DynamicQueryT f (c, a)
-zipFetchMapAccumDynM f cId q = Op cId $ ZipFetchMapM f q
-
-{-# INLINE withDyn #-}
-withDyn :: ComponentID -> DynamicQueryT f ()
-withDyn cId = Op cId With
-
-{-# INLINE withoutDyn #-}
-withoutDyn :: ComponentID -> DynamicQueryT f ()
-withoutDyn cId = Op cId Without
-
-{-# INLINE liftQueryDyn #-}
-liftQueryDyn :: (MonadTrans g, Monad (g f), Monad f) => DynamicQueryT f a -> DynamicQueryT (g f) a
-liftQueryDyn = Lift
-
--- | Match all entities.
---
--- @since 0.11
-readQueryDyn :: (Applicative f) => DynamicQueryT f a -> Entities -> f [a]
-readQueryDyn q es =
-  let qf = queryFilter q
-   in if Set.null $ filterWith qf
-        then readDynQuery q $ A.empty {A.entities = Map.keysSet $ entities es}
-        else
-          let go n = readDynQuery q $ AS.nodeArchetype n
-           in concat <$> traverse go (AS.find (filterWith qf) (filterWithout qf) $ archetypes es)
-
--- | Match a single entity.
---
--- @since 0.11
-readQuerySingleDyn :: (HasCallStack, Applicative f) => DynamicQueryT f a -> Entities -> f a
-readQuerySingleDyn q es = do
-  res <- readQuerySingleMaybeDyn q es
-  return $ case res of
-    Just a -> a
-    _ -> error "singleDyn: expected a single entity"
-
--- | Match a single entity, or `Nothing`.
---
--- @since 0.11
-readQuerySingleMaybeDyn :: (Applicative f) => DynamicQueryT f a -> Entities -> f (Maybe a)
-readQuerySingleMaybeDyn q es =
-  let qf = queryFilter q
-   in if Set.null $ filterWith qf
-        then case Map.keys $ entities es of
-          [eId] -> do
-            res <- readDynQuery q $ A.singleton eId
-            return $ case res of
-              [a] -> Just a
-              _ -> Nothing
-          _ -> pure Nothing
-        else case Map.elems $ AS.find (filterWith qf) (filterWithout qf) $ archetypes es of
-          [n] -> do
-            res <- readDynQuery q $ AS.nodeArchetype n
-            return $ case res of
-              [a] -> Just a
-              _ -> Nothing
-          _ -> pure Nothing
-
-readQueryEntitiesDyn :: (Applicative f) => [EntityID] -> DynamicQueryT f a -> Entities -> f [a]
-readQueryEntitiesDyn eIds q es =
-  let qf = queryFilter q
-   in if Set.null $ filterWith qf
-        then readDynQueryEntities eIds q A.empty {A.entities = Map.keysSet $ entities es}
-        else
-          let go n = readDynQuery q $ AS.nodeArchetype n
-           in concat <$> traverse go (AS.find (filterWith qf) (filterWithout qf) $ archetypes es)
-
--- | Match and update all matched entities.
---
--- @since 0.11
-{-# INLINE queryDyn #-}
-queryDyn :: (Applicative f) => DynamicQueryT f a -> Entities -> f ([a], Entities)
-queryDyn q es =
-  let qf = queryFilter q
-   in if Set.null $ filterWith qf
-        then (,es) . fst <$> runDynQuery q A.empty {A.entities = Map.keysSet $ entities es}
-        else
-          let go (aId, n) = do
-                res <- runDynQuery q $ nodeArchetype n
-                return $
-                  let (as', arch') = res
-                   in (as', aId, n {nodeArchetype = arch' <> nodeArchetype n})
-              matches = Map.toList . AS.find (filterWith qf) (filterWithout qf) $ archetypes es
-              res' = traverse go matches
-              folder (acc, esAcc) (as, aId, node) =
-                let nodes = Map.insert aId node . AS.nodes $ archetypes esAcc
-                 in (as ++ acc, esAcc {archetypes = (archetypes esAcc) {AS.nodes = nodes}})
-           in fmap (foldl' folder ([], es)) res'
-
--- | Match and update a single entity.
---
--- @since 0.11
-querySingleDyn :: (HasCallStack, Applicative m) => DynamicQueryT m a -> Entities -> m (a, Entities)
-querySingleDyn q es = do
-  res <- querySingleMaybeDyn q es
-  return $ case res of
-    (Just a, es') -> (a, es')
-    _ -> error "mapSingleDyn: expected single matching entity"
-
--- | Match and update a single entity, or @Nothing@.
---
--- @since 0.11
-{-# INLINE querySingleMaybeDyn #-}
-querySingleMaybeDyn :: (Applicative f) => DynamicQueryT f a -> Entities -> f (Maybe a, Entities)
-querySingleMaybeDyn q es =
-  let qf = queryFilter q
-   in if Set.null $ filterWith qf
-        then case Map.keys $ entities es of
-          [eId] -> do
-            res <- runDynQuery q $ A.singleton eId
-            return $ case res of
-              ([a], _) -> (Just a, es)
-              _ -> (Nothing, es)
-          _ -> pure (Nothing, es)
-        else case Map.toList $ AS.find (filterWith qf) (filterWithout qf) $ archetypes es of
-          [(aId, n)] -> do
-            res <- runDynQuery q $ AS.nodeArchetype n
-            return $ case res of
-              ([a], arch') ->
-                let nodes = Map.insert aId n {nodeArchetype = arch' <> nodeArchetype n} . AS.nodes $ archetypes es
-                 in (Just a, es {archetypes = (archetypes es) {AS.nodes = nodes}})
-              _ -> (Nothing, es)
-          _ -> pure (Nothing, es)
-
-{-# INLINE queryEntitiesDyn #-}
-queryEntitiesDyn ::
-  (Monad m) =>
-  [EntityID] ->
-  DynamicQueryT m a ->
-  Entities ->
-  m ([a], Entities)
-queryEntitiesDyn eIds q es =
-  let qf = queryFilter q
-      go = runDynQueryEntities eIds q
-   in if Set.null $ filterWith qf
-        then do
-          (as, _) <- go A.empty {A.entities = Map.keysSet $ entities es}
-          return (as, es)
-        else
-          let go' (acc, esAcc) (aId, n) = do
-                (as', arch') <- go $ nodeArchetype n
-                let n' = n {nodeArchetype = arch' <> nodeArchetype n}
-                    nodes = Map.insert aId n' . AS.nodes $ archetypes esAcc
-                return (as' ++ acc, esAcc {archetypes = (archetypes esAcc) {AS.nodes = nodes}})
-           in foldlM go' ([], es) $ Map.toList . AS.find (filterWith qf) (filterWithout qf) $ archetypes es
-
-{-# INLINE queryFilter #-}
-queryFilter :: DynamicQueryT f a -> QueryFilter
-queryFilter (Pure _) = mempty
-queryFilter (Map _ q) = queryFilter q
-queryFilter (Ap f g) = queryFilter f <> queryFilter g
-queryFilter (Lift q) = queryFilter q
-queryFilter Entity = mempty
-queryFilter (Op cId op) = opFilter cId op
-
-{-# INLINE readDynQuery #-}
-readDynQuery :: (Applicative f) => DynamicQueryT f a -> Archetype -> f [a]
-readDynQuery (Pure a) arch = pure $ replicate (length $ A.entities arch) a
-readDynQuery (Map f q) arch = fmap f <$> readDynQuery q arch
-readDynQuery (Ap f g) arch = do
-  as <- readDynQuery g arch
-  bs <- readDynQuery f arch
-  pure $ zipWith ($) bs as
-readDynQuery (Lift q) arch = lift $ readDynQuery q arch
-readDynQuery Entity arch = pure $ Set.toList $ A.entities arch
-readDynQuery (Op cId op) arch = readOp cId op arch
-
-{-# INLINE readDynQueryEntities #-}
-readDynQueryEntities :: (Applicative f) => [EntityID] -> DynamicQueryT f a -> Archetype -> f [a]
-readDynQueryEntities es (Pure a) _ = pure $ replicate (length es) a
-readDynQueryEntities es (Map f q) arch = fmap f <$> readDynQueryEntities es q arch
-readDynQueryEntities es (Ap f g) arch = do
-  a <- readDynQueryEntities es g arch
-  b <- readDynQueryEntities es f arch
-  pure $ b <*> a
-readDynQueryEntities es (Lift q) arch = lift $ readDynQueryEntities es q arch
-readDynQueryEntities es Entity _ = pure es
-readDynQueryEntities es (Op cId op) arch = readOpEntities cId es op arch
-
-{-# INLINE runDynQuery #-}
-runDynQuery :: (Applicative f) => DynamicQueryT f a -> Archetype -> f ([a], Archetype)
-runDynQuery (Pure a) arch = pure (replicate (length $ A.entities arch) a, mempty)
-runDynQuery (Map f q) arch = do
-  res <- runDynQuery q arch
-  return $ first (fmap f) res
-runDynQuery (Ap f g) arch = do
-  res <- runDynQuery g arch
-  res' <- runDynQuery f arch
-  return $
-    let (as, arch') = res
-        (bs, arch'') = res'
-     in (zipWith ($) bs as, arch'' <> arch')
-runDynQuery (Lift q) arch = lift $ runDynQuery q arch
-runDynQuery Entity arch = (,arch) <$> readDynQuery Entity arch
-runDynQuery (Op cId op) arch = runOp cId op arch
-
-runDynQueryEntities :: (Applicative f) => [EntityID] -> DynamicQueryT f a -> Archetype -> f ([a], Archetype)
-runDynQueryEntities es (Pure a) _ = pure (replicate (length es) a, mempty)
-runDynQueryEntities es (Map f q) arch = first (fmap f) <$> runDynQueryEntities es q arch
-runDynQueryEntities es (Ap f g) arch = do
-  res <- runDynQueryEntities es g arch
-  res' <- runDynQueryEntities es f arch
-  return $
-    let (as, arch') = res
-        (bs, arch'') = res'
-     in (zipWith ($) bs as, arch'' <> arch')
-runDynQueryEntities es (Lift q) arch = lift $ runDynQueryEntities es q arch
-runDynQueryEntities es Entity _ = pure (es, mempty)
-runDynQueryEntities es (Op cId op) arch = runOpEntities cId es op arch
-
-data Operation f a where
-  Fetch :: (Component a) => Operation f a
-  FetchMaybe :: (Component a) => Operation f (Maybe a)
-  FetchMap :: (Component a) => (a -> a) -> Operation f a
-  FetchMapM :: (Monad f, Component a) => (a -> f a) -> Operation f a
-  ZipFetchMap :: (Component a) => (b -> a -> (c, a)) -> (DynamicQueryT f b) -> Operation f (c, a)
-  ZipFetchMapM :: (Monad f, Component a) => (b -> a -> f (c, a)) -> (DynamicQueryT f b) -> Operation f (c, a)
-  With :: Operation f ()
-  Without :: Operation f ()
-
-{-# INLINE opFilter #-}
-opFilter :: ComponentID -> Operation f a -> QueryFilter
-opFilter cId Fetch = mempty {filterWith = Set.singleton cId}
-opFilter cId FetchMaybe = mempty {filterWith = Set.singleton cId}
-opFilter cId (FetchMap _) = mempty {filterWith = Set.singleton cId}
-opFilter cId (FetchMapM _) = mempty {filterWith = Set.singleton cId}
-opFilter cId (ZipFetchMap _ q) = queryFilter q <> mempty {filterWith = Set.singleton cId}
-opFilter cId (ZipFetchMapM _ q) = queryFilter q <> mempty {filterWith = Set.singleton cId}
-opFilter cId With = mempty {filterWith = Set.singleton cId}
-opFilter cId Without = mempty {filterWithout = Set.singleton cId}
-
-{-# INLINE readOp #-}
-readOp :: (Applicative f) => ComponentID -> Operation f a -> Archetype -> f [a]
-readOp cId Fetch arch = pure $ A.lookupComponentsAsc cId arch
-readOp cId FetchMaybe arch =
-  pure $
-    case A.lookupComponentsAscMaybe cId arch of
-      Just as -> fmap Just as
-      Nothing -> replicate (length $ A.entities arch) Nothing
-readOp cId (FetchMap f) arch = do
-  bs <- readOp cId Fetch arch
-  return $ map f bs
-readOp cId (FetchMapM f) arch = do
-  bs <- readOp cId Fetch arch
-  mapM f bs
-readOp cId (ZipFetchMap f q) arch = do
-  as <- readDynQuery q arch
-  bs <- readOp cId Fetch arch
-  return $ zipWith f as bs
-readOp cId (ZipFetchMapM f q) arch = do
-  as <- readDynQuery q arch
-  bs <- readOp cId Fetch arch
-  zipWithM f as bs
-readOp _ With _ = pure []
-readOp _ Without _ = pure []
-
-{-# INLINE runOp #-}
-runOp :: (Applicative f) => ComponentID -> Operation f a -> Archetype -> f ([a], Archetype)
-runOp cId (FetchMap f) arch = pure $ A.map f cId arch
-runOp cId (FetchMapM f) arch = do
-  (as, arch') <- A.mapM f cId arch
-  return (as, arch')
-runOp cId (ZipFetchMap f q) arch = do
-  res <- runDynQuery q arch
-  return $
-    let (bs, arch') = res
-        (as, arch'') = A.zipMap bs f cId arch
-     in (as, arch'' <> arch')
-runOp cId (ZipFetchMapM f q) arch = do
-  (as, arch') <- runDynQuery q arch
-  (bs, arch'') <- A.zipMapM as f cId arch
-  return (bs, arch'' <> arch')
-runOp cId op arch = (,mempty) <$> readOp cId op arch
-
-{-# INLINE readOpEntities #-}
-readOpEntities :: (Applicative f) => ComponentID -> [EntityID] -> Operation f a -> Archetype -> f [a]
-readOpEntities cId es Fetch arch =
-  pure
-    . map snd
-    . filter (\(e, _) -> e `elem` es)
-    . Map.toList
-    $ A.lookupComponents cId arch
-readOpEntities cId es FetchMaybe arch =
-  pure
-    . map (\(e, a) -> if e `elem` es then Just a else Nothing)
-    . Map.toList
-    $ A.lookupComponents cId arch
-readOpEntities cId es (FetchMap f) arch = do
-  b <- readOpEntities cId es Fetch arch
-  pure $ map f b
-readOpEntities cId es (FetchMapM f) arch = do
-  b <- readOpEntities cId es Fetch arch
-  mapM f b
-readOpEntities cId es (ZipFetchMap f q) arch = do
-  a <- readDynQueryEntities es q arch
-  b <- readOpEntities cId es Fetch arch
-  pure $ zipWith f a b
-readOpEntities cId es (ZipFetchMapM f q) arch = do
-  a <- readDynQueryEntities es q arch
-  b <- readOpEntities cId es Fetch arch
-  zipWithM f a b
-readOpEntities _ _ With _ = pure []
-readOpEntities _ _ Without _ = pure []
-
-runOpEntities :: (Applicative f) => ComponentID -> [EntityID] -> Operation f a -> Archetype -> f ([a], Archetype)
-runOpEntities cId es (FetchMap f) arch =
-  pure $
-    let go e a =
-          if e `elem` es
-            then let a' = f a in (Just a', a')
-            else (Nothing, a)
-        (as, arch') = A.zipMap es go cId arch
-     in (mapMaybe fst as, arch')
-runOpEntities cId es (FetchMapM f) arch = do
-  (as, arch') <- runOpEntities cId es (ZipFetchMapM (\() a -> (,a) <$> f a) (pure ())) arch
-  return (map snd as, arch')
-runOpEntities cId es (ZipFetchMap f q) arch = do
-  res <- runDynQuery q arch
-  return $
-    let go (e, b) a =
-          if e `elem` es
-            then let (x, y) = f b a in (Just x, y)
-            else (Nothing, a)
-        (bs, arch') = res
-        (as, arch'') = A.zipMap (zip es bs) go cId arch
-     in (mapMaybe (\(m, b) -> fmap (,b) m) as, arch'' <> arch')
-runOpEntities cId es (ZipFetchMapM f q) arch = do
-  (bs, arch') <- runDynQuery q arch
-  let go (e, b) a =
-        if e `elem` es
-          then do
-            (x, y) <- f b a
-            return (Just x, y)
-          else return (Nothing, a)
-  (as, arch'') <- A.zipMapM (zip es bs) go cId arch
-  return (mapMaybe (\(m, b) -> fmap (,b) m) as, arch'' <> arch')
-runOpEntities cId es op arch = (,arch) <$> readOpEntities cId es op arch
-
--- | `Query` filter.
---
--- @since 0.11
-data QueryFilter = QueryFilter
-  { filterWith :: !(Set ComponentID),
-    filterWithout :: !(Set ComponentID)
-  }
-  deriving (Show)
-
--- | @since 0.9
-instance Semigroup QueryFilter where
-  QueryFilter r1 w1 <> QueryFilter r2 w2 = QueryFilter (r1 <> r2) (w1 <> w2)
-
--- | @since 0.9
-instance Monoid QueryFilter where
-  mempty = QueryFilter mempty mempty
+ src/Aztecs/ECS/Queryable.hs view
@@ -0,0 +1,3 @@+module Aztecs.ECS.Queryable (Queryable (..), With (..), Without (..)) where
+
+import Aztecs.ECS.Queryable.Internal
+ src/Aztecs/ECS/Queryable/Internal.hs view
@@ -0,0 +1,351 @@+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Aztecs.ECS.Queryable.Internal where
+
+import Aztecs.ECS.Entities
+import Aztecs.ECS.HSet
+import qualified Aztecs.ECS.HSet as HS
+import Aztecs.ECS.Query
+import Data.Kind
+import Data.Maybe
+import qualified Data.Set as Set
+import Data.SparseSet.Strict.Mutable
+import qualified Data.SparseSet.Strict.Mutable as MS
+import Data.Word
+import GHC.Generics
+import Prelude hiding (Read)
+
+type family (++) (xs :: [Type]) (ys :: [Type]) :: [Type] where
+  '[] ++ ys = ys
+  (x ': xs) ++ ys = x ': (xs ++ ys)
+
+type family AccessToComponents (accesses :: [Type]) :: [Type] where
+  AccessToComponents '[] = '[]
+  AccessToComponents (Read a ': rest) = a ': AccessToComponents rest
+  AccessToComponents (Write a ': rest) = a ': AccessToComponents rest
+  AccessToComponents (With a ': rest) = a ': AccessToComponents rest
+  AccessToComponents (Without a ': rest) = AccessToComponents rest
+
+type family ReadComponents (accesses :: [Type]) :: [Type] where
+  ReadComponents '[] = '[]
+  ReadComponents (Read a ': rest) = a ': ReadComponents rest
+  ReadComponents (Write a ': rest) = ReadComponents rest
+  ReadComponents (With a ': rest) = ReadComponents rest
+  ReadComponents (Without a ': rest) = ReadComponents rest
+
+type family WriteComponents (accesses :: [Type]) :: [Type] where
+  WriteComponents '[] = '[]
+  WriteComponents (Read a ': rest) = WriteComponents rest
+  WriteComponents (Write a ': rest) = a ': WriteComponents rest
+  WriteComponents (With a ': rest) = WriteComponents rest
+  WriteComponents (Without a ': rest) = WriteComponents rest
+
+type family WithComponents (accesses :: [Type]) :: [Type] where
+  WithComponents '[] = '[]
+  WithComponents (Read a ': rest) = WithComponents rest
+  WithComponents (Write a ': rest) = WithComponents rest
+  WithComponents (With a ': rest) = a ': WithComponents rest
+  WithComponents (Without a ': rest) = WithComponents rest
+
+type family WithoutComponents (accesses :: [Type]) :: [Type] where
+  WithoutComponents '[] = '[]
+  WithoutComponents (Read a ': rest) = WithoutComponents rest
+  WithoutComponents (Write a ': rest) = WithoutComponents rest
+  WithoutComponents (With a ': rest) = WithoutComponents rest
+  WithoutComponents (Without a ': rest) = a ': WithoutComponents rest
+
+type family Contains (a :: Type) (list :: [Type]) :: Bool where
+  Contains a '[] = 'False
+  Contains a (a ': rest) = 'True
+  Contains a (b ': rest) = Contains a rest
+
+type family HasOverlap (list1 :: [Type]) (list2 :: [Type]) :: Bool where
+  HasOverlap '[] list2 = 'False
+  HasOverlap (a ': rest) list2 = Or (Contains a list2) (HasOverlap rest list2)
+
+type family HasDuplicates (list :: [Type]) :: Bool where
+  HasDuplicates '[] = 'False
+  HasDuplicates (a ': rest) = Or (Contains a rest) (HasDuplicates rest)
+
+type family ValidateAccess (accesses :: [Type]) :: Bool where
+  ValidateAccess accesses =
+    And
+      (Not (HasOverlap (WriteComponents accesses) (ReadComponents accesses)))
+      (Not (HasDuplicates (WriteComponents accesses)))
+
+type family And (a :: Bool) (b :: Bool) :: Bool where
+  And 'True 'True = 'True
+  And 'True 'False = 'False
+  And 'False 'True = 'False
+  And 'False 'False = 'False
+
+type family Or (a :: Bool) (b :: Bool) :: Bool where
+  Or 'True _ = 'True
+  Or 'False 'True = 'True
+  Or 'False 'False = 'False
+
+type family Not (b :: Bool) :: Bool where
+  Not 'True = 'False
+  Not 'False = 'True
+
+type ValidAccess accesses = (ValidateAccess accesses ~ 'True)
+
+data Read (a :: Type)
+
+data Write (a :: Type)
+
+data With (a :: Type) = With
+
+data Without (a :: Type) = Without
+
+instance (PrimMonad m, Lookup a cs) => Queryable cs m (With a) where
+  type QueryableAccess (With a) = '[With a]
+  queryable cs entitiesArg = Query $ do
+    withComponent <- MS.toList $ HS.lookup @a cs
+    let withComponentIndices = Set.fromList $ map fst $ catMaybes withComponent
+        allEntities = entities entitiesArg
+        result =
+          map
+            ( \e ->
+                if Set.member (entityIndex e) withComponentIndices
+                  then Just (With)
+                  else Nothing
+            )
+            allEntities
+    return result
+
+instance (PrimMonad m, Lookup a cs) => Queryable cs m (Without a) where
+  type QueryableAccess (Without a) = '[Without a]
+  queryable cs entitiesArg = Query $ do
+    withComponent <- MS.toList $ HS.lookup @a cs
+    let withComponentIndices = Set.fromList $ map fst $ catMaybes withComponent
+        allEntities = entities entitiesArg
+        result =
+          map
+            ( \e ->
+                if Set.member (entityIndex e) withComponentIndices
+                  then Nothing
+                  else Just (Without)
+            )
+            allEntities
+    return result
+
+type family AccessComponent (access :: Type) :: Type where
+  AccessComponent (Read a) = a
+  AccessComponent (Write a) = a
+  AccessComponent (With a) = a
+  AccessComponent (Without a) = a
+
+type Components s = HSet (ComponentStorage s)
+
+type ComponentStorage s = MSparseSet s Word32
+
+type family GenericQueryableAccess (f :: Type -> Type) :: [Type] where
+  GenericQueryableAccess (M1 _ _ f) = GenericQueryableAccess f
+  GenericQueryableAccess (f :*: g) = GenericQueryableAccess f ++ GenericQueryableAccess g
+  GenericQueryableAccess (K1 _ a) = QueryableAccess a
+  GenericQueryableAccess U1 = '[]
+
+class GenericQueryable cs m (f :: Type -> Type) where
+  genericQueryableRep :: Components (PrimState m) cs -> Entities -> m [Maybe (f p)]
+
+instance (Monad m) => GenericQueryable s m U1 where
+  genericQueryableRep _ _ = pure [Just U1]
+  {-# INLINE genericQueryableRep #-}
+
+instance
+  ( Monad m,
+    GenericQueryable cs m f,
+    GenericQueryable cs m g
+  ) =>
+  GenericQueryable cs m (f :*: g)
+  where
+  genericQueryableRep components entitiesArg = do
+    fs <- genericQueryableRep components entitiesArg
+    gs <- genericQueryableRep components entitiesArg
+    return $ zipWith (\f g -> (:*:) <$> f <*> g) fs gs
+  {-# INLINE genericQueryableRep #-}
+
+instance (Functor m, GenericQueryable s m f) => GenericQueryable s m (M1 i c f) where
+  genericQueryableRep components entitiesArg = map (fmap M1) <$> genericQueryableRep components entitiesArg
+  {-# INLINE genericQueryableRep #-}
+
+instance (Functor m, PrimMonad m, PrimState m ~ s, Queryable cs m a) => GenericQueryable cs m (K1 i a) where
+  genericQueryableRep components entitiesArg = map (fmap K1) <$> unQuery (queryable components entitiesArg)
+  {-# INLINE genericQueryableRep #-}
+
+genericQueryable ::
+  forall a cs m.
+  ( Generic a,
+    GenericQueryable cs m (Rep a),
+    Functor m
+  ) =>
+  Components (PrimState m) cs ->
+  Entities ->
+  m [Maybe a]
+genericQueryable components entitiesArg = map (fmap to) <$> genericQueryableRep components entitiesArg
+{-# INLINE genericQueryable #-}
+
+class (PrimMonad m) => Queryable cs m a where
+  type QueryableAccess a :: [Type]
+  type QueryableAccess a = GenericQueryableAccess (Rep a)
+
+  queryable :: Components (PrimState m) cs -> Entities -> Query m a
+  default queryable ::
+    ( Generic a,
+      GenericQueryable cs m (Rep a),
+      QueryableAccess a ~ GenericQueryableAccess (Rep a),
+      ValidAccess (QueryableAccess a)
+    ) =>
+    Components (PrimState m) cs ->
+    Entities ->
+    Query m a
+  queryable components entitiesArg = Query $ map (fmap to) <$> genericQueryableRep components entitiesArg
+  {-# INLINE queryable #-}
+
+instance (Functor m, Monad m, PrimMonad m) => Queryable cs m Entity where
+  type QueryableAccess Entity = '[]
+  queryable _ ec = Query $ pure . map pure $ entities ec
+
+instance
+  ( Queryable cs m a,
+    Queryable cs m b,
+    ValidAccess (QueryableAccess a ++ QueryableAccess b)
+  ) =>
+  Queryable cs m (a, b)
+  where
+  type QueryableAccess (a, b) = QueryableAccess a ++ QueryableAccess b
+
+instance
+  ( Queryable cs m a,
+    Queryable cs m b,
+    Queryable cs m c,
+    ValidAccess (QueryableAccess a ++ (QueryableAccess b ++ QueryableAccess c))
+  ) =>
+  Queryable cs m (a, b, c)
+  where
+  type QueryableAccess (a, b, c) = QueryableAccess a ++ (QueryableAccess b ++ QueryableAccess c)
+
+instance
+  ( Queryable cs m a,
+    Queryable cs m b,
+    Queryable cs m c,
+    Queryable cs m d,
+    ValidAccess
+      ( (QueryableAccess a ++ QueryableAccess b)
+          ++ (QueryableAccess c ++ QueryableAccess d)
+      )
+  ) =>
+  Queryable cs m (a, b, c, d)
+  where
+  type QueryableAccess (a, b, c, d) = (QueryableAccess a ++ QueryableAccess b) ++ (QueryableAccess c ++ QueryableAccess d)
+
+instance
+  ( Queryable cs m a,
+    Queryable cs m b,
+    Queryable cs m c,
+    Queryable cs m d,
+    Queryable cs m e,
+    ValidAccess
+      ( (QueryableAccess a ++ QueryableAccess b)
+          ++ (QueryableAccess c ++ (QueryableAccess d ++ QueryableAccess e))
+      )
+  ) =>
+  Queryable cs m (a, b, c, d, e)
+  where
+  type
+    QueryableAccess (a, b, c, d, e) =
+      (QueryableAccess a ++ QueryableAccess b)
+        ++ (QueryableAccess c ++ (QueryableAccess d ++ QueryableAccess e))
+
+instance
+  ( Queryable cs m a,
+    Queryable cs m b,
+    Queryable cs m c,
+    Queryable cs m d,
+    Queryable cs m e,
+    Queryable cs m f,
+    ValidAccess
+      ( (QueryableAccess a ++ (QueryableAccess b ++ QueryableAccess c))
+          ++ ( QueryableAccess d
+                 ++ (QueryableAccess e ++ QueryableAccess f)
+             )
+      )
+  ) =>
+  Queryable cs m (a, b, c, d, e, f)
+  where
+  type
+    QueryableAccess (a, b, c, d, e, f) =
+      ( (QueryableAccess a ++ (QueryableAccess b ++ QueryableAccess c))
+          ++ ( QueryableAccess d
+                 ++ (QueryableAccess e ++ QueryableAccess f)
+             )
+      )
+
+instance
+  ( Queryable cs m a,
+    Queryable cs m b,
+    Queryable cs m c,
+    Queryable cs m d,
+    Queryable cs m e,
+    Queryable cs m f,
+    Queryable cs m g,
+    ValidAccess
+      ( (QueryableAccess a ++ (QueryableAccess b ++ QueryableAccess c))
+          ++ ( (QueryableAccess d ++ QueryableAccess e)
+                 ++ (QueryableAccess f ++ QueryableAccess g)
+             )
+      )
+  ) =>
+  Queryable cs m (a, b, c, d, e, f, g)
+  where
+  type
+    QueryableAccess (a, b, c, d, e, f, g) =
+      (QueryableAccess a ++ (QueryableAccess b ++ QueryableAccess c))
+        ++ ( (QueryableAccess d ++ QueryableAccess e)
+               ++ (QueryableAccess f ++ QueryableAccess g)
+           )
+
+instance
+  ( Queryable cs m a,
+    Queryable cs m b,
+    Queryable cs m c,
+    Queryable cs m d,
+    Queryable cs m e,
+    Queryable cs m f,
+    Queryable cs m g,
+    Queryable cs m h,
+    ValidAccess
+      ( ( (QueryableAccess a ++ QueryableAccess b)
+            ++ (QueryableAccess c ++ QueryableAccess d)
+        )
+          ++ ( (QueryableAccess e ++ QueryableAccess f)
+                 ++ (QueryableAccess g ++ QueryableAccess h)
+             )
+      )
+  ) =>
+  Queryable cs m (a, b, c, d, e, f, g, h)
+  where
+  type
+    QueryableAccess (a, b, c, d, e, f, g, h) =
+      ( (QueryableAccess a ++ QueryableAccess b)
+          ++ (QueryableAccess c ++ QueryableAccess d)
+      )
+        ++ ( (QueryableAccess e ++ QueryableAccess f)
+               ++ (QueryableAccess g ++ QueryableAccess h)
+           )
+ src/Aztecs/ECS/Queryable/R.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Aztecs.ECS.Queryable.R where
+
+import Aztecs.ECS.HSet
+import Aztecs.ECS.Query (Query (..))
+import Aztecs.ECS.Queryable
+import Aztecs.ECS.Queryable.Internal
+import Control.Monad.Primitive
+import qualified Data.SparseSet.Strict.Mutable as MS
+import Prelude hiding (Read, lookup)
+
+newtype R a = R {unR :: a}
+  deriving (Show, Eq, Functor)
+
+instance (PrimMonad m, Lookup a cs) => Queryable cs m (R a) where
+  type QueryableAccess (R a) = '[Read a]
+  queryable cs _ = Query $ do
+    !as <- MS.toList $ lookup cs
+    let go (_, c) = R c
+    return $ map (fmap go) as
+  {-# INLINE queryable #-}
+ src/Aztecs/ECS/Queryable/W.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Aztecs.ECS.Queryable.W where
+
+import Aztecs.ECS.HSet
+import Aztecs.ECS.Query (Query (..))
+import Aztecs.ECS.Queryable
+import Aztecs.ECS.Queryable.Internal
+import Control.Monad.Primitive
+import qualified Data.SparseSet.Strict.Mutable as MS
+import Data.Word
+import Prelude hiding (Read, lookup)
+
+type W m a = MkW (PrimState m) a
+
+data MkW s c = W
+  { wIndex :: {-# UNPACK #-} !Word32,
+    wSparseSet :: {-# UNPACK #-} !(ComponentStorage s c)
+  }
+
+readW :: (PrimMonad m) => W m c -> m c
+readW r = MS.unsafeRead (wSparseSet r) (fromIntegral $ wIndex r)
+{-# INLINE readW #-}
+
+writeW :: (PrimMonad m) => W m c -> c -> m ()
+writeW r = MS.unsafeWrite (wSparseSet r) (fromIntegral $ wIndex r)
+{-# INLINE writeW #-}
+
+modifyW :: (PrimMonad m) => W m c -> (c -> c) -> m ()
+modifyW r f = MS.unsafeModify (wSparseSet r) (fromIntegral $ wIndex r) f
+{-# INLINE modifyW #-}
+
+instance (PrimMonad m, PrimState m ~ s, Functor m, Lookup a cs) => Queryable cs m (MkW s a) where
+  type QueryableAccess (MkW s a) = '[Write a]
+  queryable cs _ = Query $ do
+    let s = lookup @a cs
+    !as <- MS.toList s
+    let go (i, _) = W i s
+    return $ map (fmap go) as
+  {-# INLINE queryable #-}
src/Aztecs/ECS/System.hs view
@@ -1,337 +1,35 @@-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
-
--- |
--- 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)
---
--- Systems to process entities.
-module Aztecs.ECS.System
-  ( -- * Systems
-    System,
-    SystemT (..),
-
-    -- ** Queries
-
-    -- *** Reading
-    readQuery,
-    readQueryT,
-    readQueryEntities,
-    readQueryEntitiesT,
-
-    -- *** Writing
-    query,
-    queryT,
-    querySingleMaybe,
-    querySingleMaybeT,
-
-    -- *** Conversion
-    fromQuery,
-    fromQueryT,
-
-    -- ** Dynamic Queries
-
-    -- *** Reading
-    readQueryDyn,
-    readQueryDynT,
-    readQueryEntitiesDyn,
-    readQueryEntitiesDynT,
-
-    -- *** Writing
-    queryDyn,
-    queryDynT,
-    querySingleMaybeDyn,
-    querySingleMaybeDynT,
-
-    -- * Internal
-    Job (..),
-    Task (..),
-
-    -- ** Running
-    runSystemT,
-    concurrently,
-  )
-where
-
-import Aztecs.ECS.Entity
-import Aztecs.ECS.Query (Query, QueryT (..))
-import Aztecs.ECS.Query.Dynamic
-  ( DynamicQuery,
-    DynamicQueryT,
-    queryFilter,
-    readDynQuery,
-    readDynQueryEntities,
-  )
-import qualified Aztecs.ECS.View as V
-import qualified Aztecs.ECS.World.Archetype as A
-import Aztecs.ECS.World.Entities (Entities (..))
-import Control.Concurrent
-import Control.Monad.Identity
-import Control.Monad.Trans
-import Data.Kind
-import qualified Data.Map as Map
-
--- | System task.
---
--- @since 0.11
-newtype Task t (m :: Type -> Type) a
-  = Task {runTask :: ((Entities -> Entities) -> t m Entities) -> t m a}
-  deriving (Functor)
-
--- | Job to be interpreted.
---
--- @since 0.11
-data Job t m a where
-  Pure :: a -> Job t m a
-  Map :: (a -> b) -> Job t m a -> Job t m b
-  Ap :: Job t m (a -> b) -> Job t m a -> Job t m b
-  Bind :: Job t m a -> (a -> Job t m b) -> Job t m b
-  Once :: Task t m a -> Job t m a
-
-type System = SystemT Identity
-
--- | System to process entities.
---
--- @since 0.11
-newtype SystemT m a
-  = System {unSystem :: forall t. (MonadTrans t, Monad (t m)) => Job t m a}
-
--- | @since 0.11
-instance Functor (SystemT m) where
-  fmap f (System s) = System $ Map f s
-
--- | @since 0.11
-instance (Monad m) => Applicative (SystemT m) where
-  pure a = System $ Pure a
-  (System f) <*> (System g) = System $ Ap f g
-
--- | @since 0.11
-instance (Monad m) => Monad (SystemT m) where
-  (System a) >>= f = System $ Bind a (unSystem . f)
-
--- | @since 0.11
-instance (MonadIO m) => MonadIO (SystemT m) where
-  liftIO m = System $ Once . Task . const . lift $ liftIO m
-
--- | Match all entities with a `Query`.
---
--- @since 0.11
-readQuery :: (Monad m) => Query a -> SystemT m [a]
-readQuery q = do
-  dynQ <- fromQuery q
-  readQueryDyn dynQ
-
--- | Match all entities with a `QueryT`.
---
--- @since 0.11
-readQueryT :: (Monad m) => QueryT m a -> SystemT m [a]
-readQueryT q = do
-  dynQ <- fromQueryT q
-  readQueryDynT dynQ
-
--- | Match and update all entities with a `QueryT`.
---
--- @since 0.11
-query :: (Monad m) => Query a -> SystemT m [a]
-query q = do
-  dynQ <- fromQuery q
-  queryDyn dynQ
-
--- | Match and update all entities with a `QueryT`.
---
--- @since 0.11
-queryT :: (Monad m) => QueryT m a -> SystemT m [a]
-queryT q = do
-  dynQ <- fromQueryT q
-  queryDynT dynQ
-
--- | Match and update a single entity with a `Query`, or @Nothing@.
---
--- @since 0.11
-querySingleMaybe :: (Monad m) => Query a -> SystemT m (Maybe a)
-querySingleMaybe q = do
-  dynQ <- fromQuery q
-  querySingleMaybeDyn dynQ
-
--- | Match and update a single entity with a `QueryT`, or @Nothing@.
---
--- @since 0.11
-querySingleMaybeT :: (Monad m) => QueryT m a -> SystemT m (Maybe a)
-querySingleMaybeT q = do
-  dynQ <- fromQueryT q
-  querySingleMaybeDynT dynQ
-
--- | Map all entities with a `DynamicQuery`.
---
--- @since 0.11
-queryDyn :: (Monad m) => DynamicQuery a -> SystemT m [a]
-queryDyn q = System $ Once . Task $ \f -> do
-  w <- f id
-  let qf = queryFilter q
-      !v = V.view qf $ archetypes w
-  let (o, v') = runIdentity $ V.mapDyn q v
-  _ <- f $ V.unview v'
-  return o
-
--- | Map all entities with a `DynamicQueryT`.
---
--- @since 0.11
-queryDynT :: (Monad m) => DynamicQueryT m a -> SystemT m [a]
-queryDynT q = System $ Once . Task $ \f -> do
-  w <- f id
-  let qf = queryFilter q
-      !v = V.view qf $ archetypes w
-  (o, v') <- lift $ V.mapDyn q v
-  _ <- f $ V.unview v'
-  return o
-
--- | Map a single entity with a `DynamicQuery`.
---
--- @since 0.11
-querySingleMaybeDyn :: (Monad m) => DynamicQuery a -> SystemT m (Maybe a)
-querySingleMaybeDyn q = System $ Once . Task $ \f -> do
-  w <- f id
-  let qf = queryFilter q
-  case V.viewSingle qf $ archetypes w of
-    Just v -> do
-      let (o, v') = runIdentity $ V.mapSingleDyn q v
-      _ <- f $ V.unview v'
-      return o
-    Nothing -> return Nothing
-
--- | Map a single entity with a `DynamicQueryT`.
---
--- @since 0.11
-querySingleMaybeDynT :: (Monad m) => DynamicQueryT m a -> SystemT m (Maybe a)
-querySingleMaybeDynT q = System $ Once . Task $ \f -> do
-  w <- f id
-  let qf = queryFilter q
-  case V.viewSingle qf $ archetypes w of
-    Just v -> do
-      (o, v') <- lift $ V.mapSingleDyn q v
-      _ <- f $ V.unview v'
-      return o
-    Nothing -> return Nothing
-
-readQueryDyn :: (Monad m) => DynamicQuery a -> SystemT m [a]
-readQueryDyn q = System $ Once . Task $ \f -> do
-  w <- f id
-  let qf = queryFilter q
-      !v = V.view qf $ archetypes w
-  return $
-    runIdentity $
-      if V.null v
-        then readDynQuery q $ A.empty {A.entities = Map.keysSet $ entities w}
-        else V.allDyn q v
-
-readQueryDynT :: (Monad m) => DynamicQueryT m a -> SystemT m [a]
-readQueryDynT q = System $ Once . Task $ \f -> do
-  w <- f id
-  let qf = queryFilter q
-      !v = V.view qf $ archetypes w
-  lift $
-    if V.null v
-      then readDynQuery q $ A.empty {A.entities = Map.keysSet $ entities w}
-      else V.allDyn q v
-
--- | Match entities with a `QueryT`.
---
--- @since 0.11
-readQueryEntities :: (Monad m) => [EntityID] -> Query a -> SystemT m [a]
-readQueryEntities es q = fromQuery q >>= readQueryEntitiesDyn es
-
--- | Match entities with a `QueryT`.
---
--- @since 0.11
-readQueryEntitiesT :: (Monad m) => [EntityID] -> QueryT m a -> SystemT m [a]
-readQueryEntitiesT es q = fromQueryT q >>= readQueryEntitiesDynT es
-
-readQueryEntitiesDyn :: (Monad m) => [EntityID] -> DynamicQuery a -> SystemT m [a]
-readQueryEntitiesDyn es q = System $ Once . Task $ \f -> do
-  w <- f id
-  let qf = queryFilter q
-      !v = V.view qf $ archetypes w
-  return . runIdentity $
-    if V.null v
-      then readDynQueryEntities es q $ A.empty {A.entities = Map.keysSet $ entities w}
-      else V.allDyn q v
-
-readQueryEntitiesDynT :: (Monad m) => [EntityID] -> DynamicQueryT m a -> SystemT m [a]
-readQueryEntitiesDynT es q = System $ Once . Task $ \f -> do
-  w <- f id
-  let qf = queryFilter q
-      !v = V.view qf $ archetypes w
-  lift $
-    if V.null v
-      then readDynQueryEntities es q $ A.empty {A.entities = Map.keysSet $ entities w}
-      else V.allDyn q v
-
--- | Convert a `Query` to a `SystemT`.
---
--- @since 0.11
-fromQuery :: Query a -> SystemT m (DynamicQuery a)
-fromQuery q = System $ Once . Task $ \f -> do
-  w <- f id
-  let (cs', dynQ) = runQuery q $ components w
-  _ <- f $ const w {components = cs'}
-  return dynQ
-
--- | Convert a `QueryT` to a `SystemT`.
---
--- @since 0.11
-fromQueryT :: (Monad m) => QueryT m a -> SystemT m (DynamicQueryT m a)
-fromQueryT q = System $ Once . Task $ \f -> do
-  w <- f id
-  let (cs', dynQ) = runQuery q $ components w
-  _ <- f $ const w {components = cs'}
-  return dynQ
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
 
-runSystemT ::
-  (MonadTrans t, Monad (t m), Monad m) =>
-  SystemT m a ->
-  ((Entities -> Entities) -> t m Entities) ->
-  t m a
-runSystemT (System s) = runJob s
+module Aztecs.ECS.System where
 
-runJob ::
-  (MonadTrans t, Monad (t m), Monad m) =>
-  Job t m a ->
-  ((Entities -> Entities) -> t m Entities) ->
-  t m a
-runJob (Pure a) _ = return a
-runJob (Map f' s') f = f' <$> runJob s' f
-runJob (Ap f' a) f = runJob f' f <*> runJob a f
-runJob (Bind a f') f = runJob a f >>= \a' -> runJob (f' a') f
-runJob (Once (Task t)) f = t f
+import Aztecs.ECS.Access.Internal
+import Aztecs.ECS.HSet
+import Aztecs.ECS.Queryable.Internal
+import Aztecs.ECS.World
 
-concurrently :: SystemT IO a -> ((Entities -> Entities) -> IO Entities) -> IO a
-concurrently (System s) f = runJobConcurrently s $ lift . f
+class System m sys where
+  type SystemInputs m sys
+  runSystem :: sys -> SystemInputs m sys -> m ()
 
-runJobConcurrently :: Job IdentityT IO a -> ((Entities -> Entities) -> IdentityT IO Entities) -> IO a
-runJobConcurrently (Pure a) _ = return a
-runJobConcurrently (Map f' s') f = f' <$> runJobConcurrently s' f
-runJobConcurrently (Ap f' a) f = do
-  aVar <- newEmptyMVar
-  fVar <- newEmptyMVar
-  _ <- forkIO $ do
-    f'' <- runJobConcurrently f' f
-    putMVar fVar f''
-  _ <- forkIO $ do
-    a' <- runJobConcurrently a f
-    putMVar aVar a'
-  a' <- takeMVar aVar
-  f'' <- takeMVar fVar
-  return $ f'' a'
-runJobConcurrently (Bind a f') f = runJobConcurrently a f >>= \a' -> runJobConcurrently (f' a') f
-runJobConcurrently (Once (Task t)) f = runIdentityT $ t f
+runSystemWithWorld ::
+  ( System m sys,
+    Access cs m (SystemInputs m sys),
+    Subset (AccessToComponents (AccessType (SystemInputs m sys))) cs,
+    ValidAccessInput (AccessType (SystemInputs m sys))
+  ) =>
+  sys ->
+  World m cs ->
+  m ()
+runSystemWithWorld sys world = runSystem sys (access world)
− src/Aztecs/ECS/View.hs 
@@ -1,127 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
--- |
--- Module      : Aztecs.ECS.View
--- 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.View
-  ( View (..),
-    view,
-    viewSingle,
-    null,
-    unview,
-    allDyn,
-    singleDyn,
-    mapDyn,
-    mapSingleDyn,
-  )
-where
-
-import Aztecs.ECS.Query.Dynamic
-import Aztecs.ECS.World.Archetypes
-import qualified Aztecs.ECS.World.Archetypes as AS
-import Aztecs.ECS.World.Entities (Entities)
-import qualified Aztecs.ECS.World.Entities as E
-import Data.Foldable (foldl', foldlM)
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-import Prelude hiding (null)
-
--- | View into a `World`, containing a subset of archetypes.
---
--- @since 0.9
-newtype View = View
-  { -- | Archetypes contained in this view.
-    --
-    -- @since 0.9
-    viewArchetypes :: Map ArchetypeID Node
-  }
-  deriving (Show, Semigroup, Monoid)
-
--- | View into all archetypes containing the provided component IDs.
---
--- @since 0.9
-view :: QueryFilter -> Archetypes -> View
-view qf as = View $ AS.find (filterWith qf) (filterWithout qf) as
-
--- | View into a single archetype containing the provided component IDs.
---
--- @since 0.9
-viewSingle :: QueryFilter -> Archetypes -> Maybe View
-viewSingle qf as = case Map.toList $ AS.find (filterWith qf) (filterWithout qf) as of
-  [a] -> Just . View $ uncurry Map.singleton a
-  _ -> Nothing
-
--- | @True@ if the `View` is empty.
---
--- @since 0.9
-null :: View -> Bool
-null = Map.null . viewArchetypes
-
--- | "Un-view" a `View` back into a `World`.
---
--- @since 0.9
-unview :: View -> Entities -> Entities
-unview v es =
-  es
-    { E.archetypes =
-        foldl'
-          (\as (aId, n) -> as {AS.nodes = Map.insert aId n (AS.nodes as)})
-          (E.archetypes es)
-          (Map.toList $ viewArchetypes v)
-    }
-
--- | Query all matching entities in a `View`.
---
--- @since 0.9
-allDyn :: (Monad m) => DynamicQueryT m a -> View -> m [a]
-allDyn q v =
-  foldlM
-    ( \acc n -> do
-        as <- readDynQuery q $ nodeArchetype n
-        return $ as ++ acc
-    )
-    []
-    (viewArchetypes v)
-
--- | Query all matching entities in a `View`.
---
--- @since 0.9
-singleDyn :: (Monad m) => DynamicQueryT m a -> View -> m (Maybe a)
-singleDyn q v = do
-  as <- allDyn q v
-  return $ case as of
-    [a] -> Just a
-    _ -> Nothing
-
--- | Map all matching entities in a `View`.
---
--- @since 0.9
-mapDyn :: (Monad m) => DynamicQueryT m a -> View -> m ([a], View)
-mapDyn q v = do
-  (as, arches) <-
-    foldlM
-      ( \(acc, archAcc) (aId, n) -> do
-          (as', arch') <- runDynQuery q $ nodeArchetype n
-          return (as' ++ acc, Map.insert aId (n {nodeArchetype = arch'}) archAcc)
-      )
-      ([], Map.empty)
-      (Map.toList $ viewArchetypes v)
-  return (as, View arches)
-
--- | Map a single matching entity in a `View`.
---
--- @since 0.9
-mapSingleDyn :: (Monad m) => DynamicQueryT m a -> View -> m (Maybe a, View)
-mapSingleDyn q v = do
-  (as, arches) <- mapDyn q v
-  return $ case as of
-    [a] -> (Just a, arches)
-    _ -> (Nothing, arches)
src/Aztecs/ECS/World.hs view
@@ -1,105 +1,134 @@ {-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
 
--- |
--- 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 (..),
+  ( Bundle (..),
+    bundle,
+    World (..),
     empty,
     spawn,
-    spawnEmpty,
     insert,
-    lookup,
+    removeComponent,
     remove,
-    removeWithId,
-    despawn,
+    query,
   )
 where
 
-import Aztecs.ECS.Component
-import Aztecs.ECS.Entity
-import Aztecs.ECS.World.Bundle
-import Aztecs.ECS.World.Entities (Entities)
-import qualified Aztecs.ECS.World.Entities as E
-import Control.DeepSeq
-import Data.Dynamic
-import Data.IntMap (IntMap)
-import GHC.Generics
-import Prelude hiding (lookup)
+import Aztecs.ECS.Entities
+import Aztecs.ECS.HSet hiding (empty)
+import qualified Aztecs.ECS.HSet as HS
+import Aztecs.ECS.Query
+import Aztecs.ECS.Queryable
+import Aztecs.ECS.Queryable.Internal
+import Control.Monad
+import Control.Monad.Primitive
+import Data.IntMap.Strict (IntMap)
+import qualified Data.IntMap.Strict as IntMap
+import Data.Kind
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import Data.Proxy
+import qualified Data.SparseSet.Strict as S
+import Data.SparseSet.Strict.Mutable (MSparseSet)
+import Data.Typeable
+import Data.Word
+import Prelude hiding (Read, lookup)
 
--- | World of entities and their components.
---
--- @since 0.9
-data World = World
-  { -- | Entities and their components.
-    --
-    -- @since 0.9
-    entities :: !Entities,
-    -- | Next unique entity identifier.
-    --
-    -- @since 0.9
-    nextEntityId :: !EntityID
-  }
-  deriving (Show, Generic, NFData)
+newtype Bundle cs m = Bundle {runBundle :: Entity -> World m cs -> m (World m cs)}
 
--- | Empty `World`.
---
--- @since 0.9
-empty :: World
-empty =
-  World
-    { entities = E.empty,
-      nextEntityId = EntityID 0
-    }
+instance (Monad m) => Semigroup (Bundle cs m) where
+  Bundle f <> Bundle g = Bundle $ \entity w -> f entity w >>= g entity
 
--- | Spawn a `Bundle` into the `World`.
---
--- @since 0.9
-spawn :: Bundle -> World -> (EntityID, World)
-spawn b w =
-  let e = nextEntityId w
-   in (e, w {entities = E.spawn e b $ entities w, nextEntityId = EntityID $ unEntityId e + 1})
+instance (Monad m) => Monoid (Bundle cs m) where
+  mempty = Bundle $ \_ w -> return w
 
--- | Spawn an empty entity.
---
--- @since 0.9
-spawnEmpty :: World -> (EntityID, World)
-spawnEmpty w = let e = nextEntityId w in (e, w {nextEntityId = EntityID $ unEntityId e + 1})
+bundle ::
+  forall cs m c.
+  (AdjustM m (MSparseSet (PrimState m) Word32) c cs, PrimMonad m, Typeable c) =>
+  c ->
+  Bundle cs m
+bundle c = Bundle $ \entity w -> do
+  let entityIdx = fromIntegral (entityIndex entity)
+      componentType = typeOf c
+      go s = do
+        s' <- S.freeze s
+        S.thaw $ S.insert (entityIndex entity) c s'
+  cs <- HS.adjustM go $ worldComponents w
+  let entityComponents' = IntMap.insertWith Map.union entityIdx (Map.singleton componentType (removeComponent' @m @c entity)) (worldEntityComponents w)
+  return w {worldComponents = cs, worldEntityComponents = entityComponents'}
 
--- | Insert a `Bundle` into an entity.
---
--- @since 0.9
-insert :: EntityID -> Bundle -> World -> World
-insert e c w = w {entities = E.insert e c (entities w)}
+data World m cs = World
+  { worldComponents :: Components (PrimState m) cs,
+    worldEntities :: Entities,
+    worldEntityComponents :: IntMap (Map TypeRep (Components (PrimState m) cs -> m (Components (PrimState m) cs)))
+  }
 
--- | Lookup a component in an entity.
---
--- @since 0.9
-lookup :: forall a. (Component a) => EntityID -> World -> Maybe a
-lookup e w = E.lookup e $ entities w
+empty :: (Monad m, Empty m (Components (PrimState m) cs)) => m (World m cs)
+empty = do
+  cs <- HS.empty
+  return $ World cs emptyEntities IntMap.empty
 
--- | Remove a component from an entity.
---
--- @since 0.9
-remove :: forall a. (Component a) => EntityID -> World -> (Maybe a, World)
-remove e w = let (a, es) = E.remove e (entities w) in (a, w {entities = es})
+spawn :: (Monad m) => Bundle cs m -> World m cs -> m (Entity, World m cs)
+spawn c w = do
+  let (newEntity, counter) = mkEntityWithCounter (worldEntities w)
+      world' = w {worldEntities = counter}
+  world'' <- runBundle c newEntity world'
+  return (newEntity, world'')
 
--- | Remove a component from an entity with its `ComponentID`.
---
--- @since 0.9
-removeWithId :: forall a. (Component a) => EntityID -> ComponentID -> World -> (Maybe a, World)
-removeWithId e cId w = let (a, es) = E.removeWithId e cId (entities w) in (a, w {entities = es})
+insert :: Entity -> Bundle cs m -> World m cs -> m (World m cs)
+insert entity b = runBundle b entity
 
--- | Despawn an entity, returning its components.
-despawn :: EntityID -> World -> (IntMap Dynamic, World)
-despawn e w = let (a, es) = E.despawn e (entities w) in (a, w {entities = es})
+removeComponent ::
+  forall m cs c.
+  (AdjustM m (MSparseSet (PrimState m) Word32) c cs, PrimMonad m, Typeable c) =>
+  Entity ->
+  World m cs ->
+  m (World m cs)
+removeComponent entity w = do
+  let entityIdx = fromIntegral (entityIndex entity)
+      componentType = typeRep (Proxy :: Proxy c)
+      removeGo s = do
+        s' <- S.freeze s
+        S.thaw $ S.delete (entityIndex entity) s'
+  cs <- HS.adjustM @m @(MSparseSet (PrimState m) Word32) @c removeGo (worldComponents w)
+  let entityComponents' = IntMap.adjust (Map.delete componentType) entityIdx (worldEntityComponents w)
+  return $ w {worldComponents = cs, worldEntityComponents = entityComponents'}
+
+removeComponent' ::
+  forall m (c :: Type) cs.
+  (AdjustM m (MSparseSet (PrimState m) Word32) c cs, PrimMonad m) =>
+  Entity ->
+  Components (PrimState m) cs ->
+  m (Components (PrimState m) cs)
+removeComponent' e components = do
+  let removeGo s = do
+        s' <- S.freeze s
+        S.thaw $ S.delete (entityIndex e) s'
+  HS.adjustM @m @(MSparseSet (PrimState m) Word32) @c removeGo components
+
+remove :: (Monad m) => Entity -> World m cs -> m (World m cs)
+remove entity w = do
+  let entityIdx = fromIntegral (entityIndex entity)
+  case IntMap.lookup entityIdx (worldEntityComponents w) of
+    Nothing -> return w
+    Just componentRemovalFunctions -> do
+      cs' <- foldr (<=<) return (Map.elems componentRemovalFunctions) (worldComponents w)
+      let entityComponents' = IntMap.delete entityIdx (worldEntityComponents w)
+      return $ w {worldComponents = cs', worldEntityComponents = entityComponents'}
+
+query :: (Queryable cs m a) => World m cs -> Query m a
+query w = queryable (worldComponents w) (worldEntities w)
+{-# INLINE query #-}
− src/Aztecs/ECS/World/Archetype.hs 
@@ -1,299 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE ApplicativeDo #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-
--- |
--- Module      : Aztecs.ECS.World.Archetype
--- Copyright   : (c) Matt Hunzinger, 2025
--- License     : BSD-style (see the LICENSE file in the distribution)
---
--- Maintainer  : matt@hunzinger.me
--- Stability   : provisional
--- Portability : non-portable (GHC extensions)
-module Aztecs.ECS.World.Archetype
-  ( Archetype (..),
-    empty,
-    singleton,
-    lookupComponent,
-    lookupComponents,
-    lookupComponentsAsc,
-    lookupComponentsAscMaybe,
-    lookupStorage,
-    member,
-    remove,
-    removeStorages,
-    insertComponent,
-    insertComponents,
-    insertAscList,
-    map,
-    mapM,
-    zipMap,
-    zipMapM,
-  )
-where
-
-import Aztecs.ECS.Component
-import Aztecs.ECS.Entity
-import qualified Aztecs.ECS.World.Storage as S
-import Aztecs.ECS.World.Storage.Dynamic
-import qualified Aztecs.ECS.World.Storage.Dynamic as S
-import Control.DeepSeq
-import Control.Monad.Writer
-  ( MonadTrans (..),
-    MonadWriter (..),
-    WriterT (..),
-    runWriter,
-  )
-import Data.Dynamic
-import Data.Foldable
-import Data.IntMap (IntMap)
-import qualified Data.IntMap.Strict as IntMap
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Maybe
-import Data.Set (Set)
-import qualified Data.Set as Set
-import GHC.Generics
-import Prelude hiding (map, mapM, zipWith)
-
--- | Archetype of entities and components.
--- An archetype is guranteed to contain one of each stored component per entity.
---
--- @since 0.9
-data Archetype = Archetype
-  { -- | Component storages.
-    --
-    -- @since 0.9
-    storages :: !(IntMap DynamicStorage),
-    -- | Entities stored in this archetype.
-    --
-    -- @since 0.9
-    entities :: !(Set EntityID)
-  }
-  deriving (Show, Generic)
-
-instance Semigroup Archetype where
-  a <> b = Archetype {storages = storages a <> storages b, entities = entities a <> entities b}
-
-instance Monoid Archetype where
-  mempty = empty
-
-instance NFData Archetype where
-  rnf = rnf . entities
-
--- | Empty archetype.
---
--- @since 0.9
-empty :: Archetype
-empty = Archetype {storages = IntMap.empty, entities = Set.empty}
-
--- | Archetype with a single entity.
---
--- @since 0.9
-singleton :: EntityID -> Archetype
-singleton e = Archetype {storages = IntMap.empty, entities = Set.singleton e}
-
--- | Lookup a component `Storage` by its `ComponentID`.
---
--- @since 0.9
-{-# INLINE lookupStorage #-}
-lookupStorage :: (Component a) => ComponentID -> Archetype -> Maybe (StorageT a)
-lookupStorage cId w = do
-  dynS <- IntMap.lookup (unComponentId cId) $ storages w
-  fromDynamic $ storageDyn dynS
-
--- | Lookup a component by its `EntityID` and `ComponentID`.
---
--- @since 0.9
-{-# INLINE lookupComponent #-}
-lookupComponent :: (Component a) => EntityID -> ComponentID -> Archetype -> Maybe a
-lookupComponent e cId w = lookupComponents cId w Map.!? e
-
--- | Lookup all components by their `ComponentID`.
---
--- @since 0.9
-{-# INLINE lookupComponents #-}
-lookupComponents :: (Component a) => ComponentID -> Archetype -> Map EntityID a
-lookupComponents cId arch = case lookupComponentsAscMaybe cId arch of
-  Just as -> Map.fromAscList $ zip (Set.toList $ entities arch) as
-  Nothing -> Map.empty
-
--- | Lookup all components by their `ComponentID`, in ascending order by their `EntityID`.
---
--- @since 0.9
-{-# INLINE lookupComponentsAsc #-}
-lookupComponentsAsc :: (Component a) => ComponentID -> Archetype -> [a]
-lookupComponentsAsc cId = fromMaybe [] . lookupComponentsAscMaybe cId
-
--- | Lookup all components by their `ComponentID`, in ascending order by their `EntityID`.
---
--- @since 0.9
-{-# INLINE lookupComponentsAscMaybe #-}
-lookupComponentsAscMaybe :: forall a. (Component a) => ComponentID -> Archetype -> Maybe [a]
-lookupComponentsAscMaybe cId arch = S.toAscList <$> lookupStorage @a cId arch
-
--- | Insert a component into the archetype.
--- This assumes the archetype contains one of each stored component per entity.
---
--- @since 0.9
-insertComponent ::
-  forall a. (Component a) => EntityID -> ComponentID -> a -> Archetype -> Archetype
-insertComponent e cId c arch =
-  let !storage =
-        S.fromAscList @a @(StorageT a) . Map.elems . Map.insert e c $ lookupComponents cId arch
-   in arch {storages = IntMap.insert (unComponentId cId) (dynStorage @a storage) (storages arch)}
-
--- | @True@ if this archetype contains an entity with the provided `ComponentID`.
---
--- @since 0.9
-{-# INLINE member #-}
-member :: ComponentID -> Archetype -> Bool
-member cId = IntMap.member (unComponentId cId) . storages
-
--- | Map a list of components with a function and a component storage.
---
--- @since 0.11
-{-# INLINE map #-}
-map ::
-  forall a. (Component a) => (a -> a) -> ComponentID -> Archetype -> ([a], Archetype)
-map f cId arch =
-  let go maybeDyn = case maybeDyn of
-        Just dyn -> case fromDynamic $ storageDyn dyn of
-          Just s -> do
-            let !(as, s') = S.map @a @(StorageT a) f s
-            tell as
-            return $ Just $ dyn {storageDyn = toDyn s'}
-          Nothing -> return maybeDyn
-        Nothing -> return Nothing
-      !(storages', cs) = runWriter $ IntMap.alterF go (unComponentId cId) $ storages arch
-   in (cs, arch {storages = storages'})
-
--- | Map a list of components with a monadic function.
---
--- @since 0.11
-{-# INLINE mapM #-}
-mapM ::
-  forall m a.
-  (Monad m, Component a) =>
-  (a -> m a) ->
-  ComponentID ->
-  Archetype ->
-  m ([a], Archetype)
-mapM f cId arch = do
-  let go maybeDyn = case maybeDyn of
-        Just dyn -> case fromDynamic $ storageDyn dyn of
-          Just s -> do
-            (as, s') <- lift $ S.mapM @a @(StorageT a) f s
-            tell as
-            return $ Just $ dyn {storageDyn = toDyn s'}
-          Nothing -> return maybeDyn
-        Nothing -> return Nothing
-  (storages', cs) <- runWriterT $ IntMap.alterF go (unComponentId cId) $ storages arch
-  return (cs, arch {storages = storages'})
-
--- | Zip a list of components with a function.
---
--- @since 0.9
-{-# INLINE zipMap #-}
-zipMap ::
-  forall a b c.
-  (Component c) =>
-  [a] ->
-  (a -> c -> (b, c)) ->
-  ComponentID ->
-  Archetype ->
-  ([(b, c)], Archetype)
-zipMap as f cId arch =
-  let go maybeDyn = case maybeDyn of
-        Just dyn -> case fromDynamic $ storageDyn dyn of
-          Just s -> do
-            let (acs, s') = S.zipWith @c @(StorageT c) f as s
-            tell acs
-            return $ Just $ dyn {storageDyn = toDyn s'}
-          Nothing -> return maybeDyn
-        Nothing -> return Nothing
-      (storages', cs) = runWriter $ IntMap.alterF go (unComponentId cId) $ storages arch
-   in (cs, arch {storages = storages'})
-
--- | Zip a list of components with a monadic function .
---
--- @since 0.9
-zipMapM ::
-  forall m a b c.
-  (Applicative m, Component c) =>
-  [a] ->
-  (a -> c -> m (b, c)) ->
-  ComponentID ->
-  Archetype ->
-  m ([(b, c)], Archetype)
-zipMapM as f cId arch = do
-  let go maybeDyn = case maybeDyn of
-        Just dyn -> case fromDynamic $ storageDyn dyn of
-          Just s ->
-            WriterT $
-              fmap
-                (\(cs, s') -> (Just dyn {storageDyn = toDyn s'}, cs))
-                (S.zipWithM @c @(StorageT c) f as s)
-          Nothing -> pure maybeDyn
-        Nothing -> pure Nothing
-  res <- runWriterT $ IntMap.alterF go (unComponentId cId) $ storages arch
-  return (snd res, arch {storages = fst res})
-
--- | Insert a list of components into the archetype, sorted in ascending order by their `EntityID`.
---
--- @since 0.9
-{-# INLINE insertAscList #-}
-insertAscList :: forall a. (Component a) => ComponentID -> [a] -> Archetype -> Archetype
-insertAscList cId as arch =
-  let !storage = dynStorage @a $ S.fromAscList @a @(StorageT a) as
-   in arch {storages = IntMap.insert (unComponentId cId) storage $ storages arch}
-
--- | Remove an entity from an archetype, returning its components.
---
--- @since 0.9
-remove :: EntityID -> Archetype -> (IntMap Dynamic, Archetype)
-remove e arch =
-  let go (dynAcc, archAcc) (cId, dynS) =
-        let cs = Map.fromAscList . zip (Set.toList $ entities arch) $ toAscListDyn dynS
-            !(dynA, cs') = Map.updateLookupWithKey (\_ _ -> Nothing) e cs
-            dynS' = S.fromAscListDyn (Map.elems cs') dynS
-            !dynAcc' = case dynA of
-              Just d -> IntMap.insert cId d dynAcc
-              Nothing -> dynAcc
-         in (dynAcc', archAcc {storages = IntMap.insert cId dynS' $ storages archAcc})
-      arch' = arch {entities = Set.delete e $ entities arch}
-   in foldl' go (IntMap.empty, arch') . IntMap.toList $ storages arch'
-
--- | Remove an entity from an archetype, returning its component storages.
---
--- @since 0.9
-removeStorages :: EntityID -> Archetype -> (IntMap DynamicStorage, Archetype)
-removeStorages e arch =
-  let go (dynAcc, archAcc) (cId, dynS) =
-        let cs = Map.fromAscList . zip (Set.toList $ entities arch) $ toAscListDyn dynS
-            !(dynA, cs') = Map.updateLookupWithKey (\_ _ -> Nothing) e cs
-            dynS' = S.fromAscListDyn (Map.elems cs') dynS
-            !dynAcc' = case dynA of
-              Just d -> IntMap.insert cId (S.singletonDyn d dynS') dynAcc
-              Nothing -> dynAcc
-         in (dynAcc', archAcc {storages = IntMap.insert cId dynS' $ storages archAcc})
-      arch' = arch {entities = Set.delete e $ entities arch}
-   in foldl' go (IntMap.empty, arch') . IntMap.toList $ storages arch'
-
--- | Insert a map of component storages and their `EntityID` into the archetype.
---
--- @since 0.9
-insertComponents :: EntityID -> IntMap Dynamic -> Archetype -> Archetype
-insertComponents e cs arch =
-  let f archAcc (itemCId, dyn) =
-        let storages' = IntMap.adjust go itemCId (storages archAcc)
-            es = Set.toList $ entities archAcc
-            go s =
-              let ecs = Map.elems . Map.insert e dyn . Map.fromAscList . zip es $ toAscListDyn s
-               in fromAscListDyn ecs s
-         in archAcc {storages = storages', entities = Set.insert e $ entities archAcc}
-   in foldl' f arch (IntMap.toList cs)
− src/Aztecs/ECS/World/Archetypes.hs 
@@ -1,245 +0,0 @@-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeFamilies #-}
-
--- |
--- Module      : Aztecs.ECS.World.Archetypes
--- Copyright   : (c) Matt Hunzinger, 2025
--- License     : BSD-style (see the LICENSE file in the distribution)
---
--- Maintainer  : matt@hunzinger.me
--- Stability   : provisional
--- Portability : non-portable (GHC extensions)
-module Aztecs.ECS.World.Archetypes
-  ( ArchetypeID (..),
-    Node (..),
-    Archetypes (..),
-    empty,
-    insertArchetype,
-    lookupArchetypeId,
-    findArchetypeIds,
-    lookup,
-    find,
-    adjustArchetype,
-    insert,
-    remove,
-  )
-where
-
-import Aztecs.ECS.Component
-import Aztecs.ECS.Entity
-import Aztecs.ECS.World.Archetype (Archetype (..))
-import qualified Aztecs.ECS.World.Archetype as A
-import Aztecs.ECS.World.Bundle.Dynamic
-import Aztecs.ECS.World.Storage.Dynamic
-import Control.DeepSeq (NFData (..))
-import Data.Dynamic
-import Data.Foldable (foldl')
-import qualified Data.IntMap.Strict as IntMap
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-import Data.Maybe
-import Data.Set (Set)
-import qualified Data.Set as Set
-import GHC.Generics
-import Prelude hiding (all, lookup, map)
-
--- | `Archetype` ID.
---
--- @since 0.9
-newtype ArchetypeID = ArchetypeID
-  { -- | Unique integer identifier.
-    --
-    -- @since 0.9
-    unArchetypeId :: Int
-  }
-  deriving newtype (Eq, Ord, Show, NFData)
-
--- | Node in `Archetypes`.
---
--- @since 0.9
-data Node = Node
-  { -- | Unique set of `ComponentID`s of this `Node`.
-    --
-    -- @since 0.9
-    nodeComponentIds :: !(Set ComponentID),
-    -- | `Archetype` of this `Node`.
-    --
-    -- @since 0.9
-    nodeArchetype :: !Archetype
-  }
-  deriving (Show, Generic, NFData)
-
--- | `Archetype` map.
-data Archetypes = Archetypes
-  { -- | Archetype nodes in the map.
-    --
-    -- @since 0.9
-    nodes :: !(Map ArchetypeID Node),
-    -- | Mapping of unique `ComponentID` sets to `ArchetypeID`s.
-    --
-    -- @since 0.9
-    archetypeIds :: !(Map (Set ComponentID) ArchetypeID),
-    -- | Next unique `ArchetypeID`.
-    --
-    -- @since 0.9
-    nextArchetypeId :: !ArchetypeID,
-    -- | Mapping of `ComponentID`s to `ArchetypeID`s of `Archetypes` that contain them.
-    --
-    -- @since 0.9
-    componentIds :: !(Map ComponentID (Set ArchetypeID))
-  }
-  deriving (Show, Generic, NFData)
-
--- | Empty `Archetypes`.
---
--- @since 0.9
-empty :: Archetypes
-empty =
-  Archetypes
-    { nodes = mempty,
-      archetypeIds = mempty,
-      nextArchetypeId = ArchetypeID 0,
-      componentIds = mempty
-    }
-
--- | Insert an archetype by its set of `ComponentID`s.
---
--- @since 0.9
-insertArchetype :: Set ComponentID -> Node -> Archetypes -> (ArchetypeID, Archetypes)
-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`.
---
--- @since 0.9
-adjustArchetype :: ArchetypeID -> (Archetype -> Archetype) -> Archetypes -> Archetypes
-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.
---
--- @since 0.11
-findArchetypeIds :: Set ComponentID -> Set ComponentID -> Archetypes -> Set ArchetypeID
-findArchetypeIds w wo arches =
-  let !withIds = mapMaybe (\cId -> Map.lookup cId (componentIds arches)) (Set.elems w)
-      !withoutIds = mapMaybe (\cId -> Map.lookup cId (componentIds arches)) (Set.elems wo)
-      !withoutSet = foldl' Set.union Set.empty withoutIds
-   in case withIds of
-        (aId : aIds') -> foldl' Set.intersection aId aIds' `Set.difference` withoutSet
-        [] -> Set.empty
-
--- | Lookup `Archetype`s containing a set of `ComponentID`s.
---
--- @since 0.9
-find :: Set ComponentID -> Set ComponentID -> Archetypes -> Map ArchetypeID Node
-find w wo arches = Map.fromSet (\aId -> nodes arches Map.! aId) (findArchetypeIds w wo arches)
-
--- | Lookup an `ArchetypeID` by its set of `ComponentID`s.
---
--- @since 0.9
-lookupArchetypeId :: Set ComponentID -> Archetypes -> Maybe ArchetypeID
-lookupArchetypeId cIds arches = Map.lookup cIds (archetypeIds arches)
-
--- | Lookup an `Archetype` by its `ArchetypeID`.
---
--- @since 0.9
-lookup :: ArchetypeID -> Archetypes -> Maybe Node
-lookup aId arches = Map.lookup aId (nodes arches)
-
--- | Insert a component into an entity with its `ComponentID`.
---
--- @since 0.9
-insert ::
-  EntityID ->
-  ArchetypeID ->
-  Set ComponentID ->
-  DynamicBundle ->
-  Archetypes ->
-  (Maybe ArchetypeID, Archetypes)
-insert e aId cIds b arches = case lookup aId arches of
-  Just node ->
-    if Set.isSubsetOf cIds $ nodeComponentIds node
-      then
-        let go n = n {nodeArchetype = runDynamicBundle b e $ nodeArchetype n}
-         in (Nothing, arches {nodes = Map.adjust go aId $ nodes arches})
-      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'
-                       in nextNode {nodeArchetype = runDynamicBundle b e nextArch''}
-                 in (Just nextAId, arches {nodes = Map.adjust adjustNode nextAId nodes'})
-              Nothing ->
-                let !(s, arch) = A.removeStorages e $ nodeArchetype node
-                    nodes' = Map.insert aId node {nodeArchetype = arch} $ nodes arches
-                    !nextArch = 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')
-  Nothing -> (Nothing, arches)
-
--- | Remove a component from an entity with its `ComponentID`.
---
--- @since 0.9
-remove ::
-  (Component a) =>
-  EntityID ->
-  ArchetypeID ->
-  ComponentID ->
-  Archetypes ->
-  (Maybe (a, ArchetypeID), Archetypes)
-remove 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 = fromAscListDyn (Map.elems . Map.insert e dyn . Map.fromAscList . zip (Set.toList $ entities archAcc) $ toAscListDyn s) s
-             in archAcc {storages = IntMap.adjust adjustStorage itemCId (storages archAcc)}
-          go nextNode =
-            nextNode {nodeArchetype = foldl' go' (nodeArchetype nextNode) (IntMap.toList cs')}
-       in ( (,nextAId) <$> (a >>= fromDynamic),
-            arches' {nodes = Map.adjust go nextAId (nodes arches')}
-          )
-    Nothing ->
-      let !(cs, arch') = A.removeStorages e (nodeArchetype node)
-          (a, cs') = IntMap.updateLookupWithKey (\_ _ -> Nothing) (unComponentId cId) cs
-          !n =
-            Node
-              { nodeComponentIds = Set.insert cId (nodeComponentIds node),
-                nodeArchetype = Archetype {storages = cs', entities = Set.singleton e}
-              }
-          !(nextAId, arches') = insertArchetype (Set.insert cId (nodeComponentIds node)) n arches
-          node' = node {nodeArchetype = arch'}
-          removeDyn s =
-            let (res, dyns) = Map.updateLookupWithKey (\_ _ -> Nothing) e . Map.fromAscList . zip (Set.toList $ entities arch') $ toAscListDyn s
-             in (res, fromAscListDyn $ Map.elems dyns)
-       in ( (,nextAId) <$> (a >>= (\a' -> fst (removeDyn a') >>= fromDynamic)),
-            arches' {nodes = Map.insert aId node' (nodes arches')}
-          )
-  Nothing -> (Nothing, arches)
− src/Aztecs/ECS/World/Bundle.hs 
@@ -1,69 +0,0 @@-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-
--- |
--- Module      : Aztecs.ECS.World.Bundle
--- 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
-  ( Bundle (..),
-    bundle,
-    fromDynBundle,
-    runBundle,
-  )
-where
-
-import Aztecs.ECS.Component
-import Aztecs.ECS.Entity
-import Aztecs.ECS.World.Archetype
-import Aztecs.ECS.World.Bundle.Dynamic
-import Aztecs.ECS.World.Components
-import qualified Aztecs.ECS.World.Components as CS
-import Data.Set (Set)
-import qualified Data.Set as Set
-
--- | Bundle of components.
---
--- @since 0.9
-newtype Bundle = Bundle
-  { -- | Unwrap the bundle.
-    --
-    -- @since 0.9
-    unBundle :: Components -> (Set ComponentID, Components, DynamicBundle)
-  }
-
--- | @since 0.9
-instance Monoid Bundle where
-  mempty = Bundle (Set.empty,,mempty)
-
--- | @since 0.9
-instance Semigroup Bundle where
-  Bundle b1 <> Bundle b2 = Bundle $ \cs ->
-    let (cIds1, cs', d1) = b1 cs
-        (cIds2, cs'', d2) = b2 cs'
-     in (cIds1 <> cIds2, cs'', d1 <> d2)
-
--- | @since 0.11
-bundle :: forall a. (Component a) => a -> Bundle
-bundle a = Bundle $ \cs ->
-  let (cId, cs') = CS.insert @a cs in (Set.singleton cId, cs', dynBundle cId a)
-
-fromDynBundle :: DynamicBundle -> Bundle
-fromDynBundle d = Bundle (Set.empty,,d)
-
--- | Insert a bundle of components into an archetype.
---
--- @since 0.9
-runBundle :: Bundle -> Components -> EntityID -> Archetype -> (Components, Archetype)
-runBundle b cs eId arch =
-  let !(_, cs', d) = unBundle b cs
-      !arch' = runDynamicBundle d eId arch
-   in (cs', arch')
− src/Aztecs/ECS/World/Bundle/Dynamic.hs 
@@ -1,30 +0,0 @@--- |
--- 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 (..), dynBundle) where
-
-import Aztecs.ECS.Component
-import Aztecs.ECS.Entity
-import Aztecs.ECS.World.Archetype
-
--- | Dynamic bundle of components.
---
--- @since 0.9
-newtype DynamicBundle = DynamicBundle {runDynamicBundle :: EntityID -> Archetype -> Archetype}
-
--- | @since 0.9
-instance Semigroup DynamicBundle where
-  DynamicBundle d1 <> DynamicBundle d2 = DynamicBundle $ \eId arch -> d2 eId (d1 eId arch)
-
--- | @since 0.9
-instance Monoid DynamicBundle where
-  mempty = DynamicBundle $ \_ arch -> arch
-
--- | @since 0.11
-dynBundle :: (Component a) => ComponentID -> a -> DynamicBundle
-dynBundle cId a = DynamicBundle $ \eId arch -> insertComponent eId cId a arch
− src/Aztecs/ECS/World/Components.hs 
@@ -1,84 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-
--- |
--- Module      : Aztecs.ECS.World.Components
--- 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.Components
-  ( ComponentID (..),
-    Components (..),
-    empty,
-    lookup,
-    insert,
-    insert',
-  )
-where
-
-import Aztecs.ECS.Component
-import Control.DeepSeq
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-import Data.Typeable
-import GHC.Generics
-import Prelude hiding (lookup)
-
--- | Component ID map.
---
--- @since 0.9
-data Components = Components
-  { -- | Map of component types to identifiers.
-    --
-    -- @since 0.9
-    componentIds :: !(Map TypeRep ComponentID),
-    -- | Next unique component identifier.
-    --
-    -- @since 0.9
-    nextComponentId :: !ComponentID
-  }
-  deriving (Show, Generic, NFData)
-
--- | Empty `Components`.
---
--- @since 0.9
-empty :: Components
-empty =
-  Components
-    { componentIds = mempty,
-      nextComponentId = ComponentID 0
-    }
-
--- | Lookup a component ID by type.
---
--- @since 0.9
-lookup :: forall a. (Typeable a) => Components -> Maybe ComponentID
-lookup cs = Map.lookup (typeOf (Proxy @a)) (componentIds cs)
-
--- | Insert a component ID by type, if it does not already exist.
---
--- @since 0.9
-insert :: forall a. (Component a) => Components -> (ComponentID, Components)
-insert cs = case lookup @a cs of
-  Just cId -> (cId, cs)
-  Nothing -> insert' @a cs
-
--- | Insert a component ID by type.
---
--- @since 0.9
-insert' :: forall c. (Component c) => Components -> (ComponentID, Components)
-insert' cs =
-  let !cId = nextComponentId cs
-   in ( cId,
-        cs
-          { componentIds = Map.insert (typeOf (Proxy @c)) cId (componentIds cs),
-            nextComponentId = ComponentID (unComponentId cId + 1)
-          }
-      )
− src/Aztecs/ECS/World/Entities.hs 
@@ -1,206 +0,0 @@-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# 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,
-    lookup,
-    remove,
-    removeWithId,
-    despawn,
-  )
-where
-
-import Aztecs.ECS.Component
-import Aztecs.ECS.Entity
-import qualified Aztecs.ECS.World.Archetype as A
-import Aztecs.ECS.World.Archetypes (ArchetypeID, Archetypes, Node (..))
-import qualified Aztecs.ECS.World.Archetypes as AS
-import Aztecs.ECS.World.Bundle
-import Aztecs.ECS.World.Bundle.Dynamic
-import Aztecs.ECS.World.Components (Components (..))
-import qualified Aztecs.ECS.World.Components as CS
-import Control.DeepSeq
-import Data.Dynamic
-import Data.IntMap (IntMap)
-import qualified Data.IntMap as IntMap
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Maybe
-import Data.Set (Set)
-import qualified Data.Set as Set
-import GHC.Generics
-import Prelude hiding (lookup)
-
--- | World of entities and their components.
---
--- @since 0.9
-data Entities = Entities
-  { -- | Archetypes.
-    --
-    -- @since 0.9
-    archetypes :: !Archetypes,
-    -- | Components.
-    --
-    -- @since 0.9
-    components :: !Components,
-    -- | Entities and their archetype identifiers.
-    --
-    -- @since 0.9
-    entities :: !(Map EntityID ArchetypeID)
-  }
-  deriving (Show, Generic, NFData)
-
--- | Empty `World`.
---
--- @since 0.9
-empty :: Entities
-empty =
-  Entities
-    { archetypes = AS.empty,
-      components = CS.empty,
-      entities = mempty
-    }
-
--- | Spawn a `Bundle`.
---
--- @since 0.9
-spawn :: EntityID -> Bundle -> Entities -> Entities
-spawn eId b w =
-  let (cIds, components', dynB) = unBundle b (components w)
-   in case AS.lookupArchetypeId cIds (archetypes w) of
-        Just aId -> fromMaybe w $ do
-          node <- AS.lookup aId $ archetypes w
-          let arch' =
-                runDynamicBundle
-                  dynB
-                  eId
-                  ( (nodeArchetype node)
-                      { A.entities = Set.insert eId . A.entities $ nodeArchetype node
-                      }
-                  )
-          return
-            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)
-              }
-        Nothing ->
-          let arch' = 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'
-                }
-
--- | Spawn a `DynamicBundle` with a specified `ArchetypeID`.
---
--- @since 0.9
-spawnWithArchetypeId ::
-  EntityID ->
-  ArchetypeID ->
-  DynamicBundle ->
-  Entities ->
-  Entities
-spawnWithArchetypeId e aId b w =
-  let f n = n {nodeArchetype = runDynamicBundle b e ((nodeArchetype n) {A.entities = Set.insert e . A.entities $ nodeArchetype n})}
-   in w
-        { archetypes = (archetypes w) {AS.nodes = Map.adjust f aId (AS.nodes $ archetypes w)},
-          entities = Map.insert e aId (entities w)
-        }
-
--- | Insert a component into an entity.
---
--- @since 0.9
-insert :: EntityID -> Bundle -> Entities -> Entities
-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`.
---
--- @since 0.9
-insertDyn :: EntityID -> Set ComponentID -> DynamicBundle -> Entities -> Entities
-insertDyn e cIds b w = case Map.lookup e $ entities w of
-  Just aId ->
-    let (maybeNextAId, arches) = 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}
-  Nothing -> case AS.lookupArchetypeId cIds $ archetypes w of
-    Just aId -> spawnWithArchetypeId e aId b w
-    Nothing ->
-      let arch = 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)}
-
--- | Lookup a component in an entity.
---
--- @since 0.9
-lookup :: forall a. (Component a) => EntityID -> Entities -> 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
-
--- | Insert a component into an entity.
---
--- @since 0.9
-remove :: forall a. (Component a) => EntityID -> Entities -> (Maybe a, Entities)
-remove e w =
-  let !(cId, components') = CS.insert @a (components w)
-   in removeWithId @a e cId w {components = components'}
-
--- | Remove a component from an entity with its `ComponentID`.
---
--- @since 0.9
-removeWithId :: forall a. (Component a) => EntityID -> ComponentID -> Entities -> (Maybe a, Entities)
-removeWithId e cId w = case Map.lookup e (entities w) of
-  Just aId ->
-    let (res, as) = AS.remove @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})
-  Nothing -> (Nothing, w)
-
--- | Despawn an entity, returning its components.
---
--- @since 0.9
-despawn :: EntityID -> Entities -> (IntMap Dynamic, Entities)
-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)
− src/Aztecs/ECS/World/Storage.hs 
@@ -1,75 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-
--- |
--- Module      : Aztecs.ECS.World.Storage
--- Copyright   : (c) Matt Hunzinger, 2025
--- License     : BSD-style (see the LICENSE file in the distribution)
---
--- Maintainer  : matt@hunzinger.me
--- Stability   : provisional
--- Portability : non-portable (GHC extensions)
-module Aztecs.ECS.World.Storage (Storage (..)) where
-
-import qualified Control.Monad
-import qualified Control.Monad as M
-import Data.Data
-import Prelude hiding (zipWith)
-import qualified Prelude
-
--- | Component storage, containing zero or many components of the same type.
---
--- @since 0.9
-class (Typeable s, Typeable a) => Storage a s where
-  -- | Storage with a single component.
-  --
-  -- @since 0.9
-  singleton :: a -> s
-
-  -- | List of all components in the storage in ascending order.
-  --
-  -- @since 0.9
-  toAscList :: s -> [a]
-
-  -- | Convert a sorted list of components (in ascending order) into a storage.
-  --
-  -- @since 0.9
-  fromAscList :: [a] -> s
-
-  -- | Map a function over all components in the storage.
-  --
-  --
-  -- @since 0.11
-  map :: (a -> a) -> s -> ([a], s)
-
-  -- | Map a monadic function over all components in the storage.
-  --
-  -- @since 0.11
-  mapM :: (Monad m) => (a -> m a) -> s -> m ([a], s)
-
-  -- | Map a function with some input over all components in the storage.
-  --
-  -- @since 0.11
-  zipWith :: (b -> a -> (c, a)) -> [b] -> s -> ([(c, a)], s)
-
-  -- | Map an applicative functor with some input over all components in the storage.
-  --
-  -- @since 0.11
-  zipWithM :: (Applicative m) => (b -> a -> m (c, a)) -> [b] -> s -> m ([(c, a)], s)
-
--- | @since 0.11
-instance (Typeable a) => Storage a [a] where
-  {-# INLINE singleton #-}
-  singleton a = [a]
-  {-# INLINE toAscList #-}
-  toAscList = id
-  {-# INLINE fromAscList #-}
-  fromAscList = id
-  {-# INLINE map #-}
-  map f as = let as' = fmap f as in (as', as')
-  {-# INLINE mapM #-}
-  mapM f as = (\as' -> (as', as')) <$> M.mapM f as
-  {-# INLINE zipWith #-}
-  zipWith f is as = let as' = Prelude.zipWith f is as in (as', fmap snd as')
-  {-# INLINE zipWithM #-}
-  zipWithM f is as = (\as' -> (as', fmap snd as')) <$> Control.Monad.zipWithM f is as
− src/Aztecs/ECS/World/Storage/Dynamic.hs 
@@ -1,87 +0,0 @@-{-# 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,
-    fromAscListDyn,
-    toAscListDyn,
-  )
-where
-
-import qualified Aztecs.ECS.World.Storage as S
-import Data.Dynamic
-import Data.Maybe
-
--- | Dynamic storage of components.
---
--- @since 0.9
-data DynamicStorage = DynamicStorage
-  { -- | Dynamic storage.
-    --
-    -- @since 0.9
-    storageDyn :: !Dynamic,
-    -- | Singleton storage.
-    --
-    -- @since 0.9
-    singletonDyn' :: !(Dynamic -> Dynamic),
-    -- | Convert this storage to an ascending list.
-    --
-    -- @since 0.9
-    toAscListDyn' :: !(Dynamic -> [Dynamic]),
-    -- | Convert from an ascending list.
-    --
-    -- @since 0.9
-    fromAscListDyn' :: !([Dynamic] -> Dynamic)
-  }
-
--- | @since 0.9
-instance Show DynamicStorage where
-  show s = "DynamicStorage " ++ show (storageDyn s)
-
--- | Create a dynamic storage from a storage.
---
--- @since 0.9
-{-# INLINE dynStorage #-}
-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,
-      toAscListDyn' = \d -> map toDyn (S.toAscList @a @s (fromMaybe (error "TODO") $ fromDynamic d)),
-      fromAscListDyn' = toDyn . S.fromAscList @a @s . map (fromMaybe (error "TODO") . fromDynamic)
-    }
-
--- | Singleton dynamic storage.
---
--- @since 0.9
-singletonDyn :: Dynamic -> DynamicStorage -> DynamicStorage
-singletonDyn dyn s = s {storageDyn = singletonDyn' s dyn}
-
--- | Convert from an ascending list.
---
--- @since 0.9
-fromAscListDyn :: [Dynamic] -> DynamicStorage -> DynamicStorage
-fromAscListDyn dyns s = s {storageDyn = fromAscListDyn' s dyns}
-
--- | Convert this storage to an ascending list.
---
--- @since 0.9
-toAscListDyn :: DynamicStorage -> [Dynamic]
-toAscListDyn = toAscListDyn' <*> storageDyn
test/Main.hs view
@@ -1,127 +1,4 @@-{-# LANGUAGE ApplicativeDo #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-
-module Main (main) where
-
-import Aztecs.ECS
-import Aztecs.ECS.Component (ComponentID (ComponentID))
-import qualified Aztecs.ECS.Query as Q
-import qualified Aztecs.ECS.Query.Dynamic as Q
-import qualified Aztecs.ECS.World as W
-import Control.DeepSeq
-import Data.Functor.Identity (Identity (runIdentity))
-import Data.Word
-import GHC.Generics
-import Test.Hspec
-import Test.QuickCheck
-
-newtype X = X Int deriving (Eq, Show, Arbitrary, Generic, NFData)
-
-instance Component X
-
-newtype Y = Y Int deriving (Eq, Show, Arbitrary, Generic, NFData)
-
-instance Component Y
-
-newtype Z = Z Int deriving (Eq, Show, Arbitrary, Generic, NFData)
-
-instance Component Z
+module Main where
 
 main :: IO ()
-main = hspec $ do
-  describe "Aztecs.ECS.Query.querySingle" $ do
-    it "queries a single entity" prop_querySingle
-  describe "Aztecs.ECS.Query.queryMapSingle" $ do
-    it "maps a single entity" $ property prop_queryMapSingle
-  describe "Aztecs.ECS.Query.query" $ do
-    it "queries an empty world" prop_queryEmpty
-    it "queries dynamic components" $ property prop_queryDyn
-    it "queries a typed component" $ property prop_queryTypedComponent
-    it "queries 2 typed components" $ property prop_queryTwoTypedComponents
-    it "queries 3 typed components" $ property prop_queryThreeTypedComponents
-
-{-TODO
-describe "Aztecs.ECS.System.mapSingle" $ do
-  it "maps a single entity" $ property prop_systemMapSingle
-describe "Aztecs.ECS.Hierarchy.update" $ do
-  it "adds Parent components to children" $ property prop_addParents
-  it "removes Parent components from removed children" $ property prop_removeParents
--}
-
-prop_queryEmpty :: Expectation
-prop_queryEmpty =
-  let res = fst . runIdentity . Q.query (fetch @_ @X) $ W.entities W.empty in res `shouldMatchList` []
-
--- | Query all components from a list of `ComponentID`s.
-queryComponentIds ::
-  forall f a.
-  (Monad f, Component a) =>
-  [ComponentID] ->
-  QueryT f (EntityID, [a])
-queryComponentIds =
-  let go cId qAcc = do
-        x' <- Q.fromDyn $ Q.fetchDyn @a cId
-        (e, xs) <- qAcc
-        return (e, x' : xs)
-   in foldr go ((,) <$> Q.entity <*> pure [])
-
-prop_queryDyn :: [[X]] -> Expectation
-prop_queryDyn xs =
-  let s xs' (acc, wAcc) =
-        let s' x (bAcc, cAcc, idAcc) =
-              ( fromDynBundle (dynBundle (ComponentID idAcc) x) <> bAcc,
-                (x, ComponentID idAcc) : cAcc,
-                idAcc + 1
-              )
-            (b, cs, _) = foldr s' (mempty, [], 0) xs'
-            (e, wAcc') = W.spawn b wAcc
-         in ((e, cs) : acc, wAcc')
-      (es, w) = foldr s ([], W.empty) xs
-      go (e, cs) = do
-        let q = queryComponentIds $ map snd cs
-            (res, _) = runIdentity . Q.query q $ W.entities w
-        return $ res `shouldContain` [(e, map fst cs)]
-   in mapM_ go es
-
-prop_queryTypedComponent :: [X] -> Expectation
-prop_queryTypedComponent xs = do
-  let w = foldr (\x -> snd . W.spawn (bundle x)) W.empty xs
-      (res, _) = runIdentity . Q.query Q.fetch $ W.entities w
-  res `shouldMatchList` xs
-
-prop_queryTwoTypedComponents :: [(X, Y)] -> Expectation
-prop_queryTwoTypedComponents xys = do
-  let w = foldr (\(x, y) -> snd . W.spawn (bundle x <> bundle y)) W.empty xys
-      (res, _) = runIdentity . Q.query ((,) <$> Q.fetch <*> Q.fetch) $ W.entities w
-  res `shouldMatchList` xys
-
-prop_queryThreeTypedComponents :: [(X, Y, Z)] -> Expectation
-prop_queryThreeTypedComponents xyzs = do
-  let w = foldr (\(x, y, z) -> snd . W.spawn (bundle x <> bundle y <> bundle z)) W.empty xyzs
-      q = do
-        x <- Q.fetch
-        y <- Q.fetch
-        z <- Q.fetch
-        pure (x, y, z)
-      (res, _) = runIdentity . Q.query q $ W.entities w
-  res `shouldMatchList` xyzs
-
-prop_querySingle :: Expectation
-prop_querySingle =
-  let (_, w) = W.spawn (bundle $ X 1) W.empty
-      (res, _) = runIdentity . Q.readQuerySingle Q.fetch $ W.entities w
-   in res `shouldBe` X 1
-
-prop_queryMapSingle :: Word8 -> Expectation
-prop_queryMapSingle n =
-  let (_, w) = W.spawn (bundle $ X 0) W.empty
-      q = Q.zipFetchMap (\_ (X x) -> X $ x + 1) (pure ())
-      w' = foldr (\_ es -> snd . runIdentity $ Q.querySingle q es) (W.entities w) [1 .. n]
-      (res, _) = runIdentity $ Q.readQuerySingle Q.fetch w'
-   in res `shouldBe` X (fromIntegral n)
+main = return ()