module Data.SpirV.Reflect.FFI
  ( Module
  , load
  , loadBytes
  ) where

import Control.Exception (finally)
import Control.Monad.IO.Class (MonadIO(..))
import Data.ByteString (ByteString)
import Data.ByteString qualified as ByteString
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.SpirV.Reflect.FFI.Internal qualified as C
import Foreign (allocaBytes, castPtr)

import Data.SpirV.Reflect.Module (Module)

load :: MonadIO io => FilePath -> io Module
load :: forall (io :: * -> *). MonadIO io => FilePath -> io Module
load FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
  FilePath -> IO ByteString
ByteString.readFile FilePath
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (io :: * -> *). MonadIO io => ByteString -> io Module
loadBytes

loadBytes :: MonadIO io => ByteString -> io Module
loadBytes :: forall (io :: * -> *). MonadIO io => ByteString -> io Module
loadBytes ByteString
bytes = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bytes \(Ptr CChar
code, Int
size) -> do
    forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
C.shaderModuleSize \Ptr ()
smPtr -> do
      Result
res <- ModuleFlags -> CULong -> Ptr () -> Ptr () -> IO Result
C.createShaderModule2
        ModuleFlags
C.SpvReflectModuleFlagNoCopy
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
        (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
code)
        Ptr ()
smPtr
      case Result
res of
        Result
C.SpvReflectResultSuccess ->
          Ptr () -> IO Module
C.inflateModule Ptr ()
smPtr forall a b. IO a -> IO b -> IO a
`finally` Ptr () -> IO ()
C.destroyShaderModule Ptr ()
smPtr
        Result
err ->
          forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"spvReflectCreateShaderModule2:" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Result
err