aztecs 0.13.0 → 0.14.0

raw patch · 36 files changed

+2067/−1100 lines, 36 filesdep ~basedep ~mtlnew-component:exe:hooksnew-component:exe:scheduler

Dependency ranges changed: base, mtl

Files

• aztecs.cabal +119/−87
• bench/Bench.hs +18/−25
• examples/ECS.hs +12/−8
• examples/Hooks.hs +64/−0
• examples/Scheduler.hs +148/−0
• src/Aztecs.hs +26/−0
• src/Aztecs/ECS.hs +20/−53
• src/Aztecs/ECS/Access/Internal.hs +99/−191
• src/Aztecs/ECS/Bundle.hs +12/−0
• src/Aztecs/ECS/Bundle/Class.hs +9/−0
• src/Aztecs/ECS/Class.hs +12/−35
• src/Aztecs/ECS/Commands.hs +61/−0
• src/Aztecs/ECS/Component.hs +37/−0
• src/Aztecs/ECS/Entities.hs +0/−45
• src/Aztecs/ECS/Executor.hs +76/−0
• src/Aztecs/ECS/HSet.hs +18/−43
• src/Aztecs/ECS/Query.hs +8/−26
• src/Aztecs/ECS/Query/Class.hs +3/−0
• src/Aztecs/ECS/Query/Internal.hs +274/−0
• src/Aztecs/ECS/Queryable.hs +0/−3
• src/Aztecs/ECS/Queryable/Internal.hs +0/−351
• src/Aztecs/ECS/Queryable/R.hs +0/−28
• src/Aztecs/ECS/Queryable/W.hs +0/−49
• src/Aztecs/ECS/R.hs +7/−0
• src/Aztecs/ECS/Schedule.hs +3/−0
• src/Aztecs/ECS/Schedule/Internal.hs +188/−0
• src/Aztecs/ECS/Scheduler.hs +49/−0
• src/Aztecs/ECS/Scheduler/Internal.hs +298/−0
• src/Aztecs/ECS/System.hs +11/−22
• src/Aztecs/ECS/W.hs +8/−0
• src/Aztecs/ECS/World.hs +0/−134
• src/Aztecs/Entity.hs +22/−0
• src/Aztecs/Internal.hs +217/−0
• src/Aztecs/Storage.hs +81/−0
• src/Aztecs/World.hs +134/−0
• src/Aztecs/World/Entities.hs +33/−0

@@ -1,87 +1,119 @@-cabal-version: 2.4
-name:          aztecs
-version:       0.13.0
-license:       BSD-3-Clause
-license-file:  LICENSE
-maintainer:    matt@hunzinger.me
-author:        Matt Hunzinger
-homepage:      https://github.com/aztecs-hs/aztecs
-synopsis:
-    A modular game engine and Entity-Component-System (ECS) for Haskell.
-
-description:
-    A modular game engine and Entity-Component-System (ECS) for Haskell.
-    An ECS is a modern approach to organizing your application state as a database,
-    providing patterns for data-oriented design and parallel processing.
-    Aztecs provides side-effect free components and systems,
-    as well as backends for rendering and input (such as `aztecs-sdl`),
-    allowing you to structure your game as simple function of `Input -> World -> World`.
-
-category:      Game Engine
-
-source-repository head
-    type:     git
-    location: https://github.com/aztecs-hs/aztecs.git
-
-library
-    exposed-modules:
-        Aztecs.ECS
-        Aztecs.ECS.Access
-        Aztecs.ECS.Access.Internal
-        Aztecs.ECS.Class
-        Aztecs.ECS.Entities
-        Aztecs.ECS.HSet
-        Aztecs.ECS.Query
-        Aztecs.ECS.Queryable
-        Aztecs.ECS.Queryable.Internal
-        Aztecs.ECS.Queryable.R
-        Aztecs.ECS.Queryable.W
-        Aztecs.ECS.World
-        Aztecs.ECS.System
-
-    hs-source-dirs:   src
-    default-language: Haskell2010
-    build-depends:
-        base >=4.2 && <5,
-        containers >=0.6,
-        deepseq >=1,
-        mtl >=2,
-        primitive >=0.6,
-        sparse-set >=0.2
-
-executable ecs
-    main-is:          examples/ECS.hs
-    default-language: Haskell2010
-    ghc-options:      -Wall
-    build-depends:
-        base,
-        aztecs
-
-test-suite aztecs-test
-    type:             exitcode-stdio-1.0
-    main-is:          Main.hs
-    hs-source-dirs:   test
-    default-language: Haskell2010
-    ghc-options:      -Wall
-    build-depends:
-        base >=4.2 && <5,
-        aztecs,
-        containers >=0.6,
-        deepseq >=1,
-        hspec >=2,
-        QuickCheck >=2
-
-benchmark aztecs-bench
-    type:             exitcode-stdio-1.0
-    main-is:          Bench.hs
-    hs-source-dirs:   bench
-    default-language: Haskell2010
-    ghc-options:
-        -Wall -O2 -fspecialise-aggressively -fexpose-all-unfoldings
-    build-depends:
-        base >=4.2 && <5,
-        aztecs,
-        criterion >=1,
-        deepseq >=1,
-        primitive >=0.6,
-        sparse-set >=0.2
+cabal-version: 2.4+name:          aztecs+version:       0.14.0+license:       BSD-3-Clause+license-file:  LICENSE+maintainer:    matt@hunzinger.me+author:        Matt Hunzinger+homepage:      https://github.com/aztecs-hs/aztecs+synopsis:+    A modular game engine and Entity-Component-System (ECS) for Haskell.++description:+    A modular game engine and Entity-Component-System (ECS) for Haskell.+    An ECS is a modern approach to organizing your application state as a database,+    providing patterns for data-oriented design and parallel processing.+    Aztecs provides side-effect free components and systems,+    as well as backends for rendering and input (such as `aztecs-sdl`),+    allowing you to structure your game as simple function of `Input -> World -> World`.++category:      Game Engine++source-repository head+    type:     git+    location: https://github.com/aztecs-hs/aztecs.git++library+    exposed-modules:+        Aztecs+        Aztecs.ECS+        Aztecs.ECS.Access+        Aztecs.ECS.Access.Internal+        Aztecs.ECS.Bundle+        Aztecs.ECS.Bundle.Class+        Aztecs.ECS.Class+        Aztecs.ECS.Commands+        Aztecs.ECS.Component+        Aztecs.ECS.Executor+        Aztecs.ECS.HSet+        Aztecs.ECS.Query+        Aztecs.ECS.Query.Class+        Aztecs.ECS.Query.Internal+        Aztecs.ECS.R+        Aztecs.ECS.Schedule+        Aztecs.ECS.Schedule.Internal+        Aztecs.ECS.Scheduler+        Aztecs.ECS.Scheduler.Internal+        Aztecs.ECS.System+        Aztecs.ECS.W+        Aztecs.Entity+        Aztecs.Internal+        Aztecs.Storage+        Aztecs.World+        Aztecs.World.Entities++    hs-source-dirs:   src+    default-language: Haskell2010+    build-depends:+        base >=4.2 && <5,+        containers >=0.6,+        deepseq >=1,+        mtl >=2,+        primitive >=0.6,+        sparse-set >=0.2++executable ecs+    main-is:          examples/ECS.hs+    default-language: Haskell2010+    ghc-options:      -Wall+    build-depends:+        base,+        aztecs++executable scheduler+    main-is:          examples/Scheduler.hs+    default-language: Haskell2010+    ghc-options:      -Wall+    build-depends:+        base,+        aztecs,+        mtl++executable hooks+    main-is:          examples/Hooks.hs+    default-language: Haskell2010+    ghc-options:      -Wall+    build-depends:+        base,+        aztecs,+        mtl++test-suite aztecs-test+    type:             exitcode-stdio-1.0+    main-is:          Main.hs+    hs-source-dirs:   test+    default-language: Haskell2010+    ghc-options:      -Wall+    build-depends:+        base >=4.2 && <5,+        aztecs,+        containers >=0.6,+        deepseq >=1,+        hspec >=2,+        QuickCheck >=2++benchmark aztecs-bench+    type:             exitcode-stdio-1.0+    main-is:          Bench.hs+    hs-source-dirs:   bench+    default-language: Haskell2010+    ghc-options:+        -Wall -O2 -fspecialise-aggressively -fexpose-all-unfoldings++    build-depends:+        base >=4.2 && <5,+        aztecs,+        criterion >=1,+        deepseq >=1,+        primitive >=0.6,+        sparse-set >=0.2

@@ -2,53 +2,46 @@ {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
 
-import Aztecs.ECS
-import qualified Aztecs.ECS as ECS
-import qualified Aztecs.ECS.World as W
+import Aztecs
+import qualified Aztecs.World as W
 import Control.DeepSeq
-import Control.Monad
+import Control.Monad.IO.Class
 import Criterion.Main
 import GHC.Generics (Generic)
 
 newtype Position = Position Int deriving (Generic, NFData, Show)
 
+instance (Monad m) => Component m Position where
+  type ComponentStorage m Position = SparseStorage m
+
 newtype Velocity = Velocity Int deriving (Generic, NFData, Show)
 
-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 (Monad m) => Component m Velocity where
+  type ComponentStorage m Velocity = SparseStorage m
 
 data MoveSystem = MoveSystem
 
-instance System IO MoveSystem where
-  type SystemInputs MoveSystem = Query IO (W IO Position, ECS.R Velocity)
-  runSystem MoveSystem q = move q
+instance (PrimMonad m, MonadIO m) => System m MoveSystem where
+  type SystemIn m MoveSystem = Query (W m Position, R Velocity)
+  runSystem _ = mapM_ go
+    where
+      go (posRef, R (Velocity v)) =
+        modifyW posRef $ \(Position p) -> Position (p + v)
 
 setup :: IO (W.World IO '[Position, Velocity])
 setup = do
   w <- W.empty @_ @'[Position, Velocity]
-  foldM setupEntity w [0 :: Int .. 10000]
+  snd <$> runAztecsT (mapM setupEntity [0 :: Int .. 10000]) w
   where
-    setupEntity w _ = do
-      (e, w') <- W.spawn (Position 0) w
-      W.insert e (Velocity 1) w'
+    setupEntity _ = spawn (bundle (Position 0) <> bundle (Velocity 1))
 
 main :: IO ()
 main = do
   !w <- setup
-  defaultMain [bench "iter" $ whnfIO (runSystemWithWorld MoveSystem w)]
+  defaultMain [bench "iter" . whnfIO $ runAztecsT_ (system MoveSystem) w]

@@ -6,24 +6,28 @@ 
 module Main where
 
-import Aztecs.ECS
-import qualified Aztecs.ECS.Query as Q
-import qualified Aztecs.ECS.World as W
+import Aztecs
+import qualified Aztecs.World as W
 import Control.Monad.IO.Class
 
 newtype Position = Position Int
   deriving (Show, Eq)
 
+instance (Monad m) => Component m Position where
+  type ComponentStorage m Position = SparseStorage m
+
 newtype Velocity = Velocity Int
   deriving (Show, Eq)
 
+instance (Monad m) => Component m Velocity where
+  type ComponentStorage m Velocity = SparseStorage m
+
 data MoveSystem = MoveSystem
 
 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
+  type SystemIn m MoveSystem = Query (W m Position, R Velocity)
+
+  runSystem _ = mapM_ go
     where
       go (posRef, R (Velocity v)) = do
         modifyW posRef $ \(Position p) -> Position (p + v)
@@ -38,4 +42,4 @@   where
     go = do
       _ <- spawn (bundle (Position 0) <> bundle (Velocity 1))
-      runSystemWithWorld MoveSystem
+      system MoveSystem

@@ -0,0 +1,64 @@+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Main where
+
+import Aztecs
+import qualified Aztecs.World as W
+import Control.Monad.IO.Class
+
+newtype Position = Position Int
+  deriving (Show, Eq)
+
+instance (MonadIO m, Show (Entity m)) => Component m Position where
+  type ComponentStorage m Position = SparseStorage m
+
+  componentHooks _ =
+    Hooks
+      { onInsert = \entity ->
+          liftIO . putStrLn $ "Position component inserted for " ++ show entity,
+        onRemove = \entity ->
+          liftIO . putStrLn $ "Position component removed for " ++ show entity
+      }
+
+newtype Velocity = Velocity Int
+  deriving (Show, Eq)
+
+instance (MonadIO m, Show (Entity m)) => Component m Velocity where
+  type ComponentStorage m Velocity = SparseStorage m
+
+  componentHooks _ =
+    Hooks
+      { onInsert = \entity ->
+          liftIO $ putStrLn $ "Velocity component inserted for " ++ show entity,
+        onRemove = \entity ->
+          liftIO $ putStrLn $ "Velocity component removed for " ++ show entity
+      }
+
+data MoveSystem = MoveSystem
+
+instance (PrimMonad m, MonadIO m) => System m MoveSystem where
+  type SystemIn m MoveSystem = Query (W m Position, R Velocity)
+
+  runSystem _ = mapM_ go
+    where
+      go (posRef, R (Velocity v)) = do
+        modifyW posRef $ \(Position p) -> Position (p + v)
+        p <- readW posRef
+        liftIO $ putStrLn $ "Moved to: " ++ show p
+
+main :: IO ()
+main = do
+  world <- W.empty @_ @'[Position, Velocity]
+  (entity1, world') <- runAztecsT go world
+  runAztecsT_ (remove entity1) world'
+  where
+    go = do
+      e <- spawn (bundle (Position 0) <> bundle (Velocity 5))
+      system MoveSystem
+      return e

@@ -0,0 +1,148 @@+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Main where
+
+import Aztecs
+import qualified Aztecs.World as W
+import Control.Monad.IO.Class
+
+newtype Position = Position Int
+  deriving (Show, Eq)
+
+instance (Monad m) => Component m Position where
+  type ComponentStorage m Position = SparseStorage m
+
+newtype Velocity = Velocity Int
+  deriving (Show, Eq)
+
+instance (Monad m) => Component m Velocity where
+  type ComponentStorage m Velocity = SparseStorage m
+
+newtype Health = Health Int
+  deriving (Show, Eq)
+
+instance (Monad m) => Component m Health where
+  type ComponentStorage m Health = SparseStorage m
+
+newtype Damage = Damage Int
+  deriving (Show, Eq)
+
+instance (Monad m) => Component m Damage where
+  type ComponentStorage m Damage = SparseStorage m
+
+data MoveSystem = MoveSystem
+  deriving (Show)
+
+data PhysicsSystem = PhysicsSystem
+  deriving (Show)
+
+data CombatSystem = CombatSystem
+  deriving (Show)
+
+data RenderSystem = RenderSystem
+  deriving (Show)
+
+instance (PrimMonad m, MonadIO m) => System m MoveSystem where
+  type SystemIn m MoveSystem = Query (W m Position, R Velocity)
+  runSystem MoveSystem q = do
+    liftIO $ putStrLn "Running MoveSystem..."
+    mapM_ go q
+    where
+      go (posRef, R (Velocity v)) = do
+        modifyW posRef $ \(Position p) -> Position (p + v)
+        p <- readW posRef
+        liftIO $ putStrLn $ "  Moved to position: " ++ show p
+
+instance (PrimMonad m, MonadIO m) => System m PhysicsSystem where
+  type SystemIn m PhysicsSystem = Query (R Position, W m Velocity)
+  runSystem PhysicsSystem q = do
+    liftIO $ putStrLn "Running PhysicsSystem..."
+    mapM_ go q
+    where
+      go (R (Position p), velRef) = do
+        modifyW velRef $ \(Velocity v) -> Velocity (max 0 (v - 1))
+        v <- readW velRef
+        liftIO $ putStrLn $ "  Applied physics at position " ++ show p ++ ", new velocity: " ++ show v
+
+instance (PrimMonad m, MonadIO m) => System m CombatSystem where
+  type SystemIn m CombatSystem = Query (W m Health, R Damage)
+
+  runSystem CombatSystem q = do
+    liftIO $ putStrLn "Running CombatSystem..."
+    mapM_ go q
+    where
+      go (healthRef, R (Damage d)) = do
+        modifyW healthRef $ \(Health h) -> Health (max 0 (h - d))
+        h <- readW healthRef
+        liftIO $ putStrLn $ "  Applied damage, remaining health: " ++ show h
+
+instance (PrimMonad m, MonadIO m) => System m RenderSystem where
+  type SystemIn m RenderSystem = Query (R Position, R Health)
+
+  runSystem RenderSystem q = do
+    liftIO $ putStrLn "Running RenderSystem..."
+    mapM_ go q
+    where
+      go (R (Position p), R (Health h)) = do
+        liftIO $ putStrLn $ "  Rendering entity at position " ++ show p ++ " with health " ++ show h
+
+app ::
+  HSet
+    '[ Run '[] MoveSystem,
+       Run '[After MoveSystem] PhysicsSystem,
+       Run '[After PhysicsSystem] CombatSystem,
+       Run '[After CombatSystem] RenderSystem
+     ]
+app =
+  HCons (Run MoveSystem) $
+    HCons (Run PhysicsSystem) $
+      HCons (Run CombatSystem) $
+        HCons (Run RenderSystem) $
+          HEmpty
+
+appSmall ::
+  HSet
+    '[ Run '[After PhysicsSystem] MoveSystem,
+       Run '[] PhysicsSystem,
+       Run '[] RenderSystem
+     ]
+appSmall =
+  HCons (Run MoveSystem) $
+    HCons (Run PhysicsSystem) $
+      HCons (Run RenderSystem) $
+        HEmpty
+
+runSchedulerExample :: IO ()
+runSchedulerExample = do
+  world <- W.empty @_ @'[Position, Velocity, Health, Damage]
+  runAztecsT_ go world
+  where
+    go :: AztecsT '[Position, Velocity, Health, Damage] IO ()
+    go = do
+      _ <- spawn (bundle (Position 0) <> bundle (Velocity 5) <> bundle (Health 100))
+      _ <- spawn (bundle (Position 10) <> bundle (Velocity 3) <> bundle (Health 75) <> bundle (Damage 10))
+      _ <- spawn (bundle (Position (-5)) <> bundle (Velocity 2) <> bundle (Health 50))
+      runSchedule app
+      return ()
+
+runSchedulerExampleSmall :: IO ()
+runSchedulerExampleSmall = do
+  world <- W.empty @_ @'[Position, Velocity, Health, Damage]
+  runAztecsT_ go world
+  where
+    go :: AztecsT '[Position, Velocity, Health, Damage] IO ()
+    go = do
+      _ <- spawn (bundle (Position 0) <> bundle (Velocity 5) <> bundle (Health 100))
+      _ <- spawn (bundle (Position 10) <> bundle (Velocity 3) <> bundle (Health 75) <> bundle (Damage 10))
+      _ <- spawn (bundle (Position (-5)) <> bundle (Velocity 2) <> bundle (Health 50))
+      runSchedule appSmall
+      return ()
+
+main :: IO ()
+main = do
+  runSchedulerExample
+  runSchedulerExampleSmall

@@ -0,0 +1,26 @@+module Aztecs
+  ( module Aztecs.ECS.Component,
+    module Aztecs.ECS,
+    module Aztecs.Internal,
+    module Aztecs.ECS.R,
+    module Aztecs.ECS.W,
+    module Aztecs.Storage,
+    module Aztecs.ECS.HSet,
+    module Aztecs.ECS.Query.Class,
+    module Aztecs.ECS.Schedule,
+    module Aztecs.ECS.Scheduler,
+    module Aztecs.World,
+  )
+where
+
+import Aztecs.ECS
+import Aztecs.ECS.Component
+import Aztecs.ECS.HSet
+import Aztecs.ECS.Query.Class
+import Aztecs.ECS.R
+import Aztecs.ECS.Schedule
+import Aztecs.ECS.Scheduler
+import Aztecs.ECS.W
+import Aztecs.Internal
+import Aztecs.Storage
+import Aztecs.World (SparseStorage)

@@ -1,70 +1,37 @@ {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE UnboxedTuples #-}
 
 module Aztecs.ECS
-  ( module Aztecs.ECS.Queryable,
-    module Aztecs.ECS.Queryable.R,
-    module Aztecs.ECS.Queryable.W,
+  ( module Aztecs.ECS.Bundle,
+    module Aztecs.ECS.Bundle.Class,
+    module Aztecs.ECS.Class,
+    module Aztecs.ECS.Commands,
+    module Aztecs.ECS.Component,
+    module Aztecs.ECS.Query.Class,
+    module Aztecs.ECS.Schedule,
+    module Aztecs.ECS.Scheduler,
     PrimMonad (..),
-    bundle,
     Query (..),
+    runQuery,
     System (..),
-    ECS (..),
-    AztecsT (..),
-    runAztecsT_,
+    system,
   )
 where
 
-import qualified Aztecs.ECS.Access.Internal as A
+import Aztecs.ECS.Bundle
+import Aztecs.ECS.Bundle.Class
 import Aztecs.ECS.Class
-import qualified Aztecs.ECS.Entities as E
+import Aztecs.ECS.Commands
+import Aztecs.ECS.Component
 import Aztecs.ECS.Query
-import Aztecs.ECS.Queryable
-import Aztecs.ECS.Queryable.R
-import Aztecs.ECS.Queryable.W
+import Aztecs.ECS.Query.Class
+import Aztecs.ECS.Schedule
+import Aztecs.ECS.Scheduler
 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

@@ -2,219 +2,172 @@ {-# 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.Class
 import Aztecs.ECS.Query
-import Aztecs.ECS.Queryable
-import Aztecs.ECS.Queryable.Internal
-import Aztecs.ECS.World
-import Control.Monad.Primitive
+import Aztecs.ECS.Query.Class
+import Aztecs.ECS.Query.Internal
 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)
+    (ValidAccess 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
+class (Functor m) => Access m a where
   type AccessType a :: [Type]
-  access ::
-    ( Subset (AccessToComponents (AccessType a)) cs,
-      ValidAccessInput (AccessType a)
-    ) =>
-    World m cs ->
-    a
+  access :: m a
   default access ::
     ( Generic a,
-      GenericAccess cs m (Rep a),
-      Subset (AccessToComponents (GenericAccessType (Rep a))) cs,
+      GenericAccess m (Rep a),
       ValidAccessInput (GenericAccessType (Rep a)),
       AccessType a ~ GenericAccessType (Rep a)
     ) =>
-    World m cs ->
-    a
+    m a
   access = deriveAccess
   {-# INLINE access #-}
 
-class GenericAccess cs m f where
+class GenericAccess m f where
   type GenericAccessType f :: [Type]
-  genericAccess ::
-    ( Subset (AccessToComponents (GenericAccessType f)) cs,
-      ValidAccessInput (GenericAccessType f)
-    ) =>
-    World m cs ->
-    f p
+  genericAccess :: (ValidAccessInput (GenericAccessType f)) => m (f p)
 
-instance GenericAccess cs m U1 where
+instance (Applicative m) => GenericAccess m U1 where
   type GenericAccessType U1 = '[]
-  genericAccess _ = U1
+  genericAccess = pure U1
   {-# INLINE genericAccess #-}
 
-instance (Access cs m c) => GenericAccess cs m (K1 i c) where
+instance (Access m c) => GenericAccess m (K1 i c) where
   type GenericAccessType (K1 i c) = AccessType c
-  genericAccess world = K1 (access world)
+  genericAccess = K1 <$> access
   {-# INLINE genericAccess #-}
 
-instance (GenericAccess cs m f) => GenericAccess cs m (M1 i c f) where
+instance (Functor m, GenericAccess m f) => GenericAccess m (M1 i c f) where
   type GenericAccessType (M1 i c f) = GenericAccessType f
-  genericAccess world = M1 (genericAccess world)
+  genericAccess = M1 <$> genericAccess
   {-# INLINE genericAccess #-}
 
 instance
-  ( GenericAccess cs m f,
-    GenericAccess cs m g,
-    Subset (AccessToComponents (GenericAccessType f)) cs,
+  ( Applicative m,
+    GenericAccess m f,
+    GenericAccess m g,
     ValidAccessInput (GenericAccessType f),
-    Subset (AccessToComponents (GenericAccessType g)) cs,
     ValidAccessInput (GenericAccessType g)
   ) =>
-  GenericAccess cs m (f :*: g)
+  GenericAccess m (f :*: g)
   where
   type GenericAccessType (f :*: g) = GenericAccessType f ++ GenericAccessType g
-  genericAccess world = genericAccess world :*: genericAccess world
+  genericAccess = (:*:) <$> genericAccess <*> genericAccess
   {-# 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
+instance (ECS m, Applicative m, Queryable m a) => Access m (Query a) where
+  type AccessType (Query a) = QueryableAccess a
+  access = queryable
   {-# INLINE access #-}
 
-instance (PrimMonad m) => Access cs m () where
+instance (Applicative m) => Access m () where
   type AccessType () = '[]
-  access _ = ()
+  access = pure ()
   {-# INLINE access #-}
 
 deriveAccess ::
   forall a m cs.
-  ( Generic a,
-    GenericAccess cs m (Rep a),
-    Subset (AccessToComponents (GenericAccessType (Rep a))) cs,
+  ( Functor m,
+    Generic a,
+    GenericAccess m (Rep a),
     ValidAccessInput (GenericAccessType (Rep a))
   ) =>
-  World m cs ->
-  a
-deriveAccess world = to (genericAccess world)
+  m a
+deriveAccess = to <$> genericAccess
 {-# INLINE deriveAccess #-}
 
 type family DeriveAccessType (rep :: Type -> Type) :: [Type] where
   DeriveAccessType rep = GenericAccessType rep
 
 instance
-  ( Access cs m a,
-    Access cs m b,
+  ( Applicative m,
+    Access m a,
+    Access m b,
     ValidAccessInput (AccessType a),
     ValidAccessInput (AccessType b),
-    Subset (AccessToComponents (AccessType a)) cs,
-    Subset (AccessToComponents (AccessType b)) cs
+    ValidAccessInput (AccessType a ++ AccessType b)
   ) =>
-  Access cs m (a, b)
+  Access 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,
+  ( Applicative m,
+    Access m a,
+    Access m b,
+    Access 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
+    ValidAccessInput (AccessType a ++ (AccessType b ++ AccessType c))
   ) =>
-  Access cs m (a, b, c)
+  Access 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,
+  ( Applicative m,
+    Access m a,
+    Access m b,
+    Access m c,
+    Access 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
+    ValidAccessInput
+      ( (AccessType a ++ AccessType b)
+          ++ (AccessType c ++ AccessType d)
+      )
   ) =>
-  Access cs m (a, b, c, d)
+  Access 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,
+  ( Applicative m,
+    Access m a,
+    Access m b,
+    Access m c,
+    Access m d,
+    Access 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 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))
-            )
-          )
+    ValidAccessInput
+      ( (AccessType a ++ AccessType b)
+          ++ (AccessType c ++ (AccessType d ++ AccessType e))
       )
-      cs
   ) =>
-  Access cs m (a, b, c, d, e)
+  Access m (a, b, c, d, e)
   where
   type
     AccessType (a, b, c, d, e) =
@@ -223,12 +176,13 @@       )
 
 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,
+  ( Applicative m,
+    Access m a,
+    Access m b,
+    Access m c,
+    Access m d,
+    Access m e,
+    Access m f,
     ValidAccessInput (AccessType a),
     ValidAccessInput (AccessType b),
     ValidAccessInput (AccessType c),
@@ -239,26 +193,12 @@     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))
+    ValidAccessInput
+      ( (AccessType a ++ (AccessType b ++ AccessType c))
+          ++ (AccessType d ++ (AccessType e ++ AccessType f))
       )
-      cs
   ) =>
-  Access cs m (a, b, c, d, e, f)
+  Access m (a, b, c, d, e, f)
   where
   type
     AccessType (a, b, c, d, e, f) =
@@ -267,13 +207,14 @@       )
 
 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,
+  ( Applicative m,
+    Access m a,
+    Access m b,
+    Access m c,
+    Access m d,
+    Access m e,
+    Access m f,
+    Access m g,
     ValidAccessInput (AccessType a),
     ValidAccessInput (AccessType b),
     ValidAccessInput (AccessType c),
@@ -286,28 +227,12 @@     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))
+    ValidAccessInput
+      ( (AccessType a ++ (AccessType b ++ AccessType c))
+          ++ ((AccessType d ++ AccessType e) ++ (AccessType f ++ AccessType g))
       )
-      cs
   ) =>
-  Access cs m (a, b, c, d, e, f, g)
+  Access m (a, b, c, d, e, f, g)
   where
   type
     AccessType (a, b, c, d, e, f, g) =
@@ -316,14 +241,15 @@       )
 
 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,
+  ( Applicative m,
+    Access m a,
+    Access m b,
+    Access m c,
+    Access m d,
+    Access m e,
+    Access m f,
+    Access m g,
+    Access m h,
     ValidAccessInput (AccessType a),
     ValidAccessInput (AccessType b),
     ValidAccessInput (AccessType c),
@@ -338,30 +264,12 @@     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))
+    ValidAccessInput
+      ( ((AccessType a ++ AccessType b) ++ (AccessType c ++ AccessType d))
+          ++ ((AccessType e ++ AccessType f) ++ (AccessType g ++ AccessType h))
       )
-      cs
   ) =>
-  Access cs m (a, b, c, d, e, f, g, h)
+  Access m (a, b, c, d, e, f, g, h)
   where
   type
     AccessType (a, b, c, d, e, f, g, h) =

@@ -0,0 +1,12 @@+module Aztecs.ECS.Bundle (Bundle (..)) where
+
+-- | Bundle of components that can be stored in an entity.
+newtype Bundle e m = Bundle {runBundle :: e -> m ()}
+
+instance (Monad m) => Semigroup (Bundle e m) where
+  Bundle f <> Bundle g = Bundle $ \entity -> f entity >> g entity
+  {-# INLINE (<>) #-}
+
+instance (Monad m) => Monoid (Bundle e m) where
+  mempty = Bundle $ \_ -> return ()
+  {-# INLINE mempty #-}

@@ -0,0 +1,9 @@+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Aztecs.ECS.Bundle.Class (Bundleable (..)) where
+
+import Aztecs.ECS.Bundle
+import Aztecs.ECS.Class
+
+class Bundleable c m where
+  bundle :: c -> Bundle (Entity m) m

@@ -1,50 +1,27 @@-{-# 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 Aztecs.ECS.Bundle
 import Data.Kind
 
+-- | Entity Component System (ECS) implementation.
 class ECS m where
+  -- | Entity identifier.
   type Entity m :: Type
-  type Components m :: [Type]
-  type Bundle m :: Type
+
+  -- | Task monad for running systems.
   type Task m :: Type -> Type
 
-  spawn :: Bundle m -> m (Entity m)
+  -- | Spawn a new entity with a `Bundle` of components.
+  spawn :: Bundle (Entity m) m -> m (Entity m)
 
-  insert :: Entity m -> Bundle m -> m ()
+  -- | Insert a `Bundle` of components into an existing entity
+  -- (otherwise this will do nothing).
+  insert :: Entity m -> Bundle (Entity m) m -> m ()
 
+  -- | Remove an entity and its components.
   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
-
+  -- | Run a `Task`.
   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

@@ -0,0 +1,61 @@+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Aztecs.ECS.Commands where
+
+import Aztecs.ECS.Query.Class
+import Control.Monad.IO.Class
+import Control.Monad.Primitive
+import Control.Monad.Trans
+
+newtype Commands t m a = Commands {unCommands :: m (a, t m ())}
+  deriving (Functor)
+
+instance (Monad (t m), Monad m) => Applicative (Commands t m) where
+  pure x = Commands $ pure (x, pure ())
+  {-# INLINE pure #-}
+  Commands mf <*> Commands mx = Commands $ do
+    (f, w1) <- mf
+    (x, w2) <- mx
+    return (f x, w1 >> w2)
+  {-# INLINE (<*>) #-}
+
+instance (Monad (t m), Monad m) => Monad (Commands t m) where
+  Commands mx >>= f = Commands $ do
+    (x, w1) <- mx
+    (y, w2) <- unCommands (f x)
+    return (y, w1 >> w2)
+  {-# INLINE (>>=) #-}
+
+instance (MonadTrans t) => MonadTrans (Commands t) where
+  lift m = Commands $ do
+    x <- m
+    return (x, lift $ pure ())
+  {-# INLINE lift #-}
+
+instance (MonadTrans t, Monad (t m), MonadIO m) => MonadIO (Commands t m) where
+  liftIO io = Commands $ do
+    x <- liftIO io
+    return (x, lift $ pure ())
+  {-# INLINE liftIO #-}
+
+instance (MonadTrans t, Monad (t m), PrimMonad m) => PrimMonad (Commands t m) where
+  type PrimState (Commands t m) = PrimState m
+  primitive f = Commands $ do
+    x <- primitive f
+    return (x, lift $ pure ())
+  {-# INLINE primitive #-}
+
+runCommands :: (MonadTrans t, Monad (t m), Monad m) => Commands t m a -> t m a
+runCommands (Commands m) = do
+  (result, action) <- lift m
+  action
+  return result
+{-# INLINE runCommands #-}
+
+queue :: (Applicative m) => t m () -> Commands t m ()
+queue action = Commands $ pure ((), action)
+{-# INLINE queue #-}

@@ -0,0 +1,37 @@+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Aztecs.ECS.Component where
+
+import Aztecs.ECS.Class
+import Data.Kind
+
+-- | Component lifecycle hooks.
+data Hooks m = Hooks
+  { -- | Hook called when a component is inserted.
+    onInsert :: Entity m -> m (),
+    -- | Hook called when a component is removed.
+    onRemove :: Entity m -> m ()
+  }
+
+instance (Monad m) => Semigroup (Hooks m) where
+  h1 <> h2 =
+    Hooks
+      { onInsert = \e -> onInsert h1 e >> onInsert h2 e,
+        onRemove = \e -> onRemove h1 e >> onRemove h2 e
+      }
+
+instance (Monad m) => Monoid (Hooks m) where
+  mempty =
+    Hooks
+      { onInsert = \_ -> return (),
+        onRemove = \_ -> return ()
+      }
+
+class (Monad m) => Component m a where
+  type ComponentStorage (m :: Type -> Type) a :: Type -> Type
+
+  -- | Component lifecycle `Hooks`.
+  componentHooks :: proxy a -> Hooks m
+  componentHooks _ = mempty

@@ -1,45 +0,0 @@-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

@@ -0,0 +1,76 @@+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Aztecs.ECS.Executor where
+
+import Aztecs.ECS.Access.Internal
+import Aztecs.ECS.HSet
+import Aztecs.ECS.System
+
+newtype ExecutorT m a = ExecutorT {runSystems :: ([m ()] -> m ()) -> m a}
+  deriving (Functor)
+
+instance (Applicative m) => Applicative (ExecutorT m) where
+  pure x = ExecutorT $ \_ -> pure x
+  {-# INLINE pure #-}
+  ExecutorT f <*> ExecutorT g = ExecutorT $ \run -> f run <*> g run
+  {-# INLINE (<*>) #-}
+
+instance (Monad m) => Monad (ExecutorT m) where
+  ExecutorT f >>= g = ExecutorT $ \run -> f run >>= \x -> runSystems (g x) run
+  {-# INLINE (>>=) #-}
+
+class Execute' m s where
+  execute' :: s -> [m ()]
+
+instance Execute' m (HSet '[]) where
+  execute' _ = []
+  {-# INLINE execute' #-}
+
+instance
+  {-# OVERLAPS #-}
+  ( Monad m,
+    System m sys,
+    Access m (SystemIn m sys),
+    ValidAccessInput (AccessType (SystemIn m sys))
+  ) =>
+  Execute' m (HSet '[sys])
+  where
+  execute' (HCons system HEmpty) = [access >>= runSystem system]
+  {-# INLINE execute' #-}
+
+instance
+  {-# OVERLAPPABLE #-}
+  ( Monad m,
+    System m sys,
+    Access m (SystemIn m sys),
+    ValidAccessInput (AccessType (SystemIn m sys)),
+    Execute' m (HSet systems)
+  ) =>
+  Execute' m (HSet (sys ': systems))
+  where
+  execute' (HCons s rest) = (access >>= runSystem s) : execute' rest
+  {-# INLINE execute' #-}
+
+class Execute m s where
+  execute :: s -> ExecutorT m ()
+
+instance (Applicative m) => Execute m (HSet '[]) where
+  execute _ = pure ()
+  {-# INLINE execute #-}
+
+instance
+  {-# OVERLAPPING #-}
+  (Monad m, Execute' m systems, Execute m (HSet schedule)) =>
+  Execute m (HSet (systems ': schedule))
+  where
+  execute (HCons system rest) = do
+    ExecutorT $ \run -> run $ execute' system
+    execute rest
+  {-# INLINE execute #-}

@@ -13,8 +13,6 @@ 
 module Aztecs.ECS.HSet
   ( HSet (..),
-    EmptyStorage (..),
-    Empty (..),
     Lookup (..),
     AdjustM (..),
     Subset (..),
@@ -22,44 +20,26 @@ 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)
+data HSet ts where
+  HEmpty :: HSet '[]
+  HCons :: t -> HSet ts -> HSet (t ': ts)
 
-instance (ShowHSet f ts) => Show (HSet f ts) where
+instance (ShowHSet ts) => Show (HSet ts) where
   show = showHSet
+  {-# INLINE show #-}
 
-class ShowHSet f ts where
-  showHSet :: HSet f ts -> String
+class ShowHSet ts where
+  showHSet :: HSet ts -> String
 
-instance ShowHSet f '[] where
+instance ShowHSet '[] where
   showHSet _ = "HEmpty"
+  {-# INLINE showHSet #-}
 
-instance (Show (f t), ShowHSet f ts) => ShowHSet f (t ': ts) where
+instance (Show t, ShowHSet ts) => ShowHSet (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)
+  {-# INLINE showHSet #-}
 
 type family Elem (t :: k) (ts :: [k]) :: Bool where
   Elem t '[] = 'False
@@ -67,7 +47,7 @@   Elem t (_ ': xs) = Elem t xs
 
 class Lookup (t :: Type) (ts :: [Type]) where
-  lookup :: HSet f ts -> f t
+  lookup :: HSet ts -> t
 
 instance {-# OVERLAPPING #-} Lookup t (t ': ts) where
   lookup (HCons x _) = x
@@ -77,29 +57,24 @@   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)
+class AdjustM m t ts where
+  adjustM :: (t -> m t) -> HSet ts -> m (HSet ts)
 
-instance {-# OVERLAPPING #-} (Applicative m) => AdjustM m f t (t ': ts) where
+instance {-# OVERLAPPING #-} (Applicative m) => AdjustM m 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
+instance {-# OVERLAPPABLE #-} (Functor m, AdjustM m t ts) => AdjustM m 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
+  subset :: HSet superset -> HSet subset
 
 instance Subset '[] superset where
   subset _ = HEmpty
   {-# INLINE subset #-}
 
-instance
-  ( Lookup t superset,
-    Subset ts superset
-  ) =>
-  Subset (t ': ts) superset
-  where
+instance (Lookup t superset, Subset ts superset) => Subset (t ': ts) superset where
   subset hset = HCons (lookup hset) (subset @ts hset)
   {-# INLINE subset #-}

@@ -1,37 +1,19 @@-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# 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.Query where
 
 import Data.Maybe
-import Prelude hiding (Read)
 
-newtype Query m a = Query {unQuery :: m [Maybe a]}
-  deriving (Functor)
+newtype Query a = Query {unQuery :: [Maybe a]}
+  deriving (Functor, Foldable)
 
-instance (Monad m) => Applicative (Query m) where
-  pure x = Query $ return [Just x]
+instance Applicative Query where
+  pure x = Query [Just x]
   {-# INLINE pure #-}
-  Query f <*> Query x = Query $ do
-    fs <- f
-    zipWith (<*>) fs <$> x
+  Query f <*> Query x = Query $ zipWith (<*>) f x
   {-# INLINE (<*>) #-}
 
-runQuery :: (Monad m) => Query m a -> m [a]
-runQuery (Query q) = catMaybes <$> q
+runQuery :: Query a -> [a]
+runQuery (Query q) = catMaybes q
 {-# INLINE runQuery #-}

@@ -0,0 +1,3 @@+module Aztecs.ECS.Query.Class (Queryable (..), With (..), Without (..)) where
+
+import Aztecs.ECS.Query.Internal

@@ -0,0 +1,274 @@+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Aztecs.ECS.Query.Internal where
+
+import qualified Aztecs.ECS.HSet as HS
+import Aztecs.ECS.Query
+import Data.Kind
+import Data.Maybe
+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
+
+type family AccessComponent (access :: Type) :: Type where
+  AccessComponent (Read a) = a
+  AccessComponent (Write a) = a
+  AccessComponent (With a) = a
+  AccessComponent (Without a) = a
+
+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 m (f :: Type -> Type) where
+  genericQueryableRep :: m [Maybe (f p)]
+
+instance (Monad m) => GenericQueryable m U1 where
+  genericQueryableRep = pure [Just U1]
+  {-# INLINE genericQueryableRep #-}
+
+instance
+  ( Monad m,
+    GenericQueryable m f,
+    GenericQueryable m g
+  ) =>
+  GenericQueryable m (f :*: g)
+  where
+  genericQueryableRep = do
+    fs <- genericQueryableRep
+    zipWith (\f g -> (:*:) <$> f <*> g) fs <$> genericQueryableRep
+  {-# INLINE genericQueryableRep #-}
+
+instance (Functor m, GenericQueryable m f) => GenericQueryable m (M1 i c f) where
+  genericQueryableRep = map (fmap M1) <$> genericQueryableRep
+  {-# INLINE genericQueryableRep #-}
+
+instance (Functor m, Queryable m a) => GenericQueryable m (K1 i a) where
+  genericQueryableRep = fmap (map (fmap K1) . unQuery) queryable
+  {-# INLINE genericQueryableRep #-}
+
+class Queryable m a where
+  type QueryableAccess a :: [Type]
+  type QueryableAccess a = GenericQueryableAccess (Rep a)
+
+  queryable :: m (Query a)
+  default queryable ::
+    ( Functor m,
+      Generic a,
+      GenericQueryable m (Rep a),
+      QueryableAccess a ~ GenericQueryableAccess (Rep a),
+      ValidAccess (QueryableAccess a)
+    ) =>
+    m (Query a)
+  queryable = fmap (Query . map (fmap to)) genericQueryableRep
+  {-# INLINE queryable #-}
+
+instance
+  ( Monad m,
+    Queryable m a,
+    Queryable m b,
+    ValidAccess (QueryableAccess a ++ QueryableAccess b)
+  ) =>
+  Queryable m (a, b)
+  where
+  type QueryableAccess (a, b) = QueryableAccess a ++ QueryableAccess b
+
+instance
+  ( Monad m,
+    Queryable m a,
+    Queryable m b,
+    Queryable m c,
+    ValidAccess (QueryableAccess a ++ (QueryableAccess b ++ QueryableAccess c))
+  ) =>
+  Queryable m (a, b, c)
+  where
+  type QueryableAccess (a, b, c) = QueryableAccess a ++ (QueryableAccess b ++ QueryableAccess c)
+
+instance
+  ( Monad m,
+    Queryable m a,
+    Queryable m b,
+    Queryable m c,
+    Queryable m d,
+    ValidAccess
+      ((QueryableAccess a ++ QueryableAccess b) ++ (QueryableAccess c ++ QueryableAccess d))
+  ) =>
+  Queryable m (a, b, c, d)
+  where
+  type QueryableAccess (a, b, c, d) = (QueryableAccess a ++ QueryableAccess b) ++ (QueryableAccess c ++ QueryableAccess d)
+
+instance
+  ( Monad m,
+    Queryable m a,
+    Queryable m b,
+    Queryable m c,
+    Queryable m d,
+    Queryable m e,
+    ValidAccess
+      ( (QueryableAccess a ++ QueryableAccess b)
+          ++ (QueryableAccess c ++ (QueryableAccess d ++ QueryableAccess e))
+      )
+  ) =>
+  Queryable 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
+  ( Monad m,
+    Queryable m a,
+    Queryable m b,
+    Queryable m c,
+    Queryable m d,
+    Queryable m e,
+    Queryable m f,
+    ValidAccess
+      ( (QueryableAccess a ++ (QueryableAccess b ++ QueryableAccess c))
+          ++ (QueryableAccess d ++ (QueryableAccess e ++ QueryableAccess f))
+      )
+  ) =>
+  Queryable 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
+  ( Monad m,
+    Queryable m a,
+    Queryable m b,
+    Queryable m c,
+    Queryable m d,
+    Queryable m e,
+    Queryable m f,
+    Queryable m g,
+    ValidAccess
+      ( (QueryableAccess a ++ (QueryableAccess b ++ QueryableAccess c))
+          ++ ((QueryableAccess d ++ QueryableAccess e) ++ (QueryableAccess f ++ QueryableAccess g))
+      )
+  ) =>
+  Queryable 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
+  ( Monad m,
+    Queryable m a,
+    Queryable m b,
+    Queryable m c,
+    Queryable m d,
+    Queryable m e,
+    Queryable m f,
+    Queryable m g,
+    Queryable m h,
+    ValidAccess
+      ( ((QueryableAccess a ++ QueryableAccess b) ++ (QueryableAccess c ++ QueryableAccess d))
+          ++ ((QueryableAccess e ++ QueryableAccess f) ++ (QueryableAccess g ++ QueryableAccess h))
+      )
+  ) =>
+  Queryable 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))

@@ -1,3 +0,0 @@-module Aztecs.ECS.Queryable (Queryable (..), With (..), Without (..)) where
-
-import Aztecs.ECS.Queryable.Internal

@@ -1,351 +0,0 @@-{-# 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)
-           )

@@ -1,28 +0,0 @@-{-# 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 #-}

@@ -1,49 +0,0 @@-{-# 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 #-}

@@ -0,0 +1,7 @@+{-# LANGUAGE DeriveFunctor #-}
+
+module Aztecs.ECS.R (R (..)) where
+
+-- | Read-only 'Queryable' component access.
+newtype R a = R {unR :: a}
+  deriving (Show, Eq, Functor)

@@ -0,0 +1,3 @@+module Aztecs.ECS.Schedule (Schedule (..)) where
+
+import Aztecs.ECS.Schedule.Internal

@@ -0,0 +1,188 @@+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# 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.Schedule.Internal where
+
+import Aztecs.ECS.Access.Internal
+import Aztecs.ECS.HSet
+import Aztecs.ECS.Query.Internal
+import Aztecs.ECS.System
+import Data.Kind
+
+class Schedule m s where
+  type Scheduled m s :: Type
+
+  schedule :: s -> Scheduled m s
+
+type family SystemInOf m sys :: [Type] where
+  SystemInOf m sys = AccessType (SystemIn m sys)
+
+type family HasInputOverlap (inputs1 :: [Type]) (inputs2 :: [Type]) :: Bool where
+  HasInputOverlap inputs1 inputs2 =
+    Or
+      (HasComponentOverlap (WriteComponents inputs1) (AccessToComponents inputs2))
+      (HasComponentOverlap (WriteComponents inputs2) (AccessToComponents inputs1))
+
+type family HasComponentOverlap (components1 :: [Type]) (components2 :: [Type]) :: Bool where
+  HasComponentOverlap '[] components2 = 'False
+  HasComponentOverlap (c ': rest) components2 =
+    Or (Contains c components2) (HasComponentOverlap rest components2)
+
+type family GroupSystems m (systems :: [Type]) :: [[Type]] where
+  GroupSystems m '[] = '[]
+  GroupSystems m '[sys] = '[ '[sys]]
+  GroupSystems m (sys1 ': sys2 ': rest) =
+    If
+      (HasInputOverlap (SystemInOf m sys1) (SystemInOf m sys2))
+      (GroupSystemsConflict m (sys1 ': sys2 ': rest))
+      (GroupSystemsNoConflict m (sys1 ': sys2 ': rest))
+
+type family GroupSystemsConflict m (systems :: [Type]) :: [[Type]] where
+  GroupSystemsConflict m (sys ': rest) = '[sys] ': GroupSystems m rest
+
+type family GroupSystemsNoConflict m (systems :: [Type]) :: [[Type]] where
+  GroupSystemsNoConflict m (sys1 ': sys2 ': rest) =
+    MergeCompatibleSystems m '[sys1, sys2] rest
+
+type family MergeCompatibleSystems m (group :: [Type]) (remaining :: [Type]) :: [[Type]] where
+  MergeCompatibleSystems m group '[] = '[group]
+  MergeCompatibleSystems m group (sys ': rest) =
+    If
+      (CanAddSystemToGroup m sys group)
+      (MergeCompatibleSystems m (AppendToGroup sys group) rest)
+      (group ': GroupSystems m (sys ': rest))
+
+type family CanAddSystemToGroup m (sys :: Type) (group :: [Type]) :: Bool where
+  CanAddSystemToGroup m sys '[] = 'True
+  CanAddSystemToGroup m sys (groupSys ': rest) =
+    And
+      (Not (HasInputOverlap (SystemInOf m sys) (SystemInOf m groupSys)))
+      (CanAddSystemToGroup m sys rest)
+
+type family AppendToGroup (sys :: Type) (group :: [Type]) :: [Type] where
+  AppendToGroup sys group = sys ': group
+
+type family If (condition :: Bool) (then_ :: k) (else_ :: k) :: k where
+  If 'True then_ else_ = then_
+  If 'False then_ else_ = else_
+
+type family GroupsToNestedHSet m (groups :: [[Type]]) :: [Type] where
+  GroupsToNestedHSet m '[] = '[]
+  GroupsToNestedHSet m (group ': rest) = HSet (MapToIdentityT m group) ': GroupsToNestedHSet m rest
+
+instance Schedule m (HSet '[]) where
+  type Scheduled m (HSet '[]) = HSet '[]
+  schedule HEmpty = HEmpty
+  {-# INLINE schedule #-}
+
+instance (System m sys) => Schedule m (HSet '[sys]) where
+  type Scheduled m (HSet '[sys]) = HSet (GroupsToNestedHSet m (GroupSystems m '[sys]))
+  schedule (HCons sys HEmpty) = HCons (HCons sys HEmpty) HEmpty
+  {-# INLINE schedule #-}
+
+instance
+  ( System m sys,
+    AllSystems m rest,
+    rest ~ (sys2 ': rest'),
+    CompileGroups m (GroupSystems m (sys ': rest)) (sys ': rest)
+  ) =>
+  Schedule m (HSet (sys ': rest))
+  where
+  type Scheduled m (HSet (sys ': rest)) = HSet (GroupsToNestedHSet m (GroupSystems m (sys ': rest)))
+  schedule = compileGroups @m @(GroupSystems m (sys ': rest)) @(sys ': rest)
+  {-# INLINE schedule #-}
+
+class AllSystems m systems
+
+instance AllSystems m '[]
+
+instance (System m (Run constraints sys), AllSystems m rest) => AllSystems m (Run constraints sys ': rest)
+
+instance {-# OVERLAPPABLE #-} (System m sys, AllSystems m rest) => AllSystems m (sys ': rest)
+
+class CompileGroups m (groups :: [[Type]]) (systems :: [Type]) where
+  compileGroups :: HSet systems -> HSet (GroupsToNestedHSet m groups)
+
+instance CompileGroups m '[] systems where
+  compileGroups _ = HEmpty
+  {-# INLINE compileGroups #-}
+
+instance (CompileGroup m group systems) => CompileGroups m '[group] systems where
+  compileGroups systems = HCons (compileGroup @m @group @systems systems) HEmpty
+  {-# INLINE compileGroups #-}
+
+instance
+  (CompileGroup m group systems, CompileGroups m rest systems) =>
+  CompileGroups m (group ': rest) systems
+  where
+  compileGroups systems =
+    HCons (compileGroup @m @group @systems systems) (compileGroups @m @rest @systems systems)
+  {-# INLINE compileGroups #-}
+
+class CompileGroup m (group :: [Type]) (systems :: [Type]) where
+  compileGroup :: HSet systems -> HSet (MapToIdentityT m group)
+
+type family MapToIdentityT m (systems :: [Type]) :: [Type] where
+  MapToIdentityT m '[] = '[]
+  MapToIdentityT m (sys ': rest) = sys ': MapToIdentityT m rest
+
+instance CompileGroup m '[] systems where
+  compileGroup _ = HEmpty
+  {-# INLINE compileGroup #-}
+
+instance (ExtractSystem m sys systems) => CompileGroup m '[sys] systems where
+  compileGroup systems = HCons (extractSystem @m @sys @systems systems) HEmpty
+  {-# INLINE compileGroup #-}
+
+instance
+  (ExtractSystem m sys systems, CompileGroup m rest systems) =>
+  CompileGroup m (sys ': rest) systems
+  where
+  compileGroup systems =
+    HCons (extractSystem @m @sys @systems systems) (compileGroup @m @rest @systems systems)
+  {-# INLINE compileGroup #-}
+
+class ExtractSystem m (sys :: Type) (systems :: [Type]) where
+  extractSystem :: HSet systems -> sys
+
+instance ExtractSystem m sys (sys ': rest) where
+  extractSystem (HCons sys _) = sys
+  {-# INLINE extractSystem #-}
+
+instance (ExtractSystem m sys rest) => ExtractSystem m sys (other ': rest) where
+  extractSystem (HCons _ rest) = extractSystem @m @sys @rest rest
+  {-# INLINE extractSystem #-}
+
+data Before (sys :: Type)
+
+data After (sys :: Type)
+
+data Run (constraints :: [Type]) (sys :: Type) where
+  Run :: sys -> Run constraints sys
+
+type family UnwrapSystem (runSys :: Type) :: Type where
+  UnwrapSystem (Run constraints sys) = sys
+  UnwrapSystem sys = sys
+
+type family GetConstraints (runSys :: Type) :: [Type] where
+  GetConstraints (Run constraints sys) = constraints
+  GetConstraints sys = '[]
+
+instance (Show sys) => Show (Run constraints sys) where
+  show (Run sys) = "Run " ++ show sys
+
+instance (System m sys) => System m (Run constraints sys) where
+  type SystemIn m (Run constraints sys) = SystemIn m sys
+  runSystem (Run sys) = runSystem sys
+  {-# INLINE runSystem #-}

@@ -0,0 +1,49 @@+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Aztecs.ECS.Scheduler
+  ( Scheduler (..),
+    runSchedule,
+    Run (..),
+    Before (..),
+    After (..),
+  )
+where
+
+import Aztecs.ECS.Executor
+import Aztecs.ECS.HSet
+import Aztecs.ECS.Schedule.Internal
+import Aztecs.ECS.Scheduler.Internal
+import Data.Foldable
+
+executeSchedule ::
+  forall m cs s.
+  ( Scheduler m s,
+    Execute m (SchedulerOutput m s),
+    s ~ HSet (SchedulerInput m s)
+  ) =>
+  s ->
+  ExecutorT m ()
+executeSchedule s = execute (buildSchedule @m @s s)
+{-# INLINE executeSchedule #-}
+
+runSchedule ::
+  forall m cs s.
+  ( Applicative m,
+    Execute m (SchedulerOutput m s),
+    s ~ HSet (SchedulerInput m s),
+    AllSystems m (SchedulerInput m s),
+    ScheduleLevelsBuilder
+      m
+      (TopologicalSort (BuildSystemGraph (SchedulerInput m s)))
+      (SchedulerInput m s)
+  ) =>
+  s ->
+  m ()
+runSchedule s = runSystems (executeSchedule @m @cs @s s) $
+  \actions -> sequenceA_ actions
+{-# INLINE runSchedule #-}

@@ -0,0 +1,298 @@+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Aztecs.ECS.Scheduler.Internal where
+
+import Aztecs.ECS.Access.Internal
+import Aztecs.ECS.Class
+import Aztecs.ECS.Executor
+import Aztecs.ECS.HSet
+import Aztecs.ECS.Schedule.Internal
+import Data.Kind
+
+class Scheduler m s where
+  type SchedulerInput m s :: [Type]
+  type SchedulerOutput m s :: Type
+
+  buildSchedule :: HSet (SchedulerInput m s) -> SchedulerOutput m s
+
+instance (Applicative m, ECS m) => Access m (HSet '[]) where
+  type AccessType (HSet '[]) = '[]
+  access = pure HEmpty
+  {-# INLINE access #-}
+
+instance
+  ( AllSystems m systems,
+    BuildSystemGraph systems ~ graph,
+    TopologicalSort graph ~ levels,
+    ScheduleLevels m levels ~ output,
+    ScheduleLevelsBuilder m levels systems
+  ) =>
+  Scheduler m (HSet systems)
+  where
+  type SchedulerInput m (HSet systems) = systems
+  type
+    SchedulerOutput m (HSet systems) =
+      HSet (LevelsToNestedHSet (ScheduleLevels m (TopologicalSort (BuildSystemGraph systems))))
+
+  buildSchedule = scheduleSystemLevels @m @(TopologicalSort (BuildSystemGraph systems))
+  {-# INLINE buildSchedule #-}
+
+type family BuildSystemGraph (systems :: [Type]) :: DependencyGraph where
+  BuildSystemGraph '[] = EmptyGraph
+  BuildSystemGraph (runSys ': rest) =
+    AddSystemToGraph
+      (UnwrapSystem runSys)
+      (GetConstraints runSys)
+      (BuildSystemGraph rest)
+
+data ConstrainedSystem = ConstrainedSystem Type [Type]
+
+type family BuildDependencyGraph (constrainedSystems :: [ConstrainedSystem]) :: DependencyGraph where
+  BuildDependencyGraph '[] = EmptyGraph
+  BuildDependencyGraph ('ConstrainedSystem sys constraints ': rest) =
+    AddSystemToGraph sys constraints (BuildDependencyGraph rest)
+
+type family AddSystemToGraph (sys :: Type) (constraints :: [Type]) (graph :: DependencyGraph) :: DependencyGraph where
+  AddSystemToGraph sys '[] graph = AddNode sys graph
+  AddSystemToGraph sys (Before target ': rest) graph =
+    AddSystemToGraph sys rest (AddEdge sys (UnwrapSystem target) graph)
+  AddSystemToGraph sys (After source ': rest) graph =
+    AddSystemToGraph sys rest (AddEdge (UnwrapSystem source) sys graph)
+  AddSystemToGraph sys (other ': rest) graph =
+    AddSystemToGraph sys rest graph
+
+data DependencyGraph = EmptyGraph | Graph [Type] [(Type, Type)] [Type]
+
+type family AddNode (sys :: Type) (graph :: DependencyGraph) :: DependencyGraph where
+  AddNode sys EmptyGraph = Graph '[sys] '[] '[]
+  AddNode sys (Graph nodes edges groups) = Graph (AddToList sys nodes) edges groups
+
+type family AddEdge (from :: Type) (to :: Type) (graph :: DependencyGraph) :: DependencyGraph where
+  AddEdge from to EmptyGraph = Graph '[from, to] '[ '(from, to)] '[]
+  AddEdge from to (Graph nodes edges groups) =
+    Graph (AddToList to (AddToList from nodes)) (AddToList '(from, to) edges) groups
+
+type family AddGroupConstraint (sys :: Type) (graph :: DependencyGraph) :: DependencyGraph where
+  AddGroupConstraint sys EmptyGraph = Graph '[sys] '[] '[sys]
+  AddGroupConstraint sys (Graph nodes edges groups) =
+    Graph (AddToList sys nodes) edges (AddToList sys groups)
+
+type family AddToList (item :: k) (list :: [k]) :: [k] where
+  AddToList item '[] = '[item]
+  AddToList item (item ': rest) = item ': rest
+  AddToList item (other ': rest) = other ': AddToList item rest
+
+type family TopologicalSort (graph :: DependencyGraph) :: [[Type]] where
+  TopologicalSort EmptyGraph = '[]
+  TopologicalSort (Graph nodes edges groups) = TopSortHelper nodes edges '[]
+
+type family TopSortHelper (nodes :: [Type]) (edges :: [(Type, Type)]) (result :: [[Type]]) :: [[Type]] where
+  TopSortHelper '[] edges result = Reverse result
+  TopSortHelper nodes edges result =
+    TopSortHelper
+      (RemoveNodes (NoIncomingEdges nodes edges) nodes)
+      (RemoveEdgesFrom (NoIncomingEdges nodes edges) edges)
+      (NoIncomingEdges nodes edges ': result)
+
+type family NoIncomingEdges (nodes :: [Type]) (edges :: [(Type, Type)]) :: [Type] where
+  NoIncomingEdges '[] edges = '[]
+  NoIncomingEdges (node ': rest) edges =
+    If
+      (HasIncomingEdge node edges)
+      (NoIncomingEdges rest edges)
+      (node ': NoIncomingEdges rest edges)
+
+type family HasIncomingEdge (node :: Type) (edges :: [(Type, Type)]) :: Bool where
+  HasIncomingEdge node '[] = 'False
+  HasIncomingEdge node ('(from, to) ': rest) =
+    If (TypeEq node to) 'True (HasIncomingEdge node rest)
+
+type family RemoveNodes (toRemove :: [Type]) (nodes :: [Type]) :: [Type] where
+  RemoveNodes '[] nodes = nodes
+  RemoveNodes (remove ': rest) nodes = RemoveNodes rest (FilterOut remove nodes)
+
+type family FilterOut (item :: Type) (list :: [Type]) :: [Type] where
+  FilterOut item '[] = '[]
+  FilterOut item (item ': rest) = FilterOut item rest
+  FilterOut item (other ': rest) = other ': FilterOut item rest
+
+type family RemoveEdgesFrom (removed :: [Type]) (edges :: [(Type, Type)]) :: [(Type, Type)] where
+  RemoveEdgesFrom '[] edges = edges
+  RemoveEdgesFrom (node ': rest) edges = RemoveEdgesFrom rest (FilterOutEdgesFrom node edges)
+
+type family FilterOutEdgesFrom (node :: Type) (edges :: [(Type, Type)]) :: [(Type, Type)] where
+  FilterOutEdgesFrom node '[] = '[]
+  FilterOutEdgesFrom node ('(from, to) ': rest) =
+    If
+      (TypeEq node from)
+      (FilterOutEdgesFrom node rest)
+      ('(from, to) ': FilterOutEdgesFrom node rest)
+
+type family TypeEq (a :: Type) (b :: Type) :: Bool where
+  TypeEq a a = 'True
+  TypeEq a b = 'False
+
+type family Reverse (list :: [k]) :: [k] where
+  Reverse list = ReverseHelper list '[]
+
+type family ReverseHelper (list :: [k]) (acc :: [k]) :: [k] where
+  ReverseHelper '[] acc = acc
+  ReverseHelper (x ': xs) acc = ReverseHelper xs (x ': acc)
+
+type family ScheduleLevels (m :: Type -> Type) (levels :: [[Type]]) :: [[Type]] where
+  ScheduleLevels m '[] = '[]
+  ScheduleLevels m (level ': rest) =
+    GroupByConflicts m level ': ScheduleLevels m rest
+
+type family GroupByConflicts (m :: Type -> Type) (systems :: [Type]) :: [Type] where
+  GroupByConflicts m '[] = '[]
+  GroupByConflicts m '[sys] = '[sys]
+  GroupByConflicts m systems = systems
+
+scheduleSystemLevels ::
+  forall m levels systems.
+  ( AllSystems m systems,
+    ScheduleLevelsBuilder m levels systems
+  ) =>
+  HSet systems ->
+  HSet (LevelsToNestedHSet (ScheduleLevels m levels))
+scheduleSystemLevels = buildScheduleLevels @m @levels @systems
+{-# INLINE scheduleSystemLevels #-}
+
+type family LevelsToNestedHSet (levels :: [[Type]]) :: [Type] where
+  LevelsToNestedHSet '[] = '[]
+  LevelsToNestedHSet (level ': rest) = HSet level ': LevelsToNestedHSet rest
+
+class ScheduleLevelsBuilder (m :: Type -> Type) (levels :: [[Type]]) (systems :: [Type]) where
+  buildScheduleLevels ::
+    HSet systems ->
+    HSet (LevelsToNestedHSet (ScheduleLevels m levels))
+
+instance ScheduleLevelsBuilder m '[] systems where
+  buildScheduleLevels _ = HEmpty
+  {-# INLINE buildScheduleLevels #-}
+
+instance
+  ( GroupByConflicts m systems ~ systems
+  ) =>
+  ScheduleLevelsBuilder m '[systems] systems
+  where
+  buildScheduleLevels systems = HCons systems HEmpty
+  {-# INLINE buildScheduleLevels #-}
+
+instance
+  ( SystemReorderer originalSystems levelSystems,
+    GroupByConflicts m levelSystems ~ levelSystems
+  ) =>
+  ScheduleLevelsBuilder m '[levelSystems] originalSystems
+  where
+  buildScheduleLevels originalSystems =
+    HCons (reorderSystems @originalSystems @levelSystems originalSystems) HEmpty
+  {-# INLINE buildScheduleLevels #-}
+
+instance
+  ( SystemReorderer originalSystems levelSystems1,
+    SystemReorderer originalSystems levelSystems2,
+    GroupByConflicts m levelSystems1 ~ levelSystems1,
+    GroupByConflicts m levelSystems2 ~ levelSystems2
+  ) =>
+  ScheduleLevelsBuilder m '[levelSystems1, levelSystems2] originalSystems
+  where
+  buildScheduleLevels originalSystems =
+    HCons (reorderSystems @originalSystems @levelSystems1 originalSystems) $
+      HCons
+        (reorderSystems @originalSystems @levelSystems2 originalSystems)
+        HEmpty
+  {-# INLINE buildScheduleLevels #-}
+
+instance
+  {-# OVERLAPPABLE #-}
+  ( SystemReorderer originalSystems levelSystems,
+    GroupByConflicts m levelSystems ~ levelSystems,
+    ScheduleLevelsBuilder m restLevels originalSystems
+  ) =>
+  ScheduleLevelsBuilder m (levelSystems ': restLevels) originalSystems
+  where
+  buildScheduleLevels originalSystems =
+    HCons (reorderSystems @originalSystems @levelSystems originalSystems) $
+      buildScheduleLevels @m @restLevels @originalSystems originalSystems
+  {-# INLINE buildScheduleLevels #-}
+
+class SystemReorderer (originalSystems :: [Type]) (targetSystems :: [Type]) where
+  reorderSystems ::
+    HSet originalSystems ->
+    HSet targetSystems
+
+instance SystemReorderer originalSystems '[] where
+  reorderSystems _ = HEmpty
+  {-# INLINE reorderSystems #-}
+
+instance
+  ( ExtractFromHSet targetSys originalSystems,
+    SystemReorderer (RemainingAfterExtract targetSys originalSystems) restTargets
+  ) =>
+  SystemReorderer originalSystems (targetSys ': restTargets)
+  where
+  reorderSystems originalSystems =
+    let (targetSys, remaining) = extractFromHSet @targetSys @originalSystems originalSystems
+        rest = reorderSystems @(RemainingAfterExtract targetSys originalSystems) @restTargets remaining
+     in HCons targetSys rest
+  {-# INLINE reorderSystems #-}
+
+type family RemainingAfterExtract (targetSys :: Type) (systems :: [Type]) :: [Type] where
+  RemainingAfterExtract sys (sys ': rest) = rest
+  RemainingAfterExtract sys (Run constraints sys ': rest) = rest
+  RemainingAfterExtract targetSys (other ': rest) = other ': RemainingAfterExtract targetSys rest
+
+class ExtractFromHSet (targetSys :: Type) (systems :: [Type]) where
+  extractFromHSet ::
+    HSet systems ->
+    (targetSys, HSet (RemainingAfterExtract targetSys systems))
+
+instance {-# OVERLAPPING #-} ExtractFromHSet sys (sys ': rest) where
+  extractFromHSet (HCons sys rest) = (sys, rest)
+  {-# INLINE extractFromHSet #-}
+
+instance
+  {-# OVERLAPPING #-}
+  (RemainingAfterExtract sys (Run constraints sys ': rest) ~ rest) =>
+  ExtractFromHSet sys (Run constraints sys ': rest)
+  where
+  extractFromHSet (HCons (Run sys) rest) = (sys, rest)
+  {-# INLINE extractFromHSet #-}
+
+instance
+  ( ExtractFromHSet targetSys rest,
+    RemainingAfterExtract targetSys (other ': rest) ~ (other ': RemainingAfterExtract targetSys rest),
+    TypeEq targetSys other ~ 'False
+  ) =>
+  ExtractFromHSet targetSys (other ': rest)
+  where
+  extractFromHSet (HCons other rest) =
+    let (target, remaining) = extractFromHSet @targetSys @rest rest
+     in (target, HCons other remaining)
+  {-# INLINE extractFromHSet #-}
+
+instance
+  {-# OVERLAPPING #-}
+  ( Monad m,
+    Execute' m (HSet level),
+    Execute m (HSet restLevels)
+  ) =>
+  Execute m (HSet (HSet level ': restLevels))
+  where
+  execute (HCons level restLevels) = do
+    ExecutorT $ \run -> run $ execute' level
+    execute restLevels
+  {-# INLINE execute #-}

@@ -1,35 +1,24 @@-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
 
 module Aztecs.ECS.System where
 
 import Aztecs.ECS.Access.Internal
-import Aztecs.ECS.HSet
-import Aztecs.ECS.Queryable.Internal
-import Aztecs.ECS.World
+import Aztecs.ECS.Class
 
 class System m sys where
-  type SystemInputs m sys
-  runSystem :: sys -> SystemInputs m sys -> m ()
+  type SystemIn m sys
 
-runSystemWithWorld ::
-  ( System m sys,
-    Access cs m (SystemInputs m sys),
-    Subset (AccessToComponents (AccessType (SystemInputs m sys))) cs,
-    ValidAccessInput (AccessType (SystemInputs m sys))
+  runSystem :: sys -> SystemIn m sys -> m ()
+
+system ::
+  ( ECS m,
+    Monad m,
+    System (Task m) sys,
+    Access m (SystemIn (Task m) sys)
   ) =>
   sys ->
-  World m cs ->
   m ()
-runSystemWithWorld sys world = runSystem sys (access world)
+system sys = access >>= task . runSystem sys
+{-# INLINE system #-}

@@ -0,0 +1,8 @@+module Aztecs.ECS.W (W (..)) where
+
+-- | Read-write 'Queryable' component access.
+data W m c = W
+  { readW :: m c,
+    writeW :: c -> m (),
+    modifyW :: (c -> c) -> m ()
+  }

@@ -1,134 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# 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
-  ( Bundle (..),
-    bundle,
-    World (..),
-    empty,
-    spawn,
-    insert,
-    removeComponent,
-    remove,
-    query,
-  )
-where
-
-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)
-
-newtype Bundle cs m = Bundle {runBundle :: Entity -> World m cs -> m (World m cs)}
-
-instance (Monad m) => Semigroup (Bundle cs m) where
-  Bundle f <> Bundle g = Bundle $ \entity w -> f entity w >>= g entity
-
-instance (Monad m) => Monoid (Bundle cs m) where
-  mempty = Bundle $ \_ w -> return w
-
-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'}
-
-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)))
-  }
-
-empty :: (Monad m, Empty m (Components (PrimState m) cs)) => m (World m cs)
-empty = do
-  cs <- HS.empty
-  return $ World cs emptyEntities IntMap.empty
-
-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'')
-
-insert :: Entity -> Bundle cs m -> World m cs -> m (World m cs)
-insert entity b = runBundle b entity
-
-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 #-}

@@ -0,0 +1,22 @@+module Aztecs.Entity where
+
+import Data.Bits
+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
+{-# INLINE mkEntity #-}
+
+entityIndex :: Entity -> Word32
+entityIndex (Entity e) = fromIntegral (e .&. 0xFFFFFFFF)
+{-# INLINE entityIndex #-}
+
+entityGeneration :: Entity -> Word32
+entityGeneration (Entity e) = fromIntegral ((e `shiftR` 32) .&. 0xFFFFFFFF)
+{-# INLINE entityGeneration #-}

@@ -0,0 +1,217 @@+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Aztecs.Internal
+  ( AztecsT (..),
+    runAztecsT,
+    runAztecsT_,
+  )
+where
+
+import Aztecs.ECS.Bundle
+import Aztecs.ECS.Bundle.Class
+import Aztecs.ECS.Class
+import Aztecs.ECS.Commands
+import Aztecs.ECS.Component (Component (ComponentStorage, componentHooks), Hooks (..))
+import Aztecs.ECS.HSet (AdjustM, HSet (..), Lookup (..))
+import qualified Aztecs.ECS.HSet as HS
+import Aztecs.ECS.Query
+import Aztecs.ECS.Query.Internal
+import Aztecs.ECS.R
+import qualified Aztecs.ECS.Scheduler as Scheduler
+import Aztecs.ECS.W
+import qualified Aztecs.Entity as E
+import Aztecs.Storage
+import qualified Aztecs.Storage as S
+import Aztecs.World (SparseStorage, WorldComponents)
+import qualified Aztecs.World as W
+import qualified Aztecs.World.Entities as E
+import Control.Monad.Primitive
+import Control.Monad.State.Strict
+import qualified Data.IntMap.Strict as IntMap
+import qualified Data.Map.Strict as Map
+import Data.Maybe
+import Data.Proxy
+import qualified Data.Set as Set
+import Data.Typeable
+import Prelude hiding (Read, lookup)
+
+newtype AztecsT cs m a = AztecsT {unAztecsT :: StateT (W.World m cs) m a}
+  deriving (Functor, Applicative, Monad, MonadIO, PrimMonad)
+
+instance MonadTrans (AztecsT cs) where
+  lift = AztecsT . lift
+  {-# INLINE lift #-}
+
+instance (PrimMonad m) => ECS (AztecsT cs m) where
+  type Entity (AztecsT cs m) = E.Entity
+  type Task (AztecsT cs m) = (Commands (AztecsT cs) m)
+
+  spawn b = do
+    w <- AztecsT get
+    let (e, counter) = E.mkEntityWithCounter (W.worldEntities w)
+    AztecsT $ put w {W.worldEntities = counter}
+    runBundle b e
+    return e
+  {-# INLINE spawn #-}
+  insert e b = runBundle b e
+  {-# INLINE insert #-}
+  remove e = AztecsT $ do
+    w <- get
+    w' <- lift $ W.remove e w
+    put w'
+  {-# INLINE remove #-}
+  task = runCommands
+  {-# INLINE task #-}
+
+instance
+  ( PrimMonad m,
+    Typeable c,
+    Component (AztecsT cs m) c,
+    AdjustM m (SparseStorage m c) (WorldComponents m cs)
+  ) =>
+  Bundleable c (AztecsT cs m)
+  where
+  bundle c = Bundle $ \entity -> do
+    w <- AztecsT get
+    let entityIdx = fromIntegral $ E.entityIndex entity
+        componentType = typeOf c
+        go = S.insertStorage entity c
+        hooks = componentHooks (Proxy :: Proxy c)
+    cs <- lift . HS.adjustM @_ @(SparseStorage m c) go $ W.worldComponents w
+    let entityComponents' =
+          IntMap.insertWith
+            Map.union
+            entityIdx
+            (Map.singleton componentType (W.removeComponent' @m @c entity))
+            (W.worldEntityComponents w)
+    AztecsT $ put w {W.worldComponents = cs, W.worldEntityComponents = entityComponents'}
+    onInsert hooks entity
+  {-# INLINE bundle #-}
+
+runAztecsT :: (Monad m) => AztecsT cs m a -> W.World m cs -> m (a, W.World m cs)
+runAztecsT (AztecsT m) = runStateT m
+{-# INLINE runAztecsT #-}
+
+runAztecsT_ :: (Monad m) => AztecsT cs m a -> W.World m cs -> m a
+runAztecsT_ (AztecsT m) = evalStateT m
+{-# INLINE runAztecsT_ #-}
+
+instance (PrimMonad m) => Queryable (AztecsT cs m) E.Entity where
+  type QueryableAccess E.Entity = '[]
+  queryable = AztecsT $ do
+    w <- get
+    return . Query . map pure . E.entities $ W.worldEntities w
+  {-# INLINE queryable #-}
+
+instance
+  ( PrimMonad m,
+    Lookup (ComponentStorage m a a) (WorldComponents m cs),
+    Storage m (ComponentStorage m a)
+  ) =>
+  Queryable (AztecsT cs m) (With a)
+  where
+  type QueryableAccess (With a) = '[With a]
+  queryable = AztecsT $ do
+    w <- get
+    withComponent <-
+      lift
+        . S.queryStorageR
+        . HS.lookup @(ComponentStorage m a a)
+        $ W.worldComponents w
+    return . fmap (const With) $ withComponent
+  {-# INLINE queryable #-}
+
+instance
+  ( PrimMonad m,
+    Lookup (ComponentStorage m a a) (WorldComponents m cs),
+    Storage m (ComponentStorage m a)
+  ) =>
+  Queryable (AztecsT cs m) (Without a)
+  where
+  type QueryableAccess (Without a) = '[Without a]
+  queryable = AztecsT $ do
+    w <- get
+    (Query cs) <-
+      lift
+        . S.queryStorageR
+        . HS.lookup @(ComponentStorage m a a)
+        $ W.worldComponents w
+    let go m = case m of
+          Just v -> Nothing
+          Nothing -> Just Without
+    return . Query $ fmap go cs
+  {-# INLINE queryable #-}
+
+instance
+  ( PrimMonad m,
+    Lookup (ComponentStorage m a a) (WorldComponents m cs),
+    Storage (AztecsT cs m) (ComponentStorage m a)
+  ) =>
+  Queryable (AztecsT cs m) (R a)
+  where
+  type QueryableAccess (R a) = '[Read a]
+  queryable = do
+    w <- AztecsT get
+    S.queryStorageR . HS.lookup @(ComponentStorage m a a) $ W.worldComponents w
+  {-# INLINE queryable #-}
+
+instance
+  ( PrimMonad m,
+    PrimState m ~ s,
+    Lookup (ComponentStorage m a a) (WorldComponents m cs),
+    Storage m (ComponentStorage m a)
+  ) =>
+  Queryable (AztecsT cs m) (W (Commands (AztecsT cs) m) a)
+  where
+  type QueryableAccess (W (Commands (AztecsT cs) m) a) = '[Write a]
+  queryable = AztecsT $ do
+    w <- get
+    Query results <-
+      lift
+        . S.queryStorageW
+        . HS.lookup @(ComponentStorage m a a)
+        $ W.worldComponents w
+    let liftToCommands m = Commands $ (,pure ()) <$> m
+        go (W r wf mf) =
+          W
+            (liftToCommands r)
+            (liftToCommands . wf)
+            (liftToCommands . mf)
+    return . Query $ map (fmap go) results
+  {-# INLINE queryable #-}
+
+-- Additional instance for direct AztecsT usage in scheduler
+instance
+  ( PrimMonad m,
+    PrimState m ~ s,
+    Lookup (ComponentStorage m a a) (WorldComponents m cs),
+    Storage m (ComponentStorage m a)
+  ) =>
+  Queryable (AztecsT cs m) (W (AztecsT cs m) a)
+  where
+  type QueryableAccess (W (AztecsT cs m) a) = '[Write a]
+  queryable = AztecsT $ do
+    w <- get
+    Query results <-
+      lift
+        . S.queryStorageW
+        . HS.lookup @(ComponentStorage m a a)
+        $ W.worldComponents w
+    let liftToAztecs (W r wf mf) =
+          W
+            (AztecsT $ lift r)
+            (AztecsT . lift . wf)
+            (AztecsT . lift . mf)
+    return . Query $ map (fmap liftToAztecs) results
+  {-# INLINE queryable #-}

@@ -0,0 +1,81 @@+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Aztecs.Storage (Storage (..), Empty (..)) where
+
+import Aztecs.ECS.HSet
+import qualified Aztecs.ECS.HSet as HS
+import Aztecs.ECS.Query
+import Aztecs.ECS.R
+import Aztecs.ECS.W
+import Aztecs.Entity
+import Control.Monad.Primitive
+import qualified Data.SparseSet.Strict as S
+import Data.SparseSet.Strict.Mutable (MSparseSet)
+import qualified Data.SparseSet.Strict.Mutable as MS
+import Data.Word
+import Prelude hiding (lookup)
+
+class Storage m s where
+  emptyStorage :: m (s a)
+
+  insertStorage :: Entity -> a -> s a -> m (s a)
+
+  removeStorage :: Entity -> s a -> m (s a)
+
+  queryStorageR :: s a -> m (Query (R a))
+
+  queryStorageW :: s a -> m (Query (W m a))
+
+instance (PrimMonad m, PrimState m ~ s) => Storage m (MSparseSet s Word32) where
+  emptyStorage = MS.empty
+  {-# INLINE emptyStorage #-}
+
+  insertStorage entity a s = do
+    s' <- S.freeze s
+    S.thaw $ S.insert (entityIndex entity) a s'
+  {-# INLINE insertStorage #-}
+
+  removeStorage entity s = do
+    s' <- S.freeze s
+    S.thaw $ S.delete (entityIndex entity) s'
+  {-# INLINE removeStorage #-}
+
+  queryStorageR s = do
+    s' <- S.freeze s
+    return . Query . fmap (fmap R) $ S.toList s'
+  {-# INLINE queryStorageR #-}
+
+  queryStorageW s = do
+    !as <- MS.toList s
+    let go (i, _) =
+          W
+            { readW = MS.unsafeRead s (fromIntegral i),
+              writeW = MS.unsafeWrite s (fromIntegral i),
+              modifyW = MS.unsafeModify s (fromIntegral i)
+            }
+    return . Query $ map (fmap go) as
+  {-# INLINE queryStorageW #-}
+
+class Empty m a where
+  empty :: m a
+
+instance (Applicative m) => Empty m (HSet '[]) where
+  empty = pure HEmpty
+  {-# INLINE empty #-}
+
+instance (Monad m, Storage m s, Empty m (HSet ts)) => Empty m (HSet (s a ': ts)) where
+  empty = do
+    xs <- emptyStorage @m @s
+    HCons xs <$> empty
+  {-# INLINE empty #-}

@@ -0,0 +1,134 @@+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Aztecs.World
+  ( World (..),
+    WorldComponents (..),
+    empty,
+    removeComponent,
+    removeComponent',
+    remove,
+    SparseStorage,
+  )
+where
+
+import qualified Aztecs.ECS.Class as ECS
+import Aztecs.ECS.Component
+import Aztecs.ECS.HSet
+import qualified Aztecs.ECS.HSet as HS
+import Aztecs.Entity
+import Aztecs.Storage hiding (empty)
+import qualified Aztecs.Storage as Storage
+import Aztecs.World.Entities
+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
+
+type SparseStorage m = MSparseSet (PrimState m) Word32
+
+type family WorldComponents m (cs :: [Type]) :: [Type] where
+  WorldComponents m '[] = '[]
+  WorldComponents m (c ': cs) = ComponentStorage m c c ': WorldComponents m cs
+
+type WorldComponentSet m cs =
+  HSet (WorldComponents m cs)
+
+type WorldEntityComponents m cs =
+  IntMap (Map TypeRep (WorldComponentSet m cs -> m (WorldComponentSet m cs)))
+
+data World m cs = World
+  { worldComponents :: !(HSet (WorldComponents m cs)),
+    worldEntities :: {-# UNPACK #-} !Entities,
+    worldEntityComponents :: {-# UNPACK #-} !(WorldEntityComponents m cs)
+  }
+
+empty :: (Monad m, Empty m (HSet (WorldComponents m cs))) => m (World m cs)
+empty = do
+  cs <- Storage.empty
+  return $ World cs emptyEntities IntMap.empty
+{-# INLINE empty #-}
+
+lookupStorage ::
+  (Lookup (ComponentStorage m c c) (WorldComponents m cs)) =>
+  World m cs ->
+  ComponentStorage m c c
+lookupStorage = HS.lookup . worldComponents
+{-# INLINE lookupStorage #-}
+
+adjustStorage ::
+  forall m cs c.
+  ( PrimMonad m,
+    Typeable c,
+    Component m c,
+    AdjustM m (ComponentStorage m c c) (WorldComponents m cs),
+    Storage m (ComponentStorage m c)
+  ) =>
+  (ComponentStorage m c c -> m (ComponentStorage m c c)) ->
+  World m cs ->
+  m (World m cs)
+adjustStorage f w = do
+  cs <- HS.adjustM @m @(ComponentStorage m c c) f (worldComponents w)
+  return $ w {worldComponents = cs}
+{-# INLINE adjustStorage #-}
+
+removeComponent ::
+  forall m cs c.
+  ( AdjustM m (ComponentStorage m c c) (WorldComponents m cs),
+    PrimMonad m,
+    Component m c,
+    ECS.Entity m ~ Entity,
+    Typeable c,
+    Storage m (ComponentStorage m c)
+  ) =>
+  Entity ->
+  World m cs ->
+  m (World m cs)
+removeComponent entity w = do
+  let entityIdx = fromIntegral (entityIndex entity)
+      componentType = typeRep (Proxy :: Proxy c)
+      hooks = componentHooks (Proxy :: Proxy c)
+  -- Run the onRemove hook first
+  onRemove hooks entity
+  w' <- adjustStorage @_ @_ @c (removeStorage entity) w
+  let entityComponents' = IntMap.adjust (Map.delete componentType) entityIdx (worldEntityComponents w)
+  return $ w' {worldEntityComponents = entityComponents'}
+{-# INLINE removeComponent #-}
+
+removeComponent' ::
+  forall m (c :: Type) cs.
+  (AdjustM m (SparseStorage m c) cs, PrimMonad m) =>
+  Entity ->
+  HSet cs ->
+  m (HSet cs)
+removeComponent' e components = HS.adjustM @m @(SparseStorage m c) go components
+  where
+    go s = do
+      s' <- S.freeze s
+      S.thaw (S.delete (entityIndex e) s')
+{-# INLINE removeComponent' #-}
+
+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'}
+{-# INLINE remove #-}

@@ -0,0 +1,33 @@+module Aztecs.World.Entities where
+
+import Aztecs.Entity
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+import Data.Word
+
+data Entities = Entities
+  { entitiesNextGeneration :: Word32,
+    entitiesGenerations :: IntMap Word32,
+    entitiesNextIndex :: Word32,
+    entitiesFreeIndicies :: [Word32]
+  }
+
+emptyEntities :: Entities
+emptyEntities = Entities 0 IntMap.empty 0 []
+{-# INLINE emptyEntities #-}
+
+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')
+{-# INLINE mkEntityWithCounter #-}
+
+entities :: Entities -> [Entity]
+entities (Entities _ gens _ _) = map go (IntMap.toList gens)
+  where
+    go (i, gen) = mkEntity (fromIntegral i) gen
+{-# INLINE entities #-}