diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,10 @@
+## [0.4.3]
+### Added
+- `addPostStepCallback`
+
+### Changed
+- Now runs in `MonadIO` rather than `IO`
+
 ## [0.4.2]
 ### Added
 - Query `Impulse` for `Constraints`
diff --git a/apecs-physics.cabal b/apecs-physics.cabal
--- a/apecs-physics.cabal
+++ b/apecs-physics.cabal
@@ -1,5 +1,5 @@
 name:                apecs-physics
-version:             0.4.2
+version:             0.4.3
 synopsis:            2D physics for apecs
 description:         2D physics for apecs. Uses Chipmunk physics library under the hood.
 homepage:            https://github.com/jonascarpay/apecs#readme
diff --git a/src/Apecs/Physics.hs b/src/Apecs/Physics.hs
--- a/src/Apecs/Physics.hs
+++ b/src/Apecs/Physics.hs
@@ -27,7 +27,7 @@
   -- * Collision
   Collision (..), CollisionHandler (..), defaultHandler,
   CollisionSource(..), BeginCB, SeparateCB, PreSolveCB, PostSolveCB,
-  mkBeginCB, mkSeparateCB, mkPreSolveCB, mkPostSolveCB,
+  mkBeginCB, mkSeparateCB, mkPreSolveCB, mkPostSolveCB, addPostStepCallback,
 
   -- * Query
   PointQueryResult (..),
@@ -59,5 +59,5 @@
 -- also give this entity a number of __sub-components__.
 -- These sub-components may be read and written separately from the actualy @'Body'@ itself,
 -- which makes the library both more expressive (as you can only write about the parts of a
--- physics body you actually want to view or change) and more performant 
+-- physics body you actually want to view or change) and more performant
 -- (as only the changed parts of a body actually need to be updated when you write to them).
diff --git a/src/Apecs/Physics/Body.hs b/src/Apecs/Physics/Body.hs
--- a/src/Apecs/Physics/Body.hs
+++ b/src/Apecs/Physics/Body.hs
@@ -18,6 +18,7 @@
 import           Apecs
 import           Apecs.Core
 import           Control.Monad
+import           Control.Monad.IO.Class (liftIO, MonadIO)
 import qualified Data.IntMap         as M
 import qualified Data.IntSet         as S
 import           Data.IORef
@@ -59,11 +60,11 @@
 instance Component Body where
   type Storage Body = Space Body
 
-instance Has w IO Physics => Has w IO Body where
+instance (MonadIO m, Has w m Physics) => Has w m Body where
   getStore = (cast :: Space Physics -> Space Body) <$> getStore
 
-instance ExplSet IO (Space Body) where
-  explSet (Space bMap _ _ _ spcPtr) ety btype = do
+instance MonadIO m => ExplSet m (Space Body) where
+  explSet (Space bMap _ _ _ spcPtr) ety btype = liftIO $ do
     rd <- M.lookup ety <$> readIORef bMap
     bdyPtr <- case rd of
                 Just (BodyRecord bdyPtr _ _ _) -> return bdyPtr
@@ -75,8 +76,8 @@
                   return bdyPtr
     setBodyType bdyPtr btype
 
-instance ExplDestroy IO (Space Body) where
-  explDestroy sp@(Space bMap _ _ _ spc) ety = do
+instance MonadIO m => ExplDestroy m (Space Body) where
+  explDestroy sp@(Space bMap _ _ _ spc) ety = liftIO $ do
     rd <- M.lookup ety <$> readIORef bMap
     modifyIORef' bMap (M.delete ety)
     forM_ rd $ \(BodyRecord bPtr _ shapes constraints) -> do
@@ -84,12 +85,12 @@
       readIORef constraints >>= mapM_ (explDestroy (cast sp :: Space Constraint)) . S.toList
       destroyBody spc bPtr
 
-instance ExplMembers IO (Space Body) where
-  explMembers (Space bMap _ _ _ _) = U.fromList . M.keys <$> readIORef bMap
+instance MonadIO m => ExplMembers m (Space Body) where
+  explMembers (Space bMap _ _ _ _) = liftIO $ U.fromList . M.keys <$> readIORef bMap
 
-instance ExplGet IO (Space Body) where
-  explExists (Space bMap _ _ _ _) ety = M.member ety <$> readIORef bMap
-  explGet (Space bMap _ _ _ _) ety = do
+instance MonadIO m => ExplGet m (Space Body) where
+  explExists (Space bMap _ _ _ _) ety = liftIO $ M.member ety <$> readIORef bMap
+  explGet (Space bMap _ _ _ _) ety = liftIO $ do
     Just (BodyRecord _ b _ _) <- M.lookup ety <$> readIORef bMap
     return b
 
@@ -112,20 +113,20 @@
 instance Component Position where
   type Storage Position = Space Position
 
-instance Has w IO Physics => Has w IO Position where
+instance (MonadIO m, Has w m Physics) => Has w m Position where
   getStore = (cast :: Space Physics -> Space Position) <$> getStore
 
-instance ExplMembers IO (Space Position) where
+instance MonadIO m => ExplMembers m (Space Position) where
   explMembers s = explMembers (cast s :: Space Body)
 
-instance ExplSet IO (Space Position) where
-  explSet (Space bMap _ _ _ _) ety (Position pos) = do
+instance MonadIO m => ExplSet m (Space Position) where
+  explSet (Space bMap _ _ _ _) ety (Position pos) = liftIO $ do
     rd <- M.lookup ety <$> readIORef bMap
     forM_ rd$ \(BodyRecord b _ _ _) -> setPosition b pos
 
-instance ExplGet IO (Space Position) where
+instance MonadIO m => ExplGet m (Space Position) where
   explExists s ety = explExists (cast s :: Space Body) ety
-  explGet (Space bMap _ _ _ _) ety = do
+  explGet (Space bMap _ _ _ _) ety = liftIO $ do
     Just (BodyRecord b _ _ _) <- M.lookup ety <$> readIORef bMap
     Position <$> getPosition b
 
@@ -145,20 +146,20 @@
 instance Component Velocity where
   type Storage Velocity = Space Velocity
 
-instance Has w IO Physics => Has w IO Velocity where
+instance (MonadIO m, Has w m Physics) => Has w m Velocity where
   getStore = (cast :: Space Physics -> Space Velocity) <$> getStore
 
-instance ExplMembers IO (Space Velocity) where
+instance MonadIO m => ExplMembers m (Space Velocity) where
   explMembers s = explMembers (cast s :: Space Body)
 
-instance ExplSet IO (Space Velocity) where
-  explSet (Space bMap _ _ _ _) ety (Velocity vel) = do
+instance MonadIO m => ExplSet m (Space Velocity) where
+  explSet (Space bMap _ _ _ _) ety (Velocity vel) = liftIO $ do
     rd <- M.lookup ety <$> readIORef bMap
     forM_ rd$ \(BodyRecord b _ _ _) -> setVelocity b vel
 
-instance ExplGet IO (Space Velocity) where
+instance MonadIO m => ExplGet m (Space Velocity) where
   explExists s ety = explExists (cast s :: Space Body) ety
-  explGet (Space bMap _ _ _ _) ety = do
+  explGet (Space bMap _ _ _ _) ety = liftIO $ do
     Just (BodyRecord b _ _ _) <- M.lookup ety <$> readIORef bMap
     Velocity <$> getVelocity b
 
@@ -180,20 +181,20 @@
 instance Component Angle where
   type Storage Angle = Space Angle
 
-instance Has w IO Physics => Has w IO Angle where
+instance (MonadIO m, Has w m Physics) => Has w m Angle where
   getStore = (cast :: Space Physics -> Space Angle) <$> getStore
 
-instance ExplMembers IO (Space Angle) where
+instance MonadIO m => ExplMembers m (Space Angle) where
   explMembers s = explMembers (cast s :: Space Body)
 
-instance ExplSet IO (Space Angle) where
-  explSet (Space bMap _ _ _ _) ety (Angle angle) = do
+instance MonadIO m => ExplSet m (Space Angle) where
+  explSet (Space bMap _ _ _ _) ety (Angle angle) = liftIO $ do
     rd <- M.lookup ety <$> readIORef bMap
     forM_ rd $ \(BodyRecord b _ _ _) -> setAngle b angle
 
-instance ExplGet IO (Space Angle) where
+instance MonadIO m => ExplGet m (Space Angle) where
   explExists s ety = explExists (cast s :: Space Body) ety
-  explGet (Space bMap _ _ _ _) ety = do
+  explGet (Space bMap _ _ _ _) ety = liftIO $ do
     Just (BodyRecord b _ _ _) <- M.lookup ety <$> readIORef bMap
     Angle <$> getAngle b
 
@@ -215,20 +216,20 @@
 instance Component AngularVelocity where
   type Storage AngularVelocity = Space AngularVelocity
 
-instance Has w IO Physics => Has w IO AngularVelocity where
+instance (MonadIO m, Has w m Physics) => Has w m AngularVelocity where
   getStore = (cast :: Space Physics -> Space AngularVelocity) <$> getStore
 
-instance ExplMembers IO (Space AngularVelocity) where
+instance MonadIO m => ExplMembers m (Space AngularVelocity) where
   explMembers s = explMembers (cast s :: Space Body)
 
-instance ExplSet IO (Space AngularVelocity) where
-  explSet (Space bMap _ _ _ _) ety (AngularVelocity angle) = do
+instance MonadIO m => ExplSet m (Space AngularVelocity) where
+  explSet (Space bMap _ _ _ _) ety (AngularVelocity angle) = liftIO $ do
     rd <- M.lookup ety <$> readIORef bMap
     forM_ rd $ \(BodyRecord b _ _ _) -> setAngularVelocity b angle
 
-instance ExplGet IO (Space AngularVelocity) where
+instance MonadIO m => ExplGet m (Space AngularVelocity) where
   explExists s ety = explExists (cast s :: Space Body) ety
-  explGet (Space bMap _ _ _ _) ety = do
+  explGet (Space bMap _ _ _ _) ety = liftIO $ do
     Just (BodyRecord b _ _ _) <- M.lookup ety <$> readIORef bMap
     AngularVelocity <$> getAngularVelocity b
 
@@ -248,20 +249,20 @@
 instance Component Force where
   type Storage Force = Space Force
 
-instance Has w IO Physics => Has w IO Force where
+instance (MonadIO m, Has w m Physics) => Has w m Force where
   getStore = (cast :: Space Physics -> Space Force) <$> getStore
 
-instance ExplMembers IO (Space Force) where
+instance MonadIO m => ExplMembers m (Space Force) where
   explMembers s = explMembers (cast s :: Space Body)
 
-instance ExplSet IO (Space Force) where
-  explSet (Space bMap _ _ _ _) ety (Force frc) = do
+instance MonadIO m => ExplSet m (Space Force) where
+  explSet (Space bMap _ _ _ _) ety (Force frc) = liftIO $ do
     rd <- M.lookup ety <$> readIORef bMap
     forM_ rd$ \(BodyRecord b _ _ _) -> setForce b frc
 
-instance ExplGet IO (Space Force) where
+instance MonadIO m => ExplGet m (Space Force) where
   explExists s ety = explExists (cast s :: Space Body) ety
-  explGet (Space bMap _ _ _ _) ety = do
+  explGet (Space bMap _ _ _ _) ety = liftIO $ do
     Just (BodyRecord b _ _ _) <- M.lookup ety <$> readIORef bMap
     Force <$> getForce b
 
@@ -283,20 +284,20 @@
 instance Component BodyMass where
   type Storage BodyMass = Space BodyMass
 
-instance Has w IO Physics => Has w IO BodyMass where
+instance (MonadIO m, Has w m Physics) => Has w m BodyMass where
   getStore = (cast :: Space Physics -> Space BodyMass) <$> getStore
 
-instance ExplMembers IO (Space BodyMass) where
+instance MonadIO m => ExplMembers m (Space BodyMass) where
   explMembers s = explMembers (cast s :: Space Body)
 
-instance ExplSet IO (Space BodyMass) where
-  explSet (Space bMap _ _ _ _) ety (BodyMass angle) = do
+instance MonadIO m => ExplSet m (Space BodyMass) where
+  explSet (Space bMap _ _ _ _) ety (BodyMass angle) = liftIO $ do
     rd <- M.lookup ety <$> readIORef bMap
     forM_ rd $ \(BodyRecord b _ _ _) -> setBodyMass b angle
 
-instance ExplGet IO (Space BodyMass) where
+instance MonadIO m => ExplGet m (Space BodyMass) where
   explExists s ety = explExists (cast s :: Space Body) ety
-  explGet (Space bMap _ _ _ _) ety = do
+  explGet (Space bMap _ _ _ _) ety = liftIO $ do
     Just (BodyRecord b _ _ _) <- M.lookup ety <$> readIORef bMap
     BodyMass <$> getBodyMass b
 
@@ -318,20 +319,20 @@
 instance Component Moment where
   type Storage Moment = Space Moment
 
-instance Has w IO Physics => Has w IO Moment where
+instance (MonadIO m, Has w m Physics) => Has w m Moment where
   getStore = (cast :: Space Physics -> Space Moment) <$> getStore
 
-instance ExplMembers IO (Space Moment) where
+instance MonadIO m => ExplMembers m (Space Moment) where
   explMembers s = explMembers (cast s :: Space Body)
 
-instance ExplSet IO (Space Moment) where
-  explSet (Space bMap _ _ _ _) ety (Moment angle) = do
+instance MonadIO m => ExplSet m (Space Moment) where
+  explSet (Space bMap _ _ _ _) ety (Moment angle) = liftIO $ do
     rd <- M.lookup ety <$> readIORef bMap
     forM_ rd $ \(BodyRecord b _ _ _) -> setMoment b angle
 
-instance ExplGet IO (Space Moment) where
+instance MonadIO m => ExplGet m (Space Moment) where
   explExists s ety = explExists (cast s :: Space Body) ety
-  explGet (Space bMap _ _ _ _) ety = do
+  explGet (Space bMap _ _ _ _) ety = liftIO $ do
     Just (BodyRecord b _ _ _) <- M.lookup ety <$> readIORef bMap
     Moment <$> getMoment b
 
@@ -353,20 +354,20 @@
 instance Component Torque where
   type Storage Torque = Space Torque
 
-instance Has w IO Physics => Has w IO Torque where
+instance (MonadIO m, Has w m Physics) => Has w m Torque where
   getStore = (cast :: Space Physics -> Space Torque) <$> getStore
 
-instance ExplMembers IO (Space Torque) where
+instance MonadIO m => ExplMembers m (Space Torque) where
   explMembers s = explMembers (cast s :: Space Body)
 
-instance ExplSet IO (Space Torque) where
-  explSet (Space bMap _ _ _ _) ety (Torque angle) = do
+instance MonadIO m => ExplSet m (Space Torque) where
+  explSet (Space bMap _ _ _ _) ety (Torque angle) = liftIO $ do
     rd <- M.lookup ety <$> readIORef bMap
     forM_ rd $ \(BodyRecord b _ _ _) -> setTorque b angle
 
-instance ExplGet IO (Space Torque) where
+instance MonadIO m => ExplGet m (Space Torque) where
   explExists s ety = explExists (cast s :: Space Body) ety
-  explGet (Space bMap _ _ _ _) ety = do
+  explGet (Space bMap _ _ _ _) ety = liftIO $ do
     Just (BodyRecord b _ _ _) <- M.lookup ety <$> readIORef bMap
     Torque <$> getTorque b
 
@@ -386,20 +387,20 @@
 instance Component CenterOfGravity where
   type Storage CenterOfGravity = Space CenterOfGravity
 
-instance Has w IO Physics => Has w IO CenterOfGravity where
+instance (MonadIO m, Has w m Physics) => Has w m CenterOfGravity where
   getStore = (cast :: Space Physics -> Space CenterOfGravity) <$> getStore
 
-instance ExplMembers IO (Space CenterOfGravity) where
+instance MonadIO m => ExplMembers m (Space CenterOfGravity) where
   explMembers s = explMembers (cast s :: Space Body)
 
-instance ExplSet IO (Space CenterOfGravity) where
-  explSet (Space bMap _ _ _ _) ety (CenterOfGravity vel) = do
+instance MonadIO m => ExplSet m (Space CenterOfGravity) where
+  explSet (Space bMap _ _ _ _) ety (CenterOfGravity vel) = liftIO $ do
     rd <- M.lookup ety <$> readIORef bMap
     forM_ rd$ \(BodyRecord b _ _ _) -> setCenterOfGravity b vel
 
-instance ExplGet IO (Space CenterOfGravity) where
+instance MonadIO m => ExplGet m (Space CenterOfGravity) where
   explExists s ety = explExists (cast s :: Space Body) ety
-  explGet (Space bMap _ _ _ _) ety = do
+  explGet (Space bMap _ _ _ _) ety = liftIO $ do
     Just (BodyRecord b _ _ _) <- M.lookup ety <$> readIORef bMap
     CenterOfGravity <$> getCenterOfGravity b
 
@@ -407,15 +408,15 @@
 instance Component ShapeList where
   type Storage ShapeList = Space ShapeList
 
-instance Has w IO Physics => Has w IO ShapeList where
+instance (MonadIO m, Has w m Physics) => Has w m ShapeList where
   getStore = (cast :: Space Physics -> Space ShapeList) <$> getStore
 
-instance ExplMembers IO (Space ShapeList) where
+instance MonadIO m => ExplMembers m (Space ShapeList) where
   explMembers s = explMembers (cast s :: Space Body)
 
-instance ExplGet IO (Space ShapeList) where
+instance MonadIO m => ExplGet m (Space ShapeList) where
   explExists s ety = explExists (cast s :: Space Body) ety
-  explGet (Space bMap _ _ _ _) ety = do
+  explGet (Space bMap _ _ _ _) ety = liftIO $ do
     Just (BodyRecord _ _ sPtr _) <- M.lookup ety <$> readIORef bMap
     ShapeList . fmap Entity . S.toList <$> readIORef sPtr
 
@@ -423,14 +424,14 @@
 instance Component ConstraintList where
   type Storage ConstraintList = Space ConstraintList
 
-instance Has w IO Physics => Has w IO ConstraintList where
+instance (MonadIO m, Has w m Physics) => Has w m ConstraintList where
   getStore = (cast :: Space Physics -> Space ConstraintList) <$> getStore
 
-instance ExplMembers IO (Space ConstraintList) where
+instance MonadIO m => ExplMembers m (Space ConstraintList) where
   explMembers s = explMembers (cast s :: Space Body)
 
-instance ExplGet IO (Space ConstraintList) where
+instance MonadIO m => ExplGet m (Space ConstraintList) where
   explExists s ety = explExists (cast s :: Space Body) ety
-  explGet (Space bMap _ _ _ _) ety = do
+  explGet (Space bMap _ _ _ _) ety = liftIO $ do
     Just (BodyRecord _ _ _ cPtr) <- M.lookup ety <$> readIORef bMap
     ConstraintList . fmap Entity . S.toList <$> readIORef cPtr
diff --git a/src/Apecs/Physics/Collision.hs b/src/Apecs/Physics/Collision.hs
--- a/src/Apecs/Physics/Collision.hs
+++ b/src/Apecs/Physics/Collision.hs
@@ -16,11 +16,13 @@
 module Apecs.Physics.Collision
   ( defaultHandler
   , mkBeginCB, mkSeparateCB, mkPreSolveCB, mkPostSolveCB
+  , addPostStepCallback
   ) where
 
 import           Apecs
 import           Apecs.Core
 import           Control.Monad
+import           Control.Monad.IO.Class (MonadIO, liftIO)
 import qualified Data.IntMap         as M
 import           Data.IORef
 import qualified Data.Vector.Unboxed as U
@@ -50,32 +52,32 @@
   sb <- fromIntegral <$> [C.block| unsigned int { CP_ARBITER_GET_SHAPES($(cpArbiter* arb), sa, sb); return (intptr_t) (sb->userData); } |]
   return $ Collision (V2 nx ny) (Entity ba) (Entity bb) (Entity sa) (Entity sb)
 
-mkBeginCB :: (Collision -> System w Bool) -> System w BeginCB
+mkBeginCB :: MonadIO m => (Collision -> SystemT w IO Bool) -> SystemT w m BeginCB
 mkBeginCB sys = do
     w <- ask
 
     let cb arb _ _ = do
-          col <- mkCollision arb
-          r <- liftIO$ runSystem (sys col) w
+          col <- liftIO $ mkCollision arb
+          r <- runSystem (sys col) w
           return . fromIntegral . fromEnum $ r
 
     return (BeginCB cb)
 
-mkSeparateCB :: (Collision -> System w ()) -> System w SeparateCB
+mkSeparateCB :: MonadIO m => (Collision -> SystemT w IO ()) -> SystemT w m SeparateCB
 mkSeparateCB sys = do
     w <- ask
 
     let cb arb _ _ = do
-          col <- mkCollision arb
-          liftIO$ runSystem (sys col) w
+          col <- liftIO $ mkCollision arb
+          runSystem (sys col) w
 
     return (SeparateCB cb)
 
 
-mkPreSolveCB :: (Collision -> System w Bool) -> System w PreSolveCB
+mkPreSolveCB :: MonadIO m => (Collision -> SystemT w IO Bool) -> SystemT w m PreSolveCB
 mkPreSolveCB sys = (\(BeginCB cb) -> PreSolveCB cb) <$> mkBeginCB sys
 
-mkPostSolveCB :: (Collision -> System w ()) -> System w PostSolveCB
+mkPostSolveCB :: MonadIO m => (Collision -> SystemT w IO ()) -> SystemT w m PostSolveCB
 mkPostSolveCB sys = (\(SeparateCB cb) -> PostSolveCB cb) <$> mkSeparateCB sys
 
 newCollisionHandler :: SpacePtr -> CollisionHandler -> Int -> IO (Ptr CollisionHandler)
@@ -87,6 +89,7 @@
       Wildcard (CollisionType ct)
         -> [C.exp| cpCollisionHandler* {cpSpaceAddWildcardHandler($(cpSpace* space), $(uintptr_t ct))}|]
 
+
     [C.exp| void { $(cpCollisionHandler* handler)->userData = (void*) $(intptr_t ety) }|]
 
     forM_ begin$ \(BeginCB cb) -> do
@@ -117,26 +120,41 @@
 instance Component CollisionHandler where
   type Storage CollisionHandler = Space CollisionHandler
 
-instance Has w IO Physics => Has w IO CollisionHandler where
+instance (MonadIO m, Has w m Physics) => Has w m CollisionHandler where
   getStore = (cast :: Space Physics -> Space CollisionHandler) <$> getStore
 
-instance ExplSet IO (Space CollisionHandler) where
-  explSet sp@(Space _ _ _ hMap spcPtr) ety handler = do
+instance (MonadIO m) => ExplSet m (Space CollisionHandler) where
+  explSet sp@(Space _ _ _ hMap spcPtr) ety handler = liftIO $ do
     explDestroy sp ety
     hPtr <- newCollisionHandler spcPtr handler ety
     modifyIORef' hMap (M.insert ety (Record hPtr handler))
 
-instance ExplDestroy IO (Space CollisionHandler) where
-  explDestroy (Space _ _ _ hMap _) ety = do
+instance (MonadIO m) => ExplDestroy m (Space CollisionHandler) where
+  explDestroy (Space _ _ _ hMap _) ety = liftIO $ do
     rd <- M.lookup ety <$> readIORef hMap
     forM_ rd$ \(Record c _) -> destroyCollisionHandler c >> modifyIORef' hMap (M.delete ety)
 
-instance ExplMembers IO (Space CollisionHandler) where
-  explMembers (Space _ _ _ hMap _) = U.fromList . M.keys <$> readIORef hMap
+instance (MonadIO m) => ExplMembers m (Space CollisionHandler) where
+  explMembers (Space _ _ _ hMap _) = liftIO $ U.fromList . M.keys <$> readIORef hMap
 
-instance ExplGet IO (Space CollisionHandler) where
-  explExists (Space _ _ _ hMap _) ety = M.member ety <$> readIORef hMap
-  explGet (Space _ _ _ hMap _) ety = do
+instance (MonadIO m) => ExplGet m (Space CollisionHandler) where
+  explExists (Space _ _ _ hMap _) ety = liftIO $ M.member ety <$> readIORef hMap
+  explGet (Space _ _ _ hMap _) ety = liftIO $ do
     Just (Record _ handler) <- M.lookup ety <$> readIORef hMap
     return handler
 
+-- | Add an action that will be executed after the physics engine is done processing the current step. Since you generally cannot modify the physics space while the engine is handling collisions, 'addPostStepCallback' is the primary way of making changes to the physics space with a 'CollisionHandler' in a safe manner.
+-- Please note that you should only use this function for callbacks in conjunction with a 'CollisionHandler'!
+addPostStepCallback :: (Has w m Physics, MonadIO m) => Int -> SystemT w IO () -> SystemT w m ()
+addPostStepCallback (toEnum -> k) systemCallback= do
+  w <- ask
+  let callback _ _ _ = runSystem systemCallback w
+  (Space _ _ _ _ spcPtr) :: Space Physics <- getStore
+  liftIO $ withForeignPtr spcPtr $ \space -> do
+    funPtr <- liftIO$ $(C.mkFunPtr [t| Ptr FrnSpace -> Ptr () -> Ptr () -> IO () |]) callback
+    let fn = castFunPtrToPtr funPtr
+    [C.block| void {
+      int *data = 0;
+      cpSpaceAddPostStepCallback($(cpSpace *space), $(void*fn),$(int k), &data);
+    } |]
+  pure ()
diff --git a/src/Apecs/Physics/Constraint.hs b/src/Apecs/Physics/Constraint.hs
--- a/src/Apecs/Physics/Constraint.hs
+++ b/src/Apecs/Physics/Constraint.hs
@@ -20,6 +20,7 @@
 import           Apecs
 import           Apecs.Core
 import           Control.Monad
+import           Control.Monad.IO.Class (liftIO, MonadIO)
 import qualified Data.IntMap         as M
 import qualified Data.IntSet         as S
 import           Data.IORef
@@ -146,11 +147,11 @@
 instance Component Constraint where
   type Storage Constraint = Space Constraint
 
-instance Has w IO Physics => Has w IO Constraint where
+instance (MonadIO m, Has w m Physics) => Has w m Constraint where
   getStore = (cast :: Space Physics -> Space Constraint) <$> getStore
 
-instance ExplSet IO (Space Constraint) where
-  explSet sp@(Space bMap _ cMap _ spcPtr) cEty cons@(Constraint (Entity bEtyA) (Entity bEtyB) ctype) = do
+instance MonadIO m => ExplSet m (Space Constraint) where
+  explSet sp@(Space bMap _ cMap _ spcPtr) cEty cons@(Constraint (Entity bEtyA) (Entity bEtyB) ctype) = liftIO $ do
     explDestroy sp cEty
     mBrA <- M.lookup bEtyA <$> readIORef bMap
     mBrB <- M.lookup bEtyB <$> readIORef bMap
@@ -164,8 +165,8 @@
 
       _ -> return ()
 
-instance ExplDestroy IO (Space Constraint) where
-  explDestroy (Space bMap _ cMap _ spc) cEty = do
+instance MonadIO m => ExplDestroy m (Space Constraint) where
+  explDestroy (Space bMap _ cMap _ spc) cEty = liftIO $ do
     rd <- M.lookup cEty <$> readIORef cMap
     forM_ rd $ \(Record cPtr (Constraint (Entity bEtyA) (Entity bEtyB) _)) -> do
       bMap' <- readIORef bMap
@@ -175,12 +176,12 @@
       modifyIORef' cMap $ M.delete cEty
       destroyConstraint spc cPtr
 
-instance ExplMembers IO (Space Constraint) where
-  explMembers (Space _ _ cMap _ _) = U.fromList . M.keys <$> readIORef cMap
+instance MonadIO m => ExplMembers m (Space Constraint) where
+  explMembers (Space _ _ cMap _ _) = liftIO $ U.fromList . M.keys <$> readIORef cMap
 
-instance ExplGet IO (Space Constraint) where
-  explExists (Space _ _ cMap _ _) ety = M.member ety <$> readIORef cMap
-  explGet    (Space _ _ cMap _ _) ety = do
+instance MonadIO m => ExplGet m (Space Constraint) where
+  explExists (Space _ _ cMap _ _) ety = liftIO $ M.member ety <$> readIORef cMap
+  explGet    (Space _ _ cMap _ _) ety = liftIO $ do
     Just (Record _ cons)  <- M.lookup ety <$> readIORef cMap
     return cons
 
@@ -194,22 +195,22 @@
 instance Component MaxForce where
   type Storage MaxForce = Space MaxForce
 
-instance Has w IO Physics => Has w IO MaxForce where
+instance (MonadIO m, Has w m Physics) => Has w m MaxForce where
   getStore = (cast :: Space Physics -> Space MaxForce) <$> getStore
 
-instance ExplMembers IO (Space MaxForce) where
+instance MonadIO m => ExplMembers m (Space MaxForce) where
   explMembers s = explMembers (cast s :: Space Constraint)
 
-instance ExplSet IO (Space MaxForce) where
-  explSet (Space _ _ cMap _ _) ety (MaxForce vec) = do
+instance MonadIO m => ExplSet m (Space MaxForce) where
+  explSet (Space _ _ cMap _ _) ety (MaxForce vec) = liftIO $ do
     rd <- M.lookup ety <$> readIORef cMap
     case rd of
       Nothing -> return ()
       Just (Record c _) -> setMaxForce c vec
 
-instance ExplGet IO (Space MaxForce) where
+instance MonadIO m => ExplGet m (Space MaxForce) where
   explExists s ety = explExists (cast s :: Space Constraint) ety
-  explGet (Space _ _ cMap _ _) ety = do
+  explGet (Space _ _ cMap _ _) ety = liftIO $ do
     Just (Record c _) <- M.lookup ety <$> readIORef cMap
     MaxForce <$> getMaxForce c
 
@@ -225,28 +226,28 @@
 instance Component MaxBias where
   type Storage MaxBias = Space MaxBias
 
-instance Has w IO Physics => Has w IO MaxBias where
+instance (MonadIO m, Has w m Physics) => Has w m MaxBias where
   getStore = (cast :: Space Physics -> Space MaxBias) <$> getStore
 
-instance ExplMembers IO (Space MaxBias) where
+instance MonadIO m => ExplMembers m (Space MaxBias) where
   explMembers s = explMembers (cast s :: Space Constraint)
 
-instance ExplSet IO (Space MaxBias) where
-  explSet (Space _ _ cMap _ _) ety (MaxBias vec) = do
+instance MonadIO m => ExplSet m (Space MaxBias) where
+  explSet (Space _ _ cMap _ _) ety (MaxBias vec) = liftIO $ do
     rd <- M.lookup ety <$> readIORef cMap
     case rd of
       Nothing -> return ()
       Just (Record c _) -> setMaxBias c vec
 
-instance ExplGet IO (Space MaxBias) where
-  explGet (Space _ _ cMap _ _) ety = do
+instance MonadIO m => ExplGet m (Space MaxBias) where
+  explGet (Space _ _ cMap _ _) ety = liftIO $ do
     Just (Record c _) <- M.lookup ety <$> readIORef cMap
     MaxBias <$> getMaxBias c
   explExists s ety = explExists (cast s :: Space Constraint) ety
 
 -- ErrorBias
 getErrorBias :: Ptr Constraint -> IO Double
-getErrorBias c = do
+getErrorBias c = liftIO $ do
   errorBias <- [C.exp| double { cpConstraintGetErrorBias ($(cpConstraint* c)) } |]
   return (realToFrac errorBias)
 
@@ -256,22 +257,22 @@
 instance Component ErrorBias where
   type Storage ErrorBias = Space ErrorBias
 
-instance Has w IO Physics => Has w IO ErrorBias where
+instance (MonadIO m, Has w m Physics) => Has w m ErrorBias where
   getStore = (cast :: Space Physics -> Space ErrorBias) <$> getStore
 
-instance ExplMembers IO (Space ErrorBias) where
+instance MonadIO m => ExplMembers m (Space ErrorBias) where
   explMembers s = explMembers (cast s :: Space Constraint)
 
-instance ExplSet IO (Space ErrorBias) where
-  explSet (Space _ _ cMap _ _) ety (ErrorBias vec) = do
+instance MonadIO m => ExplSet m (Space ErrorBias) where
+  explSet (Space _ _ cMap _ _) ety (ErrorBias vec) = liftIO $ do
     rd <- M.lookup ety <$> readIORef cMap
     case rd of
       Nothing -> return ()
       Just (Record c _) -> setErrorBias c vec
 
-instance ExplGet IO (Space ErrorBias) where
+instance MonadIO m => ExplGet m (Space ErrorBias) where
   explExists s ety = explExists (cast s :: Space Constraint) ety
-  explGet (Space _ _ cMap _ _) ety = do
+  explGet (Space _ _ cMap _ _) ety = liftIO $ do
     Just (Record c _) <- M.lookup ety <$> readIORef cMap
     ErrorBias <$> getErrorBias c
 
@@ -282,15 +283,15 @@
 instance Component Impulse where
   type Storage Impulse = Space Impulse
 
-instance Has w IO Physics => Has w IO Impulse where
+instance (MonadIO m, Has w m Physics) => Has w m Impulse where
   getStore = (cast :: Space Physics -> Space Impulse) <$> getStore
 
-instance ExplMembers IO (Space Impulse) where
+instance MonadIO m => ExplMembers m (Space Impulse) where
   explMembers s = explMembers (cast s :: Space Constraint)
 
-instance ExplGet IO (Space Impulse) where
+instance MonadIO m => ExplGet m (Space Impulse) where
   explExists s ety = explExists (cast s :: Space Constraint) ety
-  explGet (Space _ _ cMap _ _) ety = do
+  explGet (Space _ _ cMap _ _) ety = liftIO $ do
     Just (Record c _) <- M.lookup ety <$> readIORef cMap
     Impulse <$> getImpulse c
 
@@ -306,21 +307,21 @@
 instance Component CollideBodies where
   type Storage CollideBodies = Space CollideBodies
 
-instance Has w IO Physics => Has w IO CollideBodies where
+instance (MonadIO m, Has w m Physics) => Has w m CollideBodies where
   getStore = (cast :: Space Physics -> Space CollideBodies) <$> getStore
 
-instance ExplMembers IO (Space CollideBodies) where
+instance MonadIO m => ExplMembers m (Space CollideBodies) where
   explMembers s = explMembers (cast s :: Space Constraint)
 
-instance ExplSet IO (Space CollideBodies) where
-  explSet (Space _ _ cMap _ _) ety (CollideBodies vec) = do
+instance MonadIO m => ExplSet m (Space CollideBodies) where
+  explSet (Space _ _ cMap _ _) ety (CollideBodies vec) = liftIO $ do
     rd <- M.lookup ety <$> readIORef cMap
     case rd of
       Nothing -> return ()
       Just (Record c _) -> setCollideBodies c vec
 
-instance ExplGet IO (Space CollideBodies) where
+instance MonadIO m => ExplGet m (Space CollideBodies) where
   explExists s ety = explExists (cast s :: Space Constraint) ety
-  explGet (Space _ _ cMap _ _) ety = do
+  explGet (Space _ _ cMap _ _) ety = liftIO $ do
     Just (Record c _) <- M.lookup ety <$> readIORef cMap
     CollideBodies <$> getCollideBodies c
diff --git a/src/Apecs/Physics/Query.hs b/src/Apecs/Physics/Query.hs
--- a/src/Apecs/Physics/Query.hs
+++ b/src/Apecs/Physics/Query.hs
@@ -16,6 +16,7 @@
 module Apecs.Physics.Query where
 
 import           Apecs
+import           Control.Monad.IO.Class (liftIO, MonadIO)
 import           Foreign.C.Types
 import           Foreign.ForeignPtr    (withForeignPtr)
 import           Foreign.Marshal.Alloc
@@ -34,7 +35,7 @@
 -- cpFloat cpShapeNearestPointQuery(cpShape *shape, cpVect p, cpPointQueryInfo *out)
 -- cpShape *cpSpacePointQueryNearest(cpSpace *space, cpVect point, cpFloat maxDistance, cpShapeFilter filter, cpPointQueryInfo *out)
 
-pointQuery :: Has w IO Physics => WVec -> Double -> CollisionFilter -> System w (Maybe PointQueryResult)
+pointQuery :: (MonadIO m, Has w m Physics) => WVec -> Double -> CollisionFilter -> SystemT w m (Maybe PointQueryResult)
 pointQuery (fmap realToFrac -> V2 px py) (realToFrac -> maxDistance) (CollisionFilter gr (Bitmask cs) (Bitmask mk)) = do
   Space _ _ _ _ spcPtr :: Space Physics <- getStore
   liftIO $ alloca $ \pq -> do
diff --git a/src/Apecs/Physics/Shape.hs b/src/Apecs/Physics/Shape.hs
--- a/src/Apecs/Physics/Shape.hs
+++ b/src/Apecs/Physics/Shape.hs
@@ -14,6 +14,7 @@
 
 import           Apecs.Core
 import           Control.Monad
+import           Control.Monad.IO.Class (liftIO, MonadIO)
 import           Data.Bits
 import qualified Data.IntMap          as M
 import qualified Data.IntSet          as S
@@ -56,14 +57,14 @@
 instance Component Shape where
   type Storage Shape = Space Shape
 
-instance Has w IO Physics => Has w IO Shape where
+instance (MonadIO m, Has w m Physics) => Has w m Shape where
   getStore = (cast :: Space Physics -> Space Shape) <$> getStore
 
-instance ExplMembers IO (Space Shape) where
-  explMembers (Space _ sMap _ _ _) = U.fromList . M.keys <$> readIORef sMap
+instance MonadIO m => ExplMembers m (Space Shape) where
+  explMembers (Space _ sMap _ _ _) = liftIO $ U.fromList . M.keys <$> readIORef sMap
 
-instance ExplDestroy IO (Space Shape) where
-  explDestroy (Space bMap sMap _ _ spc) sEty = do
+instance MonadIO m => ExplDestroy m (Space Shape) where
+  explDestroy (Space bMap sMap _ _ spc) sEty = liftIO $ do
     rd <- M.lookup sEty <$> readIORef sMap
     forM_ rd $ \(Record sPtr (Shape (Entity bEty) _)) -> do
       rd <- M.lookup bEty <$> readIORef bMap
@@ -71,8 +72,8 @@
       modifyIORef' sMap (M.delete sEty)
       destroyShape spc sPtr
 
-instance ExplSet IO (Space Shape) where
-  explSet sp@(Space bMap sMap _ _ spcPtr) sEty shape@(Shape (Entity bEty) sh) = do
+instance MonadIO m => ExplSet m (Space Shape) where
+  explSet sp@(Space bMap sMap _ _ spcPtr) sEty shape@(Shape (Entity bEty) sh) = liftIO $ do
     explDestroy sp sEty
     rd <- M.lookup bEty <$> readIORef bMap
     forM_ rd $ \bRec -> do
@@ -80,11 +81,11 @@
       modifyIORef' (brShapes bRec) (S.insert sEty)
       modifyIORef' sMap (M.insert sEty (Record shPtr shape))
 
-instance ExplGet IO (Space Shape) where
-  explGet    (Space _ sMap _ _ _) ety = do
+instance MonadIO m => ExplGet m (Space Shape) where
+  explGet    (Space _ sMap _ _ _) ety = liftIO $ do
     Just (Record _ s) <- M.lookup ety <$> readIORef sMap
     return s
-  explExists (Space _ sMap _ _ _) ety = M.member ety <$> readIORef sMap
+  explExists (Space _ sMap _ _ _) ety = liftIO $ M.member ety <$> readIORef sMap
 
 newShape :: SpacePtr -> Ptr Body -> Convex -> Int -> IO (Ptr Shape)
 newShape spacePtr' bodyPtr shape (fromIntegral -> ety) = withForeignPtr spacePtr' (go shape)
@@ -108,7 +109,7 @@
 
     go (Convex ((fmap.fmap) realToFrac -> verts)
                (realToFrac -> radius)
-       ) spacePtr = do
+       ) spacePtr = liftIO $ do
          vec <- V.thaw (V.fromList verts)
          [C.block| cpShape* {
            cpTransform trans = cpTransformIdentity;
@@ -133,20 +134,20 @@
 
 instance Component Sensor where
   type Storage Sensor = Space Sensor
-instance Has w IO Physics => Has w IO Sensor where
+instance (MonadIO m, Has w m Physics) => Has w m Sensor where
   getStore = (cast :: Space Physics -> Space Sensor) <$> getStore
 
-instance ExplMembers IO (Space Sensor) where
+instance MonadIO m => ExplMembers m (Space Sensor) where
   explMembers s = explMembers (cast s :: Space Shape)
 
-instance ExplSet IO (Space Sensor) where
-  explSet (Space _ sMap _ _ _) ety (Sensor isSensor) = do
+instance MonadIO m => ExplSet m (Space Sensor) where
+  explSet (Space _ sMap _ _ _) ety (Sensor isSensor) = liftIO $ do
     rd <- M.lookup ety <$> readIORef sMap
     forM_ rd$ \(Record s _) -> setSensor s isSensor
 
-instance ExplGet IO (Space Sensor) where
-  explExists s ety = explExists (cast s :: Space Shape) ety
-  explGet (Space _ sMap _ _ _) ety = do
+instance MonadIO m => ExplGet m (Space Sensor) where
+  explExists s ety = liftIO $ explExists (cast s :: Space Shape) ety
+  explGet (Space _ sMap _ _ _) ety = liftIO $ do
     Just (Record s _) <- M.lookup ety <$> readIORef sMap
     Sensor <$> getSensor s
 
@@ -161,20 +162,20 @@
 
 instance Component Elasticity where
   type Storage Elasticity = Space Elasticity
-instance Has w IO Physics => Has w IO Elasticity where
+instance (MonadIO m, Has w m Physics) => Has w m Elasticity where
   getStore = (cast :: Space Physics -> Space Elasticity) <$> getStore
 
-instance ExplMembers IO (Space Elasticity) where
+instance MonadIO m => ExplMembers m (Space Elasticity) where
   explMembers s = explMembers (cast s :: Space Shape)
 
-instance ExplSet IO (Space Elasticity) where
-  explSet (Space _ sMap _ _ _) ety (Elasticity elasticity) = do
+instance MonadIO m => ExplSet m (Space Elasticity) where
+  explSet (Space _ sMap _ _ _) ety (Elasticity elasticity) = liftIO $ do
     rd <- M.lookup ety <$> readIORef sMap
     forM_ rd$ \(Record s _) -> setElasticity s elasticity
 
-instance ExplGet IO (Space Elasticity) where
-  explExists s ety = explExists (cast s :: Space Shape) ety
-  explGet (Space _ sMap _ _ _) ety = do
+instance MonadIO m => ExplGet m (Space Elasticity) where
+  explExists s ety = liftIO $ explExists (cast s :: Space Shape) ety
+  explGet (Space _ sMap _ _ _) ety = liftIO $ do
     Just (Record s _) <- M.lookup ety <$> readIORef sMap
     Elasticity <$> getElasticity s
 
@@ -189,20 +190,20 @@
 
 instance Component Mass where
   type Storage Mass = Space Mass
-instance Has w IO Physics => Has w IO Mass where
+instance (MonadIO m, Has w m Physics) => Has w m Mass where
   getStore = (cast :: Space Physics -> Space Mass) <$> getStore
 
-instance ExplMembers IO (Space Mass) where
+instance MonadIO m => ExplMembers m (Space Mass) where
   explMembers s = explMembers (cast s :: Space Shape)
 
-instance ExplSet IO (Space Mass) where
-  explSet (Space _ sMap _ _ _) ety (Mass mass) = do
+instance MonadIO m => ExplSet m (Space Mass) where
+  explSet (Space _ sMap _ _ _) ety (Mass mass) = liftIO $ do
     rd <- M.lookup ety <$> readIORef sMap
     forM_ rd$ \(Record s _) -> setMass s mass
 
-instance ExplGet IO (Space Mass) where
-  explExists s ety = explExists (cast s :: Space Shape) ety
-  explGet (Space _ sMap _ _ _) ety = do
+instance MonadIO m => ExplGet m (Space Mass) where
+  explExists s ety = liftIO $ explExists (cast s :: Space Shape) ety
+  explGet (Space _ sMap _ _ _) ety = liftIO $ do
     Just (Record s _) <- M.lookup ety <$> readIORef sMap
     Mass <$> getMass s
 
@@ -217,20 +218,20 @@
 
 instance Component Density where
   type Storage Density = Space Density
-instance Has w IO Physics => Has w IO Density where
+instance (MonadIO m, Has w m Physics) => Has w m Density where
   getStore = (cast :: Space Physics -> Space Density) <$> getStore
 
-instance ExplMembers IO (Space Density) where
+instance MonadIO m => ExplMembers m (Space Density) where
   explMembers s = explMembers (cast s :: Space Shape)
 
-instance ExplSet IO (Space Density) where
-  explSet (Space _ sMap _ _ _) ety (Density density) = do
+instance MonadIO m => ExplSet m (Space Density) where
+  explSet (Space _ sMap _ _ _) ety (Density density) = liftIO $ do
     rd <- M.lookup ety <$> readIORef sMap
     forM_ rd$ \(Record s _) -> setDensity s density
 
-instance ExplGet IO (Space Density) where
-  explExists s ety = explExists (cast s :: Space Shape) ety
-  explGet (Space _ sMap _ _ _) ety = do
+instance MonadIO m => ExplGet m (Space Density) where
+  explExists s ety = liftIO $ explExists (cast s :: Space Shape) ety
+  explGet (Space _ sMap _ _ _) ety = liftIO $ do
     Just (Record s _) <- M.lookup ety <$> readIORef sMap
     Density <$> getDensity s
 
@@ -245,20 +246,20 @@
 
 instance Component Friction where
   type Storage Friction = Space Friction
-instance Has w IO Physics => Has w IO Friction where
+instance (MonadIO m, Has w m Physics) => Has w m Friction where
   getStore = (cast :: Space Physics -> Space Friction) <$> getStore
 
-instance ExplMembers IO (Space Friction) where
+instance MonadIO m => ExplMembers m (Space Friction) where
   explMembers s = explMembers (cast s :: Space Shape)
 
-instance ExplSet IO (Space Friction) where
-  explSet (Space _ sMap _ _ _) ety (Friction friction) = do
+instance MonadIO m => ExplSet m (Space Friction) where
+  explSet (Space _ sMap _ _ _) ety (Friction friction) = liftIO $ do
     rd <- M.lookup ety <$> readIORef sMap
     forM_ rd$ \(Record s _) -> setFriction s friction
 
-instance ExplGet IO (Space Friction) where
-  explExists s ety = explExists (cast s :: Space Shape) ety
-  explGet (Space _ sMap _ _ _) ety = do
+instance MonadIO m => ExplGet m (Space Friction) where
+  explExists s ety = liftIO $ explExists (cast s :: Space Shape) ety
+  explGet (Space _ sMap _ _ _) ety = liftIO $ do
     Just (Record s _) <- M.lookup ety <$> readIORef sMap
     Friction <$> getFriction s
 
@@ -277,20 +278,20 @@
 
 instance Component SurfaceVelocity where
   type Storage SurfaceVelocity = Space SurfaceVelocity
-instance Has w IO Physics => Has w IO SurfaceVelocity where
+instance (MonadIO m, Has w m Physics) => Has w m SurfaceVelocity where
   getStore = (cast :: Space Physics -> Space SurfaceVelocity) <$> getStore
 
-instance ExplMembers IO (Space SurfaceVelocity) where
+instance MonadIO m => ExplMembers m (Space SurfaceVelocity) where
   explMembers s = explMembers (cast s :: Space Shape)
 
-instance ExplSet IO (Space SurfaceVelocity) where
-  explSet (Space _ sMap _ _ _) ety (SurfaceVelocity svel) = do
+instance MonadIO m => ExplSet m (Space SurfaceVelocity) where
+  explSet (Space _ sMap _ _ _) ety (SurfaceVelocity svel) = liftIO $ do
     rd <- M.lookup ety <$> readIORef sMap
     forM_ rd$ \(Record s _) -> setSurfaceVelocity s svel
 
-instance ExplGet IO (Space SurfaceVelocity) where
-  explExists s ety = explExists (cast s :: Space Shape) ety
-  explGet (Space _ sMap _ _ _) ety = do
+instance MonadIO m => ExplGet m (Space SurfaceVelocity) where
+  explExists s ety = liftIO $ explExists (cast s :: Space Shape) ety
+  explGet (Space _ sMap _ _ _) ety = liftIO $ do
     Just (Record s _) <- M.lookup ety <$> readIORef sMap
     SurfaceVelocity <$> getSurfaceVelocity s
 
@@ -313,20 +314,20 @@
 
 instance Component CollisionFilter where
   type Storage CollisionFilter = Space CollisionFilter
-instance Has w IO Physics => Has w IO CollisionFilter where
+instance (MonadIO m, Has w m Physics) => Has w m CollisionFilter where
   getStore = (cast :: Space Physics -> Space CollisionFilter) <$> getStore
 
-instance ExplMembers IO (Space CollisionFilter) where
+instance MonadIO m => ExplMembers m (Space CollisionFilter) where
   explMembers s = explMembers (cast s :: Space Shape)
 
-instance ExplSet IO (Space CollisionFilter) where
-  explSet (Space _ sMap _ _ _) ety cfilter = do
+instance MonadIO m => ExplSet m (Space CollisionFilter) where
+  explSet (Space _ sMap _ _ _) ety cfilter = liftIO $ do
     rd <- M.lookup ety <$> readIORef sMap
     forM_ rd$ \(Record s _) -> setFilter s cfilter
 
-instance ExplGet IO (Space CollisionFilter) where
-  explExists s ety = explExists (cast s :: Space Shape) ety
-  explGet (Space _ sMap _ _ _) ety = do
+instance MonadIO m => ExplGet m (Space CollisionFilter) where
+  explExists s ety = liftIO $ explExists (cast s :: Space Shape) ety
+  explGet (Space _ sMap _ _ _) ety = liftIO $ do
     Just (Record s _) <- M.lookup ety <$> readIORef sMap
     getFilter s
 
@@ -341,19 +342,19 @@
 
 instance Component CollisionType where
   type Storage CollisionType = Space CollisionType
-instance Has w IO Physics => Has w IO CollisionType where
+instance (MonadIO m, Has w m Physics) => Has w m CollisionType where
   getStore = (cast :: Space Physics -> Space CollisionType) <$> getStore
 
-instance ExplMembers IO (Space CollisionType) where
+instance MonadIO m => ExplMembers m (Space CollisionType) where
   explMembers s = explMembers (cast s :: Space Shape)
 
-instance ExplSet IO (Space CollisionType) where
-  explSet (Space _ sMap _ _ _) ety (CollisionType ctype) = do
+instance MonadIO m => ExplSet m (Space CollisionType) where
+  explSet (Space _ sMap _ _ _) ety (CollisionType ctype) = liftIO $ do
     rd <- M.lookup ety <$> readIORef sMap
     forM_ rd$ \(Record s _) -> setCollisionType s ctype
 
-instance ExplGet IO (Space CollisionType) where
-  explExists s ety = explExists (cast s :: Space Shape) ety
-  explGet (Space _ sMap _ _ _) ety = do
+instance MonadIO m => ExplGet m (Space CollisionType) where
+  explExists s ety = liftIO $ explExists (cast s :: Space Shape) ety
+  explGet (Space _ sMap _ _ _) ety = liftIO $ do
     Just (Record s _) <- M.lookup ety <$> readIORef sMap
     CollisionType <$> getCollisionType s
diff --git a/src/Apecs/Physics/Space.hs b/src/Apecs/Physics/Space.hs
--- a/src/Apecs/Physics/Space.hs
+++ b/src/Apecs/Physics/Space.hs
@@ -16,6 +16,7 @@
 
 import           Apecs
 import           Apecs.Core
+import           Control.Monad.IO.Class (liftIO, MonadIO)
 import           Data.IORef
 import           Foreign.Concurrent
 import           Foreign.ForeignPtr  (withForeignPtr)
@@ -37,7 +38,7 @@
 explStepPhysics spacePtr (realToFrac -> dT) = withForeignPtr spacePtr $ \space ->
   [C.exp| void { cpSpaceStep( $(cpSpace* space), $(double dT) ) } |]
 
-stepPhysics :: Has w IO Physics => Double -> System w ()
+stepPhysics :: MonadIO m => Has w m Physics => Double -> SystemT w m ()
 stepPhysics dT = do
   s :: Space Physics <- getStore
   liftIO$ explStepPhysics (spacePtr s) dT
@@ -47,8 +48,8 @@
 
 type instance Elem (Space Physics) = Physics
 
-instance ExplInit IO (Space Physics) where
-  explInit = do
+instance MonadIO m => ExplInit m (Space Physics) where
+  explInit = liftIO $ do
     spacePtr <- newSpace
     bRef     <- newIORef mempty
     sRef     <- newIORef mempty
@@ -75,16 +76,16 @@
 instance Component Gravity where
   type Storage Gravity = Space Gravity
 
-instance Has w IO Physics => Has w IO Gravity where
+instance (MonadIO m, Has w m Physics) => Has w m Gravity where
   getStore = (cast :: Space Physics -> Space Gravity) <$> getStore
 
 type instance Elem (Space Gravity) = Gravity
 
-instance ExplGet IO (Space Gravity) where
+instance MonadIO m => ExplGet m (Space Gravity) where
   explExists _ _  = return True
-  explGet (Space _ _ _ _ spcPtr) _ = Gravity <$> getGravity spcPtr
-instance ExplSet IO (Space Gravity) where
-  explSet (Space _ _ _ _ spcPtr) _ (Gravity v) = setGravity spcPtr v
+  explGet (Space _ _ _ _ spcPtr) _ = liftIO $ Gravity <$> getGravity spcPtr
+instance MonadIO m => ExplSet m (Space Gravity) where
+  explSet (Space _ _ _ _ spcPtr) _ (Gravity v) = liftIO $ setGravity spcPtr v
 
 -- Iterations
 getIterations :: SpacePtr -> IO Int
@@ -98,14 +99,13 @@
 instance Component Iterations where
   type Storage Iterations = Space Iterations
 
-instance Has w IO Physics => Has w IO Iterations where
+instance (MonadIO m, Has w m Physics) => Has w m Iterations where
   getStore = (cast :: Space Physics -> Space Iterations) <$> getStore
 
 type instance Elem (Space Iterations) = Iterations
 
-instance ExplGet IO (Space Iterations) where
+instance MonadIO m => ExplGet m (Space Iterations) where
   explExists _ _  = return False
-  explGet (Space _ _ _ _ spcPtr) _ = Iterations <$> getIterations spcPtr
-instance ExplSet IO (Space Iterations) where
-  explSet (Space _ _ _ _ spcPtr) _ (Iterations v) = setIterations spcPtr v
-
+  explGet (Space _ _ _ _ spcPtr) _ = liftIO $ Iterations <$> getIterations spcPtr
+instance MonadIO m => ExplSet m (Space Iterations) where
+  explSet (Space _ _ _ _ spcPtr) _ (Iterations v) = liftIO $ setIterations spcPtr v