-- | This module provides 'PerformEventT', the standard implementation of
-- 'PerformEvent'.
{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#ifdef USE_REFLEX_OPTIMIZER
{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
#endif
module Reflex.PerformEvent.Base
  ( PerformEventT (..)
  , FireCommand (..)
  , hostPerformEventT
  ) where

import Reflex.Class
import Reflex.Adjustable.Class
import Reflex.Host.Class
import Reflex.PerformEvent.Class
import Reflex.Requester.Base
import Reflex.Requester.Class

import Control.Lens
import Control.Monad.Catch (MonadMask, MonadThrow, MonadCatch)
import Control.Monad.Exception
import Control.Monad.Fix
import Control.Monad.Identity
import Control.Monad.Primitive
import Control.Monad.Reader
import Control.Monad.Ref
import Data.Coerce
import Data.Dependent.Map (DMap)
import qualified Data.Dependent.Map as DMap
import Data.Dependent.Sum
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Semigroup as S

-- | A function that fires events for the given 'EventTrigger's and then runs
-- any followup actions provided via 'PerformEvent'.  The given 'ReadPhase'
-- action will be run once for the initial trigger execution as well as once for
-- each followup.
newtype FireCommand t m = FireCommand { FireCommand t m
-> forall a.
   [DSum (EventTrigger t) Identity] -> ReadPhase m a -> m [a]
runFireCommand :: forall a. [DSum (EventTrigger t) Identity] -> ReadPhase m a -> m [a] } --TODO: The handling of this ReadPhase seems wrong, or at least inelegant; how do we actually make the decision about what order frames run in?

-- | Provides a basic implementation of 'PerformEvent'.  Note that, despite the
-- name, 'PerformEventT' is not an instance of 'MonadTrans'.
newtype PerformEventT t m a = PerformEventT { PerformEventT t m a
-> RequesterT t (HostFrame t) Identity (HostFrame t) a
unPerformEventT :: RequesterT t (HostFrame t) Identity (HostFrame t) a }

deriving instance ReflexHost t => Functor (PerformEventT t m)
deriving instance ReflexHost t => Applicative (PerformEventT t m)
deriving instance ReflexHost t => Monad (PerformEventT t m)
deriving instance ReflexHost t => MonadFix (PerformEventT t m)
deriving instance (ReflexHost t, MonadIO (HostFrame t)) => MonadIO (PerformEventT t m)
deriving instance (ReflexHost t, MonadException (HostFrame t)) => MonadException (PerformEventT t m)
deriving instance (ReflexHost t, Monoid a) => Monoid (PerformEventT t m a)
deriving instance (ReflexHost t, S.Semigroup a) => S.Semigroup (PerformEventT t m a)
deriving instance (ReflexHost t, MonadCatch (HostFrame t)) => MonadCatch (PerformEventT t m)
deriving instance (ReflexHost t, MonadThrow (HostFrame t)) => MonadThrow (PerformEventT t m)
deriving instance (ReflexHost t, MonadMask (HostFrame t)) => MonadMask (PerformEventT t m)

instance (PrimMonad (HostFrame t), ReflexHost t) => PrimMonad (PerformEventT t m) where
  type PrimState (PerformEventT t m) = PrimState (HostFrame t)
  primitive :: (State# (PrimState (PerformEventT t m))
 -> (# State# (PrimState (PerformEventT t m)), a #))
-> PerformEventT t m a
primitive = RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT t (HostFrame t) Identity (HostFrame t) a
 -> PerformEventT t m a)
-> ((State# (PrimState (HostFrame t))
     -> (# State# (PrimState (HostFrame t)), a #))
    -> RequesterT t (HostFrame t) Identity (HostFrame t) a)
-> (State# (PrimState (HostFrame t))
    -> (# State# (PrimState (HostFrame t)), a #))
-> PerformEventT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostFrame t a
-> RequesterT t (HostFrame t) Identity (HostFrame t) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostFrame t a
 -> RequesterT t (HostFrame t) Identity (HostFrame t) a)
-> ((State# (PrimState (HostFrame t))
     -> (# State# (PrimState (HostFrame t)), a #))
    -> HostFrame t a)
-> (State# (PrimState (HostFrame t))
    -> (# State# (PrimState (HostFrame t)), a #))
-> RequesterT t (HostFrame t) Identity (HostFrame t) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# (PrimState (HostFrame t))
 -> (# State# (PrimState (HostFrame t)), a #))
-> HostFrame t a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive

instance (ReflexHost t, Ref m ~ Ref IO) => PerformEvent t (PerformEventT t m) where
  type Performable (PerformEventT t m) = HostFrame t
  {-# INLINABLE performEvent_ #-}
  performEvent_ :: Event t (Performable (PerformEventT t m) ())
-> PerformEventT t m ()
performEvent_ = RequesterT t (HostFrame t) Identity (HostFrame t) ()
-> PerformEventT t m ()
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT t (HostFrame t) Identity (HostFrame t) ()
 -> PerformEventT t m ())
-> (Event t (HostFrame t ())
    -> RequesterT t (HostFrame t) Identity (HostFrame t) ())
-> Event t (HostFrame t ())
-> PerformEventT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (HostFrame t ())
-> RequesterT t (HostFrame t) Identity (HostFrame t) ()
forall t (m :: * -> *) a.
Requester t m =>
Event t (Request m a) -> m ()
requesting_
  {-# INLINABLE performEvent #-}
  performEvent :: Event t (Performable (PerformEventT t m) a)
-> PerformEventT t m (Event t a)
performEvent = RequesterT t (HostFrame t) Identity (HostFrame t) (Event t a)
-> PerformEventT t m (Event t a)
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT t (HostFrame t) Identity (HostFrame t) (Event t a)
 -> PerformEventT t m (Event t a))
-> (Event t (HostFrame t a)
    -> RequesterT t (HostFrame t) Identity (HostFrame t) (Event t a))
-> Event t (HostFrame t a)
-> PerformEventT t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (HostFrame t a)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (Event t a)
forall t (m :: * -> *) a.
(Requester t m, Response m ~ Identity) =>
Event t (Request m a) -> m (Event t a)
requestingIdentity

instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT t m) where
  runWithReplace :: PerformEventT t m a
-> Event t (PerformEventT t m b)
-> PerformEventT t m (a, Event t b)
runWithReplace PerformEventT t m a
outerA0 Event t (PerformEventT t m b)
outerA' = RequesterT t (HostFrame t) Identity (HostFrame t) (a, Event t b)
-> PerformEventT t m (a, Event t b)
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT t (HostFrame t) Identity (HostFrame t) (a, Event t b)
 -> PerformEventT t m (a, Event t b))
-> RequesterT t (HostFrame t) Identity (HostFrame t) (a, Event t b)
-> PerformEventT t m (a, Event t b)
forall a b. (a -> b) -> a -> b
$ (forall a' b'.
 HostFrame t a'
 -> Event t (HostFrame t b')
 -> RequesterT
      t (HostFrame t) Identity (HostFrame t) (a', Event t b'))
-> RequesterT t (HostFrame t) Identity (HostFrame t) a
-> Event t (RequesterT t (HostFrame t) Identity (HostFrame t) b)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (a, Event t b)
forall (m :: * -> *) t (request :: * -> *) (response :: * -> *) a
       b.
(Reflex t, MonadHold t m, MonadFix m) =>
(forall a' b'.
 m a'
 -> Event t (m b')
 -> RequesterT t request response m (a', Event t b'))
-> RequesterT t request response m a
-> Event t (RequesterT t request response m b)
-> RequesterT t request response m (a, Event t b)
runWithReplaceRequesterTWith forall a' b'.
HostFrame t a'
-> Event t (HostFrame t b')
-> RequesterT
     t (HostFrame t) Identity (HostFrame t) (a', Event t b')
f (PerformEventT t m a
-> RequesterT t (HostFrame t) Identity (HostFrame t) a
coerce PerformEventT t m a
outerA0) (Event t (PerformEventT t m b)
-> Event t (RequesterT t (HostFrame t) Identity (HostFrame t) b)
forall k (t :: k) a b.
(Reflex t, Coercible a b) =>
Event t a -> Event t b
coerceEvent Event t (PerformEventT t m b)
outerA')
    where f :: HostFrame t a -> Event t (HostFrame t b) -> RequesterT t (HostFrame t) Identity (HostFrame t) (a, Event t b)
          f :: HostFrame t a
-> Event t (HostFrame t b)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (a, Event t b)
f HostFrame t a
a0 Event t (HostFrame t b)
a' = do
            a
result0 <- HostFrame t a
-> RequesterT t (HostFrame t) Identity (HostFrame t) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift HostFrame t a
a0
            Event t b
result' <- Event
  t (Request (RequesterT t (HostFrame t) Identity (HostFrame t)) b)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (Event t b)
forall t (m :: * -> *) a.
(Requester t m, Response m ~ Identity) =>
Event t (Request m a) -> m (Event t a)
requestingIdentity Event t (HostFrame t b)
Event
  t (Request (RequesterT t (HostFrame t) Identity (HostFrame t)) b)
a'
            (a, Event t b)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (a, Event t b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
result0, Event t b
result')
  traverseIntMapWithKeyWithAdjust :: (Key -> v -> PerformEventT t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> PerformEventT t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust Key -> v -> PerformEventT t m v'
f IntMap v
outerDm0 Event t (PatchIntMap v)
outerDm' = RequesterT
  t
  (HostFrame t)
  Identity
  (HostFrame t)
  (IntMap v', Event t (PatchIntMap v'))
-> PerformEventT t m (IntMap v', Event t (PatchIntMap v'))
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT
   t
   (HostFrame t)
   Identity
   (HostFrame t)
   (IntMap v', Event t (PatchIntMap v'))
 -> PerformEventT t m (IntMap v', Event t (PatchIntMap v')))
-> RequesterT
     t
     (HostFrame t)
     Identity
     (HostFrame t)
     (IntMap v', Event t (PatchIntMap v'))
-> PerformEventT t m (IntMap v', Event t (PatchIntMap v'))
forall a b. (a -> b) -> a -> b
$ ((Key
  -> (Key, v)
  -> HostFrame
       t (Event t (IntMap (RequesterData (HostFrame t))), v'))
 -> IntMap (Key, v)
 -> Event t (PatchIntMap (Key, v))
 -> RequesterT
      t
      (HostFrame t)
      Identity
      (HostFrame t)
      (IntMap (Event t (IntMap (RequesterData (HostFrame t))), v'),
       Event
         t
         (PatchIntMap
            (Event t (IntMap (RequesterData (HostFrame t))), v'))))
-> (PatchIntMap (Event t (IntMap (RequesterData (HostFrame t))))
    -> IntMap (Event t (IntMap (RequesterData (HostFrame t)))))
-> (Incremental
      t (PatchIntMap (Event t (IntMap (RequesterData (HostFrame t)))))
    -> Event t (IntMap (IntMap (RequesterData (HostFrame t)))))
-> (Key
    -> v -> RequesterT t (HostFrame t) Identity (HostFrame t) v')
-> IntMap v
-> Event t (PatchIntMap v)
-> RequesterT
     t
     (HostFrame t)
     Identity
     (HostFrame t)
     (IntMap v', Event t (PatchIntMap v'))
forall t (request :: * -> *) (response :: * -> *) (m :: * -> *) v
       v' (p :: * -> *).
(Reflex t, MonadHold t m,
 PatchTarget (p (Event t (IntMap (RequesterData request))))
 ~ IntMap (Event t (IntMap (RequesterData request))),
 Patch (p (Event t (IntMap (RequesterData request)))), Functor p,
 MonadFix m) =>
((Key
  -> (Key, v) -> m (Event t (IntMap (RequesterData request)), v'))
 -> IntMap (Key, v)
 -> Event t (p (Key, v))
 -> RequesterT
      t
      request
      response
      m
      (IntMap (Event t (IntMap (RequesterData request)), v'),
       Event t (p (Event t (IntMap (RequesterData request)), v'))))
-> (p (Event t (IntMap (RequesterData request)))
    -> IntMap (Event t (IntMap (RequesterData request))))
-> (Incremental t (p (Event t (IntMap (RequesterData request))))
    -> Event t (IntMap (IntMap (RequesterData request))))
-> (Key -> v -> RequesterT t request response m v')
-> IntMap v
-> Event t (p v)
-> RequesterT t request response m (IntMap v', Event t (p v'))
traverseIntMapWithKeyWithAdjustRequesterTWith (((Key
  -> (Key, v)
  -> HostFrame
       t (Event t (IntMap (RequesterData (HostFrame t))), v'))
 -> PatchIntMap (Key, v)
 -> HostFrame
      t
      (PatchIntMap (Event t (IntMap (RequesterData (HostFrame t))), v')))
-> (Key
    -> (Key, v)
    -> HostFrame
         t (Event t (IntMap (RequesterData (HostFrame t))), v'))
-> IntMap (Key, v)
-> Event t (PatchIntMap (Key, v))
-> RequesterT
     t
     (HostFrame t)
     Identity
     (HostFrame t)
     (IntMap (Event t (IntMap (RequesterData (HostFrame t))), v'),
      Event
        t
        (PatchIntMap (Event t (IntMap (RequesterData (HostFrame t))), v')))
forall t v v2 (p :: * -> *).
(Monad (HostFrame t), PrimMonad (HostFrame t), Reflex t) =>
((Key -> v -> HostFrame t v2) -> p v -> HostFrame t (p v2))
-> (Key -> v -> HostFrame t v2)
-> IntMap v
-> Event t (p v)
-> RequesterT
     t (HostFrame t) Identity (HostFrame t) (IntMap v2, Event t (p v2))
defaultAdjustIntBase (Key
 -> (Key, v)
 -> HostFrame
      t (Event t (IntMap (RequesterData (HostFrame t))), v'))
-> PatchIntMap (Key, v)
-> HostFrame
     t
     (PatchIntMap (Event t (IntMap (RequesterData (HostFrame t))), v'))
forall (f :: * -> *) a b.
Applicative f =>
(Key -> a -> f b) -> PatchIntMap a -> f (PatchIntMap b)
traverseIntMapPatchWithKey) PatchIntMap (Event t (IntMap (RequesterData (HostFrame t))))
-> IntMap (Event t (IntMap (RequesterData (HostFrame t))))
forall a. PatchIntMap a -> IntMap a
patchIntMapNewElementsMap Incremental
  t (PatchIntMap (Event t (IntMap (RequesterData (HostFrame t)))))
-> Event t (IntMap (IntMap (RequesterData (HostFrame t))))
forall k (t :: k) a.
Reflex t =>
Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
mergeIntIncremental (\Key
k v
v -> PerformEventT t m v'
-> RequesterT t (HostFrame t) Identity (HostFrame t) v'
forall t k (m :: k) a.
PerformEventT t m a
-> RequesterT t (HostFrame t) Identity (HostFrame t) a
unPerformEventT (PerformEventT t m v'
 -> RequesterT t (HostFrame t) Identity (HostFrame t) v')
-> PerformEventT t m v'
-> RequesterT t (HostFrame t) Identity (HostFrame t) v'
forall a b. (a -> b) -> a -> b
$ Key -> v -> PerformEventT t m v'
f Key
k v
v) (IntMap v -> IntMap v
coerce IntMap v
outerDm0) (Event t (PatchIntMap v) -> Event t (PatchIntMap v)
forall k (t :: k) a b.
(Reflex t, Coercible a b) =>
Event t a -> Event t b
coerceEvent Event t (PatchIntMap v)
outerDm')
  traverseDMapWithKeyWithAdjust :: (forall a. k a -> v a -> PerformEventT t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> PerformEventT t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust forall a. k a -> v a -> PerformEventT t m (v' a)
f DMap k v
outerDm0 Event t (PatchDMap k v)
outerDm' = RequesterT
  t
  (HostFrame t)
  Identity
  (HostFrame t)
  (DMap k v', Event t (PatchDMap k v'))
-> PerformEventT t m (DMap k v', Event t (PatchDMap k v'))
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT
   t
   (HostFrame t)
   Identity
   (HostFrame t)
   (DMap k v', Event t (PatchDMap k v'))
 -> PerformEventT t m (DMap k v', Event t (PatchDMap k v')))
-> RequesterT
     t
     (HostFrame t)
     Identity
     (HostFrame t)
     (DMap k v', Event t (PatchDMap k v'))
-> PerformEventT t m (DMap k v', Event t (PatchDMap k v'))
forall a b. (a -> b) -> a -> b
$ (forall (k' :: * -> *) (v1 :: * -> *) (v2 :: * -> *).
 GCompare k' =>
 (forall a. k' a -> v1 a -> HostFrame t (v2 a))
 -> DMap k' v1
 -> Event t (PatchDMap k' v1)
 -> RequesterT
      t
      (HostFrame t)
      Identity
      (HostFrame t)
      (DMap k' v2, Event t (PatchDMap k' v2)))
-> (forall (v1 :: * -> *) (v2 :: * -> *).
    (forall a. v1 a -> v2 a) -> PatchDMap k v1 -> PatchDMap k v2)
-> (forall (v1 :: * -> *) v2.
    (forall a. v1 a -> v2) -> PatchDMap k v1 -> PatchMap (Some k) v2)
-> (forall v2. PatchMap (Some k) v2 -> Map (Some k) v2)
-> (forall a.
    Incremental t (PatchMap (Some k) (Event t a))
    -> Event t (Map (Some k) a))
-> (forall a.
    k a
    -> v a -> RequesterT t (HostFrame t) Identity (HostFrame t) (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> RequesterT
     t
     (HostFrame t)
     Identity
     (HostFrame t)
     (DMap k v', Event t (PatchDMap k v'))
forall (k :: * -> *) t (request :: * -> *) (response :: * -> *)
       (m :: * -> *) (v :: * -> *) (v' :: * -> *)
       (p :: (* -> *) -> (* -> *) -> *) (p' :: * -> * -> *).
(GCompare k, Reflex t, MonadHold t m,
 PatchTarget
   (p' (Some k) (Event t (IntMap (RequesterData request))))
 ~ Map (Some k) (Event t (IntMap (RequesterData request))),
 Patch (p' (Some k) (Event t (IntMap (RequesterData request)))),
 MonadFix m) =>
(forall (k' :: * -> *) (v1 :: * -> *) (v2 :: * -> *).
 GCompare k' =>
 (forall a. k' a -> v1 a -> m (v2 a))
 -> DMap k' v1
 -> Event t (p k' v1)
 -> RequesterT t request response m (DMap k' v2, Event t (p k' v2)))
-> (forall (v1 :: * -> *) (v2 :: * -> *).
    (forall a. v1 a -> v2 a) -> p k v1 -> p k v2)
-> (forall (v1 :: * -> *) v2.
    (forall a. v1 a -> v2) -> p k v1 -> p' (Some k) v2)
-> (forall v2. p' (Some k) v2 -> Map (Some k) v2)
-> (forall a.
    Incremental t (p' (Some k) (Event t a))
    -> Event t (Map (Some k) a))
-> (forall a. k a -> v a -> RequesterT t request response m (v' a))
-> DMap k v
-> Event t (p k v)
-> RequesterT t request response m (DMap k v', Event t (p k v'))
traverseDMapWithKeyWithAdjustRequesterTWith (((forall a. k' a -> v1 a -> HostFrame t (v2 a))
 -> PatchDMap k' v1 -> HostFrame t (PatchDMap k' v2))
-> (forall a. k' a -> v1 a -> HostFrame t (v2 a))
-> DMap k' v1
-> Event t (PatchDMap k' v1)
-> RequesterT
     t
     (HostFrame t)
     Identity
     (HostFrame t)
     (DMap k' v2, Event t (PatchDMap k' v2))
forall k t (v :: k -> *) (v2 :: k -> *) (k' :: k -> *)
       (p :: (k -> *) -> (k -> *) -> *).
(Monad (HostFrame t), PrimMonad (HostFrame t), Reflex t) =>
((forall (a :: k). k' a -> v a -> HostFrame t (v2 a))
 -> p k' v -> HostFrame t (p k' v2))
-> (forall (a :: k). k' a -> v a -> HostFrame t (v2 a))
-> DMap k' v
-> Event t (p k' v)
-> RequesterT
     t
     (HostFrame t)
     Identity
     (HostFrame t)
     (DMap k' v2, Event t (p k' v2))
defaultAdjustBase (forall a. k' a -> v1 a -> HostFrame t (v2 a))
-> PatchDMap k' v1 -> HostFrame t (PatchDMap k' v2)
forall k1 (m :: * -> *) (k2 :: k1 -> *) (v :: k1 -> *)
       (v' :: k1 -> *).
Applicative m =>
(forall (a :: k1). k2 a -> v a -> m (v' a))
-> PatchDMap k2 v -> m (PatchDMap k2 v')
traversePatchDMapWithKey) forall k1 (v :: k1 -> *) (v' :: k1 -> *) (k2 :: k1 -> *).
(forall (a :: k1). v a -> v' a)
-> PatchDMap k2 v -> PatchDMap k2 v'
forall (v1 :: * -> *) (v2 :: * -> *).
(forall a. v1 a -> v2 a) -> PatchDMap k v1 -> PatchDMap k v2
mapPatchDMap forall k1 (v :: k1 -> *) v' (k2 :: k1 -> *).
(forall (a :: k1). v a -> v')
-> PatchDMap k2 v -> PatchMap (Some k2) v'
forall (v1 :: * -> *) v2.
(forall a. v1 a -> v2) -> PatchDMap k v1 -> PatchMap (Some k) v2
weakenPatchDMapWith forall v2. PatchMap (Some k) v2 -> Map (Some k) v2
forall k v. PatchMap k v -> Map k v
patchMapNewElementsMap forall a.
Incremental t (PatchMap (Some k) (Event t a))
-> Event t (Map (Some k) a)
forall k1 (t :: k1) k2 a.
(Reflex t, Ord k2) =>
Incremental t (PatchMap k2 (Event t a)) -> Event t (Map k2 a)
mergeMapIncremental (\k a
k v a
v -> PerformEventT t m (v' a)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (v' a)
forall t k (m :: k) a.
PerformEventT t m a
-> RequesterT t (HostFrame t) Identity (HostFrame t) a
unPerformEventT (PerformEventT t m (v' a)
 -> RequesterT t (HostFrame t) Identity (HostFrame t) (v' a))
-> PerformEventT t m (v' a)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (v' a)
forall a b. (a -> b) -> a -> b
$ k a -> v a -> PerformEventT t m (v' a)
forall a. k a -> v a -> PerformEventT t m (v' a)
f k a
k v a
v) (DMap k v -> DMap k v
coerce DMap k v
outerDm0) (Event t (PatchDMap k v) -> Event t (PatchDMap k v)
forall k (t :: k) a b.
(Reflex t, Coercible a b) =>
Event t a -> Event t b
coerceEvent Event t (PatchDMap k v)
outerDm')
  traverseDMapWithKeyWithAdjustWithMove :: (forall a. k a -> v a -> PerformEventT t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> PerformEventT t m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove forall a. k a -> v a -> PerformEventT t m (v' a)
f DMap k v
outerDm0 Event t (PatchDMapWithMove k v)
outerDm' = RequesterT
  t
  (HostFrame t)
  Identity
  (HostFrame t)
  (DMap k v', Event t (PatchDMapWithMove k v'))
-> PerformEventT t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT
   t
   (HostFrame t)
   Identity
   (HostFrame t)
   (DMap k v', Event t (PatchDMapWithMove k v'))
 -> PerformEventT t m (DMap k v', Event t (PatchDMapWithMove k v')))
-> RequesterT
     t
     (HostFrame t)
     Identity
     (HostFrame t)
     (DMap k v', Event t (PatchDMapWithMove k v'))
-> PerformEventT t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall a b. (a -> b) -> a -> b
$ (forall (k' :: * -> *) (v1 :: * -> *) (v2 :: * -> *).
 GCompare k' =>
 (forall a. k' a -> v1 a -> HostFrame t (v2 a))
 -> DMap k' v1
 -> Event t (PatchDMapWithMove k' v1)
 -> RequesterT
      t
      (HostFrame t)
      Identity
      (HostFrame t)
      (DMap k' v2, Event t (PatchDMapWithMove k' v2)))
-> (forall (v1 :: * -> *) (v2 :: * -> *).
    (forall a. v1 a -> v2 a)
    -> PatchDMapWithMove k v1 -> PatchDMapWithMove k v2)
-> (forall (v1 :: * -> *) v2.
    (forall a. v1 a -> v2)
    -> PatchDMapWithMove k v1 -> PatchMapWithMove (Some k) v2)
-> (forall v2. PatchMapWithMove (Some k) v2 -> Map (Some k) v2)
-> (forall a.
    Incremental t (PatchMapWithMove (Some k) (Event t a))
    -> Event t (Map (Some k) a))
-> (forall a.
    k a
    -> v a -> RequesterT t (HostFrame t) Identity (HostFrame t) (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> RequesterT
     t
     (HostFrame t)
     Identity
     (HostFrame t)
     (DMap k v', Event t (PatchDMapWithMove k v'))
forall (k :: * -> *) t (request :: * -> *) (response :: * -> *)
       (m :: * -> *) (v :: * -> *) (v' :: * -> *)
       (p :: (* -> *) -> (* -> *) -> *) (p' :: * -> * -> *).
(GCompare k, Reflex t, MonadHold t m,
 PatchTarget
   (p' (Some k) (Event t (IntMap (RequesterData request))))
 ~ Map (Some k) (Event t (IntMap (RequesterData request))),
 Patch (p' (Some k) (Event t (IntMap (RequesterData request)))),
 MonadFix m) =>
(forall (k' :: * -> *) (v1 :: * -> *) (v2 :: * -> *).
 GCompare k' =>
 (forall a. k' a -> v1 a -> m (v2 a))
 -> DMap k' v1
 -> Event t (p k' v1)
 -> RequesterT t request response m (DMap k' v2, Event t (p k' v2)))
-> (forall (v1 :: * -> *) (v2 :: * -> *).
    (forall a. v1 a -> v2 a) -> p k v1 -> p k v2)
-> (forall (v1 :: * -> *) v2.
    (forall a. v1 a -> v2) -> p k v1 -> p' (Some k) v2)
-> (forall v2. p' (Some k) v2 -> Map (Some k) v2)
-> (forall a.
    Incremental t (p' (Some k) (Event t a))
    -> Event t (Map (Some k) a))
-> (forall a. k a -> v a -> RequesterT t request response m (v' a))
-> DMap k v
-> Event t (p k v)
-> RequesterT t request response m (DMap k v', Event t (p k v'))
traverseDMapWithKeyWithAdjustRequesterTWith (((forall a. k' a -> v1 a -> HostFrame t (v2 a))
 -> PatchDMapWithMove k' v1
 -> HostFrame t (PatchDMapWithMove k' v2))
-> (forall a. k' a -> v1 a -> HostFrame t (v2 a))
-> DMap k' v1
-> Event t (PatchDMapWithMove k' v1)
-> RequesterT
     t
     (HostFrame t)
     Identity
     (HostFrame t)
     (DMap k' v2, Event t (PatchDMapWithMove k' v2))
forall k t (v :: k -> *) (v2 :: k -> *) (k' :: k -> *)
       (p :: (k -> *) -> (k -> *) -> *).
(Monad (HostFrame t), PrimMonad (HostFrame t), Reflex t) =>
((forall (a :: k). k' a -> v a -> HostFrame t (v2 a))
 -> p k' v -> HostFrame t (p k' v2))
-> (forall (a :: k). k' a -> v a -> HostFrame t (v2 a))
-> DMap k' v
-> Event t (p k' v)
-> RequesterT
     t
     (HostFrame t)
     Identity
     (HostFrame t)
     (DMap k' v2, Event t (p k' v2))
defaultAdjustBase (forall a. k' a -> v1 a -> HostFrame t (v2 a))
-> PatchDMapWithMove k' v1 -> HostFrame t (PatchDMapWithMove k' v2)
forall k1 (m :: * -> *) (k2 :: k1 -> *) (v :: k1 -> *)
       (v' :: k1 -> *).
Applicative m =>
(forall (a :: k1). k2 a -> v a -> m (v' a))
-> PatchDMapWithMove k2 v -> m (PatchDMapWithMove k2 v')
traversePatchDMapWithMoveWithKey) forall k1 (k2 :: k1 -> *) (v :: k1 -> *) (v' :: k1 -> *).
(forall (a :: k1). v a -> v' a)
-> PatchDMapWithMove k2 v -> PatchDMapWithMove k2 v'
forall (v1 :: * -> *) (v2 :: * -> *).
(forall a. v1 a -> v2 a)
-> PatchDMapWithMove k v1 -> PatchDMapWithMove k v2
mapPatchDMapWithMove forall k1 (k2 :: k1 -> *) (v :: k1 -> *) v'.
(forall (a :: k1). v a -> v')
-> PatchDMapWithMove k2 v -> PatchMapWithMove (Some k2) v'
forall (v1 :: * -> *) v2.
(forall a. v1 a -> v2)
-> PatchDMapWithMove k v1 -> PatchMapWithMove (Some k) v2
weakenPatchDMapWithMoveWith forall v2. PatchMapWithMove (Some k) v2 -> Map (Some k) v2
forall k v. PatchMapWithMove k v -> Map k v
patchMapWithMoveNewElementsMap forall a.
Incremental t (PatchMapWithMove (Some k) (Event t a))
-> Event t (Map (Some k) a)
forall k1 (t :: k1) k2 a.
(Reflex t, Ord k2) =>
Incremental t (PatchMapWithMove k2 (Event t a))
-> Event t (Map k2 a)
mergeMapIncrementalWithMove (\k a
k v a
v -> PerformEventT t m (v' a)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (v' a)
forall t k (m :: k) a.
PerformEventT t m a
-> RequesterT t (HostFrame t) Identity (HostFrame t) a
unPerformEventT (PerformEventT t m (v' a)
 -> RequesterT t (HostFrame t) Identity (HostFrame t) (v' a))
-> PerformEventT t m (v' a)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (v' a)
forall a b. (a -> b) -> a -> b
$ k a -> v a -> PerformEventT t m (v' a)
forall a. k a -> v a -> PerformEventT t m (v' a)
f k a
k v a
v) (DMap k v -> DMap k v
coerce DMap k v
outerDm0) (Event t (PatchDMapWithMove k v) -> Event t (PatchDMapWithMove k v)
forall k (t :: k) a b.
(Reflex t, Coercible a b) =>
Event t a -> Event t b
coerceEvent Event t (PatchDMapWithMove k v)
outerDm')

defaultAdjustBase :: forall t v v2 k' p. (Monad (HostFrame t), PrimMonad (HostFrame t), Reflex t)
  => ((forall a. k' a -> v a -> HostFrame t (v2 a)) -> p k' v -> HostFrame t (p k' v2))
  -> (forall a. k' a -> v a -> HostFrame t (v2 a))
  -> DMap k' v
  -> Event t (p k' v)
  -> RequesterT t (HostFrame t) Identity (HostFrame t) (DMap k' v2, Event t (p k' v2))
defaultAdjustBase :: ((forall (a :: k). k' a -> v a -> HostFrame t (v2 a))
 -> p k' v -> HostFrame t (p k' v2))
-> (forall (a :: k). k' a -> v a -> HostFrame t (v2 a))
-> DMap k' v
-> Event t (p k' v)
-> RequesterT
     t
     (HostFrame t)
     Identity
     (HostFrame t)
     (DMap k' v2, Event t (p k' v2))
defaultAdjustBase (forall (a :: k). k' a -> v a -> HostFrame t (v2 a))
-> p k' v -> HostFrame t (p k' v2)
traversePatchWithKey forall (a :: k). k' a -> v a -> HostFrame t (v2 a)
f' DMap k' v
dm0 Event t (p k' v)
dm' = do
  DMap k' v2
result0 <- HostFrame t (DMap k' v2)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (DMap k' v2)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostFrame t (DMap k' v2)
 -> RequesterT t (HostFrame t) Identity (HostFrame t) (DMap k' v2))
-> HostFrame t (DMap k' v2)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (DMap k' v2)
forall a b. (a -> b) -> a -> b
$ (forall (a :: k). k' a -> v a -> HostFrame t (v2 a))
-> DMap k' v -> HostFrame t (DMap k' v2)
forall k1 (t :: * -> *) (k2 :: k1 -> *) (f :: k1 -> *)
       (g :: k1 -> *).
Applicative t =>
(forall (v :: k1). k2 v -> f v -> t (g v))
-> DMap k2 f -> t (DMap k2 g)
DMap.traverseWithKey forall (a :: k). k' a -> v a -> HostFrame t (v2 a)
f' DMap k' v
dm0
  Event t (p k' v2)
result' <- Event
  t
  (Request
     (RequesterT t (HostFrame t) Identity (HostFrame t)) (p k' v2))
-> RequesterT
     t (HostFrame t) Identity (HostFrame t) (Event t (p k' v2))
forall t (m :: * -> *) a.
(Requester t m, Response m ~ Identity) =>
Event t (Request m a) -> m (Event t a)
requestingIdentity (Event
   t
   (Request
      (RequesterT t (HostFrame t) Identity (HostFrame t)) (p k' v2))
 -> RequesterT
      t (HostFrame t) Identity (HostFrame t) (Event t (p k' v2)))
-> Event
     t
     (Request
        (RequesterT t (HostFrame t) Identity (HostFrame t)) (p k' v2))
-> RequesterT
     t (HostFrame t) Identity (HostFrame t) (Event t (p k' v2))
forall a b. (a -> b) -> a -> b
$ Event t (p k' v)
-> (p k' v -> HostFrame t (p k' v2))
-> Event t (HostFrame t (p k' v2))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (p k' v)
dm' ((p k' v -> HostFrame t (p k' v2))
 -> Event t (HostFrame t (p k' v2)))
-> (p k' v -> HostFrame t (p k' v2))
-> Event t (HostFrame t (p k' v2))
forall a b. (a -> b) -> a -> b
$ (forall (a :: k). k' a -> v a -> HostFrame t (v2 a))
-> p k' v -> HostFrame t (p k' v2)
traversePatchWithKey forall (a :: k). k' a -> v a -> HostFrame t (v2 a)
f'
  (DMap k' v2, Event t (p k' v2))
-> RequesterT
     t
     (HostFrame t)
     Identity
     (HostFrame t)
     (DMap k' v2, Event t (p k' v2))
forall (m :: * -> *) a. Monad m => a -> m a
return (DMap k' v2
result0, Event t (p k' v2)
result')

defaultAdjustIntBase :: forall t v v2 p. (Monad (HostFrame t), PrimMonad (HostFrame t), Reflex t)
  => ((IntMap.Key -> v -> HostFrame t v2) -> p v -> HostFrame t (p v2))
  -> (IntMap.Key -> v -> HostFrame t v2)
  -> IntMap v
  -> Event t (p v)
  -> RequesterT t (HostFrame t) Identity (HostFrame t) (IntMap v2, Event t (p v2))
defaultAdjustIntBase :: ((Key -> v -> HostFrame t v2) -> p v -> HostFrame t (p v2))
-> (Key -> v -> HostFrame t v2)
-> IntMap v
-> Event t (p v)
-> RequesterT
     t (HostFrame t) Identity (HostFrame t) (IntMap v2, Event t (p v2))
defaultAdjustIntBase (Key -> v -> HostFrame t v2) -> p v -> HostFrame t (p v2)
traversePatchWithKey Key -> v -> HostFrame t v2
f' IntMap v
dm0 Event t (p v)
dm' = do
  IntMap v2
result0 <- HostFrame t (IntMap v2)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (IntMap v2)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostFrame t (IntMap v2)
 -> RequesterT t (HostFrame t) Identity (HostFrame t) (IntMap v2))
-> HostFrame t (IntMap v2)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (IntMap v2)
forall a b. (a -> b) -> a -> b
$ (Key -> v -> HostFrame t v2) -> IntMap v -> HostFrame t (IntMap v2)
forall (t :: * -> *) a b.
Applicative t =>
(Key -> a -> t b) -> IntMap a -> t (IntMap b)
IntMap.traverseWithKey Key -> v -> HostFrame t v2
f' IntMap v
dm0
  Event t (p v2)
result' <- Event
  t
  (Request
     (RequesterT t (HostFrame t) Identity (HostFrame t)) (p v2))
-> RequesterT
     t (HostFrame t) Identity (HostFrame t) (Event t (p v2))
forall t (m :: * -> *) a.
(Requester t m, Response m ~ Identity) =>
Event t (Request m a) -> m (Event t a)
requestingIdentity (Event
   t
   (Request
      (RequesterT t (HostFrame t) Identity (HostFrame t)) (p v2))
 -> RequesterT
      t (HostFrame t) Identity (HostFrame t) (Event t (p v2)))
-> Event
     t
     (Request
        (RequesterT t (HostFrame t) Identity (HostFrame t)) (p v2))
-> RequesterT
     t (HostFrame t) Identity (HostFrame t) (Event t (p v2))
forall a b. (a -> b) -> a -> b
$ Event t (p v)
-> (p v -> HostFrame t (p v2)) -> Event t (HostFrame t (p v2))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (p v)
dm' ((p v -> HostFrame t (p v2)) -> Event t (HostFrame t (p v2)))
-> (p v -> HostFrame t (p v2)) -> Event t (HostFrame t (p v2))
forall a b. (a -> b) -> a -> b
$ (Key -> v -> HostFrame t v2) -> p v -> HostFrame t (p v2)
traversePatchWithKey Key -> v -> HostFrame t v2
f'
  (IntMap v2, Event t (p v2))
-> RequesterT
     t (HostFrame t) Identity (HostFrame t) (IntMap v2, Event t (p v2))
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap v2
result0, Event t (p v2)
result')

instance ReflexHost t => MonadReflexCreateTrigger t (PerformEventT t m) where
  {-# INLINABLE newEventWithTrigger #-}
  newEventWithTrigger :: (EventTrigger t a -> IO (IO ())) -> PerformEventT t m (Event t a)
newEventWithTrigger = RequesterT t (HostFrame t) Identity (HostFrame t) (Event t a)
-> PerformEventT t m (Event t a)
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT t (HostFrame t) Identity (HostFrame t) (Event t a)
 -> PerformEventT t m (Event t a))
-> ((EventTrigger t a -> IO (IO ()))
    -> RequesterT t (HostFrame t) Identity (HostFrame t) (Event t a))
-> (EventTrigger t a -> IO (IO ()))
-> PerformEventT t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostFrame t (Event t a)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostFrame t (Event t a)
 -> RequesterT t (HostFrame t) Identity (HostFrame t) (Event t a))
-> ((EventTrigger t a -> IO (IO ())) -> HostFrame t (Event t a))
-> (EventTrigger t a -> IO (IO ()))
-> RequesterT t (HostFrame t) Identity (HostFrame t) (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventTrigger t a -> IO (IO ())) -> HostFrame t (Event t a)
forall t (m :: * -> *) a.
MonadReflexCreateTrigger t m =>
(EventTrigger t a -> IO (IO ())) -> m (Event t a)
newEventWithTrigger
  {-# INLINABLE newFanEventWithTrigger #-}
  newFanEventWithTrigger :: (forall a. k a -> EventTrigger t a -> IO (IO ()))
-> PerformEventT t m (EventSelector t k)
newFanEventWithTrigger forall a. k a -> EventTrigger t a -> IO (IO ())
f = RequesterT
  t (HostFrame t) Identity (HostFrame t) (EventSelector t k)
-> PerformEventT t m (EventSelector t k)
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT
   t (HostFrame t) Identity (HostFrame t) (EventSelector t k)
 -> PerformEventT t m (EventSelector t k))
-> RequesterT
     t (HostFrame t) Identity (HostFrame t) (EventSelector t k)
-> PerformEventT t m (EventSelector t k)
forall a b. (a -> b) -> a -> b
$ HostFrame t (EventSelector t k)
-> RequesterT
     t (HostFrame t) Identity (HostFrame t) (EventSelector t k)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostFrame t (EventSelector t k)
 -> RequesterT
      t (HostFrame t) Identity (HostFrame t) (EventSelector t k))
-> HostFrame t (EventSelector t k)
-> RequesterT
     t (HostFrame t) Identity (HostFrame t) (EventSelector t k)
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> EventTrigger t a -> IO (IO ()))
-> HostFrame t (EventSelector t k)
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger forall a. k a -> EventTrigger t a -> IO (IO ())
f

-- | Run a 'PerformEventT' action, returning a 'FireCommand' that allows the
-- caller to trigger 'Event's while ensuring that 'performEvent' actions are run
-- at the appropriate time.
{-# INLINABLE hostPerformEventT #-}
hostPerformEventT :: forall t m a.
                     ( Monad m
                     , MonadSubscribeEvent t m
                     , MonadReflexHost t m
                     , MonadRef m
                     , Ref m ~ Ref IO
                     )
                  => PerformEventT t m a
                  -> m (a, FireCommand t m)
hostPerformEventT :: PerformEventT t m a -> m (a, FireCommand t m)
hostPerformEventT PerformEventT t m a
a = do
  (Event t (RequesterData Identity)
response, IORef (Maybe (EventTrigger t (RequesterData Identity)))
responseTrigger) <- m (Event t (RequesterData Identity),
   IORef (Maybe (EventTrigger t (RequesterData Identity))))
forall t (m :: * -> *) a.
(MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref IO) =>
m (Event t a, Ref m (Maybe (EventTrigger t a)))
newEventWithTriggerRef
  (a
result, Event t (RequesterData (HostFrame t))
eventToPerform) <- HostFrame t (a, Event t (RequesterData (HostFrame t)))
-> m (a, Event t (RequesterData (HostFrame t)))
forall t (m :: * -> *) a.
MonadReflexHost t m =>
HostFrame t a -> m a
runHostFrame (HostFrame t (a, Event t (RequesterData (HostFrame t)))
 -> m (a, Event t (RequesterData (HostFrame t))))
-> HostFrame t (a, Event t (RequesterData (HostFrame t)))
-> m (a, Event t (RequesterData (HostFrame t)))
forall a b. (a -> b) -> a -> b
$ RequesterT t (HostFrame t) Identity (HostFrame t) a
-> Event t (RequesterData Identity)
-> HostFrame t (a, Event t (RequesterData (HostFrame t)))
forall t (m :: * -> *) (request :: * -> *) (response :: * -> *) a.
(Reflex t, Monad m) =>
RequesterT t request response m a
-> Event t (RequesterData response)
-> m (a, Event t (RequesterData request))
runRequesterT (PerformEventT t m a
-> RequesterT t (HostFrame t) Identity (HostFrame t) a
forall t k (m :: k) a.
PerformEventT t m a
-> RequesterT t (HostFrame t) Identity (HostFrame t) a
unPerformEventT PerformEventT t m a
a) Event t (RequesterData Identity)
response
  EventHandle t (RequesterData (HostFrame t))
eventToPerformHandle <- Event t (RequesterData (HostFrame t))
-> m (EventHandle t (RequesterData (HostFrame t)))
forall t (m :: * -> *) a.
MonadSubscribeEvent t m =>
Event t a -> m (EventHandle t a)
subscribeEvent Event t (RequesterData (HostFrame t))
eventToPerform
  (a, FireCommand t m) -> m (a, FireCommand t m)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, FireCommand t m) -> m (a, FireCommand t m))
-> (a, FireCommand t m) -> m (a, FireCommand t m)
forall a b. (a -> b) -> a -> b
$ (,) a
result (FireCommand t m -> (a, FireCommand t m))
-> FireCommand t m -> (a, FireCommand t m)
forall a b. (a -> b) -> a -> b
$ (forall a.
 [DSum (EventTrigger t) Identity] -> ReadPhase m a -> m [a])
-> FireCommand t m
forall t (m :: * -> *).
(forall a.
 [DSum (EventTrigger t) Identity] -> ReadPhase m a -> m [a])
-> FireCommand t m
FireCommand ((forall a.
  [DSum (EventTrigger t) Identity] -> ReadPhase m a -> m [a])
 -> FireCommand t m)
-> (forall a.
    [DSum (EventTrigger t) Identity] -> ReadPhase m a -> m [a])
-> FireCommand t m
forall a b. (a -> b) -> a -> b
$ \[DSum (EventTrigger t) Identity]
triggers (readPhase :: ReadPhase m a') -> do
    let go :: [DSum (EventTrigger t) Identity] -> m [a']
        go :: [DSum (EventTrigger t) Identity] -> m [a]
go [DSum (EventTrigger t) Identity]
ts = do
          (a
result', Maybe (RequesterData (HostFrame t))
mToPerform) <- [DSum (EventTrigger t) Identity]
-> ReadPhase m (a, Maybe (RequesterData (HostFrame t)))
-> m (a, Maybe (RequesterData (HostFrame t)))
forall t (m :: * -> *) a.
MonadReflexHost t m =>
[DSum (EventTrigger t) Identity] -> ReadPhase m a -> m a
fireEventsAndRead [DSum (EventTrigger t) Identity]
ts (ReadPhase m (a, Maybe (RequesterData (HostFrame t)))
 -> m (a, Maybe (RequesterData (HostFrame t))))
-> ReadPhase m (a, Maybe (RequesterData (HostFrame t)))
-> m (a, Maybe (RequesterData (HostFrame t)))
forall a b. (a -> b) -> a -> b
$ do
            Maybe (RequesterData (HostFrame t))
mToPerform <- Maybe (ReadPhase m (RequesterData (HostFrame t)))
-> ReadPhase m (Maybe (RequesterData (HostFrame t)))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Maybe (ReadPhase m (RequesterData (HostFrame t)))
 -> ReadPhase m (Maybe (RequesterData (HostFrame t))))
-> ReadPhase m (Maybe (ReadPhase m (RequesterData (HostFrame t))))
-> ReadPhase m (Maybe (RequesterData (HostFrame t)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EventHandle t (RequesterData (HostFrame t))
-> ReadPhase m (Maybe (ReadPhase m (RequesterData (HostFrame t))))
forall t (m :: * -> *) a.
MonadReadEvent t m =>
EventHandle t a -> m (Maybe (m a))
readEvent EventHandle t (RequesterData (HostFrame t))
eventToPerformHandle
            a
result' <- ReadPhase m a
readPhase
            (a, Maybe (RequesterData (HostFrame t)))
-> ReadPhase m (a, Maybe (RequesterData (HostFrame t)))
forall (m :: * -> *) a. Monad m => a -> m a
return (a
result', Maybe (RequesterData (HostFrame t))
mToPerform)
          case Maybe (RequesterData (HostFrame t))
mToPerform of
            Maybe (RequesterData (HostFrame t))
Nothing -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a
result']
            Just RequesterData (HostFrame t)
toPerform -> do
              RequesterData Identity
responses <- HostFrame t (RequesterData Identity) -> m (RequesterData Identity)
forall t (m :: * -> *) a.
MonadReflexHost t m =>
HostFrame t a -> m a
runHostFrame (HostFrame t (RequesterData Identity)
 -> m (RequesterData Identity))
-> HostFrame t (RequesterData Identity)
-> m (RequesterData Identity)
forall a b. (a -> b) -> a -> b
$ (forall a. HostFrame t a -> HostFrame t (Identity a))
-> RequesterData (HostFrame t)
-> HostFrame t (RequesterData Identity)
forall (m :: * -> *) (request :: * -> *) (response :: * -> *).
Applicative m =>
(forall a. request a -> m (response a))
-> RequesterData request -> m (RequesterData response)
traverseRequesterData ((a -> Identity a) -> HostFrame t a -> HostFrame t (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Identity a
forall a. a -> Identity a
Identity) RequesterData (HostFrame t)
toPerform
              Maybe (EventTrigger t (RequesterData Identity))
mrt <- Ref m (Maybe (EventTrigger t (RequesterData Identity)))
-> m (Maybe (EventTrigger t (RequesterData Identity)))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef IORef (Maybe (EventTrigger t (RequesterData Identity)))
Ref m (Maybe (EventTrigger t (RequesterData Identity)))
responseTrigger
              let followupEventTriggers :: [DSum (EventTrigger t) Identity]
followupEventTriggers = case Maybe (EventTrigger t (RequesterData Identity))
mrt of
                    Just EventTrigger t (RequesterData Identity)
rt -> [EventTrigger t (RequesterData Identity)
rt EventTrigger t (RequesterData Identity)
-> Identity (RequesterData Identity)
-> DSum (EventTrigger t) Identity
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> RequesterData Identity -> Identity (RequesterData Identity)
forall a. a -> Identity a
Identity RequesterData Identity
responses]
                    Maybe (EventTrigger t (RequesterData Identity))
Nothing -> []
              (a
result'a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DSum (EventTrigger t) Identity] -> m [a]
go [DSum (EventTrigger t) Identity]
followupEventTriggers
    [DSum (EventTrigger t) Identity] -> m [a]
go [DSum (EventTrigger t) Identity]
triggers

instance ReflexHost t => MonadSample t (PerformEventT t m) where
  {-# INLINABLE sample #-}
  sample :: Behavior t a -> PerformEventT t m a
sample = RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT t (HostFrame t) Identity (HostFrame t) a
 -> PerformEventT t m a)
-> (Behavior t a
    -> RequesterT t (HostFrame t) Identity (HostFrame t) a)
-> Behavior t a
-> PerformEventT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostFrame t a
-> RequesterT t (HostFrame t) Identity (HostFrame t) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostFrame t a
 -> RequesterT t (HostFrame t) Identity (HostFrame t) a)
-> (Behavior t a -> HostFrame t a)
-> Behavior t a
-> RequesterT t (HostFrame t) Identity (HostFrame t) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior t a -> HostFrame t a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample

instance (ReflexHost t, MonadHold t m) => MonadHold t (PerformEventT t m) where
  {-# INLINABLE hold #-}
  hold :: a -> Event t a -> PerformEventT t m (Behavior t a)
hold a
v0 Event t a
v' = RequesterT t (HostFrame t) Identity (HostFrame t) (Behavior t a)
-> PerformEventT t m (Behavior t a)
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT t (HostFrame t) Identity (HostFrame t) (Behavior t a)
 -> PerformEventT t m (Behavior t a))
-> RequesterT t (HostFrame t) Identity (HostFrame t) (Behavior t a)
-> PerformEventT t m (Behavior t a)
forall a b. (a -> b) -> a -> b
$ HostFrame t (Behavior t a)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (Behavior t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostFrame t (Behavior t a)
 -> RequesterT
      t (HostFrame t) Identity (HostFrame t) (Behavior t a))
-> HostFrame t (Behavior t a)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (Behavior t a)
forall a b. (a -> b) -> a -> b
$ a -> Event t a -> HostFrame t (Behavior t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold a
v0 Event t a
v'
  {-# INLINABLE holdDyn #-}
  holdDyn :: a -> Event t a -> PerformEventT t m (Dynamic t a)
holdDyn a
v0 Event t a
v' = RequesterT t (HostFrame t) Identity (HostFrame t) (Dynamic t a)
-> PerformEventT t m (Dynamic t a)
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT t (HostFrame t) Identity (HostFrame t) (Dynamic t a)
 -> PerformEventT t m (Dynamic t a))
-> RequesterT t (HostFrame t) Identity (HostFrame t) (Dynamic t a)
-> PerformEventT t m (Dynamic t a)
forall a b. (a -> b) -> a -> b
$ HostFrame t (Dynamic t a)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (Dynamic t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostFrame t (Dynamic t a)
 -> RequesterT t (HostFrame t) Identity (HostFrame t) (Dynamic t a))
-> HostFrame t (Dynamic t a)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (Dynamic t a)
forall a b. (a -> b) -> a -> b
$ a -> Event t a -> HostFrame t (Dynamic t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn a
v0 Event t a
v'
  {-# INLINABLE holdIncremental #-}
  holdIncremental :: PatchTarget p -> Event t p -> PerformEventT t m (Incremental t p)
holdIncremental PatchTarget p
v0 Event t p
v' = RequesterT t (HostFrame t) Identity (HostFrame t) (Incremental t p)
-> PerformEventT t m (Incremental t p)
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT
   t (HostFrame t) Identity (HostFrame t) (Incremental t p)
 -> PerformEventT t m (Incremental t p))
-> RequesterT
     t (HostFrame t) Identity (HostFrame t) (Incremental t p)
-> PerformEventT t m (Incremental t p)
forall a b. (a -> b) -> a -> b
$ HostFrame t (Incremental t p)
-> RequesterT
     t (HostFrame t) Identity (HostFrame t) (Incremental t p)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostFrame t (Incremental t p)
 -> RequesterT
      t (HostFrame t) Identity (HostFrame t) (Incremental t p))
-> HostFrame t (Incremental t p)
-> RequesterT
     t (HostFrame t) Identity (HostFrame t) (Incremental t p)
forall a b. (a -> b) -> a -> b
$ PatchTarget p -> Event t p -> HostFrame t (Incremental t p)
forall k (t :: k) (m :: * -> *) p.
(MonadHold t m, Patch p) =>
PatchTarget p -> Event t p -> m (Incremental t p)
holdIncremental PatchTarget p
v0 Event t p
v'
  {-# INLINABLE buildDynamic #-}
  buildDynamic :: PushM t a -> Event t a -> PerformEventT t m (Dynamic t a)
buildDynamic PushM t a
getV0 Event t a
v' = RequesterT t (HostFrame t) Identity (HostFrame t) (Dynamic t a)
-> PerformEventT t m (Dynamic t a)
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT t (HostFrame t) Identity (HostFrame t) (Dynamic t a)
 -> PerformEventT t m (Dynamic t a))
-> RequesterT t (HostFrame t) Identity (HostFrame t) (Dynamic t a)
-> PerformEventT t m (Dynamic t a)
forall a b. (a -> b) -> a -> b
$ HostFrame t (Dynamic t a)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (Dynamic t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostFrame t (Dynamic t a)
 -> RequesterT t (HostFrame t) Identity (HostFrame t) (Dynamic t a))
-> HostFrame t (Dynamic t a)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (Dynamic t a)
forall a b. (a -> b) -> a -> b
$ PushM t a -> Event t a -> HostFrame t (Dynamic t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
PushM t a -> Event t a -> m (Dynamic t a)
buildDynamic PushM t a
getV0 Event t a
v'
  {-# INLINABLE headE #-}
  headE :: Event t a -> PerformEventT t m (Event t a)
headE = RequesterT t (HostFrame t) Identity (HostFrame t) (Event t a)
-> PerformEventT t m (Event t a)
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT t (HostFrame t) Identity (HostFrame t) (Event t a)
 -> PerformEventT t m (Event t a))
-> (Event t a
    -> RequesterT t (HostFrame t) Identity (HostFrame t) (Event t a))
-> Event t a
-> PerformEventT t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostFrame t (Event t a)
-> RequesterT t (HostFrame t) Identity (HostFrame t) (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostFrame t (Event t a)
 -> RequesterT t (HostFrame t) Identity (HostFrame t) (Event t a))
-> (Event t a -> HostFrame t (Event t a))
-> Event t a
-> RequesterT t (HostFrame t) Identity (HostFrame t) (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t a -> HostFrame t (Event t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
Event t a -> m (Event t a)
headE
  {-# INLINABLE now #-}
  now :: PerformEventT t m (Event t ())
now = RequesterT t (HostFrame t) Identity (HostFrame t) (Event t ())
-> PerformEventT t m (Event t ())
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT t (HostFrame t) Identity (HostFrame t) (Event t ())
 -> PerformEventT t m (Event t ()))
-> (HostFrame t (Event t ())
    -> RequesterT t (HostFrame t) Identity (HostFrame t) (Event t ()))
-> HostFrame t (Event t ())
-> PerformEventT t m (Event t ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostFrame t (Event t ())
-> RequesterT t (HostFrame t) Identity (HostFrame t) (Event t ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostFrame t (Event t ()) -> PerformEventT t m (Event t ()))
-> HostFrame t (Event t ()) -> PerformEventT t m (Event t ())
forall a b. (a -> b) -> a -> b
$ HostFrame t (Event t ())
forall k (t :: k) (m :: * -> *). MonadHold t m => m (Event t ())
now

instance (MonadRef (HostFrame t), ReflexHost t) => MonadRef (PerformEventT t m) where
  type Ref (PerformEventT t m) = Ref (HostFrame t)
  {-# INLINABLE newRef #-}
  newRef :: a -> PerformEventT t m (Ref (PerformEventT t m) a)
newRef = RequesterT
  t (HostFrame t) Identity (HostFrame t) (Ref (HostFrame t) a)
-> PerformEventT t m (Ref (HostFrame t) a)
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT
   t (HostFrame t) Identity (HostFrame t) (Ref (HostFrame t) a)
 -> PerformEventT t m (Ref (HostFrame t) a))
-> (a
    -> RequesterT
         t (HostFrame t) Identity (HostFrame t) (Ref (HostFrame t) a))
-> a
-> PerformEventT t m (Ref (HostFrame t) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostFrame t (Ref (HostFrame t) a)
-> RequesterT
     t (HostFrame t) Identity (HostFrame t) (Ref (HostFrame t) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostFrame t (Ref (HostFrame t) a)
 -> RequesterT
      t (HostFrame t) Identity (HostFrame t) (Ref (HostFrame t) a))
-> (a -> HostFrame t (Ref (HostFrame t) a))
-> a
-> RequesterT
     t (HostFrame t) Identity (HostFrame t) (Ref (HostFrame t) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> HostFrame t (Ref (HostFrame t) a)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef
  {-# INLINABLE readRef #-}
  readRef :: Ref (PerformEventT t m) a -> PerformEventT t m a
readRef = RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT t (HostFrame t) Identity (HostFrame t) a
 -> PerformEventT t m a)
-> (Ref (HostFrame t) a
    -> RequesterT t (HostFrame t) Identity (HostFrame t) a)
-> Ref (HostFrame t) a
-> PerformEventT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostFrame t a
-> RequesterT t (HostFrame t) Identity (HostFrame t) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostFrame t a
 -> RequesterT t (HostFrame t) Identity (HostFrame t) a)
-> (Ref (HostFrame t) a -> HostFrame t a)
-> Ref (HostFrame t) a
-> RequesterT t (HostFrame t) Identity (HostFrame t) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref (HostFrame t) a -> HostFrame t a
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef
  {-# INLINABLE writeRef #-}
  writeRef :: Ref (PerformEventT t m) a -> a -> PerformEventT t m ()
writeRef Ref (PerformEventT t m) a
r = RequesterT t (HostFrame t) Identity (HostFrame t) ()
-> PerformEventT t m ()
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT t (HostFrame t) Identity (HostFrame t) ()
 -> PerformEventT t m ())
-> (a -> RequesterT t (HostFrame t) Identity (HostFrame t) ())
-> a
-> PerformEventT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostFrame t ()
-> RequesterT t (HostFrame t) Identity (HostFrame t) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostFrame t ()
 -> RequesterT t (HostFrame t) Identity (HostFrame t) ())
-> (a -> HostFrame t ())
-> a
-> RequesterT t (HostFrame t) Identity (HostFrame t) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref (HostFrame t) a -> a -> HostFrame t ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
writeRef Ref (HostFrame t) a
Ref (PerformEventT t m) a
r

instance (MonadAtomicRef (HostFrame t), ReflexHost t) => MonadAtomicRef (PerformEventT t m) where
  {-# INLINABLE atomicModifyRef #-}
  atomicModifyRef :: Ref (PerformEventT t m) a -> (a -> (a, b)) -> PerformEventT t m b
atomicModifyRef Ref (PerformEventT t m) a
r = RequesterT t (HostFrame t) Identity (HostFrame t) b
-> PerformEventT t m b
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT t (HostFrame t) Identity (HostFrame t) b
 -> PerformEventT t m b)
-> ((a -> (a, b))
    -> RequesterT t (HostFrame t) Identity (HostFrame t) b)
-> (a -> (a, b))
-> PerformEventT t m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostFrame t b
-> RequesterT t (HostFrame t) Identity (HostFrame t) b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostFrame t b
 -> RequesterT t (HostFrame t) Identity (HostFrame t) b)
-> ((a -> (a, b)) -> HostFrame t b)
-> (a -> (a, b))
-> RequesterT t (HostFrame t) Identity (HostFrame t) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref (HostFrame t) a -> (a -> (a, b)) -> HostFrame t b
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef Ref (HostFrame t) a
Ref (PerformEventT t m) a
r