apecs-physics 0.4.2 → 0.4.3

raw patch · 9 files changed

+243/−214 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• apecs-physics.cabal +1/−1
• src/Apecs/Physics.hs +2/−2
• src/Apecs/Physics/Body.hs +73/−72
• src/Apecs/Physics/Collision.hs +36/−18
• src/Apecs/Physics/Constraint.hs +40/−39
• src/Apecs/Physics/Query.hs +2/−1
• src/Apecs/Physics/Shape.hs +68/−67
• src/Apecs/Physics/Space.hs +14/−14

@@ -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`

@@ -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

@@ -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).

@@ -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

@@ -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 ()

@@ -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

@@ -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

@@ -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

@@ -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