diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,29 +1,29 @@
-Copyright (c) 2024, Matt Hunzinger
-
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
-
-    * Redistributions in binary form must reproduce the above
-      copyright notice, this list of conditions and the following
-      disclaimer in the documentation and/or other materials provided
-      with the distribution.
-
-    * Neither the name of the copyright holder nor the names of its
-      contributors may be used to endorse or promote products derived
-      from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+Copyright (c) 2024, Matt Hunzinger
+
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of the copyright holder nor the names of its
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/aztecs.cabal b/aztecs.cabal
--- a/aztecs.cabal
+++ b/aztecs.cabal
@@ -1,6 +1,6 @@
 cabal-version: 3.0
 name:          aztecs
-version:       0.1.0.1
+version:       0.2.0.0
 license:       BSD-3-Clause
 license-file:  LICENSE
 maintainer:    matt@hunzinger.me
@@ -12,23 +12,19 @@
 library
     exposed-modules:
         Data.Aztecs
+        Data.Aztecs.Access
+        Data.Aztecs.Archetype
         Data.Aztecs.Core
-        Data.Aztecs.Command
-        Data.Aztecs.Schedule
-        Data.Aztecs.System
-        Data.Aztecs.Storage
-        Data.Aztecs.Task
+        Data.Aztecs.Entity
         Data.Aztecs.Query
+        Data.Aztecs.Storage
         Data.Aztecs.World
-        Data.Aztecs.World.Archetypes
-        Data.Aztecs.World.Components
 
     hs-source-dirs:   src
     default-language: Haskell2010
     ghc-options:      -Wall
     build-depends:
         base >=4 && <5,
-        async >=2,
         containers >=0.7,
         mtl >=2
 
@@ -49,7 +45,8 @@
     ghc-options:      -Wall
     build-depends:
         base >=4 && <5,
-        aztecs
+        aztecs,
+        hspec >=2
 
 benchmark aztecs-bench
     type:             exitcode-stdio-1.0
diff --git a/bench/Iter.hs b/bench/Iter.hs
--- a/bench/Iter.hs
+++ b/bench/Iter.hs
@@ -1,45 +1,34 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeApplications #-}
-
-import Criterion.Main
-import Data.Aztecs
-import qualified Data.Aztecs.Query as Q
-import Data.Aztecs.System (runSystem)
-import qualified Data.Aztecs.System as S
-import qualified Data.Aztecs.World as W
-import Data.Foldable (foldrM)
-
-newtype Position = Position Int deriving (Show)
-
-instance Component Position
-
-newtype Velocity = Velocity Int deriving (Show)
-
-instance Component Velocity
-
-data S
-
-instance System IO S where
-  access = do
-    _ <- S.all $ do
-      Velocity y <- Q.read
-      Q.write (\(Position x) -> Position (x + y))
-    return ()
-
-runner :: World -> IO ()
-runner w = do
-  !_ <- runSystem @S w
-  return ()
-
-main :: IO ()
-main = do
-  !w <-
-    foldrM
-      ( \_ wAcc -> do
-          (_, wAcc') <- W.spawn (Position 0) wAcc
-          return wAcc'
-      )
-      W.newWorld
-      [0 :: Int .. 10000]
-  defaultMain [bench "iter" $ nfIO (runner w)]
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+import Criterion.Main
+import Data.Aztecs
+import Data.Aztecs.Entity
+import qualified Data.Aztecs.Query as Q
+import Data.Aztecs.World (World)
+import qualified Data.Aztecs.World as W
+
+newtype Position = Position Int deriving (Show)
+
+instance Component Position
+
+newtype Velocity = Velocity Int deriving (Show)
+
+instance Component Velocity
+
+run :: World -> World
+run w =
+  let !(_, w') = Q.mapWith Q.fetch Q.fetch (\(Velocity v :& Position x) -> Position (x + v)) w
+   in w'
+
+main :: IO ()
+main = do
+  let w =
+        foldr
+          ( \_ wAcc ->
+              let (e, wAcc') = W.spawn (Position 0) wAcc
+               in W.insert e (Velocity 1) wAcc'
+          )
+          W.empty
+          [0 :: Int .. 10000]
+  defaultMain [bench "iter" $ whnf run w]
diff --git a/examples/ECS.hs b/examples/ECS.hs
--- a/examples/ECS.hs
+++ b/examples/ECS.hs
@@ -1,47 +1,33 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeApplications #-}
-
-module Main where
-
-import Control.Monad.IO.Class
-import Data.Aztecs
-import qualified Data.Aztecs.Command as C
-import qualified Data.Aztecs.Query as Q
-import qualified Data.Aztecs.System as S
-
--- Components
-
-newtype Position = Position Int deriving (Show)
-
-instance Component Position
-
-newtype Velocity = Velocity Int deriving (Show)
-
-instance Component Velocity
-
--- Systems
-
-data A
-
-instance System IO A where
-  access = S.command $ do
-    e <- C.spawn (Position 0)
-    C.insert e (Velocity 1)
-
-data B
-
-instance System IO B where
-  access = do
-    -- Update all entities with a `Position` and `Velocity` component.
-    positions <- S.all $ do
-      Velocity v <- Q.read
-      Q.write (\(Position p) -> Position (p + v))
-
-    liftIO $ print positions
-
-app :: Scheduler IO
-app = schedule @Startup @_ @A [] <> schedule @Update @_ @B []
-
-main :: IO ()
-main = runScheduler app
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE MonoLocalBinds #-}
+
+module Main where
+
+import Control.Monad.IO.Class (MonadIO (..))
+import Data.Aztecs
+import qualified Data.Aztecs.Access as A
+import qualified Data.Aztecs.Query as Q
+import qualified Data.Aztecs.World as W
+
+newtype Position = Position Int deriving (Show)
+
+instance Component Position
+
+newtype Velocity = Velocity Int deriving (Show)
+
+instance Component Velocity
+
+app :: Access IO ()
+app = do
+  -- Spawn an entity with position and velocity components
+  e <- A.spawn (Position 0)
+  A.insert e (Velocity 1)
+
+  -- Query for and update all matching entities
+  q <- Q.map (\(Velocity v :& Position x) -> Position (x + v))
+  liftIO $ print q
+
+main :: IO ()
+main = do
+  _ <- runAccess app W.empty
+  return ()
diff --git a/src/Data/Aztecs.hs b/src/Data/Aztecs.hs
--- a/src/Data/Aztecs.hs
+++ b/src/Data/Aztecs.hs
@@ -1,33 +1,13 @@
-module Data.Aztecs
-  ( Entity,
-    EntityComponent (..),
-    Component (..),
-    World,
-    Query,
-    Access (..),
-    Task,
-    System (..),
-    Constraint (..),
-    before,
-    after,
-    Schedule (..),
-    Startup,
-    Update,
-    Scheduler (..),
-    schedule,
-    runScheduler,
-  )
-where
-
-import Data.Aztecs.Query
-  ( Query (..),
-  )
-import Data.Aztecs.Schedule
-import Data.Aztecs.System
-import Data.Aztecs.Task (Task (..))
-import Data.Aztecs.World
-  ( Component (..),
-    Entity,
-    EntityComponent (..),
-    World,
-  )
+module Data.Aztecs
+  ( Access,
+    runAccess,
+    Component (..),
+    EntityID,
+    Entity,
+    (:&) (..),
+  )
+where
+
+import Data.Aztecs.Access (Access, runAccess)
+import Data.Aztecs.Core (Component (..), EntityID)
+import Data.Aztecs.Entity (Entity, (:&) (..))
diff --git a/src/Data/Aztecs/Access.hs b/src/Data/Aztecs/Access.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Aztecs/Access.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Data.Aztecs.Access where
+
+import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.State (MonadState (..), StateT (..))
+import Data.Aztecs.Core (Component (..), EntityID)
+import Data.Aztecs.World (World)
+import qualified Data.Aztecs.World as W
+import Data.Data (Typeable)
+
+newtype Access m a = Access {unAccess :: StateT World m a}
+  deriving (Functor, Applicative, Monad, MonadIO)
+
+runAccess :: Access m a -> World -> m (a, World)
+runAccess a = runStateT (unAccess a)
+
+spawn :: (Monad m, Component a, Typeable (StorageT a)) => a -> Access m EntityID
+spawn c = Access $ do
+  w <- get
+  let (e, w') = W.spawn c w
+  put w'
+  return e
+
+insert :: (Monad m, Component a, Typeable (StorageT a)) => EntityID -> a -> Access m ()
+insert e c = Access $ do
+  w <- get
+  let w' = W.insert e c w
+  put w'
diff --git a/src/Data/Aztecs/Archetype.hs b/src/Data/Aztecs/Archetype.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Aztecs/Archetype.hs
@@ -0,0 +1,104 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Data.Aztecs.Archetype where
+
+import Data.Aztecs.Core (Component (..), ComponentID, EntityID (..))
+import qualified Data.Aztecs.Storage as S
+import Data.Bifunctor (Bifunctor (..))
+import Data.Dynamic (Dynamic, fromDynamic, toDyn)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe)
+import Prelude hiding (all, lookup)
+
+data AnyStorage = AnyStorage
+  { storageDyn :: Dynamic,
+    insertDyn :: Int -> Dynamic -> Dynamic -> Dynamic,
+    removeDyn :: Int -> Dynamic -> (Maybe Dynamic, Dynamic),
+    removeAny :: Int -> Dynamic -> (Maybe AnyStorage, Dynamic)
+  }
+
+instance Show AnyStorage where
+  show s = "AnyStorage " ++ show (storageDyn s)
+
+anyStorage :: forall s a. (S.Storage s a) => s a -> AnyStorage
+anyStorage s =
+  AnyStorage
+    { storageDyn = toDyn s,
+      insertDyn = \i cDyn sDyn ->
+        fromMaybe sDyn $ do
+          s' <- fromDynamic @(s a) sDyn
+          c <- fromDynamic cDyn
+          return . toDyn $ S.insert i c s',
+      removeDyn = \i dyn -> case fromDynamic @(s a) dyn of
+        Just s' -> let (a, b) = S.remove i s' in (fmap toDyn a, toDyn b)
+        Nothing -> (Nothing, dyn),
+      removeAny = \i dyn -> case fromDynamic @(s a) dyn of
+        Just s' -> let (a, b) = S.remove i s' in (fmap (anyStorage . S.singleton @s i) a, toDyn b)
+        Nothing -> (Nothing, dyn)
+    }
+
+newtype Archetype = Archetype {storages :: Map ComponentID AnyStorage}
+  deriving (Show)
+
+empty :: Archetype
+empty = Archetype {storages = Map.empty}
+
+lookupStorage :: (Component a) => ComponentID -> Archetype -> Maybe (StorageT a a)
+lookupStorage cId w = do
+  dynS <- Map.lookup cId (storages w)
+  fromDynamic (storageDyn dynS)
+
+insert :: forall a. (Component a) => EntityID -> ComponentID -> a -> Archetype -> Archetype
+insert e cId c arch =
+  let storage = case lookupStorage cId arch of
+        Just s -> S.insert (unEntityId e) c s
+        Nothing -> S.singleton @(StorageT a) @a (unEntityId e) c
+   in arch {storages = Map.insert cId (anyStorage storage) (storages arch)}
+
+all :: (Component a) => ComponentID -> Archetype -> [(EntityID, a)]
+all cId arch = fromMaybe [] $ do
+  s <- lookupStorage cId arch
+  return . map (first EntityID) $ S.all s
+
+lookup :: forall a. (Component a) => EntityID -> ComponentID -> Archetype -> Maybe a
+lookup e cId w = lookupStorage cId w >>= S.lookup (unEntityId e)
+
+insertAscList :: forall a. (Component a) => ComponentID -> [(EntityID, a)] -> Archetype -> Archetype
+insertAscList cId as arch = arch {storages = Map.insert cId (anyStorage $ S.fromAscList @(StorageT a) (map (first unEntityId) as)) (storages arch)}
+
+remove :: EntityID -> Archetype -> (Map ComponentID Dynamic, Archetype)
+remove e arch =
+  foldr
+    ( \(cId, s) (dynAcc, archAcc) ->
+        let (dynA, dynS) = removeDyn s (unEntityId e) (storageDyn s)
+            dynAcc' = case dynA of
+              Just d -> Map.insert cId d dynAcc
+              Nothing -> dynAcc
+         in ( dynAcc',
+              archAcc {storages = Map.insert cId (s {storageDyn = dynS}) (storages archAcc)}
+            )
+    )
+    (Map.empty, arch)
+    (Map.toList $ storages arch)
+
+removeStorages :: EntityID -> Archetype -> (Map ComponentID AnyStorage, Archetype)
+removeStorages e arch =
+  foldr
+    ( \(cId, s) (dynAcc, archAcc) ->
+        let (dynA, dynS) = removeAny s (unEntityId e) (storageDyn s)
+            dynAcc' = case dynA of
+              Just d -> Map.insert cId d dynAcc
+              Nothing -> dynAcc
+         in ( dynAcc',
+              archAcc {storages = Map.insert cId (s {storageDyn = dynS}) (storages archAcc)}
+            )
+    )
+    (Map.empty, arch)
+    (Map.toList $ storages arch)
diff --git a/src/Data/Aztecs/Command.hs b/src/Data/Aztecs/Command.hs
deleted file mode 100644
--- a/src/Data/Aztecs/Command.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
-module Data.Aztecs.Command
-  ( Command (..),
-    spawn,
-    insert,
-    Edit (..),
-  )
-where
-
-import Control.Monad.IO.Class
-import Control.Monad.State (StateT (..))
-import qualified Control.Monad.State as S
-import Data.Aztecs.World (Component, Entity, World)
-import qualified Data.Aztecs.World as W
-import Data.Dynamic (Typeable)
-import Data.Proxy
-import Prelude hiding (all)
-
-data Edit where
-  Spawn :: (Component c) => Entity -> (Proxy c) -> Edit
-  Insert :: (Component c) => Entity -> (Proxy c) -> Edit
-
--- | Command to update the `World`.
-newtype Command m a = Command (StateT World m a)
-  deriving (Functor, Applicative, Monad, MonadIO)
-
--- | Spawn a `Component` and return its `Entity`.
-spawn :: (Component a, Typeable a) => a -> Command IO Entity
-spawn a = Command $ do
-  w <- S.get
-  (e, w') <- liftIO $ W.spawn a w
-  S.put $ w'
-  return e
-
--- | Insert a `Component` into an `Entity`.
-insert :: (Component a, Typeable a) => Entity -> a -> Command IO ()
-insert e a =  Command $ do
-  w <- S.get
-  w' <- liftIO $ W.insert e a w
-  S.put w'
diff --git a/src/Data/Aztecs/Core.hs b/src/Data/Aztecs/Core.hs
--- a/src/Data/Aztecs/Core.hs
+++ b/src/Data/Aztecs/Core.hs
@@ -1,5 +1,60 @@
-module Data.Aztecs.Core (Entity (..), EntityComponent (..)) where
-
-newtype Entity = Entity Int deriving (Eq, Ord, Show)
-
-data EntityComponent a = EntityComponent Entity a deriving (Show)
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Data.Aztecs.Core
+  ( EntityID (..),
+    Component (..),
+    ComponentID (..),
+    Components (..),
+    emptyComponents,
+    insertComponentId,
+    lookupComponentId,
+  )
+where
+
+import Data.Aztecs.Storage (Storage)
+import Data.IntMap (IntMap)
+import Data.Kind (Type)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Typeable (Proxy (..), TypeRep, Typeable, typeOf)
+
+newtype EntityID = EntityID {unEntityId :: Int}
+  deriving (Eq, Ord, Show)
+
+newtype ComponentID = ComponentID {unComponentId :: Int}
+  deriving (Eq, Ord, Show)
+
+class (Typeable a, Storage (StorageT a) a) => Component a where
+  type StorageT a :: Type -> Type
+  type StorageT a = IntMap
+
+data Components = Components
+  { componentIds :: Map TypeRep ComponentID,
+    nextComponentId :: ComponentID
+  }
+  deriving (Show)
+
+emptyComponents :: Components
+emptyComponents =
+  Components
+    { componentIds = mempty,
+      nextComponentId = ComponentID 0
+    }
+
+lookupComponentId :: forall a. (Typeable a) => Components -> Maybe ComponentID
+lookupComponentId cs = Map.lookup (typeOf (Proxy @a)) (componentIds cs)
+
+insertComponentId :: forall c. (Component c) => Components -> (ComponentID, Components)
+insertComponentId cs =
+  let cId = nextComponentId cs
+   in ( cId,
+        cs
+          { componentIds = Map.insert (typeOf (Proxy @c)) cId (componentIds cs),
+            nextComponentId = ComponentID (unComponentId cId + 1)
+          }
+      )
diff --git a/src/Data/Aztecs/Entity.hs b/src/Data/Aztecs/Entity.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Aztecs/Entity.hs
@@ -0,0 +1,162 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Data.Aztecs.Entity
+  ( Entity (..),
+    EntityT,
+    FromEntity (..),
+    ToEntity (..),
+    ConcatT,
+    IntersectT,
+    Intersect (..),
+    DifferenceT,
+    Difference (..),
+    SplitT,
+    Split (..),
+    concat,
+    (<&>),
+    (:&) (..),
+  )
+where
+
+import Data.Kind (Type)
+import Prelude hiding (concat)
+
+data Entity (ts :: [Type]) where
+  ENil :: Entity '[]
+  ECons :: t -> Entity ts -> Entity (t ': ts)
+
+instance Show (Entity '[]) where
+  show ENil = "[]"
+
+instance (Show a, Show' (Entity as)) => Show (Entity (a ': as)) where
+  show (ECons x xs) = "[" ++ show x ++ showRow xs
+
+class Show' a where
+  showRow :: a -> String
+
+instance Show' (Entity '[]) where
+  showRow ENil = "]"
+
+instance (Show a, Show' (Entity as)) => Show' (Entity (a ': as)) where
+  showRow (ECons x xs) = ", " ++ show x ++ showRow xs
+
+(<&>) :: Entity as -> a -> Entity (a : as)
+(<&>) es c = ECons c es
+
+type family ConcatT (a :: [Type]) (b :: [Type]) where
+  ConcatT '[] b = b
+  ConcatT (a ': as) b = a ': ConcatT as b
+
+concat :: Entity as -> Entity bs -> Entity (ConcatT as bs)
+concat ENil ys = ys
+concat (ECons x xs) ys = ECons x (concat xs ys)
+
+type family SplitT (a :: [Type]) (b :: [Type]) :: [Type] where
+  SplitT '[] bs = bs
+  SplitT (a ': as) (a ': bs) = SplitT as bs
+
+class Split (a :: [Type]) (b :: [Type]) where
+  split :: Entity b -> (Entity a, Entity (SplitT a b))
+
+instance Split '[] bs where
+  split e = (ENil, e)
+
+instance forall a as bs. (Split as bs) => Split (a ': as) (a ': bs) where
+  split (ECons x xs) =
+    let (as, bs) = split @as xs
+     in (ECons x as, bs)
+
+data a :& b = a :& b
+
+type family EntityT a where
+  EntityT (a :& b) = a ': EntityT b
+  EntityT (Entity ts) = ts
+  EntityT a = '[a]
+
+class FromEntity a where
+  fromEntity :: Entity (EntityT a) -> a
+
+instance {-# OVERLAPS #-} (EntityT a ~ '[a]) => FromEntity a where
+  fromEntity (ECons a ENil) = a
+
+instance FromEntity (Entity ts) where
+  fromEntity = id
+
+instance (FromEntity a, FromEntity b, EntityT (a :& b) ~ (a ': EntityT b)) => FromEntity (a :& b) where
+  fromEntity (ECons a rest) = a :& fromEntity rest
+
+class ToEntity a where
+  toEntity :: a -> Entity (EntityT a)
+
+instance {-# OVERLAPS #-} (EntityT a ~ '[a]) => ToEntity a where
+  toEntity a = ECons a ENil
+
+instance ToEntity (Entity ts) where
+  toEntity = id
+
+instance (ToEntity a, ToEntity b, EntityT (a :& b) ~ (a ': EntityT b)) => ToEntity (a :& b) where
+  toEntity (a :& b) = ECons a (toEntity b)
+
+type family ElemT (a :: Type) (b :: [Type]) :: Bool where
+  ElemT a '[] = 'False
+  ElemT a (a ': as) = 'True
+  ElemT a (b ': as) = ElemT a as
+
+type family If (cond :: Bool) (true :: [Type]) (false :: [Type]) :: [Type] where
+  If 'True true false = true
+  If 'False true false = false
+
+type family IntersectT (a :: [Type]) (b :: [Type]) :: [Type] where
+  IntersectT '[] b = '[]
+  IntersectT (a ': as) b = If (ElemT a b) (a ': IntersectT as b) (IntersectT as b)
+
+class Intersect' (flag :: Bool) (a :: [Type]) (b :: [Type]) where
+  intersect' :: Entity a -> Entity b -> Entity (IntersectT a b)
+
+instance (Intersect as b, ElemT a b ~ 'True) => Intersect' 'True (a ': as) b where
+  intersect' (ECons x xs) ys = ECons x (xs `intersect` ys)
+
+instance (Intersect as (b ': bs), ElemT a (b ': bs) ~ 'False) => Intersect' 'False (a ': as) (b ': bs) where
+  intersect' (ECons _ xs) = intersect xs
+
+class Intersect (a :: [Type]) (b :: [Type]) where
+  intersect :: Entity a -> Entity b -> Entity (IntersectT a b)
+
+instance Intersect '[] b where
+  intersect _ _ = ENil
+
+instance (Intersect' (ElemT a bs) (a ': as) bs) => Intersect (a ': as) bs where
+  intersect = intersect' @(ElemT a bs)
+
+type family DifferenceT (a :: [Type]) (b :: [Type]) :: [Type] where
+  DifferenceT '[] b = '[]
+  DifferenceT (a ': as) b = If (ElemT a b) (DifferenceT as b) (a ': DifferenceT as b)
+
+class Difference' (flag :: Bool) (a :: [Type]) (b :: [Type]) where
+  difference' :: Entity a -> Entity b -> Entity (DifferenceT a b)
+
+instance (Difference as b, DifferenceT (a ': as) b ~ DifferenceT as b) => Difference' 'True (a ': as) b where
+  difference' (ECons _ xs) ys = xs `difference` ys
+
+instance (Difference as (b ': bs), DifferenceT (a ': as) (b ': bs) ~ (a ': DifferenceT as (b ': bs))) => Difference' 'False (a ': as) (b ': bs) where
+  difference' (ECons x xs) ys = ECons x (xs `difference` ys)
+
+class Difference (a :: [Type]) (b :: [Type]) where
+  difference :: Entity a -> Entity b -> Entity (DifferenceT a b)
+
+instance Difference '[] b where
+  difference _ _ = ENil
+
+instance (Difference' (ElemT a bs) (a ': as) bs) => Difference (a ': as) bs where
+  difference = difference' @(ElemT a bs)
diff --git a/src/Data/Aztecs/Query.hs b/src/Data/Aztecs/Query.hs
--- a/src/Data/Aztecs/Query.hs
+++ b/src/Data/Aztecs/Query.hs
@@ -1,134 +1,168 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-
-module Data.Aztecs.Query
-  ( ReadWrites (..),
-    Query (..),
-    entity,
-    read,
-    buildQuery,
-    all,
-    all',
-    get,
-    get',
-    write,
-  )
-where
-
-import Control.Monad.IO.Class (MonadIO (..))
-import Data.Aztecs.World (Component, Entity, World (..))
-import Data.Aztecs.World.Archetypes (Archetype, ArchetypeId, ArchetypeState (..), archetype)
-import qualified Data.Aztecs.World.Archetypes as A
-import Data.Foldable (foldrM)
-import qualified Data.Map as Map
-import Data.Set (Set)
-import Data.Typeable
-import Prelude hiding (all, read)
-
--- | Component IDs to read and write.
-data ReadWrites = ReadWrites (Set TypeRep) (Set TypeRep)
-
-instance Semigroup ReadWrites where
-  ReadWrites rs ws <> ReadWrites rs' ws' = ReadWrites (rs <> rs') (ws <> ws')
-
-instance Monoid ReadWrites where
-  mempty = ReadWrites mempty mempty
-
--- | Builder for a `Query`.
-data Query m a where
-  PureQ :: a -> Query m a
-  MapQ :: (a -> b) -> Query m a -> Query m b
-  AppQ :: Query m (a -> b) -> Query m a -> Query m b
-  BindQ :: Query m a -> (a -> Query m b) -> Query m b
-  EntityQ :: Query m Entity
-  ReadQ :: (Component c) => Archetype -> Query m c
-  WriteQ :: (Component c) => (c -> c) -> Archetype -> Query m c
-  LiftQ :: m a -> Query m a
-
-instance Functor (Query m) where
-  fmap = MapQ
-
-instance Applicative (Query m) where
-  pure = PureQ
-  (<*>) = AppQ
-
-instance Monad (Query m) where
-  (>>=) = BindQ
-
-entity :: Query m Entity
-entity = EntityQ
-
--- | Read a `Component`.
-read :: forall m c. (Component c) => Query m c
-read = ReadQ (archetype @c)
-
--- | Alter a `Component`.
-write :: forall m c. (Component c) => (c -> c) -> Query m c
-write c = WriteQ c (archetype @c)
-
-buildQuery :: Query m a -> Archetype
-buildQuery (PureQ _) = mempty
-buildQuery (MapQ _ qb) = buildQuery qb
-buildQuery (AppQ f a) = buildQuery f <> buildQuery a
-buildQuery EntityQ = mempty
-buildQuery (ReadQ a) = a
-buildQuery (WriteQ _ a) = a
-buildQuery (BindQ a _) = buildQuery a
-buildQuery (LiftQ _) = mempty
-
-all :: (MonadIO m) => ArchetypeId -> Query m a -> World -> m [a]
-all a qb w@(World _ as) = case A.getArchetype a as of
-  Just s -> all' s qb w
-  Nothing -> return []
-
-all' :: (MonadIO m) => ArchetypeState -> Query m a -> World -> m [a]
-all' es@(ArchetypeState _ m _) q w =
-  foldrM
-    ( \e acc -> do
-        a <- get' e es q w
-        return $ case a of
-          Just a' -> (a' : acc)
-          Nothing -> acc
-    )
-    []
-    (Map.keys m)
-
-get :: (MonadIO m) => ArchetypeId -> Query m a -> Entity -> World -> m (Maybe a)
-get a qb e w@(World _ as) = case A.getArchetype a as of
-  Just s -> get' e s qb w
-  Nothing -> return Nothing
-
-get' :: (MonadIO m) => Entity -> ArchetypeState -> Query m a -> World -> m (Maybe a)
-get' _ _ (PureQ a) _ = return $ Just a
-get' e es (MapQ f qb) w = do
-  a <- get' e es qb w
-  return $ fmap f a
-get' e es (AppQ fqb aqb) w = do
-  f <- get' e es fqb w
-  a <- get' e es aqb w
-  return $ f <*> a
-get' e _ EntityQ _ = return $ Just e
-get' e (ArchetypeState _ m _) (ReadQ _) _ = return $ do
-  cs <- Map.lookup e m
-  (c, _) <- A.getArchetypeComponent cs
-  return c
-get' e (ArchetypeState _ m _) (WriteQ f _) _ = do
-  let res = do
-        cs <- Map.lookup e m
-        A.getArchetypeComponent cs
-  case res of
-    Just (c, g) -> do
-      let c' = f c
-      liftIO $ g c'
-      return $ Just c'
-    Nothing -> return Nothing
-get' e es (BindQ qb f) w = do
-  a <- get' e es qb w
-  case a of
-    Just a' -> get' e es (f a') w
-    Nothing -> return Nothing
-get' _ _ (LiftQ a) _ = fmap Just a
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Data.Aztecs.Query
+  ( Query (..),
+    (<?>),
+    fetch,
+    all,
+    allWorld,
+    map,
+    mapWorld,
+    mapWith,
+  )
+where
+
+import Control.Monad.State (MonadState (..), gets)
+import Data.Aztecs.Access (Access (Access))
+import Data.Aztecs.Archetype (Archetype)
+import qualified Data.Aztecs.Archetype as A
+import Data.Aztecs.Core
+import Data.Aztecs.Entity (ConcatT, Difference, DifferenceT, Entity (..), EntityT, FromEntity (..), Intersect, IntersectT, ToEntity (..))
+import qualified Data.Aztecs.Entity as E
+import Data.Aztecs.World (World (..))
+import Data.Data (Typeable)
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe)
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Prelude hiding (all, map)
+
+-- | Query into the `World`.
+newtype Query a
+  = Query {runQuery' :: Components -> (Set ComponentID, Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype))}
+
+(<?>) ::
+  (E.Split a (ConcatT a b), E.SplitT a (ConcatT a b) ~ b) =>
+  Query a ->
+  Query b ->
+  Query (ConcatT a b)
+(Query a) <?> (Query b) = Query $ \cs ->
+  let (aIds, a') = a cs
+      (bIds, b') = b cs
+   in ( aIds <> bIds,
+        \arch ->
+          let (a'', aF) = a' arch
+              (b'', bF) = b' arch
+           in ( uncurry E.concat <$> zip a'' b'',
+                \new newArch -> let (as, bs) = unzip $ fmap E.split new in bF bs $ aF as newArch
+              )
+      )
+
+fetch :: forall a. (Component a, Typeable (StorageT a)) => Query '[a]
+fetch = Query $ \cs ->
+  let cId = fromMaybe (error "TODO") (lookupComponentId @a cs)
+   in ( Set.singleton cId,
+        \arch ->
+          let as = A.all cId arch
+           in ( fmap (\x -> ECons (snd x) ENil) as,
+                A.insertAscList cId . fmap (\((e, _), ECons a ENil) -> (e, a)) . zip as
+              )
+      )
+
+all :: forall m a. (Monad m, ToEntity a, FromEntity a, ToQuery (EntityT a)) => Access m [a]
+all = Access $ gets (fmap fromEntity . allWorld (query @(EntityT a)))
+
+allWorld :: Query a -> World -> [Entity a]
+allWorld q w =
+  let (cIds, g) = runQuery' q (components w)
+      res = do
+        aId <- Map.lookup cIds (archetypeIds w)
+        Map.lookup aId (archetypes w)
+   in case res of
+        Just arch -> fst $ g arch
+        Nothing -> []
+
+mapWith ::
+  (FromEntity i, ToEntity o, EntityT i ~ ConcatT a b, EntityT o ~ b) =>
+  Query a ->
+  Query b ->
+  (i -> o) ->
+  World ->
+  ([o], World)
+mapWith a b f w =
+  let (aCIds, aG) = runQuery' a (components w)
+      (bCIds, bG) = runQuery' b (components w)
+      res = do
+        aId <- Map.lookup (aCIds <> bCIds) (archetypeIds w)
+        arch <- Map.lookup aId (archetypes w)
+        return (aId, arch)
+   in case res of
+        Just (aId, arch) ->
+          let (as, _) = aG arch
+              (bs, bH) = bG arch
+              es = fmap (\(aE, bE) -> f $ fromEntity (E.concat aE bE)) (zip as bs)
+              arch' = bH (fmap (toEntity . toEntity) es) arch
+           in (es, w {archetypes = Map.insert aId arch' (archetypes w)})
+        Nothing -> ([], w)
+
+class ToQuery a where
+  query :: Query a
+
+instance ToQuery '[] where
+  query = Query $ const (Set.empty, const ([], \_ arch' -> arch'))
+
+instance {-# OVERLAPPING #-} (Component a, Typeable (StorageT a)) => ToQuery '[a] where
+  query = fetch @a
+
+instance (Component a, Typeable (StorageT a), ToQuery as) => ToQuery (a ': as) where
+  query = fetch @a <?> query @as
+
+mapWorld ::
+  forall i o.
+  ( FromEntity i,
+    ToEntity o,
+    Intersect (EntityT i) (EntityT o),
+    ToQuery (IntersectT (EntityT i) (EntityT o)),
+    Difference (EntityT i) (EntityT o),
+    ToQuery (DifferenceT (EntityT i) (EntityT o)),
+    ConcatT (DifferenceT (EntityT i) (EntityT o)) (IntersectT (EntityT i) (EntityT o)) ~ EntityT i,
+    IntersectT (EntityT i) (EntityT o) ~ EntityT o
+  ) =>
+  (i -> o) ->
+  World ->
+  ([o], World)
+mapWorld f w =
+  let i = query @(IntersectT (EntityT i) (EntityT o))
+      o = query @(DifferenceT (EntityT i) (EntityT o))
+      (aCIds, aG) = runQuery' i (components w)
+      (bCIds, bG) = runQuery' o (components w)
+      res = do
+        aId <- Map.lookup (aCIds <> bCIds) (archetypeIds w)
+        arch <- Map.lookup aId (archetypes w)
+        return (aId, arch)
+   in case res of
+        Just (aId, arch) ->
+          let (as, aH) = aG arch
+              (bs, _) = bG arch
+              es = fmap (\(aE, bE) -> f $ fromEntity @i (E.concat bE aE)) (zip as bs)
+              arch' = aH (fmap (\x -> let e = toEntity x in e) es) arch
+           in (es, w {archetypes = Map.insert aId arch' (archetypes w)})
+        Nothing -> ([], w)
+
+map ::
+  forall m i o.
+  ( Monad m,
+    FromEntity i,
+    ToEntity o,
+    Intersect (EntityT i) (EntityT o),
+    ToQuery (IntersectT (EntityT i) (EntityT o)),
+    Difference (EntityT i) (EntityT o),
+    ToQuery (DifferenceT (EntityT i) (EntityT o)),
+    ConcatT (DifferenceT (EntityT i) (EntityT o)) (IntersectT (EntityT i) (EntityT o)) ~ EntityT i,
+    IntersectT (EntityT i) (EntityT o) ~ EntityT o
+  ) =>
+  (i -> o) ->
+  Access m [o]
+map f = Access $ do
+  w <- get
+  let (out, w') = mapWorld @i @o f w
+  put w'
+  return out
diff --git a/src/Data/Aztecs/Schedule.hs b/src/Data/Aztecs/Schedule.hs
deleted file mode 100644
--- a/src/Data/Aztecs/Schedule.hs
+++ /dev/null
@@ -1,207 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-
-module Data.Aztecs.Schedule
-  ( Node (..),
-    Schedule (..),
-    ScheduleNode (..),
-    runSchedule,
-    Startup,
-    Update,
-    Constraint (..),
-    before,
-    after,
-    Scheduler (..),
-    schedule,
-    SchedulerGraph (..),
-    buildScheduler,
-    runSchedulerGraph,
-    runScheduler,
-  )
-where
-
-import Control.Concurrent.Async (mapConcurrently)
-import Control.Monad.State (StateT (runStateT))
-import Data.Aztecs.Command
-import Data.Aztecs.System
-import Data.Aztecs.World
-  ( World,
-    newWorld,
-    union,
-  )
-import Data.Foldable (foldrM)
-import Data.Functor ((<&>))
-import Data.List (groupBy, sortBy)
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Proxy
-import Data.Set (Set)
-import qualified Data.Set as Set
-import Data.Typeable
-import Prelude hiding (all, read)
-
-data Constraint = Before TypeRep | After TypeRep
-
-before :: forall m a. (System m a) => Constraint
-before = Before $ typeOf (Proxy :: Proxy a)
-
-after :: forall m a. (System m a) => Constraint
-after = After $ typeOf (Proxy :: Proxy a)
-
-data Node m where
-  Node :: (System m a) => Proxy a -> Cache -> Node m
-
-data ScheduleNode m = ScheduleNode (Node m) [Constraint]
-
-data Schedule m = Schedule (Map TypeRep (ScheduleNode m))
-
-instance Semigroup (Schedule m) where
-  Schedule a <> Schedule b = Schedule $ a <> b
-
-instance Monoid (Schedule m) where
-  mempty = Schedule mempty
-
-data GraphNode m = GraphNode (Node m) (Set TypeRep) (Set TypeRep)
-
-build :: (Monad m) => Schedule m -> [[GraphNode m]]
-build (Schedule s) =
-  let graph =
-        fmap
-          ( \(ScheduleNode node constraints) ->
-              let (deps, befores) =
-                    foldr
-                      ( \c (depAcc, afterAcc) -> case c of
-                          Before i -> (depAcc, [i])
-                          After i -> (depAcc ++ [i], afterAcc)
-                      )
-                      ([], [])
-                      constraints
-               in GraphNode node (Set.fromList deps) (Set.fromList befores)
-          )
-          s
-      graph' =
-        foldr
-          ( \(GraphNode _ _ befores) acc ->
-              foldr
-                ( \i acc' ->
-                    Map.adjust
-                      ( \(GraphNode n deps bs) ->
-                          GraphNode n (Set.singleton i <> deps) bs
-                      )
-                      i
-                      acc'
-                )
-                acc
-                befores
-          )
-          graph
-          graph
-      nodes =
-        sortBy
-          ( \(GraphNode _ deps _) (GraphNode _ deps' _) ->
-              compare (length deps') (length deps)
-          )
-          (Map.elems graph')
-   in groupBy
-        ( \(GraphNode a deps aBefores) (GraphNode b deps' bBefores) ->
-            (length deps == length deps')
-            -- TODO || hasConflict (GraphNode a deps aBefores) (GraphNode b deps' bBefores)
-        )
-        nodes
-
-runNode :: Node IO -> World -> IO (Node IO, Maybe (Access IO ()), [Command IO ()], World)
-runNode (Node p cache) w =
-  runSystemProxy p cache w <&> (\(next, a', cmds, w') -> (Node p a', next, cmds, w'))
-
-runSystemProxy :: forall a. (System IO a) => Proxy a -> Cache -> World -> IO (Maybe (Access IO ()), Cache, [Command IO ()], World)
-runSystemProxy _ = runSystem' @a
-
--- | Run a `Command`, returning any temporary `Entity`s and the updated `World`.
-runCommand :: Command IO () -> World -> IO (World)
-runCommand (Command cmd) w = snd <$> runStateT cmd w
-
-runSchedule :: [[GraphNode IO]] -> World -> IO ([[GraphNode IO]], World)
-runSchedule nodes w =
-  foldrM
-    ( \nodeGroup (nodeAcc, w') -> do
-        results <-
-          mapConcurrently
-            ( \(GraphNode n as bs) -> do
-                (n', next, cmds, w'') <- runNode n w
-                return ((next, (GraphNode n' as bs)), cmds, w'')
-            )
-            nodeGroup
-        let (nexts, cmdLists, worlds) =
-              foldr
-                ( \(n, b, c) (ns, bs, cs) ->
-                    (n : ns, b : bs, c : cs)
-                )
-                ([], [], [])
-                results
-            finalWorld = foldr union w' worlds
-            (cmds, w'') = (concat cmdLists, finalWorld)
-
-        (w''', nodes', cmds') <-
-          foldrM
-            ( \(a, (GraphNode (Node p cache) as bs)) (wAcc, nodeAcc', cmdAcc) -> case a of
-                Just a' -> do
-                  ((), wAcc', cache', cmdAcc') <- runAccess' a' wAcc cache
-                  return (wAcc', (GraphNode (Node p cache') as bs) : nodeAcc', cmdAcc' ++ cmdAcc)
-                Nothing -> return (w, (GraphNode (Node p cache) as bs) : nodeAcc', cmdAcc)
-            )
-            (w'', [], [])
-            nexts
-
-        w'''' <- foldrM (\cmd wAcc -> runCommand cmd wAcc) w''' (cmds ++ cmds')
-        return (nodes' : nodeAcc, w'''')
-    )
-    ([], w)
-    nodes
-
-newtype Scheduler m = Scheduler (Map TypeRep (Schedule m))
-  deriving (Monoid)
-
-instance Semigroup (Scheduler m) where
-  Scheduler a <> Scheduler b = Scheduler $ Map.unionWith (<>) a b
-
-data Startup
-
-data Update
-
-schedule :: forall l m s. (Typeable l, System m s) => [Constraint] -> Scheduler m
-schedule cs =
-  Scheduler $
-    Map.singleton
-      (typeOf (Proxy :: Proxy l))
-      ( Schedule $
-          Map.singleton
-            (typeOf (Proxy :: Proxy s))
-            (ScheduleNode (Node (Proxy :: Proxy s) mempty) cs)
-      )
-
-newtype SchedulerGraph m = SchedulerGraph (Map TypeRep [[GraphNode m]])
-
-buildScheduler :: (Monad m) => Scheduler m -> SchedulerGraph m
-buildScheduler (Scheduler s) = SchedulerGraph $ fmap build s
-
-runSchedulerGraph :: forall l. (Typeable l) => SchedulerGraph IO -> World -> IO (SchedulerGraph IO, World)
-runSchedulerGraph (SchedulerGraph g) w = case Map.lookup (typeOf (Proxy :: Proxy l)) g of
-  Just s -> do
-    (nodes, w') <- runSchedule s w
-    let g' = Map.insert (typeOf (Proxy :: Proxy l)) nodes g
-    return (SchedulerGraph g', w')
-  Nothing -> return (SchedulerGraph g, w)
-
-runScheduler :: Scheduler IO -> IO ()
-runScheduler s = do
-  let g = buildScheduler s
-  (g', w) <- runSchedulerGraph @Startup g newWorld
-  let go gAcc wAcc = do
-        (gAcc', wAcc') <- runSchedulerGraph @Update gAcc wAcc
-        go gAcc' wAcc'
-  go g' w
diff --git a/src/Data/Aztecs/Storage.hs b/src/Data/Aztecs/Storage.hs
--- a/src/Data/Aztecs/Storage.hs
+++ b/src/Data/Aztecs/Storage.hs
@@ -1,65 +1,25 @@
-module Data.Aztecs.Storage (Storage (..), table, table') where
-
-import Control.Monad (filterM)
-import Data.Aztecs.Core
-import Data.Functor ((<&>))
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Data.List (find)
-
-data Storage a = Storage
-  { empty :: IO (Storage a),
-    spawn :: Entity -> a -> IO (Storage a),
-    get :: Entity -> IO (Maybe (a, a -> Storage a -> IO (Storage a))),
-    toList :: IO [EntityComponent a],
-    toList' :: IO [(EntityComponent a, a -> IO ())],
-    remove :: Entity -> IO (Storage a)
-  }
-
-table' :: [IORef (EntityComponent a)] -> Storage a
-table' cs =
-  Storage
-    { empty = pure $ table' [],
-      spawn = \e a -> do
-        r <- newIORef (EntityComponent e a)
-        return $ table' (r : cs),
-      get = \e -> do
-        cs' <-
-          mapM
-            ( \r -> do
-                a <- readIORef r
-                return (a, r)
-            )
-            cs
-        return
-          ( find (\(EntityComponent e' _, _) -> e == e') cs'
-              <&> \(EntityComponent _ a, r) ->
-                ( a,
-                  \a' t -> do
-                    writeIORef r (EntityComponent e a')
-                    return t
-                )
-          ),
-      toList = mapM readIORef cs,
-      toList' =
-        mapM
-          ( \r -> do
-              (EntityComponent e a) <- readIORef r
-              return
-                ( (EntityComponent e a),
-                  \a' -> writeIORef r (EntityComponent e a')
-                )
-          )
-          cs,
-      remove = \e -> do
-        cs' <-
-          filterM
-            ( \r -> do
-                (EntityComponent e' _) <- readIORef r
-                return $ e /= e'
-            )
-            cs
-        return $ table' cs'
-    }
-
-table :: Storage a
-table = table' []
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MonoLocalBinds #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Data.Aztecs.Storage (Storage(..)) where
+
+import Data.Data (Typeable)
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+
+class (Typeable (s a), Typeable a) => Storage s a where
+  singleton :: Int -> a -> s a
+  all :: s a -> [(Int, a)]
+  insert :: Int -> a -> s a -> s a
+  lookup :: Int -> s a -> Maybe a
+  fromAscList :: [(Int, a)] -> s a
+  remove :: Int -> s a -> (Maybe a, s a)
+
+instance (Typeable a) => Storage IntMap a where
+  singleton = IntMap.singleton
+  all = IntMap.toList
+  insert = IntMap.insert
+  lookup = IntMap.lookup
+  fromAscList = IntMap.fromAscList
+  remove i s = (IntMap.lookup i s, IntMap.delete i s) -- TODO remove double lookup
diff --git a/src/Data/Aztecs/System.hs b/src/Data/Aztecs/System.hs
deleted file mode 100644
--- a/src/Data/Aztecs/System.hs
+++ /dev/null
@@ -1,218 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-
-module Data.Aztecs.System
-  ( Access (..),
-    runAccess,
-    runAccess',
-    all,
-    get,
-    command,
-    System (..),
-    runSystem,
-    runSystem',
-    Cache (..),
-  )
-where
-
-import Control.Monad.IO.Class
-import Data.Aztecs.Command
-import Data.Aztecs.Query (Query (..))
-import qualified Data.Aztecs.Query as Q
-import Data.Aztecs.World (Entity, World (..))
-import Data.Aztecs.World.Archetypes (Archetype, ArchetypeId)
-import qualified Data.Aztecs.World.Archetypes as A
-import Data.Foldable (foldrM)
-import Data.Kind
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Typeable
-import Prelude hiding (all, read)
-
-newtype Cache = Cache (Map Archetype ArchetypeId)
-  deriving (Semigroup, Monoid)
-
-data Access (m :: Type -> Type) a where
-  PureA :: a -> Access m a
-  MapA :: (a -> b) -> Access m a -> Access m b
-  AppA :: Access m (a -> b) -> Access m a -> Access m b
-  BindA :: Access m a -> (a -> Access m b) -> Access m b
-  AllA :: Archetype -> Query m a -> Access m [a]
-  GetA :: Archetype -> Query m a -> Entity -> Access m (Maybe a)
-  CommandA :: Command m () -> Access m ()
-  LiftA :: m a -> Access m a
-
-instance Functor (Access m) where
-  fmap = MapA
-
-instance (Monad m) => Applicative (Access m) where
-  pure = PureA
-  (<*>) = AppA
-
-instance (Monad m) => Monad (Access m) where
-  (>>=) = BindA
-
-instance (MonadIO m) => MonadIO (Access m) where
-  liftIO io = LiftA (liftIO io)
-
-runAccess :: Access IO a -> World -> Cache -> IO (Either (Access IO a) a, World, Cache, [Command IO ()])
-runAccess (PureA a) w c = return (Right a, w, c, [])
-runAccess (MapA f a) w cache = do
-  (a', w', cache', cmds) <- runAccess a w cache
-  return
-    ( case a' of
-        Left a'' -> Left (MapA f a'')
-        Right a'' -> Right (f a''),
-      w',
-      cache',
-      cmds
-    )
-runAccess (AppA f a) w cache = do
-  (f', w', cache', cmds) <- runAccess f w cache
-  (a', w'', cache'', cmds') <- runAccess a w' cache'
-  return
-    ( case (f', a') of
-        (Right f'', Right a'') -> Right (f'' a'')
-        (Left f'', _) -> Left (AppA f'' a)
-        (_, Left a'') -> Left (AppA f a''),
-      w'',
-      cache'',
-      cmds ++ cmds'
-    )
-runAccess (BindA a f) w cache = do
-  (a', w', cache', cmds) <- runAccess a w cache
-  case a' of
-    Left a'' -> return (Left (BindA a'' f), w', cache', cmds)
-    Right a'' -> runAccess (f a'') w' cache'
-runAccess (AllA a qb) w (Cache cache) = case Map.lookup (Q.buildQuery qb) cache of
-  Just aId -> do
-    es <- Q.all aId qb w
-    return (Right es, w, Cache cache, [])
-  Nothing -> return (Left (AllA a qb), w, Cache cache, [])
-runAccess (GetA arch q e) w (Cache cache) = do
-  case Map.lookup arch cache of
-    Just aId -> do
-      a <- Q.get aId q e w
-      return (Right a, w, Cache cache, [])
-    Nothing -> return (Left (GetA arch q e), w, Cache cache, [])
-runAccess (CommandA cmd) w cache = return (Right (), w, cache, [cmd])
-runAccess (LiftA io) w cache = do
-  a <- liftIO io
-  return (Right a, w, cache, [])
-
-runAccess' :: Access IO a -> World -> Cache -> IO (a, World, Cache, [Command IO ()])
-runAccess' (PureA a) w c = return (a, w, c, [])
-runAccess' (MapA f a) w cache = do
-  (a', w', cache', cmds) <- runAccess' a w cache
-  return (f a', w', cache', cmds)
-runAccess' (AppA f a) w cache = do
-  (f', w', cache', cmds) <- runAccess' f w cache
-  (a', w'', cache'', cmds') <- runAccess' a w' cache'
-  return (f' a', w'', cache'', cmds ++ cmds')
-runAccess' (BindA a f) w cache = do
-  (a', w', cache', cmds) <- runAccess' a w cache
-  (b, w'', cache'', cmds') <- runAccess' (f a') w' cache'
-  return (b, w'', cache'', cmds ++ cmds')
-runAccess' (AllA _ qb) (World cs as) (Cache cache) = do
-  (aId, w) <- case Map.lookup (Q.buildQuery qb) cache of
-    Just q' -> return (q', World cs as)
-    Nothing -> do
-      (x, as') <- A.insertArchetype (Q.buildQuery qb) cs as
-      return (x, World cs as')
-  es <- Q.all aId qb w
-  return (es, w, Cache cache, [])
-runAccess' (GetA arch q e) (World cs as) (Cache cache) = do
-  (aId, w) <- case Map.lookup arch cache of
-    Just q' -> return (q', World cs as)
-    Nothing -> do
-      (x, as') <- A.insertArchetype arch cs as
-      return (x, World cs as')
-  a <- Q.get aId q e w
-  return (a, w, Cache cache, [])
-runAccess' (CommandA cmd) w cache = return ((), w, cache, [cmd])
-runAccess' (LiftA io) w cache = do
-  a <- liftIO io
-  return (a, w, cache, [])
-
--- | Query all matches.
-all :: (Monad m) => Query m a -> Access m [a]
-all q = fst <$> all' mempty q
-
-all' :: (Monad m) => Archetype -> Query m a -> Access m ([a], Archetype)
-all' arch (PureQ a) = pure ([a], arch)
-all' arch (MapQ f a) = all' arch (f <$> a)
-all' arch (AppQ f a) = all' arch (f <*> a)
-all' arch (BindQ a f) = do
-  (a', arch') <- all' arch a
-  foldrM
-    ( \q (acc, archAcc) -> do
-        (as, archAcc') <- all' archAcc (f q)
-        return (as ++ acc, archAcc')
-    )
-    ([], arch')
-    a'
-all' arch (LiftQ m) = do
-  a <- LiftA m
-  return ([a], arch)
-all' arch (ReadQ arch') = do
-  let arch'' = (arch <> arch')
-  as <- AllA arch'' (ReadQ arch')
-  return (as, arch'')
-all' arch (WriteQ f arch') = do
-  let arch'' = (arch <> arch')
-  as <- AllA arch'' (WriteQ f arch')
-  return (as, arch'')
-all' arch EntityQ = do
-  es <- AllA arch EntityQ
-  return (es, arch)
-
-get :: (Monad m) => Entity -> Query m a -> Access m (Maybe a)
-get e q = fst <$> get' mempty e q
-
-get' :: (Monad m) => Archetype -> Entity -> Query m a -> Access m (Maybe a, Archetype)
-get' arch _ (PureQ a) = pure (Just a, arch)
-get' arch e (MapQ f qb) = get' arch e (f <$> qb)
-get' arch e (AppQ f a) = get' arch e (f <*> a)
-get' arch e (BindQ a f) = do
-  (a', arch') <- get' arch e a
-  case fmap f a' of
-    Just a'' -> get' arch' e a''
-    Nothing -> return (Nothing, arch')
-get' arch _ (LiftQ m) = do
-  a <- LiftA m
-  return (Just a, arch)
-get' arch e (ReadQ arch') = do
-  let arch'' = (arch <> arch')
-  a <- GetA arch'' (ReadQ arch') e
-  return (a, arch'')
-get' arch e (WriteQ f arch') = do
-  let arch'' = (arch <> arch')
-  a <- GetA arch'' (WriteQ f arch') e
-  return (a, arch'')
-get' arch e EntityQ = return (Just e, arch)
-
-command :: Command m () -> Access m ()
-command = CommandA
-
-class (Typeable a) => System m a where
-  access :: Access m ()
-
-runSystem :: forall a. (System IO a) => World -> IO World
-runSystem w = do
-  (_, _, _, w') <- runSystem' @a (Cache mempty) w
-  return w'
-
-runSystem' :: forall a. (System IO a) => Cache -> World -> IO (Maybe (Access IO ()), Cache, [Command IO ()], World)
-runSystem' cache w = do
-  (result, w', cache', cmds) <- runAccess (access @IO @a) w cache
-  case result of
-    Left a -> return (Just a, cache', cmds, w')
-    Right _ -> return (Nothing, cache', cmds, w')
diff --git a/src/Data/Aztecs/Task.hs b/src/Data/Aztecs/Task.hs
deleted file mode 100644
--- a/src/Data/Aztecs/Task.hs
+++ /dev/null
@@ -1,29 +0,0 @@
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
-module Data.Aztecs.Task
-  ( Task (..),
-    command,
-    runTask,
-  )
-where
-
-import Control.Monad.IO.Class
-import Control.Monad.State (StateT (..))
-import qualified Control.Monad.State as S
-import Data.Aztecs.Command
-import Data.Aztecs.World (World)
-import Prelude hiding (all)
-
--- | System task.
-newtype Task m s a = Task (StateT (s, [Command m ()], World) m a)
-  deriving (Functor, Applicative, Monad, MonadIO)
-
-runTask :: (Functor m) => Task m s a -> s -> World -> m (a, s, [Command m ()], World)
-runTask (Task t) s w = fmap (\(a, (s', cmds, w')) -> (a, s', cmds, w')) (S.runStateT t (s, [], w))
-
--- | Queue a `Command` to run after this system is complete.
-command :: (Monad m) => Command m () -> Task m a ()
-command cmd = Task $ do
-  (s, cmds, w) <- S.get
-  S.put $ (s, cmds <> [cmd], w)
diff --git a/src/Data/Aztecs/World.hs b/src/Data/Aztecs/World.hs
--- a/src/Data/Aztecs/World.hs
+++ b/src/Data/Aztecs/World.hs
@@ -1,71 +1,191 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-
-module Data.Aztecs.World
-  ( Entity,
-    EntityComponent (..),
-    Component (..),
-    World (..),
-    union,
-    spawn,
-    insert,
-    get,
-    getRow,
-    newWorld,
-    setRow,
-    remove,
-  )
-where
-
-import Data.Aztecs.Core
-import Data.Aztecs.Storage (Storage)
-import Data.Aztecs.World.Archetypes (Archetypes, newArchetypes)
-import qualified Data.Aztecs.World.Archetypes as A
-import Data.Aztecs.World.Components (Component, Components, newComponents)
-import qualified Data.Aztecs.World.Components as C
-import Data.Typeable
-import Prelude hiding (read)
-
-data World = World Components Archetypes deriving (Show)
-
-newWorld :: World
-newWorld = World newComponents newArchetypes
-
-union :: World -> World -> World
-union (World cs as) (World cs' _) = World (C.union cs cs') as
-
-spawn :: forall c. (Component c) => c -> World -> IO (Entity, World)
-spawn c (World cs as) = do
-  (e, cs') <- C.spawn c cs 
-  return (e, World cs' as)
-
-insert :: forall c. (Component c) => Entity -> c -> World -> IO World
-insert e c (World cs as) = do
-  cs' <- C.insert e c cs
-  return $ World cs' (A.insert @c e cs' as)
-
-getRow :: (Component c) => Proxy c -> World -> Maybe (Storage c)
-getRow p (World cs _) = C.getRow p cs
-
-get :: forall c. (Component c) => Entity -> World -> IO (Maybe (c, c -> World -> IO World))
-get e (World cs _) = do
-  res <- C.get e cs
-  case res of
-    Just (c, f) ->
-      return $
-        Just
-          ( c,
-            \c' (World cs' as) -> do
-              cs'' <- f c' cs'
-              return $ World cs'' as
-          )
-    Nothing -> return Nothing
-
-setRow :: forall c. (Component c) => Storage c -> World -> World
-setRow row (World cs as) = World (C.setRow row cs) as
-
-remove :: forall c. (Component c) => Entity -> World -> World
-remove e (World cs as) = World (C.remove @c e cs) as
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Data.Aztecs.World
+  ( ArchetypeID (..),
+    World (..),
+    empty,
+    spawn,
+    spawnWithId,
+    spawnWithArchetypeId,
+    spawnEmpty,
+    insert,
+    insertWithId,
+    insertArchetype,
+    despawn,
+  )
+where
+
+import Data.Aztecs.Archetype (Archetype (..))
+import qualified Data.Aztecs.Archetype as A
+import Data.Aztecs.Core (Component (..), ComponentID, Components (..), EntityID (..), emptyComponents, insertComponentId)
+import Data.Dynamic (Dynamic)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Typeable (Proxy (..), Typeable, typeOf)
+
+newtype ArchetypeID = ArchetypeID {unArchetypeId :: Int}
+  deriving (Eq, Ord, Show)
+
+-- | World of entities and their components.
+data World = World
+  { archetypes :: Map ArchetypeID Archetype,
+    archetypeIds :: Map (Set ComponentID) ArchetypeID,
+    archetypeComponents :: Map ArchetypeID (Set ComponentID),
+    nextArchetypeId :: ArchetypeID,
+    components :: Components,
+    entities :: Map EntityID ArchetypeID,
+    nextEntityId :: EntityID
+  }
+  deriving (Show)
+
+-- | Empty `World`.
+empty :: World
+empty =
+  World
+    { archetypes = mempty,
+      archetypeIds = mempty,
+      archetypeComponents = mempty,
+      nextArchetypeId = ArchetypeID 0,
+      components = emptyComponents,
+      entities = mempty,
+      nextEntityId = EntityID 0
+    }
+
+-- | Spawn an entity with a component.
+spawn :: forall a. (Component a, Typeable (StorageT a)) => a -> World -> (EntityID, World)
+spawn c w = case Map.lookup (typeOf (Proxy @a)) (componentIds (components w)) of
+  Just cId -> spawnWithId cId c w
+  Nothing ->
+    let (cId, cs) = insertComponentId @a (components w)
+     in spawnWithId cId c w {components = cs}
+
+-- | Spawn an empty entity.
+spawnEmpty :: World -> (EntityID, World)
+spawnEmpty w = let e = nextEntityId w in (e, w {nextEntityId = EntityID (unEntityId e + 1)})
+
+-- | Spawn an entity with a component and its `ComponentID`.
+spawnWithId ::
+  forall a.
+  (Component a, Typeable (StorageT a)) =>
+  ComponentID ->
+  a ->
+  World ->
+  (EntityID, World)
+spawnWithId cId c w =
+  let (e, w') = spawnEmpty w
+   in case Map.lookup (Set.singleton cId) (archetypeIds w) of
+        Just aId -> (e, spawnWithArchetypeId' e aId cId c w')
+        Nothing ->
+          ( e,
+            snd $
+              insertArchetype
+                (Set.singleton cId)
+                (A.insert e cId c A.empty)
+                w' {entities = Map.insert e (nextArchetypeId w) (entities w)}
+          )
+
+-- | Spawn an entity with a component and its `ComponentID` directly into an archetype.
+spawnWithArchetypeId ::
+  forall a.
+  (Component a, Typeable (StorageT a)) =>
+  a ->
+  ComponentID ->
+  ArchetypeID ->
+  World ->
+  (EntityID, World)
+spawnWithArchetypeId c cId aId w =
+  let (e, w') = spawnEmpty w
+   in (e, spawnWithArchetypeId' e aId cId c w')
+
+spawnWithArchetypeId' ::
+  forall a.
+  (Component a, Typeable (StorageT a)) =>
+  EntityID ->
+  ArchetypeID ->
+  ComponentID ->
+  a ->
+  World ->
+  World
+spawnWithArchetypeId' e aId cId c w =
+  let f = A.insert e cId c
+   in w
+        { archetypes = Map.adjust f aId (archetypes w),
+          entities = Map.insert e aId (entities w)
+        }
+
+-- | Insert an archetype by its set of `ComponentID`s.
+insertArchetype :: Set ComponentID -> Archetype -> World -> (ArchetypeID, World)
+insertArchetype cIds a w =
+  let aId = nextArchetypeId w
+   in ( aId,
+        w
+          { archetypes = Map.insert aId a (archetypes w),
+            archetypeIds = Map.insert cIds aId (archetypeIds w),
+            archetypeComponents = Map.insert aId cIds (archetypeComponents w),
+            nextArchetypeId = ArchetypeID (unArchetypeId aId + 1)
+          }
+      )
+
+insert :: forall a. (Component a, Typeable (StorageT a)) => EntityID -> a -> World -> World
+insert e c w =
+  let (cId, components') = insertComponentId @a (components w)
+   in insertWithId e cId c w {components = components'}
+
+insertWithId :: (Component a, Typeable (StorageT a)) => EntityID -> ComponentID -> a -> World -> World
+insertWithId e cId c w = case Map.lookup e (entities w) of
+  Just aId -> case Map.lookup aId (archetypeComponents w) of
+    Just cIds ->
+      if Set.member cId cIds
+        then w {archetypes = Map.adjust (A.insert e cId c) aId (archetypes w)}
+        else
+          let arch = archetypes w Map.! aId
+           in case Map.lookup (Set.insert cId cIds) (archetypeIds w) of
+                Just nextAId ->
+                  let (cs, arch') = A.remove e arch
+                      w' = w {archetypes = Map.insert aId arch' (archetypes w)}
+                      f (itemCId, dyn) archAcc =
+                        archAcc
+                          { A.storages =
+                              Map.adjust
+                                (\s -> s {A.storageDyn = A.insertDyn s (unEntityId e) dyn (A.storageDyn s)})
+                                itemCId
+                                (A.storages archAcc)
+                          }
+                   in w'
+                        { archetypes =
+                            Map.adjust
+                              (\nextArch -> foldr f nextArch (Map.toList cs))
+                              nextAId
+                              (archetypes w')
+                        }
+                Nothing ->
+                  let (s, arch') = A.removeStorages e arch
+                      w' = w {archetypes = Map.insert aId arch' (archetypes w)}
+                      newArch = Archetype {A.storages = s}
+                      newArch' = A.insert e cId c newArch
+                   in snd $ insertArchetype (Set.insert cId cIds) newArch' w'
+    Nothing -> w
+  Nothing -> w
+
+despawn :: EntityID -> World -> (Map ComponentID Dynamic, World)
+despawn e w =
+  let res = do
+        aId <- Map.lookup e (entities w)
+        arch <- Map.lookup aId (archetypes w)
+        return (aId, arch)
+   in case res of
+        Just (aId, arch) ->
+          let (dynAcc, arch') = A.remove e arch
+           in ( dynAcc,
+                w
+                  { archetypes = Map.insert aId arch' (archetypes w),
+                    entities = Map.delete e (entities w)
+                  }
+              )
+        Nothing -> (Map.empty, w)
diff --git a/src/Data/Aztecs/World/Archetypes.hs b/src/Data/Aztecs/World/Archetypes.hs
deleted file mode 100644
--- a/src/Data/Aztecs/World/Archetypes.hs
+++ /dev/null
@@ -1,181 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-
-module Data.Aztecs.World.Archetypes
-  ( Archetype (..),
-    ArchetypeComponent (..),
-    ArchetypeComponents (..),
-    getArchetypeComponent,
-    ArchetypeState (..),
-    ArchetypeId (..),
-    Archetypes (..),
-    newArchetypes,
-    archetype,
-    insertArchetype,
-    getArchetype,
-    insert,
-  )
-where
-
-import Data.Aztecs.Core
-import qualified Data.Aztecs.Storage as S
-import Data.Aztecs.World.Components (Component, Components, getRow)
-import qualified Data.Aztecs.World.Components as C
-import Data.Dynamic (Dynamic, fromDynamic, toDyn)
-import Data.Foldable (foldrM)
-import Data.IntMap (IntMap)
-import qualified Data.IntMap as IntMap
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Maybe (fromMaybe, isJust)
-import Data.Set (Set)
-import qualified Data.Set as Set
-import Data.Typeable
-import Prelude hiding (read)
-
-data ArchetypeComponent where
-  ArchetypeComponent :: (Component c) => Proxy c -> ArchetypeComponent
-
-instance Eq ArchetypeComponent where
-  ArchetypeComponent a == ArchetypeComponent b = typeOf a == typeOf b
-
-instance Ord ArchetypeComponent where
-  ArchetypeComponent a `compare` ArchetypeComponent b = typeOf a `compare` typeOf b
-
-instance Show ArchetypeComponent where
-  show (ArchetypeComponent p) = show (typeOf p)
-
-newtype Archetype = Archetype (Set ArchetypeComponent)
-  deriving (Eq, Ord, Show, Monoid, Semigroup)
-
-archetype :: forall c. (Component c) => Archetype
-archetype = Archetype . Set.singleton $ ArchetypeComponent (Proxy @c)
-
-newtype ArchetypeId = ArchetypeId Int deriving (Eq, Ord, Show)
-
-newtype ArchetypeComponents = ArchetypeComponents (Map TypeRep Dynamic)
-  deriving (Show)
-
-getArchetypeComponent :: forall c. (Component c) => ArchetypeComponents -> Maybe (c, c -> IO ())
-getArchetypeComponent (ArchetypeComponents m) = do
-  d <- Map.lookup (typeOf (Proxy @c)) m
-  fromDynamic d
-
-insertArchetypeComponent :: forall c. (Component c) => c -> (c -> IO ()) -> ArchetypeComponents -> ArchetypeComponents
-insertArchetypeComponent c f (ArchetypeComponents m) = ArchetypeComponents $ Map.insert (typeOf (Proxy @c)) (toDyn (c, f)) m
-
-data ArchetypeState = ArchetypeState Archetype (Map Entity ArchetypeComponents) [ArchetypeId]
-  deriving (Show)
-
-data Archetypes
-  = Archetypes
-      (IntMap ArchetypeState)
-      (Map TypeRep [ArchetypeId])
-      (Map Archetype ArchetypeId)
-      Int
-  deriving (Show)
-
-newArchetypes :: Archetypes
-newArchetypes = Archetypes IntMap.empty Map.empty Map.empty 0
-
-insertArchetype :: Archetype -> Components -> Archetypes -> IO (ArchetypeId, Archetypes)
-insertArchetype (Archetype a) w (Archetypes es ids as i) = case Map.lookup (Archetype a) as of
-  Just (ArchetypeId i') -> return (ArchetypeId i, Archetypes es ids as i')
-  Nothing -> do
-    (es', ids') <-
-      foldrM
-        ( \(ArchetypeComponent p) (eAcc, acc) -> do
-            cs <- fromMaybe (pure []) $ fmap (\s -> S.toList' s) (getRow p w)
-            let eAcc' = map (\(EntityComponent e c, f) -> (e, insertArchetypeComponent c f (ArchetypeComponents mempty))) cs
-            return (eAcc' ++ eAcc, Map.unionWith (<>) (Map.singleton (typeOf p) [ArchetypeId i]) acc)
-        )
-        ([], ids)
-        (Set.toList a)
-    return (ArchetypeId i, Archetypes (IntMap.insert i (ArchetypeState (Archetype a) (Map.fromList es') []) es) ids' as (i + 1))
-
-getArchetype :: ArchetypeId -> Archetypes -> Maybe ArchetypeState
-getArchetype (ArchetypeId i) (Archetypes es _ _ _) = IntMap.lookup i es
-
-insert :: forall c. (Component c) => Entity -> Components -> Archetypes -> Archetypes
-insert e cs (Archetypes es ids as j) = case Map.lookup (typeOf (Proxy @c)) ids of
-  Just (ids') ->
-    let insertInArchetype :: Int -> IntMap ArchetypeState -> IntMap ArchetypeState
-        insertInArchetype archetypeId acc =
-          IntMap.alter (updateArchetypeState archetypeId) archetypeId acc
-
-        updateArchetypeState :: Int -> Maybe ArchetypeState -> Maybe ArchetypeState
-        updateArchetypeState _ state = case state of
-          Just (ArchetypeState arch esAcc deps) ->
-            let isMatch =
-                  all
-                    (\(ArchetypeComponent p) -> isJust $ C.getRow p cs)
-                    (Set.toList $ unwrapArchetype arch)
-             in if isMatch
-                  then
-                    Just $ ArchetypeState arch (Map.singleton e (ArchetypeComponents mempty) <> esAcc) deps
-                  else state
-          Nothing -> state
-
-        updateDependencies :: Int -> IntMap ArchetypeState -> IntMap ArchetypeState
-        updateDependencies archetypeId acc = case IntMap.lookup archetypeId acc of
-          Just (ArchetypeState _ _ deps) -> foldr updateDependencies (insertInArchetype archetypeId acc) (map getArchetypeId deps)
-          Nothing -> acc
-        es' = foldr updateDependencies es (map getArchetypeId ids')
-     in merge $ Archetypes es' ids as j
-  Nothing -> Archetypes es ids as j
-
-merge :: Archetypes -> Archetypes
-merge archetypes@(Archetypes es _ _ _) =
-  foldl processArchetype archetypes (IntMap.toList es)
-  where
-    processArchetype :: Archetypes -> (Int, ArchetypeState) -> Archetypes
-    processArchetype acc (parentId, ArchetypeState parentArch _ _) =
-      foldl (updateDependency parentId parentArch) acc (IntMap.toList es)
-
-    updateDependency :: Int -> Archetype -> Archetypes -> (Int, ArchetypeState) -> Archetypes
-    updateDependency parentId parentArch acc (childId, ArchetypeState childArch _ _) =
-      let parentComponents = unwrapArchetype parentArch
-          childComponents = unwrapArchetype childArch
-       in if childId /= parentId && Set.isSubsetOf childComponents parentComponents
-            then mergeWithDeps (ArchetypeId parentId) (ArchetypeId childId) acc
-            else acc
-
-mergeWithDeps :: ArchetypeId -> ArchetypeId -> Archetypes -> Archetypes
-mergeWithDeps parentId childId (Archetypes es ids as nextId) =
-  case (IntMap.lookup (getArchetypeId parentId) es, IntMap.lookup (getArchetypeId childId) es) of
-    (Just (ArchetypeState parentArch parentEntities parentDeps), Just (ArchetypeState childArch childEntities childDeps)) ->
-      let parentComponents = unwrapArchetype parentArch
-          childComponents = unwrapArchetype childArch
-
-          adjustedChildComponents = Set.intersection parentComponents childComponents
-          adjustedChildArch = Archetype adjustedChildComponents
-
-          (childId', updatedEs, updatedAs, newNextId) =
-            if adjustedChildComponents == childComponents
-              then (childId, es, as, nextId)
-              else case Map.lookup adjustedChildArch as of
-                Just existingId -> (existingId, es, as, nextId)
-                Nothing ->
-                  let newChildId = ArchetypeId nextId
-                      newState = ArchetypeState adjustedChildArch childEntities childDeps
-                   in ( newChildId,
-                        IntMap.insert nextId newState es,
-                        Map.insert adjustedChildArch newChildId as,
-                        nextId + 1
-                      )
-
-          updatedParentDeps = childId' : parentDeps
-          updatedParentState = ArchetypeState parentArch parentEntities updatedParentDeps
-          finalEs = IntMap.insert (getArchetypeId parentId) updatedParentState updatedEs
-       in Archetypes finalEs ids updatedAs newNextId
-    _ -> Archetypes es ids as nextId
-
-getArchetypeId :: ArchetypeId -> Int
-getArchetypeId (ArchetypeId x) = x
-
-unwrapArchetype :: Archetype -> Set ArchetypeComponent
-unwrapArchetype (Archetype set) = set
diff --git a/src/Data/Aztecs/World/Components.hs b/src/Data/Aztecs/World/Components.hs
deleted file mode 100644
--- a/src/Data/Aztecs/World/Components.hs
+++ /dev/null
@@ -1,87 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-
-module Data.Aztecs.World.Components
-  ( Component (..),
-    Components,
-    union,
-    spawn,
-    insert,
-    adjust,
-    get,
-    getRow,
-    newComponents,
-    setRow,
-    remove,
-  )
-where
-
-import Data.Aztecs.Core
-import Data.Aztecs.Storage (Storage, table)
-import qualified Data.Aztecs.Storage as S
-import Data.Dynamic (Dynamic, fromDynamic, toDyn)
-import Data.Map (Map, alter, empty, lookup)
-import qualified Data.Map as Map
-import Data.Maybe (fromMaybe)
-import Data.Typeable
-import Prelude hiding (read)
-
-class (Typeable a) => Component a where
-  storage :: Storage a
-  storage = table
-
-data Components = Components (Map TypeRep Dynamic) Entity deriving (Show)
-
-newComponents :: Components
-newComponents = Components empty (Entity 0)
-
-union :: Components -> Components -> Components
-union (Components a e) (Components b _) = Components (Map.union a b) e
-
-spawn :: forall c. (Component c) => c -> Components -> IO (Entity, Components)
-spawn c (Components w (Entity e)) = do
-  w' <- insert (Entity e) c (Components w (Entity $ e + 1))
-  return (Entity e, w')
-
-insert :: forall c. (Component c) => Entity -> c -> Components -> IO Components
-insert e c (Components w e') = do
-  w' <-
-    Map.alterF
-      ( \maybeRow -> do
-          s <- S.spawn (fromMaybe storage (maybeRow >>= fromDynamic)) e c
-          return . Just $ toDyn s
-      )
-      (typeOf (Proxy :: Proxy c))
-      w
-  return $ Components w' e'
-
-adjust :: (Component c) => c -> (c -> c) -> Entity -> Components -> IO Components
-adjust a f w = insert w (f a)
-
-getRow :: (Component c) => Proxy c -> Components -> Maybe (Storage c)
-getRow p (Components w _) = Data.Map.lookup (typeOf p) w >>= fromDynamic
-
-get :: forall c. (Component c) => Entity -> Components -> IO (Maybe (c, c -> Components -> IO Components))
-get e (Components w _) = case Data.Map.lookup (typeOf @(Proxy c) Proxy) w >>= fromDynamic of
-  Just s -> do
-    res <- S.get s e
-    case res of
-      Just (c, f) ->
-        return $
-          Just
-            ( c,
-              \c' (Components w' e') ->
-                return $ Components (alter (\row -> Just . toDyn $ f c' (fromMaybe storage (row >>= fromDynamic))) (typeOf @(Proxy c) Proxy) w') e'
-            )
-      Nothing -> return Nothing
-  Nothing -> return Nothing
-
-setRow :: forall c. (Component c) => Storage c -> Components -> Components
-setRow cs (Components w e') = Components (Map.insert (typeOf @(Proxy c) Proxy) (toDyn cs) w) e'
-
-remove :: forall c. (Component c) => Entity -> Components -> Components
-remove e (Components w e') = Components (alter (\row -> row >>= f) (typeOf @(Proxy c) Proxy) w) e'
-  where
-    f row = fmap (\row' -> toDyn $ S.remove @c row' e) (fromDynamic row)
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,4 +1,14 @@
-module Main (main) where
-
-main :: IO ()
-main = putStrLn "Test suite not yet implemented."
+module Main (main) where
+
+import Data.Aztecs
+
+newtype X = X Int deriving (Eq, Show)
+
+instance Component X
+
+newtype Y = Y Int deriving (Eq, Show)
+
+instance Component Y
+
+main :: IO ()
+main = return ()