From f1939232bec72fffede16a55119bc7c4fb3057cf Mon Sep 17 00:00:00 2001
From: 3gg <3gg@shellblade.net>
Date: Mon, 30 Dec 2024 19:14:12 -0800
Subject: Simplify Game monad.

---
 Demos/Pong/Main.hs            |  18 ++---
 Spear/App.hs                  |  26 +++----
 Spear/Assets/Image.hsc        |  18 ++---
 Spear/Assets/Model.hsc        |  60 +++++++--------
 Spear/GL.hs                   |  42 +++++------
 Spear/Game.hs                 | 172 +++++++++++++++++++++---------------------
 Spear/Render/AnimatedModel.hs |  13 ++--
 Spear/Render/Core/Buffer.hs   |  10 +--
 Spear/Render/Core/Geometry.hs |  12 +--
 Spear/Render/Core/Shader.hs   |  32 ++++----
 Spear/Render/Core/State.hs    |   8 +-
 Spear/Render/Immediate.hs     |  38 +++++-----
 Spear/Render/StaticModel.hs   |  13 ++--
 Spear/Scene/Loader.hs         |  14 ++--
 Spear/Window.hs               |   6 +-
 15 files changed, 238 insertions(+), 244 deletions(-)

diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs
index de8e6f2..df90020 100644
--- a/Demos/Pong/Main.hs
+++ b/Demos/Pong/Main.hs
@@ -41,16 +41,16 @@ initGame window = do
 
 endGame :: Game GameState ()
 endGame = do
-  game <- getGameState
+  game <- get
   runSubGame' (deleteImmRenderer $ immRenderState game) (renderCoreState game)
 
 
 step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
 step elapsed dt inputEvents = do
-  gs <- getGameState
+  gs <- get
   events <- processInput (window gs)
-  --when (events /= []) $ gameIO . putStrLn $ show events
-  modifyGameState $ \gs ->
+  --when (events /= []) $ liftIO . putStrLn $ show events
+  modify $ \gs ->
     gs
       { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gs)
       }
@@ -67,18 +67,18 @@ exitRequested = elem (KeyDown KEY_ESC)
 
 render :: Game GameState ()
 render = do
-  gameState <- getGameState
+  gameState <- get
   immRenderState' <- flip execSubGame (immRenderState gameState) $ do
     immStart
     immSetViewProjectionMatrix (viewProjection gameState)
     -- Clear the background to a different colour than the playable area to make
     -- the latter distinguishable.
-    gameIO $ do
+    liftIO $ do
       setClearColour (0.2, 0.2, 0.2, 0.0)
       clearBuffers [ColourBuffer]
     render' $ world gameState
     immEnd
-  saveGameState $ gameState { immRenderState = immRenderState' }
+  put $ gameState { immRenderState = immRenderState' }
 
 render' :: [GameObject] -> Game ImmRenderState ()
 render' world = do
@@ -122,7 +122,7 @@ resize (ResizeEvent w h) =
       bottom = if r > 1 then 0 else -pad
       top    = if r > 1 then 1 else 1 + pad
   in do
-    gameIO $ setViewport 0 0 w h
-    modifyGameState $ \state -> state {
+    liftIO $ setViewport 0 0 w h
+    modify $ \state -> state {
       viewProjection = Matrix4.ortho left right bottom top (-1) 1
     }
diff --git a/Spear/App.hs b/Spear/App.hs
index 61ea3b1..1520eee 100644
--- a/Spear/App.hs
+++ b/Spear/App.hs
@@ -76,15 +76,15 @@ loop :: App s -> Window -> Game s ()
 loop app window = do
   -- For convenience, trigger an initial resize followed by a render of the
   -- application's initial state.
-  (width, height) <- gameIO $ getWindowSize window
+  (width, height) <- liftIO $ getWindowSize window
   resizeApp app (ResizeEvent width height)
   renderApp app
 
   let ddt          = fpsToDdt .       maxFPS . appOptions $ app -- Desired render time step.
   let animationDdt = fpsToDdt . animationFPS . appOptions $ app -- Desired animation time step.
 
-  timer <- gameIO newTimer
-  gameIO $ Timer.start timer
+  timer <- liftIO newTimer
+  liftIO $ Timer.start timer
   let lastAnimationTime = lastTick timer
   loop' window ddt animationDdt lastAnimationTime timer app
 
@@ -97,16 +97,16 @@ loop' ::
   App s ->
   Game s ()
 loop' window renderDdt animationDdt lastAnimationTime inputTimer app = do
-  timer        <- gameIO $ tick inputTimer
-  windowEvents <- gameIO $ pollWindowEvents window
-  close        <- gameIO $ shouldWindowClose window
+  timer        <- liftIO $ tick inputTimer
+  windowEvents <- liftIO $ pollWindowEvents window
+  close        <- liftIO $ shouldWindowClose window
 
   (continue, lastAnimationTimeNextFrame) <- case animationDdt of
     0 -> do
       -- Variable time step game animation.
       let t  = timeDeltaToSec $ runningTime timer
       let dt = timeDeltaToSec $ deltaTime   timer
-      inputEvents <- gameIO $ pollInputEvents window
+      inputEvents <- liftIO $ pollInputEvents window
       continue <- stepApp app t dt inputEvents
       return (continue, lastAnimationTime)
 
@@ -118,15 +118,15 @@ loop' window renderDdt animationDdt lastAnimationTime inputTimer app = do
       let timeBudgetThisFrame = timeBudget + deltaTime timer
       let timeBudgetNextFrame = timeBudgetThisFrame `mod` ddt
       let steps = timeBudgetThisFrame `div` ddt -}
-      --gameIO . print $ "Steps: " ++ show steps ++ ", Budget: " ++ show timeBudgetThisFrame ++ ", ddt: " ++ show ddt
+      --liftIO . print $ "Steps: " ++ show steps ++ ", Budget: " ++ show timeBudgetThisFrame ++ ", ddt: " ++ show ddt
       let elapsed = runningTime timer
       let dt = timeDeltaToSec ddt
       let timeBudgetThisFrame = timeDiff lastAnimationTime (lastTick timer)
       let steps = timeBudgetThisFrame `div` ddt
       let lastAnimationTimeNextFrame = timeAdd lastAnimationTime (steps * ddt)
-      --gameIO . print $ "Steps: " ++ show steps ++ ", Budget: " ++ show timeBudgetThisFrame ++ ", ddt: " ++ show ddt
+      --liftIO . print $ "Steps: " ++ show steps ++ ", Budget: " ++ show timeBudgetThisFrame ++ ", ddt: " ++ show ddt
       continue <- and <$> forM [1..steps] (\i -> do
-        inputEvents <- gameIO $ pollInputEvents window
+        inputEvents <- liftIO $ pollInputEvents window
         let t = timeDeltaToSec $ elapsed + i * ddt
         stepApp app t dt inputEvents)
       return (continue, lastAnimationTimeNextFrame)
@@ -138,16 +138,16 @@ loop' window renderDdt animationDdt lastAnimationTime inputTimer app = do
   -- For smoother resizing, render only while not resizing.
   unless resized $ do
     renderApp app
-    gameIO $ swapBuffers window
+    liftIO $ swapBuffers window
 
   -- Limit frame rate if so requested by the application.
   -- This currently makes the rendering stutter and is not very desirable.
   when ((maxFPS . appOptions $ app) > 0) $ do
-    frameEnd <- gameIO now
+    frameEnd <- liftIO now
     let ddt = renderDdt
     let frameTime = timeDiff (lastTick timer) frameEnd
     when (frameTime < ddt) $ do
-      gameIO $ Timer.sleep (ddt - frameTime)
+      liftIO $ Timer.sleep (ddt - frameTime)
 
   when (continue && not close) $ do
     loop' window renderDdt animationDdt lastAnimationTimeNextFrame timer app
diff --git a/Spear/Assets/Image.hsc b/Spear/Assets/Image.hsc
index f9fc025..db90afe 100644
--- a/Spear/Assets/Image.hsc
+++ b/Spear/Assets/Image.hsc
@@ -46,24 +46,24 @@ data CImage = CImage
 instance Storable CImage where
     sizeOf _    = #{size Image}
     alignment _ = alignment (undefined :: CInt)
-    
+
     peek ptr = do
         width  <- #{peek Image, width}  ptr
         height <- #{peek Image, height} ptr
         bpp    <- #{peek Image, bpp}    ptr
         pixels <- #{peek Image, pixels} ptr
         return $ CImage width height bpp pixels
-    
+
     poke ptr (CImage width height bpp pixels) = do
         #{poke Image, width}  ptr width
         #{poke Image, height} ptr height
         #{poke Image, bpp}    ptr bpp
         #{poke Image, pixels} ptr pixels
 
--- | Represents an image 'Resource'.
+-- | An image resource.
 data Image = Image
     { imageData :: CImage
-    , rkey      :: Resource
+    , rkey      :: ReleaseKey
     }
 
 instance ResourceClass Image where
@@ -84,15 +84,15 @@ loadImage file = do
     dotPos <- case elemIndex '.' file of
             Nothing -> gameError $ "file name has no extension: " ++ file
             Just p  -> return p
-    
+
     let ext = map toLower . tail . snd $ splitAt dotPos file
-    
-    result <- gameIO . alloca $ \ptr -> do
+
+    result <- liftIO . alloca $ \ptr -> do
         status <- withCString file $ \fileCstr -> do
             case ext of
                 "bmp" -> bmp_load fileCstr ptr
                 _     -> return ImageNoSuitableLoader
-        
+
         case status of
             ImageSuccess               -> peek ptr >>= return . Right
             ImageReadError             -> return . Left $ "read error"
@@ -100,7 +100,7 @@ loadImage file = do
             ImageFileNotFound          -> return . Left $ "file not found"
             ImageInvalidFormat         -> return . Left $ "invalid format"
             ImageNoSuitableLoader      -> return . Left $ "no suitable loader for extension " ++ ext
-        
+
     case result of
         Right image -> register (freeImage image) >>= return . Image image
         Left  err   -> gameError $ "loadImage: " ++ err
diff --git a/Spear/Assets/Model.hsc b/Spear/Assets/Model.hsc
index 74666f2..02e1edf 100644
--- a/Spear/Assets/Model.hsc
+++ b/Spear/Assets/Model.hsc
@@ -65,12 +65,12 @@ data Vec2 = Vec2 {-# UNPACK #-} !Float {-# UNPACK #-} !Float
 instance Storable Vec2 where
     sizeOf _ = 2*sizeFloat
     alignment _ = alignment (undefined :: CFloat)
-    
+
     peek ptr = do
         f0 <- peekByteOff ptr 0
         f1 <- peekByteOff ptr sizeFloat
         return $ Vec2 f0 f1
-    
+
     poke ptr (Vec2 f0 f1) = do
         pokeByteOff ptr 0         f0
         pokeByteOff ptr sizeFloat f1
@@ -81,13 +81,13 @@ data Vec3 = Vec3 {-# UNPACK #-} !Float {-# UNPACK #-} !Float {-# UNPACK #-} !Flo
 instance Storable Vec3 where
     sizeOf _ = 3*sizeFloat
     alignment _ = alignment (undefined :: CFloat)
-    
+
     peek ptr = do
         f0 <- peekByteOff ptr 0
         f1 <- peekByteOff ptr sizeFloat
         f2 <- peekByteOff ptr (2*sizeFloat)
         return $ Vec3 f0 f1 f2
-    
+
     poke ptr (Vec3 f0 f1 f2) = do
         pokeByteOff ptr 0             f0
         pokeByteOff ptr sizeFloat     f1
@@ -99,12 +99,12 @@ data TexCoord = TexCoord {-# UNPACK #-} !Float {-# UNPACK #-} !Float
 instance Storable TexCoord where
     sizeOf _ = 2*sizeFloat
     alignment _ = alignment (undefined :: CFloat)
-    
+
     peek ptr = do
         f0 <- peekByteOff ptr 0
         f1 <- peekByteOff ptr sizeFloat
         return $ TexCoord f0 f1
-    
+
     poke ptr (TexCoord f0 f1) = do
         pokeByteOff ptr 0         f0
         pokeByteOff ptr sizeFloat f1
@@ -122,23 +122,23 @@ data CTriangle = CTriangle
 instance Storable CTriangle where
     sizeOf _ = #{size triangle}
     alignment _ = alignment (undefined :: CUShort)
-    
+
     peek ptr = do
         v0 <- #{peek triangle, vertexIndices[0]} ptr
         v1 <- #{peek triangle, vertexIndices[1]} ptr
         v2 <- #{peek triangle, vertexIndices[2]} ptr
-        
+
         t0 <- #{peek triangle, textureIndices[0]} ptr
         t1 <- #{peek triangle, textureIndices[1]} ptr
         t2 <- #{peek triangle, textureIndices[2]} ptr
-        
+
         return $ CTriangle v0 v1 v2 t0 t1 t2
-    
+
     poke ptr (CTriangle v0 v1 v2 t0 t1 t2) = do
         #{poke triangle, vertexIndices[0]} ptr v0
         #{poke triangle, vertexIndices[1]} ptr v1
         #{poke triangle, vertexIndices[2]} ptr v2
-        
+
         #{poke triangle, textureIndices[0]} ptr t0
         #{poke triangle, textureIndices[1]} ptr t1
         #{poke triangle, textureIndices[2]} ptr t2
@@ -149,7 +149,7 @@ data Box = Box {-# UNPACK #-} !Vec3 {-# UNPACK #-} !Vec3
 instance Storable Box where
     sizeOf _ = 6 * sizeFloat
     alignment _ = alignment (undefined :: CFloat)
-    
+
     peek ptr = do
         xmin <- peekByteOff ptr 0
         ymin <- peekByteOff ptr sizeFloat
@@ -158,7 +158,7 @@ instance Storable Box where
         ymax <- peekByteOff ptr $ 4*sizeFloat
         zmax <- peekByteOff ptr $ 5*sizeFloat
         return $ Box (Vec3 xmin ymin zmin) (Vec3 xmax ymax zmax)
-    
+
     poke ptr (Box (Vec3 xmin ymin zmin) (Vec3 xmax ymax zmax)) = do
         pokeByteOff ptr 0             xmin
         pokeByteOff ptr sizeFloat     ymin
@@ -173,11 +173,11 @@ newtype Skin = Skin { skinName :: B.ByteString }
 instance Storable Skin where
     sizeOf (Skin s) = 64
     alignment _ = 1
-    
+
     peek ptr = do
         s <- B.packCString $ unsafeCoerce ptr
         return $ Skin s
-    
+
     poke ptr (Skin s) = do
         B.useAsCStringLen s $ \(sptr, len) -> copyArray (unsafeCoerce ptr) sptr len
 
@@ -193,13 +193,13 @@ data Animation = Animation
 instance Storable Animation where
     sizeOf _    = #{size animation}
     alignment _ = alignment (undefined :: CUInt)
-    
+
     peek ptr = do
         name  <- B.packCString (unsafeCoerce ptr)
         start <- #{peek animation, start} ptr
         end   <- #{peek animation, end}   ptr
         return $ Animation name start end
-    
+
     poke ptr (Animation name start end) = do
         B.useAsCStringLen name $ \(sptr, len) -> copyArray (unsafeCoerce ptr) sptr len
         #{poke animation, start} ptr start
@@ -224,7 +224,7 @@ data Model = Model
 instance Storable Model where
     sizeOf _    = #{size Model}
     alignment _ = alignment (undefined :: CUInt)
-    
+
     peek ptr = do
         numFrames     <- #{peek Model, numFrames}     ptr
         numVertices   <- #{peek Model, numVertices}   ptr
@@ -232,7 +232,7 @@ instance Storable Model where
         numTexCoords  <- #{peek Model, numTexCoords}  ptr
         numSkins      <- #{peek Model, numSkins}      ptr
         numAnimations <- #{peek Model, numAnimations} ptr
-        pVerts        <- peek (unsafeCoerce ptr) 
+        pVerts        <- peek (unsafeCoerce ptr)
         pNormals      <- peekByteOff ptr sizePtr
         pTexCoords    <- peekByteOff ptr (2*sizePtr)
         pTriangles    <- peekByteOff ptr (3*sizePtr)
@@ -247,7 +247,7 @@ instance Storable Model where
         return $
             Model vertices normals texCoords triangles skins animations
                   numFrames numVertices numTriangles numTexCoords numSkins numAnimations
-    
+
     poke ptr
         (Model verts normals texCoords tris skins animations
          numFrames numVerts numTris numTex numSkins numAnimations) =
@@ -288,7 +288,7 @@ data Triangle = Triangle
 instance Storable Triangle where
     sizeOf _ = #{size model_triangle}
     alignment _ = alignment (undefined :: Float)
-    
+
     peek ptr = do
         v0 <- #{peek model_triangle, v0} ptr
         v1 <- #{peek model_triangle, v1} ptr
@@ -300,7 +300,7 @@ instance Storable Triangle where
         t1 <- #{peek model_triangle, t1} ptr
         t2 <- #{peek model_triangle, t2} ptr
         return $ Triangle v0 v1 v2 n0 n1 n2 t0 t1 t2
-    
+
     poke ptr (Triangle v0 v1 v2 n0 n1 n2 t0 t1 t2) = do
         #{poke model_triangle, v0} ptr v0
         #{poke model_triangle, v1} ptr v1
@@ -335,16 +335,16 @@ loadModel file = do
     dotPos <- case elemIndex '.' file of
             Nothing -> gameError $ "file name has no extension: " ++ file
             Just p  -> return p
-    
+
     let ext = map toLower . tail . snd $ splitAt dotPos file
-    
-    result <- gameIO . alloca $ \ptr -> do
+
+    result <- liftIO . alloca $ \ptr -> do
         status <- withCString file $ \fileCstr -> do
             case ext of
                 "md2" -> md2_load fileCstr 0 0 ptr
                 "obj" -> obj_load fileCstr 0 0 ptr
                 _     -> return ModelNoSuitableLoader
-        
+
         case status of
             ModelSuccess -> do
                 model <- peek ptr
@@ -355,7 +355,7 @@ loadModel file = do
             ModelFileNotFound           -> return . Left $ "file not found"
             ModelFileMismatch           -> return . Left $ "file mismatch"
             ModelNoSuitableLoader       -> return . Left $ "no suitable loader for extension " ++ ext
-    
+
     case result of
         Right model -> return model
         Left err    -> gameError $ "loadModel: " ++ err
@@ -392,7 +392,7 @@ transformVerts model f = model { vertices = vertices' }
     where
         n = numVerts model * numFrames model
         vertices' = S.generate n f'
-        f' i = f $ vertices model S.! i 
+        f' i = f $ vertices model S.! i
 
 -- | Transform the model's normals.
 transformNormals :: Model -> (Vec3 -> Vec3) -> Model
@@ -400,14 +400,14 @@ transformNormals model f = model { normals = normals' }
     where
         n = numVerts model * numFrames model
         normals' = S.generate n f'
-        f' i = f $ normals model S.! i 
+        f' i = f $ normals model S.! i
 
 -- | Translate the model such that its lowest point has y = 0.
 toGround :: Model -> IO Model
 toGround model =
     let model' = model { vertices = S.generate n $ \i -> vertices model S.! i }
         n = numVerts model * numFrames model
-    in    
+    in
         with model' model_to_ground >> return model'
 
 foreign import ccall "Model.h model_to_ground"
diff --git a/Spear/GL.hs b/Spear/GL.hs
index f463109..3c1734b 100644
--- a/Spear/GL.hs
+++ b/Spear/GL.hs
@@ -36,7 +36,7 @@ module Spear.GL
     Data.StateVar.get,
 
     -- * VAOs
-    VAO,
+    VAO(..),
     newVAO,
     bindVAO,
     unbindVAO,
@@ -48,7 +48,7 @@ module Spear.GL
     drawElements,
 
     -- * Buffers
-    GLBuffer,
+    GLBuffer(..),
     TargetBuffer (..),
     BufferUsage (..),
     newBuffer,
@@ -122,7 +122,7 @@ import           Unsafe.Coerce
 -- | A GLSL shader handle.
 data GLSLShader = GLSLShader
   { getShader    :: GLuint,
-    getShaderKey :: Resource
+    getShaderKey :: ReleaseKey
   }
 
 instance ResourceClass GLSLShader where
@@ -131,7 +131,7 @@ instance ResourceClass GLSLShader where
 -- | A GLSL program handle.
 data GLSLProgram = GLSLProgram
   { getProgram    :: GLuint,
-    getProgramKey :: Resource
+    getProgramKey :: ReleaseKey
   }
 
 instance ResourceClass GLSLProgram where
@@ -173,11 +173,11 @@ attribLocation prog var = makeStateVar get set
 -- | Create a new program.
 newProgram :: [GLSLShader] -> Game s GLSLProgram
 newProgram shaders = do
-  h <- gameIO glCreateProgram
+  h <- liftIO glCreateProgram
   when (h == 0) $ gameError "glCreateProgram failed"
   rkey <- register $ deleteProgram h
   let program = GLSLProgram h rkey
-  mapM_ (gameIO . attachShader program) shaders
+  mapM_ (liftIO . attachShader program) shaders
   linkProgram program
   return program
 
@@ -192,7 +192,7 @@ deleteProgram prog = do
 linkProgram :: GLSLProgram -> Game s ()
 linkProgram prog = do
   let h = getProgram prog
-  err <- gameIO $ do
+  err <- liftIO $ do
     glLinkProgram h
     alloca $ \statptr -> do
       glGetProgramiv h GL_LINK_STATUS statptr
@@ -235,7 +235,7 @@ loadShader shaderType file = do
 -- | Create a new shader.
 newShader :: ShaderType -> Game s GLSLShader
 newShader shaderType = do
-  h <- gameIO $ glCreateShader (toGLShader shaderType)
+  h <- liftIO $ glCreateShader (toGLShader shaderType)
   case h of
     0 -> gameError "glCreateShader failed"
     _ -> do
@@ -253,10 +253,10 @@ deleteShader shader = do
 -- into the shader.
 loadSource :: FilePath -> GLSLShader -> Game s ()
 loadSource file h = do
-  exists <- gameIO $ doesFileExist file
+  exists <- liftIO $ doesFileExist file
   case exists of
     False -> gameError "the specified shader file does not exist"
-    True -> gameIO $ do
+    True -> liftIO $ do
       code <- readSource file
       withCString code $ shaderSource h
 
@@ -272,10 +272,10 @@ compile file shader = do
   let h = getShader shader
 
   -- Compile
-  gameIO $ glCompileShader h
+  liftIO $ glCompileShader h
 
   -- Verify status
-  err <- gameIO $
+  err <- liftIO $
     alloca $ \statusPtr -> do
       glGetShaderiv h GL_COMPILE_STATUS statusPtr
       result <- peek statusPtr
@@ -438,7 +438,7 @@ instance Uniform [Int] where
 -- | A vertex array object.
 data VAO = VAO
   { getVAO :: GLuint,
-    vaoKey :: Resource
+    vaoKey :: ReleaseKey
   }
 
 instance ResourceClass VAO where
@@ -454,7 +454,7 @@ instance Ord VAO where
 -- | Create a new vao.
 newVAO :: Game s VAO
 newVAO = do
-  h <- gameIO . alloca $ \ptr -> do
+  h <- liftIO . alloca $ \ptr -> do
     glGenVertexArrays 1 ptr
     peek ptr
 
@@ -533,11 +533,11 @@ drawElements mode count t idxs = glDrawElements mode (unsafeCoerce count) t idxs
 -- | An OpenGL buffer.
 data GLBuffer = GLBuffer
   { getBuffer :: GLuint,
-    rkey      :: Resource
+    bufferKey :: ReleaseKey
   }
 
 instance ResourceClass GLBuffer where
-  getResource = rkey
+  getResource = bufferKey
 
 -- | The type of target buffer.
 data TargetBuffer
@@ -580,7 +580,7 @@ fromUsage DynamicCopy = GL_DYNAMIC_COPY
 -- | Create a new buffer.
 newBuffer :: Game s GLBuffer
 newBuffer = do
-  h <- gameIO . alloca $ \ptr -> do
+  h <- liftIO . alloca $ \ptr -> do
     glGenBuffers 1 ptr
     peek ptr
 
@@ -656,7 +656,7 @@ withGLBuffer buf f = f $ getBuffer buf
 -- | Represents a texture resource.
 data Texture = Texture
   { getTex :: GLuint,
-    texKey :: Resource
+    texKey :: ReleaseKey
   }
 
 instance Eq Texture where
@@ -672,7 +672,7 @@ instance ResourceClass Texture where
 -- | Create a new texture.
 newTexture :: Game s Texture
 newTexture = do
-  tex <- gameIO . alloca $ \ptr -> do
+  tex <- liftIO . alloca $ \ptr -> do
     glGenTextures 1 ptr
     peek ptr
 
@@ -697,7 +697,7 @@ loadTextureImage ::
 loadTextureImage file minFilter magFilter = do
   image <- loadImage file
   tex <- newTexture
-  gameIO $ do
+  liftIO $ do
     let w = width image
         h = height image
         pix = pixels image
@@ -794,7 +794,7 @@ printGLError =
 assertGL :: Game s a -> String -> Game s a
 assertGL action err = do
   result <- action
-  status <- gameIO getGLError
+  status <- liftIO getGLError
   case status of
     Just str -> gameError $ "OpenGL error raised: " ++ err ++ "; " ++ str
     Nothing  -> return result
diff --git a/Spear/Game.hs b/Spear/Game.hs
index 14e3f20..92cc680 100644
--- a/Spear/Game.hs
+++ b/Spear/Game.hs
@@ -1,130 +1,130 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Spear.Game
-  ( Game,
-    GameException (..),
-    Resource,
-    ResourceClass (..),
-
-    -- * Game state
-    getGameState,
-    saveGameState,
-    modifyGameState,
-
-    -- * Game resources
-    register,
-    release,
-    release',
-
-    -- * Error handling
-    gameError,
-    assertMaybe,
-    catchGameError,
-    catchGameErrorFinally,
-
-    -- * Running and IO
-    runGame,
-    evalGame,
-    runSubGame,
-    runSubGame',
-    evalSubGame,
-    execSubGame,
-    runSiblingGame,
-    runSiblingGame',
-    evalSiblingGame,
-    execSiblingGame,
-    gameIO,
-  )
+( Game
+, GameException (..)
+, ResourceClass (..)
+, ReleaseKey
+  -- * Game state
+, get
+, put
+, modify
+  -- * Game resources
+, register
+, release
+, release'
+  -- * Error handling
+, gameError
+, assertMaybe
+, catch
+  -- * Running and IO
+, runGame
+, evalGame
+, runSubGame
+, runSubGame'
+, evalSubGame
+, execSubGame
+, runSiblingGame
+, runSiblingGame'
+, evalSiblingGame
+, execSiblingGame
+, liftIO
+)
 where
 
 import           Control.Monad.Catch
 import           Control.Monad.State.Strict
 import           Control.Monad.Trans.Class    (lift)
-import qualified Control.Monad.Trans.Resource as R
-
+import           Control.Monad.Trans.Resource
 
-type Resource = R.ReleaseKey
 
+-- | Anything that holds a resource.
+--
+-- This is a convenient wrapper so that we can define the general `release'`
+-- function on any type of resource.
 class ResourceClass a where
-  getResource :: a -> Resource
+  getResource :: a -> ReleaseKey
 
-type Game s = StateT s (R.ResourceT IO)
 
+-- | A game exception.
+--
+-- This is mostly a convenient wrapper around `String` so that we can throw
+-- strings directly with `gameError`.
 newtype GameException = GameException String deriving (Show)
 
 instance Exception GameException
 
 
--- | Retrieve the game state.
-getGameState :: Game s s
-getGameState = get
-
--- | Save the game state.
-saveGameState :: s -> Game s ()
-saveGameState = put
-
--- | Modify the game state.
-modifyGameState :: (s -> s) -> Game s ()
-modifyGameState = modify
-
--- | Register the given cleaner.
-register :: IO () -> Game s Resource
-register = lift . R.register
+-- | The game monad.
+--
+-- The game monad performs three different roles:
+--
+--   1. I/O
+--   2. Resource management.
+--   3. State management.
+newtype Game s a = Game { getGame :: StateT s (ResourceT IO) a }
+  deriving
+  ( Functor
+  , Applicative
+  , Monad
+  , MonadIO
+  , MonadThrow
+  , MonadCatch
+  , MonadState s
+  , MonadResource
+  )
 
--- | Release the given 'Resource'.
-release :: ResourceClass a => a -> Game s ()
-release = lift . R.release . getResource
 
 -- | Release the given 'Resource'.
-release' :: ResourceClass a => a -> IO ()
-release' = R.release . getResource
+release' :: ResourceClass a => a -> Game s ()
+release' = release . getResource
 
 -- | Throw an error from the 'Game' monad.
 gameError :: String -> Game s a
-gameError = gameError' . GameException
-
--- | Throw an error from the 'Game' monad.
-gameError' :: GameException -> Game s a
-gameError' = lift . lift . throwM
+gameError = throwM . GameException
 
 -- | Throw the given error if given 'Nothing'.
 assertMaybe :: Maybe a -> GameException -> Game s a
-assertMaybe Nothing err = gameError' err
+assertMaybe Nothing err = throwM err
 assertMaybe (Just x) _  = return x
 
--- | Run the given game with the given error handler.
-catchGameError :: Game s a -> (GameException -> Game s a) -> Game s a
-catchGameError = catch
-
--- | Run the given game, catch any error, run the given finaliser and rethrow the error.
-catchGameErrorFinally :: Game s a -> Game s a -> Game s a
-catchGameErrorFinally game finally = catch game $ \err -> finally >> gameError' err
-
--- | Run the given game.
+-- | Run the given game, unrolling the full monad stack and returning the game's
+-- result and its final state.
+--
+-- Any resources acquired by the given game are released when this returns.
 runGame :: Game s a -> s -> IO (a, s)
-runGame game = R.runResourceT . runStateT game
+runGame game = runResourceT . runStateT (getGame game)
 
 -- | Run the given game and return its result.
 evalGame :: Game s a -> s -> IO a
 evalGame g s = fst <$> runGame g s
 
--- | Fully run the given sub game, unrolling the entire monad stack.
+-- | Run the given sub-game, unrolling the full monad stack and returning the
+-- game's result and its final state.
+--
+-- Like `runGame`, this frees any resources that are acquired by the sub-game.
+-- If you want to keep acquired resources, see `runSiblingGame` instead.
 runSubGame :: Game s a -> s -> Game t (a, s)
-runSubGame g s = gameIO $ runGame g s
+runSubGame g s = liftIO $ runGame g s
+
+-- | Run the given sub-game and return its result.
+evalSubGame :: Game s a -> s -> Game t a
+evalSubGame g s = fst <$> runSubGame g s
 
 -- | Like 'runSubGame', but discarding the result.
 runSubGame' :: Game s a -> s -> Game t ()
 runSubGame' g s = void $ runSubGame g s
 
--- | Run the given sub game and return its result.
-evalSubGame :: Game s a -> s -> Game t a
-evalSubGame g s = fst <$> runSubGame g s
-
--- | Run the given sub game and return its state.
+-- | Run the given sub-game and return its state.
 execSubGame :: Game s a -> s -> Game t s
 execSubGame g s = snd <$> runSubGame g s
 
--- | Run the given sibling game, unrolling StateT but not ResourceT.
+-- | Run the given sibling game, unrolling the state transformer but not the
+-- resource transformer.
+--
+-- Unlike `runSubGame`, any resources acquired by the sibling game are *not*
+-- released.
 runSiblingGame :: Game s a -> s -> Game t (a, s)
-runSiblingGame g s = lift $ runStateT g s
+runSiblingGame game = Game . lift . runStateT (getGame game)
 
 -- | Like 'runSiblingGame', but discarding the result.
 runSiblingGame' :: Game s a -> s -> Game t ()
@@ -137,7 +137,3 @@ evalSiblingGame g s = fst <$> runSiblingGame g s
 -- | Run the given sibling game and return its state.
 execSiblingGame :: Game s a -> s -> Game t s
 execSiblingGame g s = snd <$> runSiblingGame g s
-
--- | Perform the given IO action in the 'Game' monad.
-gameIO :: IO a -> Game s a
-gameIO = lift . lift
diff --git a/Spear/Render/AnimatedModel.hs b/Spear/Render/AnimatedModel.hs
index 8f0d6bd..e5b29ec 100644
--- a/Spear/Render/AnimatedModel.hs
+++ b/Spear/Render/AnimatedModel.hs
@@ -66,7 +66,7 @@ data AnimatedModelResource = AnimatedModelResource
     material  :: Material,
     texture   :: Texture,
     boxes     :: V.Vector Box,
-    rkey      :: Resource
+    rkey      :: ReleaseKey
   }
 
 instance Eq AnimatedModelResource where
@@ -121,12 +121,12 @@ animatedModelResource
   material
   texture
   model = do
-    RenderModel elements numFrames numVertices <- gameIO . renderModelFromModel $ model
+    RenderModel elements numFrames numVertices <- liftIO . renderModelFromModel $ model
     elementBuf <- newBuffer
     vao <- newVAO
-    boxes <- gameIO $ modelBoxes model
+    boxes <- liftIO $ modelBoxes model
 
-    gameIO $ do
+    liftIO $ do
       let elemSize = 56::CUInt
           elemSize' = fromIntegral elemSize
           n = numVertices * numFrames
@@ -149,9 +149,8 @@ animatedModelResource
       enableVAOAttrib texChan
 
     rkey <- register $ do
-      putStrLn "Releasing animated model resource"
-      release' vao
-      release' elementBuf
+      release $ vaoKey vao
+      release $ bufferKey elementBuf
 
     return $
       AnimatedModelResource
diff --git a/Spear/Render/Core/Buffer.hs b/Spear/Render/Core/Buffer.hs
index db3437e..eaff475 100644
--- a/Spear/Render/Core/Buffer.hs
+++ b/Spear/Render/Core/Buffer.hs
@@ -53,19 +53,19 @@ makeBufferAndView desc = do
 
 makeBuffer :: BufferDesc -> Game RenderCoreState Buffer
 makeBuffer (BufferDesc usage bufferData) = do
-  handle <- gameIO $ alloca $ \ptr -> glGenBuffers 1 ptr >> peek ptr
+  handle <- liftIO $ alloca $ \ptr -> glGenBuffers 1 ptr >> peek ptr
   resourceKey <- register $ deleteBuffer' handle
   let buffer = Buffer handle resourceKey usage
-  gameIO $ updateBuffer buffer bufferData
-  modifyGameState (\state -> state {
+  liftIO $ updateBuffer buffer bufferData
+  modify (\state -> state {
     buffers = HashMap.insert handle buffer (buffers state) })
   return buffer
 
 deleteBuffer :: Buffer -> Game RenderCoreState ()
 deleteBuffer buffer = do
-  modifyGameState (\state -> state {
+  modify (\state -> state {
     buffers = HashMap.delete (bufferHandle buffer) (buffers state) })
-  release buffer
+  release' buffer
 
 -- TODO: use glBufferSubData for updates.
 updateBuffer :: Buffer -> BufferData -> IO ()
diff --git a/Spear/Render/Core/Geometry.hs b/Spear/Render/Core/Geometry.hs
index 6c05b38..10ff709 100644
--- a/Spear/Render/Core/Geometry.hs
+++ b/Spear/Render/Core/Geometry.hs
@@ -87,23 +87,23 @@ newGeometryDesc = GeometryDesc
 makeGeometry :: GeometryDesc -> Game RenderCoreState Geometry
 makeGeometry desc = do
   gdata  <- geometryDescToData desc
-  handle <- gameIO $ alloca $ \ptr -> glGenVertexArrays 1 ptr >> peek ptr
-  gameIO $ do
+  handle <- liftIO $ alloca $ \ptr -> glGenVertexArrays 1 ptr >> peek ptr
+  liftIO $ do
     glBindVertexArray handle
     configureVertexAttributes gdata
     glBindVertexArray 0
-  gdataRef <- gameIO $ newIORef gdata
+  gdataRef <- liftIO $ newIORef gdata
   resourceKey <- register $ deleteGeometry' handle
   let geometry = Geometry handle resourceKey gdataRef
-  modifyGameState (\state -> state {
+  modify (\state -> state {
     geometries = HashMap.insert handle geometry (geometries state) })
   return geometry
 
 deleteGeometry :: Geometry -> Game RenderCoreState ()
 deleteGeometry geometry = do
-  modifyGameState (\state -> state {
+  modify (\state -> state {
     geometries = HashMap.delete (geometryVao geometry) (geometries state) })
-  release geometry
+  release' geometry
 
 renderGeometry :: Geometry -> IO ()
 renderGeometry geometry = do
diff --git a/Spear/Render/Core/Shader.hs b/Spear/Render/Core/Shader.hs
index 4ed4430..21db66f 100644
--- a/Spear/Render/Core/Shader.hs
+++ b/Spear/Render/Core/Shader.hs
@@ -53,22 +53,22 @@ compileShader :: ShaderDesc -> Game RenderCoreState Shader
 compileShader (ShaderDesc shaderType source defines) = do
   code <- case source of
     ShaderFromString code -> return code
-    ShaderFromFile   file -> gameIO $ readFile file
-  state <- getGameState
+    ShaderFromFile   file -> liftIO $ readFile file
+  state <- get
   let shaderHash = hash code -- TODO: Should also include defines.
   case HashMap.lookup shaderHash (shaders state) of
     Just shader -> return shader
     Nothing -> do
       let definesString = makeDefinesString defines
-      handle <- gameIO $ glCreateShader (toGLShaderType shaderType)
-      gameIO $ withCStringLen code $ \(codeCString, codeLen) ->
+      handle <- liftIO $ glCreateShader (toGLShaderType shaderType)
+      liftIO $ withCStringLen code $ \(codeCString, codeLen) ->
         withCStringLen definesString $ \(definesCString, definesLen) ->
           withCStringLen header $ \(headerCString, headerLen) ->
             withArray [headerCString, definesCString, codeCString] $ \strPtrs ->
               withArray (fromIntegral <$> [headerLen, definesLen, codeLen] :: [GLint])
                 $ \lengths ->
                   glShaderSource handle 3 strPtrs lengths
-      err <- gameIO $ do
+      err <- liftIO $ do
         glCompileShader handle
         alloca $ \statusPtr -> do
           glGetShaderiv handle GL_COMPILE_STATUS statusPtr
@@ -87,7 +87,7 @@ compileShader (ShaderDesc shaderType source defines) = do
         Nothing -> do
           resourceKey <- register $ deleteShader' handle
           let shader = Shader handle resourceKey shaderType shaderHash
-          saveGameState $ state {
+          put $ state {
             shaders = HashMap.insert shaderHash shader (shaders state)
           }
           return shader
@@ -96,17 +96,17 @@ compileShader (ShaderDesc shaderType source defines) = do
 
 compileShaderProgram :: [Shader] -> Game RenderCoreState ShaderProgram
 compileShaderProgram shaders = do
-  state <- getGameState
+  state <- get
   let programHash = hashShaders shaders
   case HashMap.lookup programHash (shaderPrograms state) of
     Just program -> return program
     Nothing -> do
-      handle <- gameIO glCreateProgram
+      handle <- liftIO glCreateProgram
       case handle of
         0 -> gameError "Failed to create shader program"
         _ -> do
-          mapM_ (gameIO . glAttachShader handle) (shaderHandle <$> shaders)
-          err <- gameIO $ do
+          mapM_ (liftIO . glAttachShader handle) (shaderHandle <$> shaders)
+          err <- liftIO $ do
             glLinkProgram handle
             alloca $ \statusPtr -> do
               glGetProgramiv handle GL_LINK_STATUS statusPtr
@@ -124,9 +124,9 @@ compileShaderProgram shaders = do
           case err of
             Nothing -> do
               resourceKey <- register $ deleteShaderProgram' handle
-              uniforms <- gameIO $ newIORef []
+              uniforms <- liftIO $ newIORef []
               let program = ShaderProgram handle resourceKey programHash uniforms
-              saveGameState $ state {
+              put $ state {
                 shaderPrograms = HashMap.insert programHash program (shaderPrograms state)
               }
               return program
@@ -136,15 +136,15 @@ compileShaderProgram shaders = do
 
 deleteShader :: Shader -> Game RenderCoreState ()
 deleteShader shader = do
-  modifyGameState (\state -> state {
+  modify (\state -> state {
     shaders = HashMap.delete (shaderHash shader) (shaders state) })
-  release shader
+  release' shader
 
 deleteShaderProgram :: ShaderProgram -> Game RenderCoreState ()
 deleteShaderProgram program = do
-  modifyGameState (\state -> state {
+  modify (\state -> state {
     shaderPrograms = HashMap.delete (shaderProgramHash program) (shaderPrograms state)})
-  release program
+  release' program
 
 activateShaderProgram :: ShaderProgram -> IO ()
 activateShaderProgram program = do
diff --git a/Spear/Render/Core/State.hs b/Spear/Render/Core/State.hs
index dac7b9a..aa42635 100644
--- a/Spear/Render/Core/State.hs
+++ b/Spear/Render/Core/State.hs
@@ -18,7 +18,7 @@ data BufferUsage
 -- | A data buffer (e.g., vertex attributes, indices).
 data Buffer = Buffer
   { bufferHandle   :: GLuint
-  , bufferResource :: Resource
+  , bufferResource :: ReleaseKey
   , bufferUsage    :: BufferUsage
   }
 
@@ -72,7 +72,7 @@ data GeometryData = GeometryData
 -- its state cannot become stale after an update.
 data Geometry = Geometry
   { geometryVao      :: GLuint
-  , geometryResource :: Resource
+  , geometryResource :: ReleaseKey
   , geometryData     :: IORef GeometryData
   }
 
@@ -80,7 +80,7 @@ data Geometry = Geometry
 -- | A shader.
 data Shader = Shader
   { shaderHandle   :: GLuint
-  , shaderResource :: Resource
+  , shaderResource :: ReleaseKey
   , shaderType     :: ShaderType
   , shaderHash     :: Int
   }
@@ -102,7 +102,7 @@ data ShaderUniform
 -- | A shader program.
 data ShaderProgram = ShaderProgram
   { shaderProgramHandle   :: GLuint
-  , shaderProgramResource :: Resource
+  , shaderProgramResource :: ReleaseKey
   , shaderProgramHash     :: Int
   -- Dirty set of uniforms that have been set since the last time uniforms were
   -- applied. OpenGL retains the values of uniforms for a program until the
diff --git a/Spear/Render/Immediate.hs b/Spear/Render/Immediate.hs
index 3c5f6ad..26f6513 100644
--- a/Spear/Render/Immediate.hs
+++ b/Spear/Render/Immediate.hs
@@ -78,20 +78,20 @@ deleteImmRenderer immState = do
 
 immStart :: Game ImmRenderState ()
 immStart = do
-  state <- getGameState
-  gameIO $ activateShaderProgram (shader state)
+  state <- get
+  liftIO $ activateShaderProgram (shader state)
 
 immEnd :: Game ImmRenderState ()
 immEnd = do
-  state <- getGameState
-  gameIO $ deactivateShaderProgram (shader state)
+  state <- get
+  liftIO $ deactivateShaderProgram (shader state)
 
 immDrawTriangles :: [Vector3] -> Game ImmRenderState ()
 immDrawTriangles vertices = do
   unless (null vertices) $ do
     loadMatrixStack
-    state <- getGameState
-    gameIO $ do
+    state <- get
+    liftIO $ do
       setPositions (triangles state) vertices
       applyUniforms (shader state)
       renderGeometry (triangles state)
@@ -112,42 +112,42 @@ immDrawQuads2d =
   immDrawQuads . (<$>) (\(p0, p1, p2, p3) -> (to3d p0, to3d p1, to3d p2, to3d p3))
 
 immLoadIdentity :: Game ImmRenderState ()
-immLoadIdentity = modifyGameState $ \state -> state {
+immLoadIdentity = modify $ \state -> state {
   matrixStack = [Matrix4.id] }
 
 immTranslate :: Vector3 -> Game ImmRenderState ()
-immTranslate vector = modifyGameState $ pushMatrix (Matrix4.translatev vector)
+immTranslate vector = modify $ pushMatrix (Matrix4.translatev vector)
 
 immPushMatrix :: Matrix4 -> Game ImmRenderState ()
-immPushMatrix matrix = modifyGameState $ pushMatrix matrix
+immPushMatrix matrix = modify $ pushMatrix matrix
 
 immPopMatrix :: Game ImmRenderState ()
-immPopMatrix = modifyGameState $ \state -> state {
+immPopMatrix = modify $ \state -> state {
   matrixStack = case matrixStack state of
     [x]  -> [x] -- Always keep the identity matrix on the stack.
     x:xs -> xs }
 
 immPreservingMatrix :: Game ImmRenderState a -> Game ImmRenderState a
 immPreservingMatrix f = do
-  originalStack <- matrixStack <$> getGameState
+  originalStack <- matrixStack <$> get
   result <- f
-  modifyGameState $ \state -> state { matrixStack = originalStack }
+  modify $ \state -> state { matrixStack = originalStack }
   return result
 
 immSetColour :: Vector4 -> Game ImmRenderState ()
 immSetColour colour = do
-  state <- getGameState
-  gameIO $ setUniform (Vec4Uniform "Colour" colour) (shader state)
+  state <- get
+  liftIO $ setUniform (Vec4Uniform "Colour" colour) (shader state)
 
 immSetModelMatrix :: Matrix4 -> Game ImmRenderState ()
 immSetModelMatrix model = do
-  state <- getGameState
-  gameIO $ setUniform (Mat4Uniform "Model" model) (shader state)
+  state <- get
+  liftIO $ setUniform (Mat4Uniform "Model" model) (shader state)
 
 immSetViewProjectionMatrix :: Matrix4 -> Game ImmRenderState ()
 immSetViewProjectionMatrix viewProjection = do
-  state <- getGameState
-  gameIO $ setUniform (Mat4Uniform "ViewProjection" viewProjection) (shader state)
+  state <- get
+  liftIO $ setUniform (Mat4Uniform "ViewProjection" viewProjection) (shader state)
 
 -- Private
 
@@ -157,7 +157,7 @@ pushMatrix matrix state = state {
 
 loadMatrixStack :: Game ImmRenderState ()
 loadMatrixStack = do
-  state <- getGameState
+  state <- get
   immSetModelMatrix (head $ matrixStack state)
 
 to3d :: Vector2 -> Vector3
diff --git a/Spear/Render/StaticModel.hs b/Spear/Render/StaticModel.hs
index f4cddf8..5168cf2 100644
--- a/Spear/Render/StaticModel.hs
+++ b/Spear/Render/StaticModel.hs
@@ -44,7 +44,7 @@ data StaticModelResource = StaticModelResource
     material  :: Material,
     texture   :: Texture,
     boxes     :: V.Vector Box,
-    rkey      :: Resource
+    rkey      :: ReleaseKey
   }
 
 instance Eq StaticModelResource where
@@ -74,12 +74,12 @@ staticModelResource ::
   Model ->
   Game s StaticModelResource
 staticModelResource (StaticProgramChannels vertChan normChan texChan) material texture model = do
-  RenderModel elements _ numVertices <- gameIO . renderModelFromModel $ model
+  RenderModel elements _ numVertices <- liftIO . renderModelFromModel $ model
   elementBuf <- newBuffer
   vao <- newVAO
-  boxes <- gameIO $ modelBoxes model
+  boxes <- liftIO $ modelBoxes model
 
-  gameIO $ do
+  liftIO $ do
     let elemSize = 32::CUInt
         elemSize' = fromIntegral elemSize
         n = numVertices
@@ -98,9 +98,8 @@ staticModelResource (StaticProgramChannels vertChan normChan texChan) material t
     enableVAOAttrib texChan
 
   rkey <- register $ do
-    putStrLn "Releasing static model resource"
-    release' vao
-    release' elementBuf
+    release $ vaoKey vao
+    release $ bufferKey elementBuf
 
   return $
     StaticModelResource
diff --git a/Spear/Scene/Loader.hs b/Spear/Scene/Loader.hs
index 3cd89f3..4bbbde0 100644
--- a/Spear/Scene/Loader.hs
+++ b/Spear/Scene/Loader.hs
@@ -43,7 +43,7 @@ type Loader = Game SceneResources
 -- | Load the scene specified by the given file.
 loadScene :: FilePath -> Game s (SceneResources, SceneGraph)
 loadScene file = do
-  result <- gameIO $ loadSceneGraphFromFile file
+  result <- liftIO $ loadSceneGraphFromFile file
   case result of
     Left err -> gameError $ show err
     Right g -> case validate g of
@@ -85,9 +85,9 @@ loadResource key field modifyResources load = do
   case M.lookup key $ field sceneData of
     Just val -> return val
     Nothing -> do
-      gameIO $ printf "Loading %s..." key
+      liftIO $ printf "Loading %s..." key
       resource <- load
-      gameIO $ printf "done\n"
+      liftIO $ printf "done\n"
       modifyResources key resource
       return resource
 
@@ -139,9 +139,9 @@ newModel (SceneLeaf _ props) = do
   let rotation = asRotation $ value "rotation" props
       scale = asVec3 $ value "scale" props
 
-  gameIO $ printf "Loading model %s..." name
+  liftIO $ printf "Loading model %s..." name
   model <- loadModel' file rotation scale
-  gameIO . putStrLn $ "done"
+  liftIO . putStrLn $ "done"
   texture <- loadTexture tex
   sceneRes <- get
 
@@ -180,7 +180,7 @@ loadModel' file rotation scale = do
                   \(Vec3 x' y' z') -> Vec3 (x s * x') (y s * y') (z s * z')
             )
 
-  (fmap transform $ Model.loadModel file) >>= gameIO . toGround
+  (fmap transform $ Model.loadModel file) >>= liftIO . toGround
 
 rotateModel :: Rotation -> Model -> Model
 rotateModel (Rotation ax ay az order) model =
@@ -213,7 +213,7 @@ newShaderProgram (SceneLeaf _ props) = do
   stype <- asString $ mandatory' "type" props
   prog <- GL.newProgram [vertShader, fragShader]
 
-  let getUniformLoc name = (gameIO . SV.get $ GL.uniformLocation prog name) `GL.assertGL` name
+  let getUniformLoc name = (liftIO . SV.get $ GL.uniformLocation prog name) `GL.assertGL` name
 
   case stype of
     "static" -> do
diff --git a/Spear/Window.hs b/Spear/Window.hs
index 2dcd1fa..75a38f7 100644
--- a/Spear/Window.hs
+++ b/Spear/Window.hs
@@ -208,7 +208,7 @@ whenKeyUp = whenKeyInState GLFW.KeyState'Released
 
 whenKeyInState :: GLFW.KeyState -> GLFW.Window -> Key -> Game s () -> Game s ()
 whenKeyInState state window key game = do
-  isDown <- fmap (==state) $ gameIO . GLFW.getKey window . toGLFWkey $ key
+  isDown <- fmap (==state) $ liftIO . GLFW.getKey window . toGLFWkey $ key
   when isDown game
 
 -- | Check whether the given keys are pressed and return the value associated
@@ -219,7 +219,7 @@ processKeys window = foldM f []
     f acc (key, result) = do
       isDown <-
         fmap (== GLFW.KeyState'Pressed) $
-          gameIO . GLFW.getKey (glfwWindow window) . toGLFWkey $
+          liftIO . GLFW.getKey (glfwWindow window) . toGLFWkey $
             key
       return $ if isDown then result : acc else acc
 
@@ -231,7 +231,7 @@ processButtons window = foldM f []
     f acc (button, result) = do
       isDown <-
         fmap (== GLFW.MouseButtonState'Pressed) $
-          gameIO . GLFW.getMouseButton (glfwWindow window) . toGLFWbutton $
+          liftIO . GLFW.getMouseButton (glfwWindow window) . toGLFWbutton $
             button
       return $ if isDown then result : acc else acc
 
-- 
cgit v1.2.3