{-# 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 }