feat: Add some "global" types

nix/hix.nix

@@ -7,6 +7,9 @@
   ]);
 
   shell = {
+    # Speed up local builds a bit
+    crossPlatforms = _: [];
+
     tools = {
       cabal = "latest";
       fourmolu = "latest";

seangine.cabal

@@ -31,12 +31,24 @@ common common-options
     build-depends:
         base ^>= 4.16.0.0,
         relude
+    default-extensions:
+        DerivingStrategies
+        RecordWildCards
+    default-language: GHC2021
 
 library
     import:           common-options
     exposed-modules:
-        Graphics.Seangine
-    build-depends:    base ^>=4.16.0.0
+        Graphics.Seangine,
+        Graphics.Seangine.Types,
+        Graphics.Seangine.Types.Config,
+        Graphics.Seangine.Types.R
+    build-depends:
+      VulkanMemoryAllocator,
+      resourcet,
+      unliftio-core,
+      vector,
+      vulkan
     hs-source-dirs:   src
     default-language: GHC2021
 
@@ -57,5 +69,4 @@ test-suite seangine-test
     hs-source-dirs:   test
     main-is:          Main.hs
     build-depends:
-        base ^>=4.16.0.0,
         seangine

src/Graphics/Seangine/Types.hs

@@ -1,8 +1,7 @@
-module Graphics.Seangine.Types (SeangineOptions (..)) where
+module Graphics.Seangine.Types
+  ( module Graphics.Seangine.Types.Config,
+    module Graphics.Seangine.Types.R,
+  ) where
 
-data SeangineOptions = SeangineOptions
-  { optFile :: !FilePath,
-    optDevice :: !(Maybe String),
-    optDebug :: !Bool
-  }
-  deriving (Eq)
+import Graphics.Seangine.Types.Config
+import Graphics.Seangine.Types.R

src/Graphics/Seangine/Types/Config.hs

@@ -0,0 +1,84 @@
+module Graphics.Seangine.Types.Config
+  ( SeangineConfig (..),
+    SeangineOptions (..),
+    VulkanHandles (..),
+    HasSeangineOptions (..),
+    HasVulkanHandles (..),
+  ) where
+
+import Data.Vector (Vector)
+import Vulkan.Core10
+import Vulkan.Extensions.VK_KHR_surface
+  ( PresentModeKHR,
+    SurfaceCapabilitiesKHR,
+    SurfaceFormatKHR,
+  )
+import VulkanMemoryAllocator (Allocator (..))
+
+data SeangineConfig = SeangineConfig
+  { options :: SeangineOptions,
+    handles :: VulkanHandles
+  }
+
+data SeangineOptions = SeangineOptions
+  { optFile :: !FilePath,
+    optDevice :: !(Maybe String),
+    optDebug :: !Bool
+  }
+  deriving (Eq)
+
+data VulkanHandles = VulkanHandles
+  { vhDataDir :: FilePath,
+    vhInstance :: Instance,
+    vhPhysicalDevice :: PhysicalDevice,
+    vhDevice :: Device,
+    vhAllocator :: Allocator,
+    vhGraphicsQueue :: Queue,
+    vhGraphicsQueueFamily :: Word32,
+    vhPresentQueue :: Queue,
+    vhPresentQueueFamily :: Word32,
+    vhSurfaceCapabilities :: SurfaceCapabilitiesKHR,
+    vhSurfaceFormats :: Vector SurfaceFormatKHR,
+    vhPresentModes :: Vector PresentModeKHR,
+    vhCommandPool :: CommandPool
+  }
+
+class HasSeangineOptions m where
+  getOptFile :: m FilePath
+  getOptDevice :: m (Maybe String)
+  getOptDebug :: m Bool
+
+class HasVulkanHandles m where
+  getDataDir :: m FilePath
+  getInstance :: m Instance
+  getPhysicalDevice :: m PhysicalDevice
+  getDevice :: m Device
+  getAllocator :: m Allocator
+  getGraphicsQueue :: m Queue
+  getGraphicsQueueFamily :: m Word32
+  getPresentQueue :: m Queue
+  getPresentQueueFamily :: m Word32
+  getSurfaceCapabilities :: m SurfaceCapabilitiesKHR
+  getSurfaceFormats :: m (Vector SurfaceFormatKHR)
+  getPresentModes :: m (Vector PresentModeKHR)
+  getCommandPool :: m CommandPool
+
+instance (Monad m, HasSeangineOptions m) => HasSeangineOptions (ReaderT r m) where
+  getOptFile = lift getOptFile
+  getOptDevice = lift getOptDevice
+  getOptDebug = lift getOptDebug
+
+instance (Monad m, HasVulkanHandles m) => HasVulkanHandles (ReaderT r m) where
+  getDataDir = lift getDataDir
+  getInstance = lift getInstance
+  getPhysicalDevice = lift getPhysicalDevice
+  getDevice = lift getDevice
+  getAllocator = lift getAllocator
+  getGraphicsQueue = lift getGraphicsQueue
+  getGraphicsQueueFamily = lift getGraphicsQueueFamily
+  getPresentQueue = lift getPresentQueue
+  getPresentQueueFamily = lift getPresentQueueFamily
+  getSurfaceCapabilities = lift getSurfaceCapabilities
+  getSurfaceFormats = lift getSurfaceFormats
+  getPresentModes = lift getPresentModes
+  getCommandPool = lift getCommandPool

src/Graphics/Seangine/Types/R.hs

@@ -0,0 +1,27 @@
+module Graphics.Seangine.Types.R
+  ( R (..),
+    runR,
+  ) where
+
+import Graphics.Seangine.Types.Config
+
+import Control.Monad.IO.Unlift (MonadUnliftIO (..))
+import Control.Monad.Trans.Resource
+
+newtype R a = R {unR :: ReaderT SeangineConfig (ResourceT IO) a}
+  deriving newtype
+    ( Functor,
+      Applicative,
+      Monad,
+      MonadReader SeangineConfig,
+      MonadResource,
+      MonadIO,
+      MonadFail
+    )
+
+instance MonadUnliftIO R where
+  withRunInIO :: ((forall a. R a -> IO a) -> IO b) -> R b
+  withRunInIO a = R $ withRunInIO (\r -> a $ r . unR)
+
+runR :: SeangineConfig -> R a -> ResourceT IO a
+runR config = usingReaderT config . unR