{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Language.SpirV.Shaderc.CompileOptions.Internal where

import Foreign.Ptr
import Foreign.Storable
import Foreign.Storable.PeekPoke
import Control.Monad.Trans
import Control.Monad.Cont
import Data.Default
import Data.Bool

import qualified Data.ByteString as BS

import Shaderc.Enum
import Shaderc.Include

import qualified Shaderc.CompileOptions.Core as C

data C ud = C {
	forall ud. C ud -> [(ByteString, ByteString)]
cMacroDefinitions :: [(BS.ByteString, BS.ByteString)],
	forall ud. C ud -> Maybe SourceLanguage
cSourceLanguage :: Maybe SourceLanguage,
	forall ud. C ud -> Bool
cGenerateDebugInfo :: Bool,
	forall ud. C ud -> Maybe OptimizationLevel
cOptimizationLevel :: Maybe OptimizationLevel,
	forall ud. C ud -> Maybe (Version, Profile)
cForcedVersionProfile :: Maybe (Version, Profile),
	forall ud. C ud -> Maybe (ResolveFn ud, Maybe ud)
cIncludeCallbacks :: Maybe (ResolveFn ud, Maybe ud) }

tToCore :: Storable ud => C ud -> ContT r IO C.C
tToCore :: forall ud r. Storable ud => C ud -> ContT r IO C
tToCore C {
	cMacroDefinitions :: forall ud. C ud -> [(ByteString, ByteString)]
cMacroDefinitions = [(ByteString, ByteString)]
mds,
	cSourceLanguage :: forall ud. C ud -> Maybe SourceLanguage
cSourceLanguage = Maybe SourceLanguage
lng,
	cGenerateDebugInfo :: forall ud. C ud -> Bool
cGenerateDebugInfo = Bool
dbg,
	cOptimizationLevel :: forall ud. C ud -> Maybe OptimizationLevel
cOptimizationLevel = Maybe OptimizationLevel
optLvl,
	cForcedVersionProfile :: forall ud. C ud -> Maybe (Version, Profile)
cForcedVersionProfile = Maybe (Version, Profile)
fvp,
	cIncludeCallbacks :: forall ud. C ud -> Maybe (ResolveFn ud, Maybe ud)
cIncludeCallbacks = Maybe (ResolveFn ud, Maybe ud)
mcb
	} = do
	ct <- IO C -> ContT r IO C
forall (m :: * -> *) a. Monad m => m a -> ContT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO C
C.initialize
	addMacroDefinitions ct mds
	setSourceLanguage ct lng
	setGenerateDebugInfo ct dbg
	setOptimizationLevel ct optLvl
	setForcedVersionProfile ct fvp
	maybe (pure ()) (uncurry $ setIncludeCallbacks ct) mcb
	ContT \C -> IO r
f -> C -> IO r
f C
ct IO r -> IO () -> IO r
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* C -> IO ()
C.release C
ct

addMacroDefinitions :: C.C -> [(BS.ByteString, BS.ByteString)] -> ContT r IO ()
addMacroDefinitions :: forall r. C -> [(ByteString, ByteString)] -> ContT r IO ()
addMacroDefinitions C
opts = ((ByteString, ByteString) -> ContT r IO ())
-> [(ByteString, ByteString)] -> ContT r IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((ByteString, ByteString) -> ContT r IO ())
 -> [(ByteString, ByteString)] -> ContT r IO ())
-> ((ByteString -> ByteString -> ContT r IO ())
    -> (ByteString, ByteString) -> ContT r IO ())
-> (ByteString -> ByteString -> ContT r IO ())
-> [(ByteString, ByteString)]
-> ContT r IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> ContT r IO ())
-> (ByteString, ByteString) -> ContT r IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((ByteString -> ByteString -> ContT r IO ())
 -> [(ByteString, ByteString)] -> ContT r IO ())
-> (ByteString -> ByteString -> ContT r IO ())
-> [(ByteString, ByteString)]
-> ContT r IO ()
forall a b. (a -> b) -> a -> b
$ C -> ByteString -> ByteString -> ContT r IO ()
forall r. C -> ByteString -> ByteString -> ContT r IO ()
addMacroDefinition C
opts

addMacroDefinition :: C.C -> BS.ByteString -> BS.ByteString -> ContT r IO ()
addMacroDefinition :: forall r. C -> ByteString -> ByteString -> ContT r IO ()
addMacroDefinition C
opts ByteString
nm ByteString
vl = do
	(cnm, fromIntegral -> cnmln) <- (((Ptr CChar, Int) -> IO r) -> IO r) -> ContT r IO (Ptr CChar, Int)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT ((((Ptr CChar, Int) -> IO r) -> IO r)
 -> ContT r IO (Ptr CChar, Int))
-> (((Ptr CChar, Int) -> IO r) -> IO r)
-> ContT r IO (Ptr CChar, Int)
forall a b. (a -> b) -> a -> b
$ ByteString -> ((Ptr CChar, Int) -> IO r) -> IO r
forall a. ByteString -> ((Ptr CChar, Int) -> IO a) -> IO a
BS.useAsCStringLen ByteString
nm
	(cvl, fromIntegral -> cvlln) <- ContT $ BS.useAsCStringLen vl
	lift $ C.addMacroDefinition opts cnm cnmln cvl cvlln

setSourceLanguage :: C.C -> Maybe SourceLanguage -> ContT r IO ()
setSourceLanguage :: forall r. C -> Maybe SourceLanguage -> ContT r IO ()
setSourceLanguage C
opts = ContT r IO ()
-> (SourceLanguage -> ContT r IO ())
-> Maybe SourceLanguage
-> ContT r IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ContT r IO ()
forall a. a -> ContT r IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ((SourceLanguage -> ContT r IO ())
 -> Maybe SourceLanguage -> ContT r IO ())
-> (SourceLanguage -> ContT r IO ())
-> Maybe SourceLanguage
-> ContT r IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> ContT r IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT r IO ())
-> (SourceLanguage -> IO ()) -> SourceLanguage -> ContT r IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C -> SourceLanguage -> IO ()
C.setSourceLanguage C
opts

setGenerateDebugInfo :: C.C -> Bool -> ContT r IO ()
setGenerateDebugInfo :: forall r. C -> Bool -> ContT r IO ()
setGenerateDebugInfo C
opts = IO () -> ContT r IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT r IO ())
-> (Bool -> IO ()) -> Bool -> ContT r IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO () -> Bool -> IO ()
forall a. a -> a -> Bool -> a
bool (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (C -> IO ()
C.setGenerateDebugInfo C
opts)

setOptimizationLevel :: C.C -> Maybe OptimizationLevel -> ContT r IO ()
setOptimizationLevel :: forall r. C -> Maybe OptimizationLevel -> ContT r IO ()
setOptimizationLevel C
opts = ContT r IO ()
-> (OptimizationLevel -> ContT r IO ())
-> Maybe OptimizationLevel
-> ContT r IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ContT r IO ()
forall a. a -> ContT r IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ((OptimizationLevel -> ContT r IO ())
 -> Maybe OptimizationLevel -> ContT r IO ())
-> (OptimizationLevel -> ContT r IO ())
-> Maybe OptimizationLevel
-> ContT r IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> ContT r IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT r IO ())
-> (OptimizationLevel -> IO ())
-> OptimizationLevel
-> ContT r IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C -> OptimizationLevel -> IO ()
C.setOptimizationLevel C
opts

setForcedVersionProfile :: C.C -> Maybe (Version, Profile) -> ContT r IO ()
setForcedVersionProfile :: forall r. C -> Maybe (Version, Profile) -> ContT r IO ()
setForcedVersionProfile C
opts =
	ContT r IO ()
-> ((Version, Profile) -> ContT r IO ())
-> Maybe (Version, Profile)
-> ContT r IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ContT r IO ()
forall a. a -> ContT r IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (((Version, Profile) -> ContT r IO ())
 -> Maybe (Version, Profile) -> ContT r IO ())
-> ((Version, Profile) -> ContT r IO ())
-> Maybe (Version, Profile)
-> ContT r IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> ContT r IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT r IO ())
-> ((Version, Profile) -> IO ())
-> (Version, Profile)
-> ContT r IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> Profile -> IO ()) -> (Version, Profile) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (C -> Version -> Profile -> IO ()
C.setForcedVersionProfile C
opts)

setIncludeCallbacks :: (Storable ud, Pokable ud) =>
	C.C -> ResolveFn ud -> Maybe ud -> ContT r IO ()
setIncludeCallbacks :: forall ud r.
(Storable ud, Pokable ud) =>
C -> ResolveFn ud -> Maybe ud -> ContT r IO ()
setIncludeCallbacks C
opts ResolveFn ud
rfun Maybe ud
mud = do
	let	(ResolveFn
crfn, ResultReleaseFn
crrfn) = ResolveFn ud -> (ResolveFn, ResultReleaseFn)
forall ud.
Storable ud =>
ResolveFn ud -> (ResolveFn, ResultReleaseFn)
resolveFnToCore ResolveFn ud
rfun
	(castPtr -> pud) <- ((Ptr ud -> IO r) -> IO r) -> ContT r IO (Ptr ud)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ud -> IO r) -> IO r) -> ContT r IO (Ptr ud))
-> ((Ptr ud -> IO r) -> IO r) -> ContT r IO (Ptr ud)
forall a b. (a -> b) -> a -> b
$ Maybe ud -> (Ptr ud -> IO r) -> IO r
forall a b. Pokable a => Maybe a -> (Ptr a -> IO b) -> IO b
withPokedMaybe Maybe ud
mud
	lift $ C.setIncludeCallbacks opts crfn crrfn pud

instance Default (C ud) where def :: C ud
def = C ud
forall ud. C ud
defaultCompileOptions

defaultCompileOptions :: C ud
defaultCompileOptions :: forall ud. C ud
defaultCompileOptions = C {
	cMacroDefinitions :: [(ByteString, ByteString)]
cMacroDefinitions = [],
	cSourceLanguage :: Maybe SourceLanguage
cSourceLanguage = Maybe SourceLanguage
forall a. Maybe a
Nothing,
	cGenerateDebugInfo :: Bool
cGenerateDebugInfo = Bool
False,
	cOptimizationLevel :: Maybe OptimizationLevel
cOptimizationLevel = Maybe OptimizationLevel
forall a. Maybe a
Nothing,
	cForcedVersionProfile :: Maybe (Version, Profile)
cForcedVersionProfile = Maybe (Version, Profile)
forall a. Maybe a
Nothing,
	cIncludeCallbacks :: Maybe (ResolveFn ud, Maybe ud)
cIncludeCallbacks = Maybe (ResolveFn ud, Maybe ud)
forall a. Maybe a
Nothing }