FFI.hs

{-# LANGUAGE Strict #-}

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

import Control.Exception (onException)
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 (callocBytes, castPtr, free)
import System.Mem.Weak (addFinalizer)

import Data.SpirV.Reflect.Module (Module)

load :: MonadIO io => FilePath -> io Module
load path = liftIO $
  ByteString.readFile path >>= loadBytes

loadBytes :: MonadIO io => ByteString -> io Module
loadBytes bytes = liftIO do
  unsafeUseAsCStringLen bytes \(code, size) -> do
    smPtr <- callocBytes C.shaderModuleSize
    flip onException (free smPtr) do
      res <- C.createShaderModule2
        C.SpvReflectModuleFlagNoCopy
        (fromIntegral size)
        (castPtr code)
        smPtr
      case res of
        C.SpvReflectResultSuccess -> do
          m <- C.inflateModule smPtr `onException` C.destroyShaderModule smPtr
          addFinalizer m $ C.destroyShaderModule smPtr
          pure m
        err ->
          error $ "spvReflectCreateShaderModule2:" <> show err