{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ScopedTypeVariables, RankNTypes, TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.PipelineCache (

	-- * CREATE

	create, P, M.CreateInfo(..),

	-- * GET DATA

	getData, M.Data(..),

	-- * READ AND WRITE DATA

	readFile, writeFile, hRead, hWrite

	) where

import Prelude hiding (readFile, writeFile)

import Foreign.Storable.PeekPoke
import Control.Exception
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.ParMaybe qualified as TPMaybe
import Data.TypeLevel.Tuple.Uncurry

import Gpu.Vulkan.PipelineCache.Type

import Gpu.Vulkan.AllocationCallbacks qualified as AllocationCallbacks
import Gpu.Vulkan.AllocationCallbacks.Type qualified as AllocationCallbacks
import Gpu.Vulkan.Device qualified as Device
import Gpu.Vulkan.Device.Type qualified as Device
import Gpu.Vulkan.PipelineCache.Middle qualified as M (
	create, destroy, CreateInfo(..), getData, Data(..) )

import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Alloc
import Foreign.C.Types
import Data.Word
import System.IO (Handle, hGetBuf, hPutBuf, withBinaryFile, IOMode(..))

import Data.ByteString qualified as BS

create :: (WithPoked (TMaybe.M mn), AllocationCallbacks.ToMiddle mscc) =>
	Device.D sd -> M.CreateInfo mn ->
	TPMaybe.M (U2 AllocationCallbacks.A) mscc -> (forall s . P s -> IO a) -> IO a
create :: forall (mn :: Maybe (*)) (mscc :: Maybe (*, *)) sd a.
(WithPoked (M mn), ToMiddle mscc) =>
D sd
-> CreateInfo mn
-> M (U2 A) mscc
-> (forall s. P s -> IO a)
-> IO a
create (Device.D D
dv) CreateInfo mn
ci
	(M (U2 A) mscc -> M A (Snd mscc)
forall (msa :: Maybe (*, *)).
ToMiddle msa =>
M (U2 A) msa -> M A (Snd msa)
AllocationCallbacks.toMiddle -> M A (Snd mscc)
mac) forall s. P s -> IO a
f =
	IO P -> (P -> IO ()) -> (P -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (D -> CreateInfo mn -> M A (Snd mscc) -> IO P
forall (mn :: Maybe (*)) (mc :: Maybe (*)).
WithPoked (M mn) =>
D -> CreateInfo mn -> M A mc -> IO P
M.create D
dv CreateInfo mn
ci M A (Snd mscc)
mac) (\P
c -> D -> P -> M A (Snd mscc) -> IO ()
forall (md :: Maybe (*)). D -> P -> M A md -> IO ()
M.destroy D
dv P
c M A (Snd mscc)
mac) (P Any -> IO a
forall s. P s -> IO a
f (P Any -> IO a) -> (P -> P Any) -> P -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P -> P Any
forall s. P -> P s
P)

getData :: Device.D sd -> P s -> IO M.Data
getData :: forall sd s. D sd -> P s -> IO Data
getData (Device.D D
dv) (P P
c) = D -> P -> IO Data
M.getData D
dv P
c

readFile :: FilePath -> IO M.Data
readFile :: FilePath -> IO Data
readFile FilePath
fp = FilePath -> IOMode -> (Handle -> IO Data) -> IO Data
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
fp IOMode
ReadMode Handle -> IO Data
hRead

hRead :: Handle -> IO M.Data
hRead :: Handle -> IO Data
hRead Handle
h = do
	Word64
sz <- Handle -> IO Word64
readDataSize Handle
h
	Int -> (Ptr CChar -> IO Data) -> IO Data
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sz) \Ptr CChar
pd -> do
		Int
_ <- Handle -> Ptr CChar -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
h Ptr CChar
pd (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sz)
		Word64 -> Ptr CChar -> IO Data
dataFromRaw Word64
sz Ptr CChar
pd

writeFile :: FilePath -> M.Data -> IO ()
writeFile :: FilePath -> Data -> IO ()
writeFile FilePath
fp Data
d = FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
fp IOMode
WriteMode (Handle -> Data -> IO ()
`hWrite` Data
d)

hWrite :: Handle -> M.Data -> IO ()
hWrite :: Handle -> Data -> IO ()
hWrite Handle
h Data
d = Data -> (Word64 -> Ptr CChar -> IO ()) -> IO ()
forall a. Data -> (Word64 -> Ptr CChar -> IO a) -> IO a
dataToRaw Data
d \Word64
sz Ptr CChar
pd ->
	Handle -> Word64 -> IO ()
writeDataSize Handle
h Word64
sz IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Ptr CChar -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
h Ptr CChar
pd (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sz)

readDataSize :: Handle -> IO Word64
readDataSize :: Handle -> IO Word64
readDataSize = Handle -> IO Word64
forall a. Storable a => Handle -> IO a
readStorable

readStorable :: forall a . Storable a => Handle -> IO a
readStorable :: forall a. Storable a => Handle -> IO a
readStorable Handle
h = (Ptr a -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr a
px -> Handle -> Ptr a -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
h Ptr a
px (forall a. Storable a => a -> Int
sizeOf @a a
forall a. HasCallStack => a
undefined) IO Int -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
px

writeDataSize :: Handle -> Word64 -> IO ()
writeDataSize :: Handle -> Word64 -> IO ()
writeDataSize = Handle -> Word64 -> IO ()
forall a. Storable a => Handle -> a -> IO ()
writeStorable

writeStorable :: Storable a => Handle -> a -> IO ()
writeStorable :: forall a. Storable a => Handle -> a -> IO ()
writeStorable Handle
h a
x = (Ptr a -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr a
px -> Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
px a
x IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Ptr a -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
h Ptr a
px (a -> Int
forall a. Storable a => a -> Int
sizeOf a
x)

dataFromRaw :: Word64 -> Ptr CChar -> IO M.Data
dataFromRaw :: Word64 -> Ptr CChar -> IO Data
dataFromRaw Word64
sz Ptr CChar
pd = ByteString -> Data
M.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 :: M.Data -> (Word64 -> Ptr CChar -> IO a) -> IO a
dataToRaw :: forall a. Data -> (Word64 -> Ptr CChar -> IO a) -> IO a
dataToRaw (M.Data ByteString
bs) Word64 -> Ptr CChar -> 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) -> Word64 -> Ptr CChar -> IO a
f (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz) Ptr CChar
pd