Gigantic refactoring

app/Main.hs

@@ -1,41 +1,16 @@
 module Main (main) where
 
 import Graphics.Seangine hiding (getDataDir)
-import Graphics.Seangine.App (App (..), runApp)
 import Paths_seangine (getDataDir)
 
-import Control.Monad.Trans.Resource
 import Options.Applicative
 import System.FilePath ((</>))
-import Text.GLTF.Loader hiding (ImpossibleError)
-import UnliftIO.Exception
-
-{-# ANN Options ("HLint: ignore Use newtype instead of data" :: String) #-}
-data Options = Options {optVerbose :: !Bool}
-  deriving (Show)
 
 main :: IO ()
-main = execParser options >>= runApp run
-
-run :: App Options ()
-run = runResourceT $ do
-  _ <- ask
-  dataDir <- liftIO getDataDir
-  scene <- loadScene $ dataDir </> "data" </> "cube.gltf"
-  (_, win) <- withWindow sdlWindowSystem "Seangine 0.1.1.0" 800 600
-  windowExts <- getVulkanExtensions win
-  instance' <- withVulkanInstance windowExts
-  (_, surface) <- withWindowSurface instance' win
-  handles <- withVulkanHandles dataDir instance' surface
+main = execParser options >>= run
 
-  pass
-
-loadScene :: MonadUnliftIO io => FilePath -> io Scene
-loadScene path = do
-  result <- fromJsonFile path
-  case result of
-    Left _ -> throwIO ImpossibleError
-    Right scene -> return scene
+run :: Options -> IO ()
+run opts = getDataDir >>= runSeangine opts
 
 options :: ParserInfo Options
 options =
@@ -45,10 +20,17 @@ options =
       <> header "seangine - An experimental 3D rendering engine"
 
 parser :: Parser Options
-parser = Options <$> verboseOpt
+parser = Options <$> verboseOpt <*> fileOpt
   where
     verboseOpt =
       switch $
         long "verbose"
           <> short 'v'
           <> help "Verbose output?"
+
+    fileOpt =
+      strOption $
+        long "file"
+          <> short 'f'
+          <> help "File?"
+          <> value ("data" </> "cube.gltf")

lib/Graphics/Seangine.hs

@@ -1,17 +1,52 @@
 module Graphics.Seangine
-  ( module Graphics.Seangine.Errors,
-    module Graphics.Seangine.Frame,
-    module Graphics.Seangine.HasVulkan,
+  ( module Graphics.Seangine.Config,
+    module Graphics.Seangine.Config.Frame,
+    module Graphics.Seangine.Config.VulkanHandles,
+    module Graphics.Seangine.Errors,
     module Graphics.Seangine.Instance,
+    module Graphics.Seangine.Monad,
     module Graphics.Seangine.Scene,
     module Graphics.Seangine.Window,
+    runSeangine,
     sdlWindowSystem,
   ) where
 
+import Graphics.Seangine.Config
+import Graphics.Seangine.Config.Frame
+import Graphics.Seangine.Config.VulkanHandles
 import Graphics.Seangine.Errors
-import Graphics.Seangine.Frame
-import Graphics.Seangine.HasVulkan
 import Graphics.Seangine.Instance
+import Graphics.Seangine.Monad
 import Graphics.Seangine.Scene
 import Graphics.Seangine.Window
 import Graphics.Seangine.Window.SDL
+
+import Control.Monad.Trans.Resource (MonadUnliftIO (), runResourceT)
+import System.FilePath ((</>))
+import Text.GLTF.Loader hiding (ImpossibleError)
+import UnliftIO.Exception (throwIO)
+
+runSeangine :: Options -> FilePath -> IO ()
+runSeangine opts dataDir = runResourceT $ do
+  scene <- loadScene $ dataDir </> optFile opts
+
+  (_, win) <- withWindow sdlWindowSystem "Seangine 0.1.1.0" 800 600
+  windowExts <- getVulkanExtensions win
+  instance' <- withVulkanInstance windowExts
+  (_, surface) <- withWindowSurface instance' win
+  handles <- withVulkanHandles dataDir instance' surface
+
+  let config =
+        Config
+          { cfgVulkanHandles = handles,
+            cfgOptions = opts
+          }
+  runVulkan config $ do
+    pass
+
+loadScene :: MonadUnliftIO io => FilePath -> io Scene
+loadScene path = do
+  result <- fromJsonFile path
+  case result of
+    Left _ -> throwIO ImpossibleError
+    Right scene -> return scene

lib/Graphics/Seangine/Config.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+module Graphics.Seangine.Config
+  ( Config (..),
+    Options (..),
+    HasConfig (..),
+    HasOptions (..),
+  ) where
+
+import Graphics.Seangine.Config.VulkanHandles
+
+data Config = Config
+  { cfgVulkanHandles :: VulkanHandles,
+    cfgOptions :: Options
+  }
+
+data Options = Options
+  { optVerbose :: Bool,
+    optFile :: FilePath
+  }
+
+class HasConfig m where
+  getVulkanHandles :: m VulkanHandles
+  getOptions :: m Options
+
+class HasOptions m where
+  getOptVerbose :: m Bool
+  getOptFile :: m FilePath

lib/Graphics/Seangine/Frame.hs → lib/Graphics/Seangine/Config/Frame.hs

@@ -1,6 +1,8 @@
-module Graphics.Seangine.Frame
+module Graphics.Seangine.Config.Frame
   ( Frame (..),
     FrameInFlight (..),
+    HasFrame (..),
+    HasFrameInFlight (..),
   ) where
 
 import Graphics.Seangine.Scene
@@ -40,3 +42,9 @@ data FrameInFlight = FrameInFlight
     ffCommandBuffer :: CommandBuffer,
     ffGpuWork :: Fence
   }
+
+class HasFrame m where
+  getFrame :: m Frame
+
+class HasFrame m => HasFrameInFlight m where
+  getFrameInFlight :: m FrameInFlight

lib/Graphics/Seangine/Config/VulkanHandles.hs

@@ -0,0 +1,48 @@
+module Graphics.Seangine.Config.VulkanHandles
+  ( VulkanHandles (..),
+    HasVulkan (..),
+    noAllocationCallbacks,
+    noPipelineCache,
+  ) where
+
+import Data.Vector (Vector)
+import Vulkan.Core10
+import Vulkan.Extensions.VK_KHR_surface (PresentModeKHR, SurfaceCapabilitiesKHR, SurfaceFormatKHR)
+import VulkanMemoryAllocator (Allocator (..))
+
+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 HasVulkan 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
+
+noAllocationCallbacks :: Maybe AllocationCallbacks
+noAllocationCallbacks = Nothing
+
+noPipelineCache :: PipelineCache
+noPipelineCache = NULL_HANDLE

lib/Graphics/Seangine/Instance/CommandBuffers.hs

@@ -3,7 +3,7 @@ module Graphics.Seangine.Instance.CommandBuffers
     withCommandBuffer',
   ) where
 
-import Graphics.Seangine.HasVulkan
+import Graphics.Seangine.Config.VulkanHandles
 import Graphics.Seangine.Monad.Vulkan
 
 import Control.Monad.Trans.Resource (MonadResource (..), allocate)

lib/Graphics/Seangine/Monad/Config.hs

@@ -0,0 +1,11 @@
+module Graphics.Seangine.Monad.Config (Config (..), Options (..)) where
+
+import Graphics.Seangine.Monad.Vulkan (VulkanHandles (..))
+
+data Config = Config
+  { cfgOptions :: Options,
+    cfgVulkanHandles :: VulkanHandles
+  }
+
+data Options = Options
+  {optVerbose :: Bool}

lib/Graphics/Seangine/Monad/Frame.hs

@@ -1,12 +1,11 @@
 module Graphics.Seangine.Monad.Frame
-  ( VulkanFrame (..),
+  ( VulkanFrame (),
     allocateVulkan,
     allocateVulkan_,
     runFrame,
   ) where
 
-import Graphics.Seangine.Frame (Frame (..))
-import Graphics.Seangine.HasVulkan (HasFrame (..), HasFrameInFlight (..))
+import Graphics.Seangine.Config.Frame (Frame (..), HasFrame (..), HasFrameInFlight (..))
 import Graphics.Seangine.Monad.Vulkan (Vulkan ())
 
 import Control.Monad.Trans.Resource