{- | Experimental helpers for managing models with multiple instance buffers.

Only works with fully-coherent models and atomic stores.
Not particularly efficient: when any element is changed, everything gets fully updated.
-}

module Resource.Model.Observer
  ( newCoherent
  , observeCoherent

  , VertexBuffers(..)
  , genericCreateInitial
  , genericDestroyCurrent

  , UpdateCoherent(..)
  , genericUpdateCoherent
  ) where

import RIO
import GHC.Generics

import Control.Monad.Trans.Resource (ResourceT)
import Control.Monad.Trans.Resource qualified as Resource
import Data.Kind (Type)
import Data.Text qualified as Text
import Data.Vector.Storable qualified as Storable
import Vulkan.Core10 qualified as Vk

import Engine.Types ()
import Engine.Vulkan.Types (HasVulkan, MonadVulkan)
import Engine.Worker qualified as Worker
import Resource.Buffer qualified as Buffer

newCoherent
  :: ( VertexBuffers res
     , MonadVulkan env m
     )
  => Int
  -> Text
  -> ResourceT m (Worker.ObserverIO res)
newCoherent :: forall res env (m :: * -> *).
(VertexBuffers res, MonadVulkan env m) =>
Int -> Text -> ResourceT m (ObserverIO res)
newCoherent Int
initialSize Text
label = do
  res
initial <- Int -> Text -> ResourceT m res
forall a env (m :: * -> *).
(VertexBuffers a, MonadVulkan env m) =>
Int -> Text -> ResourceT m a
forall env (m :: * -> *).
MonadVulkan env m =>
Int -> Text -> ResourceT m res
createInitial Int
initialSize Text
label
  ObserverIO res
observer <- res -> ResourceT m (ObserverIO res)
forall (m :: * -> *) a. MonadIO m => a -> m (ObserverIO a)
Worker.newObserverIO res
initial

  env
context <- ResourceT m env
forall r (m :: * -> *). MonadReader r m => m r
ask
  ResourceT m ReleaseKey -> ResourceT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ResourceT m ReleaseKey -> ResourceT m ())
-> ResourceT m ReleaseKey -> ResourceT m ()
forall a b. (a -> b) -> a -> b
$! IO () -> ResourceT m ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
Resource.register do
    res
current <- ObserverIO res -> IO res
forall (m :: * -> *) a.
MonadUnliftIO m =>
IORef (Versioned a) -> m a
Worker.readObservedIO ObserverIO res
observer
    env -> res -> IO ()
forall env. HasVulkan env => env -> res -> IO ()
forall a env. (VertexBuffers a, HasVulkan env) => env -> a -> IO ()
destroyCurrent env
context res
current

  pure ObserverIO res
observer

observeCoherent
  :: ( MonadVulkan env m
    , Worker.HasOutput output
    , UpdateCoherent bufs (Worker.GetOutput output)
    )
  => output
  -> Worker.ObserverIO bufs
  -> m ()
observeCoherent :: forall env (m :: * -> *) output bufs.
(MonadVulkan env m, HasOutput output,
 UpdateCoherent bufs (GetOutput output)) =>
output -> ObserverIO bufs -> m ()
observeCoherent output
process ObserverIO bufs
observer =
  m bufs -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m bufs -> m ()) -> m bufs -> m ()
forall a b. (a -> b) -> a -> b
$ output
-> ObserverIO bufs
-> (bufs -> GetOutput output -> m bufs)
-> m bufs
forall (m :: * -> *) output a.
(MonadUnliftIO m, HasOutput output) =>
output -> ObserverIO a -> (a -> GetOutput output -> m a) -> m a
Worker.observeIO output
process ObserverIO bufs
observer bufs -> GetOutput output -> m bufs
forall bufs stores env (m :: * -> *).
(UpdateCoherent bufs stores, MonadVulkan env m) =>
bufs -> stores -> m bufs
forall env (m :: * -> *).
MonadVulkan env m =>
bufs -> GetOutput output -> m bufs
updateCoherent

class VertexBuffers a where
  createInitial :: forall env m . MonadVulkan env m => Int -> Text -> ResourceT m a

  default createInitial
    :: forall env m
    .  ( Generic a
       , GVertexBuffers (Rep a)
       , MonadVulkan env m
       )
    => Int
    -> Text
    -> ResourceT m a
  createInitial = Int -> Text -> ResourceT m a
forall a env (m :: * -> *).
(Generic a, GVertexBuffers (Rep a), MonadVulkan env m) =>
Int -> Text -> ResourceT m a
genericCreateInitial

  destroyCurrent :: forall env . HasVulkan env => env -> a -> IO ()
  default destroyCurrent
    :: forall env
    .  ( Generic a
       , GVertexBuffers (Rep a)
       , HasVulkan env
       )
    => env
    -> a
    -> IO ()
  destroyCurrent = env -> a -> IO ()
forall a env.
(Generic a, GVertexBuffers (Rep a), HasVulkan env) =>
env -> a -> IO ()
genericDestroyCurrent

{- XXX: Terminal instance for generic observable requiring only MonadVulkan.

Initial values can be written post-hoc using `updateCoherent` on observed data.
The more problematic part is using hardcoded usage argument.
This is fine for the main use case of model instance buffers, but makes it unsuitable for other uses.
-}
instance Storable a => VertexBuffers (Buffer.Allocated 'Buffer.Coherent a) where
  createInitial :: forall env (m :: * -> *).
MonadVulkan env m =>
Int -> Text -> ResourceT m (Allocated 'Coherent a)
createInitial Int
initialCapacity Text
label =
    Maybe Text
-> BufferUsageFlagBits
-> Int
-> Vector a
-> ResourceT m (Allocated 'Coherent a)
forall a env (m :: * -> *).
(MonadVulkan env m, Storable a) =>
Maybe Text
-> BufferUsageFlagBits
-> Int
-> Vector a
-> m (Allocated 'Coherent a)
Buffer.createCoherent
      (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
label)
      BufferUsageFlagBits
Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT
      Int
initialCapacity
      Vector a
forall a. Monoid a => a
mempty

  destroyCurrent :: forall env. HasVulkan env => env -> Allocated 'Coherent a -> IO ()
destroyCurrent env
ctx Allocated 'Coherent a
buf = env -> Allocated 'Coherent a -> IO ()
forall {k} (io :: * -> *) context (s :: Store) (a :: k).
(MonadUnliftIO io, HasVulkan context) =>
context -> Allocated s a -> io ()
Buffer.destroy env
ctx Allocated 'Coherent a
buf

genericCreateInitial
  :: ( Generic a
     , GVertexBuffers (Rep a)
     , MonadVulkan env m
     )
  => Int
  -> Text
  -> ResourceT m a
genericCreateInitial :: forall a env (m :: * -> *).
(Generic a, GVertexBuffers (Rep a), MonadVulkan env m) =>
Int -> Text -> ResourceT m a
genericCreateInitial Int
size Text
label =
  (Rep a Any -> a) -> ResourceT m (Rep a Any) -> ResourceT m a
forall a b. (a -> b) -> ResourceT m a -> ResourceT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
GHC.Generics.to (Int -> Text -> ResourceT m (Rep a Any)
forall env (m :: * -> *) a.
MonadVulkan env m =>
Int -> Text -> ResourceT m (Rep a a)
forall (f :: * -> *) env (m :: * -> *) a.
(GVertexBuffers f, MonadVulkan env m) =>
Int -> Text -> ResourceT m (f a)
gcreate Int
size Text
label)

genericDestroyCurrent
  :: ( Generic a
     , GVertexBuffers (Rep a)
     , HasVulkan env
     )
  => env
  -> a
  -> IO ()
genericDestroyCurrent :: forall a env.
(Generic a, GVertexBuffers (Rep a), HasVulkan env) =>
env -> a -> IO ()
genericDestroyCurrent env
env = env -> Rep a Any -> IO ()
forall env a. HasVulkan env => env -> Rep a a -> IO ()
forall (f :: * -> *) env a.
(GVertexBuffers f, HasVulkan env) =>
env -> f a -> IO ()
gdestroy env
env (Rep a Any -> IO ()) -> (a -> Rep a Any) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
GHC.Generics.from

class GVertexBuffers (f :: Type -> Type) where
  gcreate :: forall env m a . MonadVulkan env m => Int -> Text -> ResourceT m (f a)
  gdestroy :: forall env a . HasVulkan env => env -> f a -> IO ()

instance GVertexBuffers f => GVertexBuffers (D1 c f) where
  gcreate :: forall env (m :: * -> *) a.
MonadVulkan env m =>
Int -> Text -> ResourceT m (D1 c f a)
gcreate Int
size Text
label = (f a -> D1 c f a) -> ResourceT m (f a) -> ResourceT m (D1 c f a)
forall a b. (a -> b) -> ResourceT m a -> ResourceT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> D1 c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (ResourceT m (f a) -> ResourceT m (D1 c f a))
-> ResourceT m (f a) -> ResourceT m (D1 c f a)
forall a b. (a -> b) -> a -> b
$ Int -> Text -> ResourceT m (f a)
forall env (m :: * -> *) a.
MonadVulkan env m =>
Int -> Text -> ResourceT m (f a)
forall (f :: * -> *) env (m :: * -> *) a.
(GVertexBuffers f, MonadVulkan env m) =>
Int -> Text -> ResourceT m (f a)
gcreate Int
size Text
label
  gdestroy :: forall env a. HasVulkan env => env -> D1 c f a -> IO ()
gdestroy env
env (M1 f a
a) = env -> f a -> IO ()
forall env a. HasVulkan env => env -> f a -> IO ()
forall (f :: * -> *) env a.
(GVertexBuffers f, HasVulkan env) =>
env -> f a -> IO ()
gdestroy env
env f a
a

instance GVertexBuffers f => GVertexBuffers (C1 c f) where
  gcreate :: forall env (m :: * -> *) a.
MonadVulkan env m =>
Int -> Text -> ResourceT m (C1 c f a)
gcreate Int
size Text
label = (f a -> C1 c f a) -> ResourceT m (f a) -> ResourceT m (C1 c f a)
forall a b. (a -> b) -> ResourceT m a -> ResourceT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> C1 c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (ResourceT m (f a) -> ResourceT m (C1 c f a))
-> ResourceT m (f a) -> ResourceT m (C1 c f a)
forall a b. (a -> b) -> a -> b
$ Int -> Text -> ResourceT m (f a)
forall env (m :: * -> *) a.
MonadVulkan env m =>
Int -> Text -> ResourceT m (f a)
forall (f :: * -> *) env (m :: * -> *) a.
(GVertexBuffers f, MonadVulkan env m) =>
Int -> Text -> ResourceT m (f a)
gcreate Int
size Text
label
  gdestroy :: forall env a. HasVulkan env => env -> C1 c f a -> IO ()
gdestroy env
env (M1 f a
a) = env -> f a -> IO ()
forall env a. HasVulkan env => env -> f a -> IO ()
forall (f :: * -> *) env a.
(GVertexBuffers f, HasVulkan env) =>
env -> f a -> IO ()
gdestroy env
env f a
a

instance (GVertexBuffers l, GVertexBuffers r) => GVertexBuffers (l :*: r) where
  gcreate :: forall env (m :: * -> *) a.
MonadVulkan env m =>
Int -> Text -> ResourceT m ((:*:) l r a)
gcreate Int
size Text
label = l a -> r a -> (:*:) l r a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
    (l a -> r a -> (:*:) l r a)
-> ResourceT m (l a) -> ResourceT m (r a -> (:*:) l r a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Text -> ResourceT m (l a)
forall env (m :: * -> *) a.
MonadVulkan env m =>
Int -> Text -> ResourceT m (l a)
forall (f :: * -> *) env (m :: * -> *) a.
(GVertexBuffers f, MonadVulkan env m) =>
Int -> Text -> ResourceT m (f a)
gcreate Int
size Text
label
    ResourceT m (r a -> (:*:) l r a)
-> ResourceT m (r a) -> ResourceT m ((:*:) l r a)
forall a b. ResourceT m (a -> b) -> ResourceT m a -> ResourceT m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Text -> ResourceT m (r a)
forall env (m :: * -> *) a.
MonadVulkan env m =>
Int -> Text -> ResourceT m (r a)
forall (f :: * -> *) env (m :: * -> *) a.
(GVertexBuffers f, MonadVulkan env m) =>
Int -> Text -> ResourceT m (f a)
gcreate Int
size Text
label
  gdestroy :: forall env a. HasVulkan env => env -> (:*:) l r a -> IO ()
gdestroy env
env (l a
l :*: r a
r) =
    env -> r a -> IO ()
forall env a. HasVulkan env => env -> r a -> IO ()
forall (f :: * -> *) env a.
(GVertexBuffers f, HasVulkan env) =>
env -> f a -> IO ()
gdestroy env
env r a
r IO () -> IO () -> IO ()
forall a. Semigroup a => a -> a -> a
<>
    env -> l a -> IO ()
forall env a. HasVulkan env => env -> l a -> IO ()
forall (f :: * -> *) env a.
(GVertexBuffers f, HasVulkan env) =>
env -> f a -> IO ()
gdestroy env
env l a
l

instance (GVertexBuffers f, Selector c) => GVertexBuffers (M1 S c f) where
  gcreate :: forall env (m :: * -> *) a.
MonadVulkan env m =>
Int -> Text -> ResourceT m (M1 S c f a)
gcreate Int
size Text
label =
    (f a -> M1 S c f a)
-> ResourceT m (f a) -> ResourceT m (M1 S c f a)
forall a b. (a -> b) -> ResourceT m a -> ResourceT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> M1 S c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (ResourceT m (f a) -> ResourceT m (M1 S c f a))
-> ResourceT m (f a) -> ResourceT m (M1 S c f a)
forall a b. (a -> b) -> a -> b
$
      Int -> Text -> ResourceT m (f a)
forall env (m :: * -> *) a.
MonadVulkan env m =>
Int -> Text -> ResourceT m (f a)
forall (f :: * -> *) env (m :: * -> *) a.
(GVertexBuffers f, MonadVulkan env m) =>
Int -> Text -> ResourceT m (f a)
gcreate Int
size (Text -> ResourceT m (f a)) -> Text -> ResourceT m (f a)
forall a b. (a -> b) -> a -> b
$
        Text -> [Text] -> Text
Text.intercalate Text
"."
          [ Text
label
          , String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Any c f Any -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
selName (t c f a
forall {k} {t :: Meta -> (* -> *) -> k -> *} {a :: k}. t c f a
forall a. HasCallStack => a
undefined :: t c f a)
          ]
  gdestroy :: forall env a. HasVulkan env => env -> M1 S c f a -> IO ()
gdestroy env
env (M1 f a
a) = env -> f a -> IO ()
forall env a. HasVulkan env => env -> f a -> IO ()
forall (f :: * -> *) env a.
(GVertexBuffers f, HasVulkan env) =>
env -> f a -> IO ()
gdestroy env
env f a
a

instance VertexBuffers a => GVertexBuffers (K1 r a) where
  gcreate :: forall env (m :: * -> *) a.
MonadVulkan env m =>
Int -> Text -> ResourceT m (K1 r a a)
gcreate Int
size Text
label = (a -> K1 r a a) -> ResourceT m a -> ResourceT m (K1 r a a)
forall a b. (a -> b) -> ResourceT m a -> ResourceT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> K1 r a a
forall k i c (p :: k). c -> K1 i c p
K1 (ResourceT m a -> ResourceT m (K1 r a a))
-> ResourceT m a -> ResourceT m (K1 r a a)
forall a b. (a -> b) -> a -> b
$ Int -> Text -> ResourceT m a
forall a env (m :: * -> *).
(VertexBuffers a, MonadVulkan env m) =>
Int -> Text -> ResourceT m a
forall env (m :: * -> *).
MonadVulkan env m =>
Int -> Text -> ResourceT m a
createInitial Int
size Text
label
  gdestroy :: forall env a. HasVulkan env => env -> K1 r a a -> IO ()
gdestroy env
env (K1 a
a) = env -> a -> IO ()
forall env. HasVulkan env => env -> a -> IO ()
forall a env. (VertexBuffers a, HasVulkan env) => env -> a -> IO ()
destroyCurrent env
env a
a

-- TODO: class UpdateStaged bufs stores

class UpdateCoherent bufs stores where
  updateCoherent :: forall env m . MonadVulkan env m => bufs -> stores -> m bufs

  default updateCoherent
    :: forall env m
    .  ( Generic bufs
       , Generic stores
       , GUpdateCoherent (Rep bufs) (Rep stores)
       , MonadVulkan env m
       )
    => bufs
    -> stores
    -> m bufs
  updateCoherent = bufs -> stores -> m bufs
forall bufs stores env (m :: * -> *).
(Generic bufs, Generic stores,
 GUpdateCoherent (Rep bufs) (Rep stores), MonadVulkan env m) =>
bufs -> stores -> m bufs
genericUpdateCoherent

genericUpdateCoherent
  :: ( Generic bufs
      , Generic stores
      , GUpdateCoherent (Rep bufs) (Rep stores)
      , MonadVulkan env m
      )
  => bufs
  -> stores
  -> m bufs
genericUpdateCoherent :: forall bufs stores env (m :: * -> *).
(Generic bufs, Generic stores,
 GUpdateCoherent (Rep bufs) (Rep stores), MonadVulkan env m) =>
bufs -> stores -> m bufs
genericUpdateCoherent bufs
bufs stores
stores =
  (Rep bufs Any -> bufs) -> m (Rep bufs Any) -> m bufs
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep bufs Any -> bufs
forall a x. Generic a => Rep a x -> a
forall x. Rep bufs x -> bufs
GHC.Generics.to (m (Rep bufs Any) -> m bufs) -> m (Rep bufs Any) -> m bufs
forall a b. (a -> b) -> a -> b
$
    Rep bufs Any -> Rep stores Any -> m (Rep bufs Any)
forall env (m :: * -> *) b s.
MonadVulkan env m =>
Rep bufs b -> Rep stores s -> m (Rep bufs b)
forall (fb :: * -> *) (fs :: * -> *) env (m :: * -> *) b s.
(GUpdateCoherent fb fs, MonadVulkan env m) =>
fb b -> fs s -> m (fb b)
gUpdateCoherent
      (bufs -> Rep bufs Any
forall x. bufs -> Rep bufs x
forall a x. Generic a => a -> Rep a x
GHC.Generics.from bufs
bufs)
      (stores -> Rep stores Any
forall x. stores -> Rep stores x
forall a x. Generic a => a -> Rep a x
GHC.Generics.from stores
stores)

instance Storable a => UpdateCoherent (Buffer.Allocated 'Buffer.Coherent a) (Storable.Vector a) where
  updateCoherent :: forall env (m :: * -> *).
MonadVulkan env m =>
Allocated 'Coherent a -> Vector a -> m (Allocated 'Coherent a)
updateCoherent = Allocated 'Coherent a -> Vector a -> m (Allocated 'Coherent a)
forall env (m :: * -> *) a.
(MonadVulkan env m, Storable a) =>
Allocated 'Coherent a -> Vector a -> m (Allocated 'Coherent a)
Buffer.updateCoherentResize_

-- TODO: barbies-style update
-- instance (ApplicativeB collection) => UpdateCoherent (collection (Buffer.Allocated 'Buffer.Coherent)) (collection Storable.Vector) where
--   update = bzipWith Buffer.updateCoherentResize_

class GUpdateCoherent (fb :: Type -> Type) (fs :: Type -> Type) where
  gUpdateCoherent :: forall env m b s . MonadVulkan env m => fb b -> fs s -> m (fb b)

instance GUpdateCoherent fb fs => GUpdateCoherent (M1 c cb fb) (M1 c cs fs) where
  gUpdateCoherent :: forall env (m :: * -> *) b s.
MonadVulkan env m =>
M1 c cb fb b -> M1 c cs fs s -> m (M1 c cb fb b)
gUpdateCoherent (M1 fb b
gb) (M1 fs s
gs) = (fb b -> M1 c cb fb b) -> m (fb b) -> m (M1 c cb fb b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap fb b -> M1 c cb fb b
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (m (fb b) -> m (M1 c cb fb b)) -> m (fb b) -> m (M1 c cb fb b)
forall a b. (a -> b) -> a -> b
$ fb b -> fs s -> m (fb b)
forall env (m :: * -> *) b s.
MonadVulkan env m =>
fb b -> fs s -> m (fb b)
forall (fb :: * -> *) (fs :: * -> *) env (m :: * -> *) b s.
(GUpdateCoherent fb fs, MonadVulkan env m) =>
fb b -> fs s -> m (fb b)
gUpdateCoherent fb b
gb fs s
gs

instance (GUpdateCoherent fbl fsl, GUpdateCoherent fbr fsr) => GUpdateCoherent (fbl :*: fbr) (fsl :*: fsr) where
  gUpdateCoherent :: forall env (m :: * -> *) b s.
MonadVulkan env m =>
(:*:) fbl fbr b -> (:*:) fsl fsr s -> m ((:*:) fbl fbr b)
gUpdateCoherent (fbl b
bl :*: fbr b
br) (fsl s
sl :*: fsr s
sr) = fbl b -> fbr b -> (:*:) fbl fbr b
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
    (fbl b -> fbr b -> (:*:) fbl fbr b)
-> m (fbl b) -> m (fbr b -> (:*:) fbl fbr b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> fbl b -> fsl s -> m (fbl b)
forall env (m :: * -> *) b s.
MonadVulkan env m =>
fbl b -> fsl s -> m (fbl b)
forall (fb :: * -> *) (fs :: * -> *) env (m :: * -> *) b s.
(GUpdateCoherent fb fs, MonadVulkan env m) =>
fb b -> fs s -> m (fb b)
gUpdateCoherent fbl b
bl fsl s
sl
    m (fbr b -> (:*:) fbl fbr b) -> m (fbr b) -> m ((:*:) fbl fbr b)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> fbr b -> fsr s -> m (fbr b)
forall env (m :: * -> *) b s.
MonadVulkan env m =>
fbr b -> fsr s -> m (fbr b)
forall (fb :: * -> *) (fs :: * -> *) env (m :: * -> *) b s.
(GUpdateCoherent fb fs, MonadVulkan env m) =>
fb b -> fs s -> m (fb b)
gUpdateCoherent fbr b
br fsr s
sr

instance UpdateCoherent ba sa => GUpdateCoherent (K1 br ba) (K1 sr sa) where
  gUpdateCoherent :: forall env (m :: * -> *) b s.
MonadVulkan env m =>
K1 br ba b -> K1 sr sa s -> m (K1 br ba b)
gUpdateCoherent (K1 ba
gb) (K1 sa
gs) = (ba -> K1 br ba b) -> m ba -> m (K1 br ba b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ba -> K1 br ba b
forall k i c (p :: k). c -> K1 i c p
K1 (m ba -> m (K1 br ba b)) -> m ba -> m (K1 br ba b)
forall a b. (a -> b) -> a -> b
$ ba -> sa -> m ba
forall bufs stores env (m :: * -> *).
(UpdateCoherent bufs stores, MonadVulkan env m) =>
bufs -> stores -> m bufs
forall env (m :: * -> *). MonadVulkan env m => ba -> sa -> m ba
updateCoherent ba
gb sa
gs