diff --git a/aztecs.cabal b/aztecs.cabal
--- a/aztecs.cabal
+++ b/aztecs.cabal
@@ -1,6 +1,6 @@
 cabal-version: 2.4
 name:          aztecs
-version:       0.4.0.0
+version:       0.4.0.1
 license:       BSD-3-Clause
 license-file:  LICENSE
 maintainer:    matt@hunzinger.me
@@ -60,7 +60,8 @@
     build-depends:
         base >=4 && <5,
         aztecs,
-        hspec >=2
+        hspec >=2,
+        QuickCheck >=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,10 +1,10 @@
+{-# LANGUAGE Arrows #-}
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 
 import Criterion.Main
 import Data.Aztecs
 import qualified Data.Aztecs.Query as Q
-import Data.Aztecs.World (World)
+import qualified Data.Aztecs.System as S
 import qualified Data.Aztecs.World as W
 
 newtype Position = Position Int deriving (Show)
@@ -15,17 +15,27 @@
 
 instance Component Velocity
 
-run :: World -> World
-run w = let !(_, w') = Q.mapWorld (\(Velocity v :& Position x) -> Position (x + v)) w in w'
+run :: World -> IO ()
+run w = do
+  let s =
+        const ()
+          <$> S.map
+            ( proc () -> do
+                Velocity v <- Q.fetch -< ()
+                Position p <- Q.fetch -< ()
+                Q.set -< Position $ p + v
+            )
+  !_ <- S.runSystemWithWorld s w
+  return ()
 
 main :: IO ()
 main = do
   let !w =
         foldr
           ( \_ wAcc ->
-              let (e, wAcc') = W.spawn (Position 0) wAcc
+              let (e, wAcc') = W.spawn (bundle $ Position 0) wAcc
                in W.insert e (Velocity 1) wAcc'
           )
           W.empty
           [0 :: Int .. 10000]
-  defaultMain [bench "iter" $ whnf run w]
+  defaultMain [bench "iter" $ nfIO (run w)]
diff --git a/src/Data/Aztecs/Access.hs b/src/Data/Aztecs/Access.hs
--- a/src/Data/Aztecs/Access.hs
+++ b/src/Data/Aztecs/Access.hs
@@ -10,6 +10,7 @@
     spawn,
     spawn_,
     insert,
+    lookup,
     despawn,
   )
 where
@@ -54,6 +55,11 @@
   w <- get
   let w' = W.insert e c w
   put w'
+
+lookup :: (Monad m, Component a) => EntityID -> Access m (Maybe a)
+lookup e = Access $ do
+  w <- get
+  return $ W.lookup e w
 
 despawn :: (Monad m) => EntityID -> Access m ()
 despawn e = Access $ do
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
@@ -14,6 +14,7 @@
     spawnEmpty,
     insert,
     insertWithId,
+    lookup,
     despawn,
   )
 where
@@ -35,6 +36,7 @@
 import Data.Maybe (fromMaybe)
 import qualified Data.Set as Set
 import Data.Typeable (Proxy (..), Typeable, typeOf)
+import Prelude hiding (lookup)
 
 -- | World of entities and their components.
 data World = World
@@ -58,17 +60,17 @@
 spawn :: Bundle -> World -> (EntityID, World)
 spawn b w =
   let (eId, w') = spawnEmpty w
-      (cIds, components', dynB) = unBundle b (components w)
-   in case AS.lookupArchetypeId cIds (archetypes w) of
+      (cIds, components', dynB) = unBundle b (components w')
+   in case AS.lookupArchetypeId cIds (archetypes w') of
         Just aId -> fromMaybe (eId, w') $ do
-          node <- AS.lookupNode aId (archetypes w)
+          node <- AS.lookupNode aId (archetypes w')
           let arch' = runDynamicBundle dynB eId (nodeArchetype node)
           return
             ( eId,
-              w
-                { archetypes = (archetypes w) {AS.nodes = Map.insert aId node {nodeArchetype = arch'} (AS.nodes $ archetypes w)},
+              w'
+                { archetypes = (archetypes w') {AS.nodes = Map.insert aId node {nodeArchetype = arch'} (AS.nodes $ archetypes w)},
                   components = components',
-                  entities = Map.insert eId aId (entities w)
+                  entities = Map.insert eId aId (entities w')
                 }
             )
         Nothing ->
@@ -87,7 +89,7 @@
            in ( eId,
                 w'
                   { archetypes = arches,
-                    entities = Map.insert eId aId (entities w),
+                    entities = Map.insert eId aId (entities w'),
                     components = components'
                   }
               )
@@ -202,7 +204,7 @@
                               nextAId
                               (AS.nodes $ archetypes w')
                         },
-                    entities = Map.insert e nextAId (entities w)
+                    entities = Map.insert e nextAId (entities w')
                   }
           Nothing ->
             let (s, arch') = A.removeStorages e (nodeArchetype node)
@@ -229,7 +231,28 @@
                     entities = Map.insert e nextAId (entities w)
                   }
     Nothing -> w
-  Nothing -> w
+  Nothing -> case AS.lookupArchetypeId (Set.singleton cId) (archetypes w) of
+    Just aId -> spawnWithArchetypeId' e aId cId c w
+    Nothing ->
+      let (aId, arches) =
+            AS.insertArchetype
+              (Set.singleton cId)
+              ( Node
+                  { nodeComponentIds = Set.singleton cId,
+                    nodeArchetype = A.insertComponent e cId c A.empty,
+                    nodeAdd = Map.empty,
+                    nodeRemove = Map.empty
+                  }
+              )
+              (archetypes w)
+       in w {archetypes = arches, entities = Map.insert e aId (entities w)}
+
+lookup :: forall a. (Component a) => EntityID -> World -> Maybe a
+lookup e w = do
+  cId <- CS.lookup @a (components w)
+  aId <- Map.lookup e (entities w)
+  node <- AS.lookupNode aId (archetypes w)
+  A.lookupComponent e cId (nodeArchetype node)
 
 -- | Despawn an entity, returning its components.
 despawn :: EntityID -> World -> (Map ComponentID Dynamic, World)
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,33 +1,54 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module Main (main) where
 
 import Control.Arrow ((&&&))
 import Data.Aztecs
 import qualified Data.Aztecs.Query as Q
 import qualified Data.Aztecs.World as W
+import Data.Functor.Identity (Identity (..))
 import Test.Hspec
+import Test.QuickCheck
 
-newtype X = X Int deriving (Eq, Show)
+newtype X = X Int deriving (Eq, Show, Arbitrary)
 
 instance Component X
 
-newtype Y = Y Int deriving (Eq, Show)
+newtype Y = Y Int deriving (Eq, Show, Arbitrary)
 
 instance Component Y
 
-newtype Z = Z Int deriving (Eq, Show)
+newtype Z = Z Int deriving (Eq, Show, Arbitrary)
 
 instance Component Z
 
 main :: IO ()
 main = hspec $ do
   describe "Data.Aztecs.Query.all" $ do
-    it "queries multiple components" $ do
-      let (_, w) = W.spawn (bundle $ X 0) W.empty
-          (_, w') = W.spawn (bundle $ X 1) w
-      (xs, _) <- Q.all (Q.fetch) w'
-      xs `shouldMatchList` [X 0, X 1]
-    it "queries a group of components" $ do
-      let (e, w) = W.spawn (bundle $ X 0) W.empty
-          w' = W.insert e (Y 1) w
-      (xs, _) <- Q.all (Q.fetch &&& Q.fetch) w'
-      xs `shouldMatchList` [(X 0, Y 1)]
+    it "queries a single component" $ property prop_queryOneComponent
+    it "queries two components" $ property prop_queryTwoComponents
+    it "queries three components" $ property prop_queryThreeComponents
+
+prop_queryOneComponent :: [X] -> Expectation
+prop_queryOneComponent xs =
+  let w = foldr (\x -> snd . W.spawn (bundle x)) W.empty xs
+      (res, _) = runIdentity $ Q.all Q.fetch w
+   in res `shouldMatchList` xs
+
+prop_queryTwoComponents :: [(X, Y)] -> Expectation
+prop_queryTwoComponents xys =
+  let w = foldr (\(x, y) -> snd . W.spawn (bundle x <> bundle y)) W.empty xys
+      (res, _) = runIdentity $ Q.all (Q.fetch &&& Q.fetch) w
+   in res `shouldMatchList` xys
+
+prop_queryThreeComponents :: [(X, Y, Z)] -> Expectation
+prop_queryThreeComponents xyzs =
+  let w = foldr (\(x, y, z) -> snd . W.spawn (bundle x <> bundle y <> bundle z)) W.empty xyzs
+      q = do
+        x <- Q.fetch
+        y <- Q.fetch
+        z <- Q.fetch
+        pure (x, y, z)
+      (res, _) = runIdentity $ Q.all q w
+   in res `shouldMatchList` xyzs