{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}

module WGPU.Raw.Dynamic
  ( -- * Types
    InstanceHandle (..),

    -- * Functions
    withWGPU,
  )
where

import Control.Monad.IO.Class (MonadIO, liftIO)
import WGPU.Raw.Generated.Fun (WGPUHsInstance, loadDynamicInstance)

#ifdef WGPUHS_UNIX

import System.Posix.DynamicLinker (dlsym, dlopen, dlclose, DL)
import System.Posix.DynamicLinker.Prim (RTLDFlags(RTLD_NOW))

data InstanceHandle = InstanceHandle
  { InstanceHandle -> DL
instanceHandleDL :: !DL,
    InstanceHandle -> WGPUHsInstance
instanceHandleInstance :: !WGPUHsInstance
  }

-- | Load WGPU from a dynamic library and run a program using an instance.
withWGPU ::
  forall m r.
  MonadIO m =>
  -- | Path to the wgpu-native dynamic library to load.
  FilePath ->
  -- | Bracketing function.
  -- This can (for example) be something like 'Control.Exception.Safe.bracket'.
  (m InstanceHandle -> (InstanceHandle -> m ()) -> r) ->
  -- | Usage or action component of the bracketing function.
  r
withWGPU :: FilePath
-> (m InstanceHandle -> (InstanceHandle -> m ()) -> r) -> r
withWGPU FilePath
dynlibFile m InstanceHandle -> (InstanceHandle -> m ()) -> r
bkt = do
  let
    create :: m InstanceHandle
    create :: m InstanceHandle
create = do
      DL
dl <- IO DL -> m DL
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DL -> m DL) -> IO DL -> m DL
forall a b. (a -> b) -> a -> b
$ FilePath -> [RTLDFlags] -> IO DL
dlopen FilePath
dynlibFile [RTLDFlags
RTLD_NOW]
      WGPUHsInstance
inst <- IO WGPUHsInstance -> m WGPUHsInstance
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WGPUHsInstance -> m WGPUHsInstance)
-> IO WGPUHsInstance -> m WGPUHsInstance
forall a b. (a -> b) -> a -> b
$ (forall a. FilePath -> IO (FunPtr a)) -> IO WGPUHsInstance
loadDynamicInstance (DL -> FilePath -> IO (FunPtr a)
forall a. DL -> FilePath -> IO (FunPtr a)
dlsym DL
dl)
      InstanceHandle -> m InstanceHandle
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DL -> WGPUHsInstance -> InstanceHandle
InstanceHandle DL
dl WGPUHsInstance
inst)

    release :: InstanceHandle -> m ()
    release :: InstanceHandle -> m ()
release = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (InstanceHandle -> IO ()) -> InstanceHandle -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DL -> IO ()
dlclose (DL -> IO ()) -> (InstanceHandle -> DL) -> InstanceHandle -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstanceHandle -> DL
instanceHandleDL

  m InstanceHandle -> (InstanceHandle -> m ()) -> r
bkt m InstanceHandle
create InstanceHandle -> m ()
release
#endif

#ifdef WGPUHS_WINDOWS
import Foreign (FunPtr, castPtrToFunPtr)
import System.Win32.DLL (loadLibrary, freeLibrary, getProcAddress)
import System.Win32.Types (HINSTANCE)

data InstanceHandle = InstanceHandle
  { instanceHandleDL :: !HINSTANCE,
    instanceHandleInstance :: !WGPUHsInstance
  }

-- | Load WGPU from a dynamic library and run a program using an instance.
withWGPU ::
  forall m r.
  MonadIO m =>
  -- | Path to the wgpu-native dynamic library to load.
  FilePath ->
  -- | Bracketing function.
  -- This can (for example) be something like 'Control.Exception.Safe.bracket'.
  (m InstanceHandle -> (InstanceHandle -> m ()) -> r) ->
  -- | Usage or action component of the bracketing function.
  r
withWGPU dynlibFile bkt = do
  let
    create :: m InstanceHandle
    create = do
      hInstance <- liftIO $ loadLibrary dynlibFile
      let load :: String -> IO (FunPtr a)
          load = fmap castPtrToFunPtr . getProcAddress hInstance
      inst <- liftIO $ loadDynamicInstance load
      pure (InstanceHandle hInstance inst)

    release :: InstanceHandle -> m ()
    release = liftIO . freeLibrary . instanceHandleDL

  bkt create release
#endif