-- |
-- Module      : WGPU.Internal.GLFW.Surface
-- Description : GLFW-specific surfaces.
module WGPU.Internal.GLFW.Surface
  ( -- * Functions
    createSurface,
  )
where

import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Graphics.UI.GLFW as GLFW
import WGPU.Internal.Instance (Instance, wgpuHsInstance)
import WGPU.Internal.Surface (Surface (Surface))
import qualified WGPU.Raw.GLFWSurface

-------------------------------------------------------------------------------

-- | Create a WGPU 'Surface' for a GLFW 'GLFW.Window'.
--
-- This function is not part of the @wgpu-native@ API, but is part of the
-- Haskell API until the native WGPU API has a better story around windowing.
createSurface ::
  MonadIO m =>
  -- | API instance.
  Instance ->
  -- | GLFW window for which the surface will be created.
  GLFW.Window ->
  -- | IO action to create the surface.
  m Surface
createSurface :: Instance -> Window -> m Surface
createSurface Instance
inst Window
window =
  IO Surface -> m Surface
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Surface -> m Surface) -> IO Surface -> m Surface
forall a b. (a -> b) -> a -> b
$
    Instance -> WGPUSurface -> Surface
Surface Instance
inst
      (WGPUSurface -> Surface) -> IO WGPUSurface -> IO Surface
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WGPUHsInstance -> Window -> IO WGPUSurface
WGPU.Raw.GLFWSurface.createSurface (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst) Window
window