-- | 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.Exception
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)

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