get reader monad in place

src/Init.hs

@@ -25,8 +25,7 @@ import Types
 import Mesh
 
 initEngine
-  :: (MonadResource m, MonadFail m)
-  => m EngineData
+  :: Render EngineData
 initEngine = do
   -- initialize SDL2 with all subsystems
   void $ allocate_
@@ -58,9 +57,8 @@ initEngine = do
 
 
 initVulkan
-  :: (MonadResource m, MonadFail m)
-  => SDL.Window
-  -> m EngineData
+  :: SDL.Window
+  -> Render EngineData
 initVulkan window = do
 
   vulkanInstance <- createInstance window

src/Main.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE DataKinds #-}
 module Main where
 
+import qualified Control.Concurrent.STM as STM
 import Control.Monad
 import Control.Monad.Loops
 import Control.Monad.IO.Class
@@ -10,7 +11,6 @@ import Control.Monad.Trans.Resource
 import Data.Bits
 import Data.Word
 import qualified SDL hiding (V2)
-import qualified Control.Concurrent.STM as STM
 import qualified Vulkan as Vk
 import qualified Vulkan.Zero as Vk
 
@@ -21,14 +21,15 @@ import Draw (drawFrame)
 import Types
 
 main :: IO ()
-main = runResourceT $ do
+main = do
+  container <- STM.newEmptyTMVarIO
+  runRender (ReadState container) $ do
     engineData <- initEngine
 
     SDL.showWindow $ engineWindow engineData
 
     -- create abort condition for upcoming lop
     quit <- liftIO $ STM.newTMVarIO True
-  showPipeline <- liftIO $ STM.newTMVarIO Green
     frameContainer <- liftIO $ STM.newTMVarIO 0
 
     -- main loop
@@ -39,7 +40,7 @@ main = runResourceT $ do
         frameNumber <- liftIO $ STM.atomically $ STM.takeTMVar frameContainer
         liftIO $ STM.atomically $ STM.putTMVar frameContainer (succ frameNumber)
         -- draw
-      drawFrame engineData showPipeline frameNumber
+        drawFrame engineData frameNumber
         -- poll events
         evs <- liftIO SDL.pollEvents
         -- flip abort condition on window close

src/Types.hs

@@ -1,6 +1,12 @@
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveFunctor #-}
 module Types where
 
+import Control.Concurrent.STM.TMVar as STM
+import Control.Monad.IO.Class
+import Control.Monad.Reader
+import Control.Monad.Trans.Resource
 import qualified Data.Vector as V
 import Foreign
 import Foreign.C.Types (CInt)
@@ -145,3 +151,32 @@ data AllocatedImage = AllocatedImage
   , allocation :: VMA.Allocation
   }
   deriving (Show)
+
+data Material = Material
+  { materialPipeline       :: Vk.Pipeline
+  , materialPipelineLayout :: Vk.PipelineLayout
+  }
+  deriving (Show)
+
+data RenderObject = RenderObject
+  { objectMesh     :: Mesh
+  , objectMaterial :: Material
+  , objectMatrix   :: M44 Float
+  }
+  deriving (Show)
+
+newtype ReadState = ReadState
+  { renderables :: STM.TMVar (V.Vector RenderObject)
+  }
+
+newtype RenderReader rd m a = RenderReader
+  { runRenderInner :: RenderInner rd m a
+  }
+  deriving (Functor, Applicative, Monad, MonadIO, MonadReader rd, MonadResource, MonadFail)
+
+type RenderInner rd m = ReaderT rd m
+
+type Render a = RenderReader ReadState ResIO a
+
+runRender :: ReadState -> Render a -> IO a
+runRender rd actions = runResourceT $ flip runReaderT rd $ runRenderInner actions

vulkan-tutorial.cabal

@@ -52,7 +52,7 @@ executable vulkan-tutorial
                     , text
                     , vector
                     , resourcet
-                    , transformers
+                    , mtl
     hs-source-dirs:   src
     default-language: Haskell2010
     ghc-options:      -Wall