{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
module WGPU.Raw.Dynamic
(
InstanceHandle (..),
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
}
withWGPU ::
forall m r.
MonadIO m =>
FilePath ->
(m InstanceHandle -> (InstanceHandle -> m ()) -> r) ->
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
}
withWGPU ::
forall m r.
MonadIO m =>
FilePath ->
(m InstanceHandle -> (InstanceHandle -> m ()) -> r) ->
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