Update window interface

Try to reduce references that have to be passed

src/Graphics/Seangine/Window.hs

@@ -1,27 +1,27 @@
 module Graphics.Seangine.Window
-  ( GlfwWindow,
-    SdlWindow,
+  ( GlfwWindowSystem,
+    SdlWindowSystem,
     WindowSystem (..),
-    glfw,
-    sdl,
+    withGlfw,
+    withSdl,
     withWindowSystem,
     withWindow,
     withWindowSurface,
   ) where
 
-import Graphics.Seangine.Window.Glfw (GlfwWindow)
-import Graphics.Seangine.Window.Sdl (SdlWindow)
+import Graphics.Seangine.Window.Glfw (GlfwWindowSystem)
+import Graphics.Seangine.Window.Sdl (SdlWindowSystem)
 import Graphics.Seangine.Window.Types (Window, WindowSystem (..))
 
 import Control.Monad.Trans.Resource
 import Vulkan.Core10 (Instance ())
 import Vulkan.Extensions.VK_KHR_surface (SurfaceKHR (..), destroySurfaceKHR)
 
-sdl :: Proxy SdlWindow
-sdl = Proxy
+withGlfw :: (MonadResource m) => m (ReleaseKey, GlfwWindowSystem)
+withGlfw = withWindowSystem (Proxy :: Proxy GlfwWindowSystem)
 
-glfw :: Proxy GlfwWindow
-glfw = Proxy
+withSdl :: (MonadResource m) => m (ReleaseKey, SdlWindowSystem)
+withSdl = withWindowSystem (Proxy :: Proxy SdlWindowSystem)
 
 withWindowSystem
   :: (MonadResource m, WindowSystem window)
@@ -38,17 +38,16 @@ withWindow
   -> m (ReleaseKey, Window window)
 withWindow win title width height = do
   let create = createWindow win title width height
-      destroy = destroyWindow win
+      destroy = destroyWindow
 
   allocate create destroy
 
 withWindowSurface
   :: (MonadResource m, WindowSystem window)
-  => window
-  -> Window window
+  => Window window
   -> Instance
   -> m (ReleaseKey, SurfaceKHR)
-withWindowSurface win handle inst = allocate create destroy
+withWindowSurface win inst = allocate create destroy
   where
-    create = getWindowSurface win handle inst
+    create = getWindowSurface win inst
     destroy = flip (destroySurfaceKHR inst) Nothing

src/Graphics/Seangine/Window/Glfw.hs

@@ -1,5 +1,5 @@
 module Graphics.Seangine.Window.Glfw
-  ( GlfwWindow (),
+  ( GlfwWindowSystem (),
   ) where
 
 import Graphics.Seangine.Window.Types (Event (..), Window (), WindowSystem (..))
@@ -10,36 +10,36 @@ import Linear (V2)
 import Vulkan.Core10 (Instance)
 import Vulkan.Extensions.VK_KHR_surface
 
-data GlfwWindow = GlfwWindow
+data GlfwWindowSystem = GlfwWindowSystem
 
-type instance Window GlfwWindow = GLFW.Window
+newtype instance Window GlfwWindowSystem = GlfwWindow {unWindow :: GLFW.Window}
 
-instance WindowSystem GlfwWindow where
+instance WindowSystem GlfwWindowSystem where
   initWindowSystem _ = initGlfw
   destroyWindowSystem _ = pass
   createWindow _ = createGlfwWindow
-  destroyWindow _ = destroyGlfwWindow
-  getWindowSurface _ = getGlfwWindowSurface
-  getDrawableSize _ = getGlfwDrawableSize
-  getWindowExtensions _ = getGlfwWindowExtensions
+  destroyWindow = destroyGlfwWindow
+  getWindowSurface = getGlfwWindowSurface
+  getDrawableSize = getGlfwDrawableSize
+  getWindowExtensions = getGlfwWindowExtensions
   pollWindowEvents _ = pollGlfwWindowEvents
 
-initGlfw :: MonadIO io => io GlfwWindow
-initGlfw = pure GlfwWindow
+initGlfw :: MonadIO io => io GlfwWindowSystem
+initGlfw = pure GlfwWindowSystem
 
-createGlfwWindow :: MonadIO io => Text -> Int -> Int -> io GLFW.Window
+createGlfwWindow :: MonadIO io => Text -> Int -> Int -> io (Window GlfwWindowSystem)
 createGlfwWindow _ _ _ = undefined
 
-destroyGlfwWindow :: MonadIO io => GLFW.Window -> io ()
+destroyGlfwWindow :: MonadIO io => Window GlfwWindowSystem -> io ()
 destroyGlfwWindow = undefined
 
-getGlfwWindowSurface :: MonadIO io => GLFW.Window -> Instance -> io SurfaceKHR
+getGlfwWindowSurface :: MonadIO io => Window GlfwWindowSystem -> Instance -> io SurfaceKHR
 getGlfwWindowSurface _ _ = undefined
 
-getGlfwDrawableSize :: MonadIO io => GLFW.Window -> io (V2 Int)
+getGlfwDrawableSize :: MonadIO io => Window GlfwWindowSystem -> io (V2 Int)
 getGlfwDrawableSize _ = undefined
 
-getGlfwWindowExtensions :: MonadIO io => GLFW.Window -> io (Vector ByteString)
+getGlfwWindowExtensions :: MonadIO io => Window GlfwWindowSystem -> io (Vector ByteString)
 getGlfwWindowExtensions _ = undefined
 
 pollGlfwWindowEvents :: MonadIO io => io [Event]

src/Graphics/Seangine/Window/Sdl.hs

@@ -1,5 +1,5 @@
 module Graphics.Seangine.Window.Sdl
-  ( SdlWindow (),
+  ( SdlWindowSystem (),
   ) where
 
 import Graphics.Seangine.Window.Types (Event (..), Window (), WindowSystem (..))
@@ -15,46 +15,46 @@ import Vulkan.Core10 (Instance)
 import Vulkan.Core10.Handles (instanceHandle)
 import Vulkan.Extensions.VK_KHR_surface
 
-data SdlWindow = SdlWindow
+data SdlWindowSystem = SdlWindowSystem
 
-type instance Window SdlWindow = SDL.Window
+newtype instance Window SdlWindowSystem = SdlWindow {unWindow :: SDL.Window}
 
-instance WindowSystem SdlWindow where
+instance WindowSystem SdlWindowSystem where
   initWindowSystem _ = initSdl
   destroyWindowSystem _ = SDL.quit
   createWindow _ = createSdlWindow
-  destroyWindow _ = SDL.destroyWindow
-  getWindowSurface _ = getSdlWindowSurface
-  getDrawableSize _ = getSdlDrawableSize
-  getWindowExtensions _ = getSdlWindowExtensions
+  destroyWindow = SDL.destroyWindow . unWindow
+  getWindowSurface = getSdlWindowSurface
+  getDrawableSize = getSdlDrawableSize
+  getWindowExtensions = getSdlWindowExtensions
   pollWindowEvents _ = pollSdlWindowEvents
 
-initSdl :: MonadIO io => io SdlWindow
-initSdl = SDL.initialize initFlags $> SdlWindow
+initSdl :: MonadIO io => io SdlWindowSystem
+initSdl = SDL.initialize initFlags $> SdlWindowSystem
   where
     initFlags = [SDL.InitVideo, SDL.InitEvents]
 
-createSdlWindow :: MonadIO io => Text -> Int -> Int -> io SDL.Window
-createSdlWindow title width height = SDL.createWindow title window
+createSdlWindow :: MonadIO io => Text -> Int -> Int -> io (Window SdlWindowSystem)
+createSdlWindow title width height = SdlWindow <$> SDL.createWindow title window
   where
     window =
       SDL.defaultWindow
         { SDL.windowInitialSize = SDL.V2 (fromIntegral width) (fromIntegral height),
           SDL.windowGraphicsContext = SDL.VulkanContext
         }
 
-getSdlWindowSurface :: MonadIO io => SDL.Window -> Instance -> io SurfaceKHR
-getSdlWindowSurface window inst =
+getSdlWindowSurface :: MonadIO io => Window SdlWindowSystem -> Instance -> io SurfaceKHR
+getSdlWindowSurface (SdlWindow window) inst =
   SurfaceKHR
     <$> SDL.vkCreateSurface window (castPtr $ instanceHandle inst)
 
-getSdlDrawableSize :: MonadIO io => SDL.Window -> io (V2 Int)
-getSdlDrawableSize window = do
+getSdlDrawableSize :: MonadIO io => Window SdlWindowSystem -> io (V2 Int)
+getSdlDrawableSize (SdlWindow window) = do
   (V2 width height) <- SDL.vkGetDrawableSize window
   pure $ V2 (fromIntegral width) (fromIntegral height)
 
-getSdlWindowExtensions :: MonadIO io => SDL.Window -> io (Vector ByteString)
-getSdlWindowExtensions window =
+getSdlWindowExtensions :: MonadIO io => Window SdlWindowSystem -> io (Vector ByteString)
+getSdlWindowExtensions (SdlWindow window) =
   SDL.vkGetInstanceExtensions window
     >>= liftIO . mapM packCString . Vector.fromList
 

src/Graphics/Seangine/Window/Types.hs

@@ -16,7 +16,7 @@ data Event
   | UnknownEvent
   deriving (Enum, Bounded, Eq, Show)
 
-type family Window w
+data family Window window
 
 class WindowSystem system where
   initWindowSystem :: MonadIO io => Proxy system -> io system
@@ -32,27 +32,23 @@ class WindowSystem system where
 
   destroyWindow
     :: MonadIO io
-    => system
-    -> Window system
+    => Window system
     -> io ()
 
   getWindowSurface
     :: MonadIO io
-    => system
-    -> Window system
+    => Window system
     -> Instance
     -> io SurfaceKHR
 
   getDrawableSize
     :: MonadIO io
-    => system
-    -> Window system
+    => Window system
     -> io (V2 Int)
 
   getWindowExtensions
     :: MonadIO io
-    => system
-    -> Window system
+    => Window system
     -> io (Vector ByteString)
 
   pollWindowEvents :: MonadIO io => system -> io [Event]