{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Fence.Middle.Internal (

	-- * CREATE AND DESTROY

	create, destroy, F(..), CreateInfo(..),

	-- * RESET AND WAIT

	resetFs, waitForFs,

	-- * INTERNAL USE

	maybeFToCore

	) where

import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Storable
import Foreign.Storable.PeekPoke (withPoked, withPoked', WithPoked, withPtrS)
import Control.Arrow
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.ParMaybe qualified as TPMaybe
import Data.Default
import Data.Bits
import Data.Word

import Gpu.Vulkan.Base.Middle.Internal
import Gpu.Vulkan.Exception.Middle.Internal
import Gpu.Vulkan.Exception.Enum
import Gpu.Vulkan.Fence.Enum

import qualified Gpu.Vulkan.AllocationCallbacks.Middle.Internal as AllocationCallbacks
import qualified Gpu.Vulkan.Device.Middle.Types as Device
import qualified Gpu.Vulkan.Fence.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 }

deriving instance Show (TMaybe.M mn) => Show (CreateInfo mn)

instance Default (CreateInfo 'Nothing) where
	def :: CreateInfo 'Nothing
def = CreateInfo {
		createInfoNext :: M 'Nothing
createInfoNext = M 'Nothing
TMaybe.N, createInfoFlags :: CreateFlags
createInfoFlags = CreateFlags
forall a. Bits a => a
zeroBits }

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 } Ptr CreateInfo -> IO a
f =
	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') ->
		CreateInfo -> (Ptr CreateInfo -> IO a) -> IO a
forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b
withPoked C.CreateInfo {
			createInfoSType :: ()
C.createInfoSType = (),
			createInfoPNext :: Ptr ()
C.createInfoPNext = Ptr ()
pnxt',
			createInfoFlags :: Word32
C.createInfoFlags = Word32
flgs } Ptr CreateInfo -> IO a
f

newtype F = F C.F deriving Int -> F -> ShowS
[F] -> ShowS
F -> String
(Int -> F -> ShowS) -> (F -> String) -> ([F] -> ShowS) -> Show F
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> F -> ShowS
showsPrec :: Int -> F -> ShowS
$cshow :: F -> String
show :: F -> String
$cshowList :: [F] -> ShowS
showList :: [F] -> ShowS
Show

fToCore :: F -> C.F
fToCore :: F -> F
fToCore (F F
f) = F
f

maybeFToCore :: Maybe F -> C.F
maybeFToCore :: Maybe F -> F
maybeFToCore Maybe F
Nothing = F
forall a. Ptr a
NullHandle
maybeFToCore (Just F
f) = F -> F
fToCore F
f

create :: WithPoked (TMaybe.M mn) =>
	Device.D -> CreateInfo mn -> TPMaybe.M AllocationCallbacks.A mc -> IO F
create :: forall (mn :: Maybe (*)) (mc :: Maybe (*)).
WithPoked (M mn) =>
D -> CreateInfo mn -> M A mc -> IO F
create (Device.D D
dvc) CreateInfo mn
ci M A mc
mac = F -> F
F (F -> F) -> IO F -> IO F
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr F -> IO F) -> IO F
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr F
pf -> 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 F -> IO Int32
C.create D
dvc Ptr CreateInfo
pci Ptr A
pac Ptr F
pf
			throwUnlessSuccess $ Result r
	Ptr F -> IO F
forall a. Storable a => Ptr a -> IO a
peek Ptr F
pf

destroy :: Device.D -> F -> TPMaybe.M AllocationCallbacks.A md -> IO ()
destroy :: forall (md :: Maybe (*)). D -> F -> M A md -> IO ()
destroy (Device.D D
dvc) (F F
f) 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 -> F -> Ptr A -> IO ()
C.destroy D
dvc F
f

waitForFs :: Device.D -> [F] -> Bool -> Word64 -> IO ()
waitForFs :: D -> [F] -> Bool -> Word64 -> IO ()
waitForFs (Device.D D
dvc) ([F] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([F] -> Int) -> ([F] -> [F]) -> [F] -> (Int, [F])
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((\(F F
f) -> F
f) (F -> F) -> [F] -> [F]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) -> (Int
fc, [F]
fs))
	(Bool -> Word32
boolToBool32 -> Word32
wa) Word64
to = Int -> (Ptr F -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
fc \Ptr F
pfs -> do
		Ptr F -> [F] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr F
pfs [F]
fs
		r <- D -> Word32 -> Ptr F -> Word32 -> Word64 -> IO Int32
C.waitForFs D
dvc (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fc) Ptr F
pfs Word32
wa Word64
to
		throwUnlessSuccess $ Result r

resetFs :: Device.D -> [F] -> IO ()
resetFs :: D -> [F] -> IO ()
resetFs (Device.D D
dvc)
	([F] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([F] -> Int) -> ([F] -> [F]) -> [F] -> (Int, [F])
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((\(F F
f) -> F
f) (F -> F) -> [F] -> [F]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) -> (Int
fc, [F]
fs)) = Int -> (Ptr F -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
fc \Ptr F
pfs -> do
		Ptr F -> [F] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr F
pfs [F]
fs
		r <- D -> Word32 -> Ptr F -> IO Int32
C.resetFs D
dvc (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fc) Ptr F
pfs
		throwUnlessSuccess $ Result r