{-# LANGUAGE BlockArguments #-}
{-# 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
	CompilerT
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
	T
rslt <- CompilerT
-> SourceText
-> ShaderKind
-> SourceText
-> SourceText
-> C ud
-> ContT (S sknd) IO T
forall ud r.
Storable ud =>
CompilerT
-> SourceText
-> ShaderKind
-> SourceText
-> SourceText
-> C ud
-> ContT r IO T
M.compileIntoSpv CompilerT
cmp SourceText
src (forall (sknd :: ShaderKind). IsShaderKind sknd => ShaderKind
shaderKind @sknd) SourceText
ifnm SourceText
epnm C ud
opts
	IO () -> ContT (S sknd) IO ()
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 () -> ContT (S sknd) IO ()) -> IO () -> ContT (S sknd) IO ()
forall a b. (a -> b) -> a -> b
$ T -> IO ()
throwUnlessSuccess T
rslt
	IO (S sknd) -> ContT (S sknd) IO (S sknd)
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 do	Ptr CChar
cspv <- T -> IO (Ptr CChar)
CompilationResult.getBytes T
rslt
		(Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
cspvln) <- T -> IO Word64
CompilationResult.getLength T
rslt
		SourceText
spv <- CStringLen -> IO SourceText
BS.packCStringLen (Ptr CChar
cspv, Int
cspvln)
		T -> IO ()
CompilationResult.release T
rslt
		CompilerT -> IO ()
C.compilerRelease CompilerT
cmp
		S sknd -> IO (S sknd)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (S sknd -> IO (S sknd)) -> S sknd -> IO (S sknd)
forall a b. (a -> b) -> a -> b
$ SourceText -> S sknd
forall (sknd :: ShaderKind). SourceText -> S sknd
S SourceText
spv

type SourceText = BS.ByteString
type InputFileName = BS.ByteString
type EntryPointName = BS.ByteString