{-# LINE 1 "src/Gpu/Vulkan/PipelineCache/Middle/Internal.hsc" #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE BlockArguments, OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables, TypeApplications #-} {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE FlexibleContexts, UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -Wall -fno-warn-tabs #-} module Gpu.Vulkan.PipelineCache.Middle.Internal ( P(..), CreateInfo(..), create, destroy, Data(..), getData, ) where import Foreign.Ptr import Foreign.Marshal.Alloc import Foreign.Storable import Foreign.Storable.PeekPoke import Foreign.C.Types import Data.TypeLevel.Maybe qualified as TMaybe import Data.TypeLevel.ParMaybe qualified as TPMaybe import Data.Default import Data.Word import Data.ByteString qualified as BS import Gpu.Vulkan.Exception.Middle.Internal import Gpu.Vulkan.Exception.Enum import Gpu.Vulkan.PipelineCache.Enum import Gpu.Vulkan.AllocationCallbacks.Middle.Internal qualified as AllocationCallbacks import qualified Gpu.Vulkan.Device.Middle.Internal as Device import qualified Gpu.Vulkan.PipelineCache.Core as C data CreateInfo mn = CreateInfo { forall (mn :: Maybe (*)). CreateInfo mn -> M mn createInfoNext :: TMaybe.M mn, forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlags createInfoFlags :: CreateFlags, forall (mn :: Maybe (*)). CreateInfo mn -> Data createInfoInitialData :: Data } deriving instance Show (TMaybe.M mn) => Show (CreateInfo mn) createInfoToCore :: WithPoked (TMaybe.M mn) => CreateInfo mn -> (Ptr C.CreateInfo -> IO a) -> IO () createInfoToCore :: forall (mn :: Maybe (*)) a. WithPoked (M mn) => CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO () createInfoToCore CreateInfo { createInfoNext :: forall (mn :: Maybe (*)). CreateInfo mn -> M mn createInfoNext = M mn mnxt, createInfoFlags :: forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlags createInfoFlags = CreateFlagBits Word32 flgs, createInfoInitialData :: forall (mn :: Maybe (*)). CreateInfo mn -> Data createInfoInitialData = Data d } Ptr CreateInfo -> IO a f = Data -> (DataRaw -> IO ()) -> IO () forall a. Data -> (DataRaw -> IO a) -> IO a dataToRaw Data d \(DataRaw Word64 dtsz Ptr CChar pdt) -> M mn -> (forall s. PtrS s (M mn) -> IO ()) -> IO () forall a b. WithPoked a => a -> (forall s. PtrS s a -> IO b) -> IO b forall b. M mn -> (forall s. PtrS s (M mn) -> IO b) -> IO b withPoked' M mn mnxt \PtrS s (M mn) pnxt -> PtrS s (M mn) -> (Ptr (M mn) -> IO a) -> IO () forall s a b. PtrS s a -> (Ptr a -> IO b) -> IO () withPtrS PtrS s (M mn) pnxt \(Ptr (M mn) -> Ptr () forall a b. Ptr a -> Ptr b castPtr -> Ptr () pnxt') -> let ci :: CreateInfo ci = C.CreateInfo { createInfoSType :: () C.createInfoSType = (), createInfoPNext :: Ptr () C.createInfoPNext = Ptr () pnxt', createInfoFlags :: Word32 C.createInfoFlags = Word32 flgs, createInfoInitialDataSize :: Word64 C.createInfoInitialDataSize = Word64 dtsz, createInfoPInitialData :: Ptr () C.createInfoPInitialData = Ptr CChar -> Ptr () forall a b. Ptr a -> Ptr b castPtr Ptr CChar pdt } in CreateInfo -> (Ptr CreateInfo -> IO a) -> IO a forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b withPoked CreateInfo ci Ptr CreateInfo -> IO a f newtype P = P C.P deriving Int -> P -> ShowS [P] -> ShowS P -> String (Int -> P -> ShowS) -> (P -> String) -> ([P] -> ShowS) -> Show P forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> P -> ShowS showsPrec :: Int -> P -> ShowS $cshow :: P -> String show :: P -> String $cshowList :: [P] -> ShowS showList :: [P] -> ShowS Show create :: WithPoked (TMaybe.M mn) => Device.D -> CreateInfo mn -> TPMaybe.M AllocationCallbacks.A mc -> IO P create :: forall (mn :: Maybe (*)) (mc :: Maybe (*)). WithPoked (M mn) => D -> CreateInfo mn -> M A mc -> IO P create (Device.D D dvc) CreateInfo mn ci M A mc mac = P -> P P (P -> P) -> IO P -> IO P forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Ptr P -> IO P) -> IO P forall a b. Storable a => (Ptr a -> IO b) -> IO b alloca \Ptr P pc -> do CreateInfo mn -> (Ptr CreateInfo -> IO ()) -> IO () forall (mn :: Maybe (*)) a. WithPoked (M mn) => CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO () createInfoToCore CreateInfo mn ci \Ptr CreateInfo pci -> M A mc -> (Ptr A -> IO ()) -> IO () forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO () AllocationCallbacks.mToCore M A mc mac \Ptr A pac -> do r <- D -> Ptr CreateInfo -> Ptr A -> Ptr P -> IO Int32 C.create D dvc Ptr CreateInfo pci Ptr A pac Ptr P pc throwUnlessSuccess $ Result r Ptr P -> IO P forall a. Storable a => Ptr a -> IO a peek Ptr P pc destroy :: Device.D -> P -> TPMaybe.M AllocationCallbacks.A md -> IO () destroy :: forall (md :: Maybe (*)). D -> P -> M A md -> IO () destroy (Device.D D dvc) (P P c) M A md mac = M A md -> (Ptr A -> IO ()) -> IO () forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO () AllocationCallbacks.mToCore M A md mac ((Ptr A -> IO ()) -> IO ()) -> (Ptr A -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ D -> P -> Ptr A -> IO () C.destroy D dvc P c getData :: Device.D -> P -> IO Data getData :: D -> P -> IO Data getData (Device.D D dv) (P P c) = (Ptr Word64 -> IO Data) -> IO Data forall a b. Storable a => (Ptr a -> IO b) -> IO b alloca \Ptr Word64 psz -> do r <- D -> P -> Ptr Word64 -> Ptr () -> IO Int32 C.getData D dv P c Ptr Word64 psz Ptr () forall a. Ptr a nullPtr throwUnlessSuccess $ Result r sz <- peek psz allocaBytes (fromIntegral sz) \Ptr () pdt -> do r' <- D -> P -> Ptr Word64 -> Ptr () -> IO Int32 C.getData D dv P c Ptr Word64 psz Ptr () pdt throwUnlessSuccess $ Result r' dataFromRaw . DataRaw sz $ castPtr pdt dataFromRaw :: DataRaw -> IO Data dataFromRaw :: DataRaw -> IO Data dataFromRaw (DataRaw Word64 sz Ptr CChar pd) = ByteString -> Data Data (ByteString -> Data) -> IO ByteString -> IO Data forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> CStringLen -> IO ByteString BS.packCStringLen (Ptr CChar pd, Word64 -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 sz) dataToRaw :: Data -> (DataRaw -> IO a) -> IO a dataToRaw :: forall a. Data -> (DataRaw -> IO a) -> IO a dataToRaw (Data ByteString bs) DataRaw -> IO a f = ByteString -> (CStringLen -> IO a) -> IO a forall a. ByteString -> (CStringLen -> IO a) -> IO a BS.useAsCStringLen ByteString bs \(Ptr CChar pd, Int sz) -> DataRaw -> IO a f (DataRaw -> IO a) -> DataRaw -> IO a forall a b. (a -> b) -> a -> b $ Word64 -> Ptr CChar -> DataRaw DataRaw (Int -> Word64 forall a b. (Integral a, Num b) => a -> b fromIntegral Int sz) Ptr CChar pd newtype Data = Data BS.ByteString deriving (Int -> Data -> ShowS [Data] -> ShowS Data -> String (Int -> Data -> ShowS) -> (Data -> String) -> ([Data] -> ShowS) -> Show Data forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> Data -> ShowS showsPrec :: Int -> Data -> ShowS $cshow :: Data -> String show :: Data -> String $cshowList :: [Data] -> ShowS showList :: [Data] -> ShowS Show, Data -> Data -> Bool (Data -> Data -> Bool) -> (Data -> Data -> Bool) -> Eq Data forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Data -> Data -> Bool == :: Data -> Data -> Bool $c/= :: Data -> Data -> Bool /= :: Data -> Data -> Bool Eq) data DataRaw = DataRaw Word64 (Ptr CChar) deriving Int -> DataRaw -> ShowS [DataRaw] -> ShowS DataRaw -> String (Int -> DataRaw -> ShowS) -> (DataRaw -> String) -> ([DataRaw] -> ShowS) -> Show DataRaw forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> DataRaw -> ShowS showsPrec :: Int -> DataRaw -> ShowS $cshow :: DataRaw -> String show :: DataRaw -> String $cshowList :: [DataRaw] -> ShowS showList :: [DataRaw] -> ShowS Show {-# LINE 95 "src/Gpu/Vulkan/PipelineCache/Middle/Internal.hsc" #-} instance Default Data where def :: Data def = ByteString -> Data Data ByteString "" instance Default DataRaw where def :: DataRaw def = Word64 -> Ptr CChar -> DataRaw DataRaw Word64 0 Ptr CChar forall a. Ptr a nullPtr