{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict              #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}
-- | This module allows to load vulkan symbols at runtime.
--
--   It is based on Vulkan API function
--   <https://www.khronos.org/registry/vulkan/specs/1.0/man/html/vkGetInstanceProcAddr.html vkGetInstanceProcAddr>
--   that is a part of Vulkan core 1.0.
--   Also, have a look at
--   <https://vulkan.lunarg.com/doc/view/1.1.70.1/windows/loader_and_layer_interface.html#user-content-instance-versus-device Vulkan loader>
--   page to see other reasons to load symbols manually.
module Graphics.Vulkan.Marshal.Proc
  ( VulkanProc (..)
  , vkGetInstanceProc, vkLookupInstanceProc
  , vkGetDeviceProc, vkLookupDeviceProc
  , vkGetProc, vkLookupProc
    -- * Re-export `Foreign.Ptr`
  , FunPtr, nullFunPtr
  ) where

import           Control.Monad                 (when)
import           Data.Void                     (Void)
import           Foreign.C.String              (CString, peekCString)
import           Foreign.ForeignPtr            (ForeignPtr, newForeignPtr,
                                                withForeignPtr)
import           Foreign.Marshal.Alloc         (alloca)
import           Foreign.Ptr                   (FunPtr, nullFunPtr, nullPtr)
import           Foreign.Storable              (peek)
import           GHC.Ptr                       (Ptr (..))
import           GHC.TypeLits                  (Symbol)
import           System.IO.Unsafe              (unsafePerformIO)



import           Graphics.Vulkan.Types.Handles (VkDevice, VkInstance)

-- | Some of the vulkan functions defined in vulkan extensions are not
--   available at the program linking time.
--   These functions should be discovered at runtime.
--   Vulkan api provides special functions for this,
--     called @vkGetInstanceProcAddr@ and @vkGetDeviceProcAddr@.
--   This class provides a simpler discovery mechanism based on that function.
--   For example, you can get @vkCreateDebugReportCallbackEXT@ function
--   as follows:
--
--   > vkGetInstanceProc @VkCreateDebugReportCallbackEXT vkInstance
class VulkanProc (proc :: Symbol) where
    -- | Haskell signature for the vulkan function
    type VkProcType proc
    -- | Name of the vulkan function
    vkProcSymbol :: CString
    -- | Convert C function pointer to an ordinary haskell function.
    unwrapVkProcPtr :: FunPtr (VkProcType proc) -> VkProcType proc

-- | An alternative to @vkGetInstanceProcAddr@ with type inference
--   and protection against typos.
--
--   Note, this is an unsafe function;
--   it does not check if the result of @vkGetInstanceProcAddr@
--   is a null function pointer.
vkGetInstanceProc :: forall proc . VulkanProc proc
                  => VkInstance -> IO (VkProcType proc)
vkGetInstanceProc :: VkInstance -> IO (VkProcType proc)
vkGetInstanceProc VkInstance
i
  = VulkanProc proc => FunPtr (VkProcType proc) -> VkProcType proc
forall (proc :: Symbol).
VulkanProc proc =>
FunPtr (VkProcType proc) -> VkProcType proc
unwrapVkProcPtr @proc
  (FunPtr (VkProcType proc) -> VkProcType proc)
-> IO (FunPtr (VkProcType proc)) -> IO (VkProcType proc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VkInstance -> CString -> IO (FunPtr (VkProcType proc))
forall a. VkInstance -> CString -> IO (FunPtr a)
c'vkGetInstanceProcAddr VkInstance
i (VulkanProc proc => CString
forall (proc :: Symbol). VulkanProc proc => CString
vkProcSymbol @proc)
{-# INLINE vkGetInstanceProc #-}

-- | An alternative to @vkGetInstanceProcAddr@ with type inference
--   and protection against typos.
vkLookupInstanceProc :: forall proc . VulkanProc proc
                     => VkInstance -> IO (Maybe (VkProcType proc))
vkLookupInstanceProc :: VkInstance -> IO (Maybe (VkProcType proc))
vkLookupInstanceProc VkInstance
i
    = FunPtr (VkProcType proc) -> Maybe (VkProcType proc)
f (FunPtr (VkProcType proc) -> Maybe (VkProcType proc))
-> IO (FunPtr (VkProcType proc)) -> IO (Maybe (VkProcType proc))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VkInstance -> CString -> IO (FunPtr (VkProcType proc))
forall a. VkInstance -> CString -> IO (FunPtr a)
c'vkGetInstanceProcAddr VkInstance
i (VulkanProc proc => CString
forall (proc :: Symbol). VulkanProc proc => CString
vkProcSymbol @proc)
  where
    f :: FunPtr (VkProcType proc) -> Maybe (VkProcType proc)
f FunPtr (VkProcType proc)
p = if FunPtr (VkProcType proc)
p FunPtr (VkProcType proc) -> FunPtr (VkProcType proc) -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr (VkProcType proc)
forall a. FunPtr a
nullFunPtr then Maybe (VkProcType proc)
forall a. Maybe a
Nothing else VkProcType proc -> Maybe (VkProcType proc)
forall a. a -> Maybe a
Just (FunPtr (VkProcType proc) -> VkProcType proc
forall (proc :: Symbol).
VulkanProc proc =>
FunPtr (VkProcType proc) -> VkProcType proc
unwrapVkProcPtr @proc FunPtr (VkProcType proc)
p)
{-# INLINE vkLookupInstanceProc #-}


-- | An alternative to @vkGetDeviceProcAddr@ with type inference
--   and protection against typos.
--
--   Note, this is an unsafe function;
--   it does not check if the result of @vkGetInstanceProcAddr@
--   is a null function pointer.
vkGetDeviceProc :: forall proc . VulkanProc proc
                => VkDevice -> IO (VkProcType proc)
vkGetDeviceProc :: VkDevice -> IO (VkProcType proc)
vkGetDeviceProc VkDevice
i
  = VulkanProc proc => FunPtr (VkProcType proc) -> VkProcType proc
forall (proc :: Symbol).
VulkanProc proc =>
FunPtr (VkProcType proc) -> VkProcType proc
unwrapVkProcPtr @proc
  (FunPtr (VkProcType proc) -> VkProcType proc)
-> IO (FunPtr (VkProcType proc)) -> IO (VkProcType proc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VkDevice -> CString -> IO (FunPtr (VkProcType proc))
forall a. VkDevice -> CString -> IO (FunPtr a)
c'vkGetDeviceProcAddr VkDevice
i (VulkanProc proc => CString
forall (proc :: Symbol). VulkanProc proc => CString
vkProcSymbol @proc)
{-# INLINE vkGetDeviceProc #-}

-- | An alternative to @vkGetDeviceProcAddr@ with type inference
--   and protection against typos.
vkLookupDeviceProc :: forall proc . VulkanProc proc
                   => VkDevice -> IO (Maybe (VkProcType proc))
vkLookupDeviceProc :: VkDevice -> IO (Maybe (VkProcType proc))
vkLookupDeviceProc VkDevice
i
    = FunPtr (VkProcType proc) -> Maybe (VkProcType proc)
f (FunPtr (VkProcType proc) -> Maybe (VkProcType proc))
-> IO (FunPtr (VkProcType proc)) -> IO (Maybe (VkProcType proc))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VkDevice -> CString -> IO (FunPtr (VkProcType proc))
forall a. VkDevice -> CString -> IO (FunPtr a)
c'vkGetDeviceProcAddr VkDevice
i (VulkanProc proc => CString
forall (proc :: Symbol). VulkanProc proc => CString
vkProcSymbol @proc)
  where
    f :: FunPtr (VkProcType proc) -> Maybe (VkProcType proc)
f FunPtr (VkProcType proc)
p = if FunPtr (VkProcType proc)
p FunPtr (VkProcType proc) -> FunPtr (VkProcType proc) -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr (VkProcType proc)
forall a. FunPtr a
nullFunPtr then Maybe (VkProcType proc)
forall a. Maybe a
Nothing else VkProcType proc -> Maybe (VkProcType proc)
forall a. a -> Maybe a
Just (FunPtr (VkProcType proc) -> VkProcType proc
forall (proc :: Symbol).
VulkanProc proc =>
FunPtr (VkProcType proc) -> VkProcType proc
unwrapVkProcPtr @proc FunPtr (VkProcType proc)
p)
{-# INLINE vkLookupDeviceProc #-}


-- | Locate Vulkan symbol dynamically at runtime using platform-dependent machinery,
--   such as @dlsym@ or @GetProcAddress@.
--   This function throws an error on failure.
--
--   Consider using `vkGetDeviceProc` or `vkGetInstanceProc` for loading a symbol,
--    because they can return a more optimized version of a function.
--   Also note, you are likely not able to lookup an extension funcion using
--   `vkGetProc`, because a corresponding symbol is simply not present in the
--   vulkan loader library.
vkGetProc :: forall proc . VulkanProc proc => IO (VkProcType proc)
vkGetProc :: IO (VkProcType proc)
vkGetProc = (Ptr CString -> IO (VkProcType proc)) -> IO (VkProcType proc)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO (VkProcType proc)) -> IO (VkProcType proc))
-> (Ptr CString -> IO (VkProcType proc)) -> IO (VkProcType proc)
forall a b. (a -> b) -> a -> b
$ \Ptr CString
errPtr -> do
    FunPtr (VkProcType proc)
fp <- ForeignPtr Void
-> (Ptr Void -> IO (FunPtr (VkProcType proc)))
-> IO (FunPtr (VkProcType proc))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
_vkDlHandle ((Ptr Void -> IO (FunPtr (VkProcType proc)))
 -> IO (FunPtr (VkProcType proc)))
-> (Ptr Void -> IO (FunPtr (VkProcType proc)))
-> IO (FunPtr (VkProcType proc))
forall a b. (a -> b) -> a -> b
$ \Ptr Void
h ->
      Ptr Void -> CString -> Ptr CString -> IO (FunPtr (VkProcType proc))
forall a. Ptr Void -> CString -> Ptr CString -> IO (FunPtr a)
c'vkdll_dlsym Ptr Void
h (VulkanProc proc => CString
forall (proc :: Symbol). VulkanProc proc => CString
vkProcSymbol @proc) Ptr CString
errPtr
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FunPtr (VkProcType proc)
fp FunPtr (VkProcType proc) -> FunPtr (VkProcType proc) -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr (VkProcType proc)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
errPtr IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (String
"An error happened while trying to load vulkan symbol dynamically: " String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    VkProcType proc -> IO (VkProcType proc)
forall (m :: * -> *) a. Monad m => a -> m a
return (VkProcType proc -> IO (VkProcType proc))
-> VkProcType proc -> IO (VkProcType proc)
forall a b. (a -> b) -> a -> b
$ FunPtr (VkProcType proc) -> VkProcType proc
forall (proc :: Symbol).
VulkanProc proc =>
FunPtr (VkProcType proc) -> VkProcType proc
unwrapVkProcPtr @proc FunPtr (VkProcType proc)
fp
{-# INLINE vkGetProc #-}

-- | Locate Vulkan symbol dynamically at runtime using platform-dependent machinery,
--   such as @dlsym@ or @GetProcAddress@.
--   This function returns @Nothing@ on failure ignoring an error message.
--
--   Consider using `vkGetDeviceProc` or `vkGetInstanceProc` for loading a symbol,
--    because they can return a more optimized version of a function.
--   Also note, you are likely not able to lookup an extension funcion using
--   `vkLookupProc`, because a corresponding symbol is simply not present in the
--   vulkan loader library.
vkLookupProc :: forall proc . VulkanProc proc => IO (Maybe (VkProcType proc))
vkLookupProc :: IO (Maybe (VkProcType proc))
vkLookupProc = (Ptr CString -> IO (Maybe (VkProcType proc)))
-> IO (Maybe (VkProcType proc))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO (Maybe (VkProcType proc)))
 -> IO (Maybe (VkProcType proc)))
-> (Ptr CString -> IO (Maybe (VkProcType proc)))
-> IO (Maybe (VkProcType proc))
forall a b. (a -> b) -> a -> b
$ \Ptr CString
errPtr -> do
    FunPtr (VkProcType proc)
fp <- ForeignPtr Void
-> (Ptr Void -> IO (FunPtr (VkProcType proc)))
-> IO (FunPtr (VkProcType proc))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
_vkDlHandle ((Ptr Void -> IO (FunPtr (VkProcType proc)))
 -> IO (FunPtr (VkProcType proc)))
-> (Ptr Void -> IO (FunPtr (VkProcType proc)))
-> IO (FunPtr (VkProcType proc))
forall a b. (a -> b) -> a -> b
$ \Ptr Void
h ->
      Ptr Void -> CString -> Ptr CString -> IO (FunPtr (VkProcType proc))
forall a. Ptr Void -> CString -> Ptr CString -> IO (FunPtr a)
c'vkdll_dlsym Ptr Void
h (VulkanProc proc => CString
forall (proc :: Symbol). VulkanProc proc => CString
vkProcSymbol @proc) Ptr CString
errPtr
    Maybe (VkProcType proc) -> IO (Maybe (VkProcType proc))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (VkProcType proc) -> IO (Maybe (VkProcType proc)))
-> Maybe (VkProcType proc) -> IO (Maybe (VkProcType proc))
forall a b. (a -> b) -> a -> b
$ if FunPtr (VkProcType proc)
fp FunPtr (VkProcType proc) -> FunPtr (VkProcType proc) -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr (VkProcType proc)
forall a. FunPtr a
nullFunPtr then Maybe (VkProcType proc)
forall a. Maybe a
Nothing else VkProcType proc -> Maybe (VkProcType proc)
forall a. a -> Maybe a
Just (FunPtr (VkProcType proc) -> VkProcType proc
forall (proc :: Symbol).
VulkanProc proc =>
FunPtr (VkProcType proc) -> VkProcType proc
unwrapVkProcPtr @proc FunPtr (VkProcType proc)
fp)
{-# INLINE vkLookupProc #-}







#ifdef VK_NO_PROTOTYPES

c'vkGetInstanceProcAddr :: VkInstance -> CString -> IO (FunPtr a)
c'vkGetInstanceProcAddr :: VkInstance -> CString -> IO (FunPtr a)
c'vkGetInstanceProcAddr = IO (VkInstance -> CString -> IO (FunPtr a))
-> VkInstance -> CString -> IO (FunPtr a)
forall a. IO a -> a
unsafePerformIO (IO (VkInstance -> CString -> IO (FunPtr a))
 -> VkInstance -> CString -> IO (FunPtr a))
-> IO (VkInstance -> CString -> IO (FunPtr a))
-> VkInstance
-> CString
-> IO (FunPtr a)
forall a b. (a -> b) -> a -> b
$ (Ptr CString -> IO (VkInstance -> CString -> IO (FunPtr a)))
-> IO (VkInstance -> CString -> IO (FunPtr a))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO (VkInstance -> CString -> IO (FunPtr a)))
 -> IO (VkInstance -> CString -> IO (FunPtr a)))
-> (Ptr CString -> IO (VkInstance -> CString -> IO (FunPtr a)))
-> IO (VkInstance -> CString -> IO (FunPtr a))
forall a b. (a -> b) -> a -> b
$ \Ptr CString
errPtr -> do
    FunPtr (VkInstance -> CString -> IO (FunPtr a))
fp <- ForeignPtr Void
-> (Ptr Void
    -> IO (FunPtr (VkInstance -> CString -> IO (FunPtr a))))
-> IO (FunPtr (VkInstance -> CString -> IO (FunPtr a)))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
_vkDlHandle ((Ptr Void -> IO (FunPtr (VkInstance -> CString -> IO (FunPtr a))))
 -> IO (FunPtr (VkInstance -> CString -> IO (FunPtr a))))
-> (Ptr Void
    -> IO (FunPtr (VkInstance -> CString -> IO (FunPtr a))))
-> IO (FunPtr (VkInstance -> CString -> IO (FunPtr a)))
forall a b. (a -> b) -> a -> b
$ \Ptr Void
h ->
      Ptr Void
-> CString
-> Ptr CString
-> IO (FunPtr (VkInstance -> CString -> IO (FunPtr a)))
forall a. Ptr Void -> CString -> Ptr CString -> IO (FunPtr a)
c'vkdll_dlsym Ptr Void
h (Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
"vkGetInstanceProcAddr"#) Ptr CString
errPtr
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FunPtr (VkInstance -> CString -> IO (FunPtr a))
fp FunPtr (VkInstance -> CString -> IO (FunPtr a))
-> FunPtr (VkInstance -> CString -> IO (FunPtr a)) -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr (VkInstance -> CString -> IO (FunPtr a))
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
errPtr IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (String
"Could not load 'vkGetInstanceProcAddr' C function from vulkan library dynamically: " String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    (VkInstance -> CString -> IO (FunPtr a))
-> IO (VkInstance -> CString -> IO (FunPtr a))
forall (m :: * -> *) a. Monad m => a -> m a
return ((VkInstance -> CString -> IO (FunPtr a))
 -> IO (VkInstance -> CString -> IO (FunPtr a)))
-> (VkInstance -> CString -> IO (FunPtr a))
-> IO (VkInstance -> CString -> IO (FunPtr a))
forall a b. (a -> b) -> a -> b
$ FunPtr (VkInstance -> CString -> IO (FunPtr a))
-> VkInstance -> CString -> IO (FunPtr a)
forall a.
FunPtr (VkInstance -> CString -> IO (FunPtr a))
-> VkInstance -> CString -> IO (FunPtr a)
unwrap'vkGetInstanceProcAddr FunPtr (VkInstance -> CString -> IO (FunPtr a))
fp

c'vkGetDeviceProcAddr :: VkDevice -> CString -> IO (FunPtr a)
c'vkGetDeviceProcAddr :: VkDevice -> CString -> IO (FunPtr a)
c'vkGetDeviceProcAddr = IO (VkDevice -> CString -> IO (FunPtr a))
-> VkDevice -> CString -> IO (FunPtr a)
forall a. IO a -> a
unsafePerformIO (IO (VkDevice -> CString -> IO (FunPtr a))
 -> VkDevice -> CString -> IO (FunPtr a))
-> IO (VkDevice -> CString -> IO (FunPtr a))
-> VkDevice
-> CString
-> IO (FunPtr a)
forall a b. (a -> b) -> a -> b
$ (Ptr CString -> IO (VkDevice -> CString -> IO (FunPtr a)))
-> IO (VkDevice -> CString -> IO (FunPtr a))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO (VkDevice -> CString -> IO (FunPtr a)))
 -> IO (VkDevice -> CString -> IO (FunPtr a)))
-> (Ptr CString -> IO (VkDevice -> CString -> IO (FunPtr a)))
-> IO (VkDevice -> CString -> IO (FunPtr a))
forall a b. (a -> b) -> a -> b
$ \Ptr CString
errPtr -> do
    FunPtr (VkDevice -> CString -> IO (FunPtr a))
fp <- ForeignPtr Void
-> (Ptr Void -> IO (FunPtr (VkDevice -> CString -> IO (FunPtr a))))
-> IO (FunPtr (VkDevice -> CString -> IO (FunPtr a)))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
_vkDlHandle ((Ptr Void -> IO (FunPtr (VkDevice -> CString -> IO (FunPtr a))))
 -> IO (FunPtr (VkDevice -> CString -> IO (FunPtr a))))
-> (Ptr Void -> IO (FunPtr (VkDevice -> CString -> IO (FunPtr a))))
-> IO (FunPtr (VkDevice -> CString -> IO (FunPtr a)))
forall a b. (a -> b) -> a -> b
$ \Ptr Void
h ->
      Ptr Void
-> CString
-> Ptr CString
-> IO (FunPtr (VkDevice -> CString -> IO (FunPtr a)))
forall a. Ptr Void -> CString -> Ptr CString -> IO (FunPtr a)
c'vkdll_dlsym Ptr Void
h (Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
"vkGetDeviceProcAddr"#) Ptr CString
errPtr
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FunPtr (VkDevice -> CString -> IO (FunPtr a))
fp FunPtr (VkDevice -> CString -> IO (FunPtr a))
-> FunPtr (VkDevice -> CString -> IO (FunPtr a)) -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr (VkDevice -> CString -> IO (FunPtr a))
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
errPtr IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (String
"Could not load 'vkGetDeviceProcAddr' C function from vulkan library dynamically: " String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    (VkDevice -> CString -> IO (FunPtr a))
-> IO (VkDevice -> CString -> IO (FunPtr a))
forall (m :: * -> *) a. Monad m => a -> m a
return ((VkDevice -> CString -> IO (FunPtr a))
 -> IO (VkDevice -> CString -> IO (FunPtr a)))
-> (VkDevice -> CString -> IO (FunPtr a))
-> IO (VkDevice -> CString -> IO (FunPtr a))
forall a b. (a -> b) -> a -> b
$ FunPtr (VkDevice -> CString -> IO (FunPtr a))
-> VkDevice -> CString -> IO (FunPtr a)
forall a.
FunPtr (VkDevice -> CString -> IO (FunPtr a))
-> VkDevice -> CString -> IO (FunPtr a)
unwrap'vkGetDeviceProcAddr FunPtr (VkDevice -> CString -> IO (FunPtr a))
fp

foreign import ccall unsafe "dynamic"
  unwrap'vkGetInstanceProcAddr
    :: FunPtr (VkInstance -> CString -> IO (FunPtr a))
    -> VkInstance -> CString -> IO (FunPtr a)

foreign import ccall unsafe "dynamic"
  unwrap'vkGetDeviceProcAddr
    :: FunPtr (VkDevice -> CString -> IO (FunPtr a))
    -> VkDevice -> CString -> IO (FunPtr a)

#else

foreign import ccall unsafe "vkGetInstanceProcAddr"
  c'vkGetInstanceProcAddr :: VkInstance -> CString -> IO (FunPtr a)

foreign import ccall unsafe "vkGetDeviceProcAddr"
  c'vkGetDeviceProcAddr :: VkDevice -> CString -> IO (FunPtr a)

#endif


foreign import ccall safe "_vkdll_dlinit"
  c'vkdll_dlinit :: Ptr CString -> IO (Ptr Void)

foreign import ccall safe "_vkdll_dlsym"
  c'vkdll_dlsym :: Ptr Void -> CString -> Ptr CString -> IO (FunPtr a)

foreign import ccall safe "&_vkdll_dlclose"
  p'vk_dlclose :: FunPtr (Ptr Void -> IO ())

_vkDlHandle :: ForeignPtr Void
_vkDlHandle :: ForeignPtr Void
_vkDlHandle = IO (ForeignPtr Void) -> ForeignPtr Void
forall a. IO a -> a
unsafePerformIO (IO (ForeignPtr Void) -> ForeignPtr Void)
-> IO (ForeignPtr Void) -> ForeignPtr Void
forall a b. (a -> b) -> a -> b
$ (Ptr CString -> IO (ForeignPtr Void)) -> IO (ForeignPtr Void)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO (ForeignPtr Void)) -> IO (ForeignPtr Void))
-> (Ptr CString -> IO (ForeignPtr Void)) -> IO (ForeignPtr Void)
forall a b. (a -> b) -> a -> b
$ \Ptr CString
errPtr -> do
  Ptr Void
handle <- Ptr CString -> IO (Ptr Void)
c'vkdll_dlinit Ptr CString
errPtr
  if Ptr Void
handle Ptr Void -> Ptr Void -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Void
forall a. Ptr a
nullPtr
  then
    Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
errPtr IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString IO String
-> (String -> IO (ForeignPtr Void)) -> IO (ForeignPtr Void)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO (ForeignPtr Void)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (ForeignPtr Void))
-> (String -> String) -> String -> IO (ForeignPtr Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (String
"An error happened while trying to load vulkan library dynamically: " String -> String -> String
forall a. [a] -> [a] -> [a]
++)
  else
    FinalizerPtr Void -> Ptr Void -> IO (ForeignPtr Void)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Void
p'vk_dlclose Ptr Void
handle
{-# NOINLINE _vkDlHandle #-}