{-# LANGUAGE BlockArguments, OverloadedStrings #-} {-# LANGUAGE TypeApplications, ScopedTypeVariables #-} {-# LANGUAGE DataKinds, KindSignatures #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -Wall -fno-warn-tabs #-} module Language.SpirV.Shaderc ( compile, SourceText, InputFileName, EntryPointName ) where import Foreign.Storable import Control.Monad.Trans import Control.Monad.Cont import qualified Data.ByteString as BS import Language.SpirV.Internal import Language.SpirV.ShaderKind import Language.SpirV.Shaderc.Exception.Internal import qualified Shaderc.Core as C import qualified Shaderc.Middle as M import qualified Language.SpirV.Shaderc.CompileOptions as CompileOptions import qualified Shaderc.CompilationResult.Core as CompilationResult compile :: forall ud sknd . (Storable ud, IsShaderKind sknd) => SourceText -> InputFileName -> EntryPointName -> CompileOptions.C ud -> IO (S sknd) compile :: forall ud (sknd :: ShaderKind). (Storable ud, IsShaderKind sknd) => SourceText -> SourceText -> SourceText -> C ud -> IO (S sknd) compile SourceText src SourceText ifnm_ SourceText epnm C ud opts = (((S sknd -> IO (S sknd)) -> IO (S sknd)) -> (S sknd -> IO (S sknd)) -> IO (S sknd) forall a b. (a -> b) -> a -> b $ S sknd -> IO (S sknd) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure) (((S sknd -> IO (S sknd)) -> IO (S sknd)) -> IO (S sknd)) -> ((S sknd -> IO (S sknd)) -> IO (S sknd)) -> IO (S sknd) forall a b. (a -> b) -> a -> b $ ContT (S sknd) IO (S sknd) -> (S sknd -> IO (S sknd)) -> IO (S sknd) forall {k} (r :: k) (m :: k -> *) a. ContT r m a -> (a -> m r) -> m r runContT do cmp <- IO CompilerT -> ContT (S sknd) IO CompilerT forall (m :: * -> *) a. Monad m => m a -> ContT (S sknd) m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift IO CompilerT C.compilerInitialize rslt <- M.compileIntoSpv cmp src (shaderKind @sknd) ifnm epnm opts lift $ throwUnlessSuccess rslt lift do cspv <- CompilationResult.getBytes rslt (fromIntegral -> cspvln) <- CompilationResult.getLength rslt spv <- BS.packCStringLen (cspv, cspvln) CompilationResult.release rslt C.compilerRelease cmp pure $ S spv where ifnm :: SourceText ifnm = case SourceText ifnm_ of SourceText "" -> SourceText "<no name>"; SourceText _ -> SourceText ifnm_ type SourceText = BS.ByteString type InputFileName = BS.ByteString type EntryPointName = BS.ByteString