{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE InstanceSigs #-}

#ifdef USE_REFLEX_OPTIMIZER
{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
#endif
{-# OPTIONS_GHC -Wunused-binds #-}
-- | This module is the implementation of the 'Spider' 'Reflex' engine.  It uses
-- a graph traversal algorithm to propagate 'Event's and 'Behavior's.
module Reflex.Spider.Internal (module Reflex.Spider.Internal) where

#if MIN_VERSION_base(4,10,0)
import Control.Applicative (liftA2)
#endif
import Control.Concurrent
import Control.Exception
import Control.Monad hiding (forM, forM_, mapM, mapM_)
import Control.Monad.Exception
import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_)
import Control.Monad.Primitive
import Control.Monad.Reader.Class
import Control.Monad.IO.Class
import Control.Monad.ReaderIO
import Control.Monad.Ref
import Control.Monad.Fail (MonadFail)
import qualified Control.Monad.Fail as MonadFail
import Data.Align
import Data.Coerce
import Data.Dependent.Map (DMap, DSum (..))
import qualified Data.Dependent.Map as DMap
import Data.FastMutableIntMap (FastMutableIntMap, PatchIntMap (..))
import qualified Data.FastMutableIntMap as FastMutableIntMap
import Data.Foldable hiding (concat, elem, sequence_)
import Data.Functor.Constant
import Data.Functor.Misc
import Data.Functor.Product
import Data.GADT.Compare
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IORef
import Data.Kind (Type)
import Data.Maybe hiding (mapMaybe)
import Data.Monoid (mempty, (<>))
import Data.Proxy
import Data.These
import Data.Traversable
import Data.Type.Equality ((:~:)(Refl))
import Data.Witherable (Filterable, mapMaybe)
import GHC.Exts hiding (toList)
import GHC.IORef (IORef (..))
import GHC.Stack
import Reflex.FastWeak
import System.IO.Unsafe
import System.Mem.Weak
import Unsafe.Coerce

#ifdef MIN_VERSION_semialign
#if MIN_VERSION_these(0,8,0)
import Data.These.Combinators (justThese)
#endif
#if MIN_VERSION_semialign(1,1,0)
import Data.Zip (Zip (..))
#endif
#endif

#ifdef DEBUG_CYCLES
import Control.Monad.State hiding (forM, forM_, mapM, mapM_, sequence)
#endif

import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Tree (Forest, Tree (..), drawForest)
import Data.List (isPrefixOf)

import Data.FastWeakBag (FastWeakBag, FastWeakBagTicket)
import qualified Data.FastWeakBag as FastWeakBag

import Data.Reflection
import Data.Some (Some(Some))
import Data.Type.Coercion
import Data.Profunctor.Unsafe ((#.), (.#))
import Data.WeakBag (WeakBag, WeakBagTicket, _weakBag_children)
import qualified Data.WeakBag as WeakBag
import qualified Reflex.Class
import qualified Reflex.Class as R
import qualified Reflex.Host.Class
import Reflex.NotReady.Class
import Data.Patch
import qualified Data.Patch.DMapWithMove as PatchDMapWithMove
import Reflex.PerformEvent.Base (PerformEventT)

#ifdef DEBUG_TRACE_EVENTS
import qualified Data.ByteString.Char8 as BS8
import System.IO (stderr)
import Data.List (isPrefixOf)
#endif

-- TODO stdout might not be the best channel for debug output
debugStrLn :: String -> IO ()
debugStrLn :: String -> IO ()
debugStrLn = String -> IO ()
putStrLn

#ifdef DEBUG_TRACE_EVENTS
withStackOneLine :: (BS8.ByteString -> a) -> a
withStackOneLine expr = unsafePerformIO $ do
  stack <- currentCallStack
  return (expr . BS8.pack  . unwords . dropInternal . reverse $ stack)
    where dropInternal = filterStack "Reflex.Spider.Internal"

#endif

debugPropagate :: Bool

debugInvalidateHeight :: Bool

debugInvalidate :: Bool

#ifdef DEBUG
#define DEBUG_NODEIDS

#ifdef DEBUG_TRACE_PROPAGATION
debugPropagate = True
#else
debugPropagate = False
#endif

#ifdef DEBUG_TRACE_HEIGHT
debugInvalidateHeight = True
#else
debugInvalidateHeight = False
#endif

#ifdef DEBUG_TRACE_INVALIDATION
debugInvalidate = True
#else
debugInvalidate = False
#endif

class HasNodeId a where
  getNodeId :: a -> Int

instance HasNodeId (CacheSubscribed x a) where
  getNodeId = _cacheSubscribed_nodeId

instance HasNodeId (FanInt x a) where
  getNodeId = _fanInt_nodeId

instance HasNodeId (Hold x p) where
  getNodeId = holdNodeId

instance HasNodeId (SwitchSubscribed x a) where
  getNodeId = switchSubscribedNodeId

instance HasNodeId (FanSubscribed x v a) where
  getNodeId = fanSubscribedNodeId

instance HasNodeId (CoincidenceSubscribed x a) where
  getNodeId = coincidenceSubscribedNodeId

instance HasNodeId (RootSubscribed x a) where
  getNodeId = rootSubscribedNodeId

instance HasNodeId (Pull x a) where
  getNodeId = pullNodeId

{-# INLINE showNodeId #-}
showNodeId :: HasNodeId a => a -> String
showNodeId = showNodeId' . getNodeId

showNodeId' :: Int -> String
showNodeId' = ("#"<>) . show


#else

debugPropagate :: Bool
debugPropagate = Bool
False
debugInvalidateHeight :: Bool
debugInvalidateHeight = Bool
False
debugInvalidate :: Bool
debugInvalidate = Bool
False

-- This must be inline, or error messages will cause memory leaks due to retaining the node in question
{-# INLINE showNodeId #-}
showNodeId :: a -> String
showNodeId :: a -> String
showNodeId _ = ""

{-# INLINE showNodeId' #-}
showNodeId' :: Int -> String
showNodeId' :: Int -> String
showNodeId' _ = ""

#endif

#ifdef DEBUG_NODEIDS
{-# NOINLINE nextNodeIdRef #-}
nextNodeIdRef :: IORef Int
nextNodeIdRef = unsafePerformIO $ newIORef 1

newNodeId :: IO Int
newNodeId = atomicModifyIORef' nextNodeIdRef $ \n -> (succ n, n)
#endif

--------------------------------------------------------------------------------
-- EventSubscription
--------------------------------------------------------------------------------

--NB: Once you subscribe to an Event, you must always hold on the the WHOLE EventSubscription you get back
-- If you do not retain the subscription, you may be prematurely unsubscribed from the parent event.
data EventSubscription x = EventSubscription
  { EventSubscription x -> IO ()
_eventSubscription_unsubscribe :: !(IO ())
  , EventSubscription x -> EventSubscribed x
_eventSubscription_subscribed :: {-# UNPACK #-} !(EventSubscribed x)
  }

unsubscribe :: EventSubscription x -> IO ()
unsubscribe :: EventSubscription x -> IO ()
unsubscribe (EventSubscription u :: IO ()
u _) = IO ()
u

--------------------------------------------------------------------------------
-- Event
--------------------------------------------------------------------------------

newtype Event x a = Event { Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
unEvent :: Subscriber x a -> EventM x (EventSubscription x, Maybe a) }

{-# INLINE subscribeAndRead #-}
subscribeAndRead :: Event x a -> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead :: Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead = Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
forall k (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
unEvent

{-# RULES
"cacheEvent/cacheEvent" forall e. cacheEvent (cacheEvent e) = cacheEvent e
"cacheEvent/pushCheap" forall f e. pushCheap f (cacheEvent e) = cacheEvent (pushCheap f e)
"hold/cacheEvent" forall f e. hold f (cacheEvent e) = hold f e
  #-}

-- | Construct an 'Event' equivalent to that constructed by 'push', but with no
-- caching; if the computation function is very cheap, this is (much) more
-- efficient than 'push'
{-# INLINE [1] pushCheap #-}
pushCheap :: HasSpiderTimeline x => (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
pushCheap :: (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
pushCheap !a -> ComputeM x (Maybe b)
f e :: Event x a
e = (Subscriber x b -> EventM x (EventSubscription x, Maybe b))
-> Event x b
forall k (x :: k) a.
(Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
Event ((Subscriber x b -> EventM x (EventSubscription x, Maybe b))
 -> Event x b)
-> (Subscriber x b -> EventM x (EventSubscription x, Maybe b))
-> Event x b
forall a b. (a -> b) -> a -> b
$ \sub :: Subscriber x b
sub -> do
  (subscription :: EventSubscription x
subscription, occ :: Maybe a
occ) <- Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
forall k (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead Event x a
e (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
forall a b. (a -> b) -> a -> b
$ String -> Subscriber x a -> Subscriber x a
forall k (x :: k) a. String -> Subscriber x a -> Subscriber x a
debugSubscriber' "push" (Subscriber x a -> Subscriber x a)
-> Subscriber x a -> Subscriber x a
forall a b. (a -> b) -> a -> b
$ Subscriber x b
sub
    { subscriberPropagate :: a -> EventM x ()
subscriberPropagate = \a :: a
a -> do
        Maybe b
mb <- a -> ComputeM x (Maybe b)
f a
a
        (b -> EventM x ()) -> Maybe b -> EventM x ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Subscriber x b -> b -> EventM x ()
forall k (x :: k) a. Subscriber x a -> a -> EventM x ()
subscriberPropagate Subscriber x b
sub) Maybe b
mb
    }
  Maybe b
occ' <- Maybe (Maybe b) -> Maybe b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe b) -> Maybe b)
-> EventM x (Maybe (Maybe b)) -> ComputeM x (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> ComputeM x (Maybe b))
-> Maybe a -> EventM x (Maybe (Maybe b))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> ComputeM x (Maybe b)
f Maybe a
occ
  (EventSubscription x, Maybe b)
-> EventM x (EventSubscription x, Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventSubscription x
subscription, Maybe b
occ')

-- | A subscriber that never triggers other 'Event's
{-# INLINE terminalSubscriber #-}
terminalSubscriber :: (a -> EventM x ()) -> Subscriber x a
terminalSubscriber :: (a -> EventM x ()) -> Subscriber x a
terminalSubscriber p :: a -> EventM x ()
p = $WSubscriber :: forall k (x :: k) a.
(a -> EventM x ())
-> (Height -> IO ()) -> (Height -> IO ()) -> Subscriber x a
Subscriber
  { subscriberPropagate :: a -> EventM x ()
subscriberPropagate = a -> EventM x ()
p
  , subscriberInvalidateHeight :: Height -> IO ()
subscriberInvalidateHeight = \_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = \_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  }

-- | Subscribe to an Event only for the duration of one occurrence
{-# INLINE subscribeAndReadHead #-}
subscribeAndReadHead :: HasSpiderTimeline x => Event x a -> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndReadHead :: Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndReadHead e :: Event x a
e sub :: Subscriber x a
sub = do
  IORef (EventSubscription x)
subscriptionRef <- IO (IORef (EventSubscription x))
-> EventM x (IORef (EventSubscription x))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (EventSubscription x))
 -> EventM x (IORef (EventSubscription x)))
-> IO (IORef (EventSubscription x))
-> EventM x (IORef (EventSubscription x))
forall a b. (a -> b) -> a -> b
$ EventSubscription x -> IO (IORef (EventSubscription x))
forall a. a -> IO (IORef a)
newIORef (EventSubscription x -> IO (IORef (EventSubscription x)))
-> EventSubscription x -> IO (IORef (EventSubscription x))
forall a b. (a -> b) -> a -> b
$ String -> EventSubscription x
forall a. HasCallStack => String -> a
error "subscribeAndReadHead: not initialized"
  (subscription :: EventSubscription x
subscription, occ :: Maybe a
occ) <- Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
forall k (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead Event x a
e (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
forall a b. (a -> b) -> a -> b
$ String -> Subscriber x a -> Subscriber x a
forall k (x :: k) a. String -> Subscriber x a -> Subscriber x a
debugSubscriber' "head" (Subscriber x a -> Subscriber x a)
-> Subscriber x a -> Subscriber x a
forall a b. (a -> b) -> a -> b
$ Subscriber x a
sub
    { subscriberPropagate :: a -> EventM x ()
subscriberPropagate = \a :: a
a -> do
        IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ EventSubscription x -> IO ()
forall k (x :: k). EventSubscription x -> IO ()
unsubscribe (EventSubscription x -> IO ()) -> IO (EventSubscription x) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (EventSubscription x) -> IO (EventSubscription x)
forall a. IORef a -> IO a
readIORef IORef (EventSubscription x)
subscriptionRef
        Subscriber x a -> a -> EventM x ()
forall k (x :: k) a. Subscriber x a -> a -> EventM x ()
subscriberPropagate Subscriber x a
sub a
a
    }
  IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ case Maybe a
occ of
    Nothing -> IORef (EventSubscription x) -> EventSubscription x -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (EventSubscription x)
subscriptionRef (EventSubscription x -> IO ()) -> EventSubscription x -> IO ()
forall a b. (a -> b) -> a -> b
$! EventSubscription x
subscription
    Just _ -> EventSubscription x -> IO ()
forall k (x :: k). EventSubscription x -> IO ()
unsubscribe EventSubscription x
subscription
  (EventSubscription x, Maybe a)
-> EventM x (EventSubscription x, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventSubscription x
subscription, Maybe a
occ)

--TODO: Make this lazy in its input event
headE :: (MonadIO m, Defer (SomeMergeInit x) m, HasSpiderTimeline x) => Event x a -> m (Event x a)
headE :: Event x a -> m (Event x a)
headE originalE :: Event x a
originalE = do
  IORef (Maybe (Event x a))
parent <- IO (IORef (Maybe (Event x a))) -> m (IORef (Maybe (Event x a)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe (Event x a))) -> m (IORef (Maybe (Event x a))))
-> IO (IORef (Maybe (Event x a))) -> m (IORef (Maybe (Event x a)))
forall a b. (a -> b) -> a -> b
$ Maybe (Event x a) -> IO (IORef (Maybe (Event x a)))
forall a. a -> IO (IORef a)
newIORef (Maybe (Event x a) -> IO (IORef (Maybe (Event x a))))
-> Maybe (Event x a) -> IO (IORef (Maybe (Event x a)))
forall a b. (a -> b) -> a -> b
$ Event x a -> Maybe (Event x a)
forall a. a -> Maybe a
Just Event x a
originalE
  SomeMergeInit x -> m ()
forall a (m :: * -> *). Defer a m => a -> m ()
defer (SomeMergeInit x -> m ()) -> SomeMergeInit x -> m ()
forall a b. (a -> b) -> a -> b
$ EventM x () -> SomeMergeInit x
forall k (x :: k). EventM x () -> SomeMergeInit x
SomeMergeInit (EventM x () -> SomeMergeInit x) -> EventM x () -> SomeMergeInit x
forall a b. (a -> b) -> a -> b
$ do --TODO: Rename SomeMergeInit appropriately
    let clearParent :: EventM x ()
clearParent = IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (Event x a)) -> Maybe (Event x a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Event x a))
parent Maybe (Event x a)
forall a. Maybe a
Nothing
    (_, occ :: Maybe a
occ) <- Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
forall x a.
HasSpiderTimeline x =>
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndReadHead Event x a
originalE (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
forall a b. (a -> b) -> a -> b
$ (a -> EventM x ()) -> Subscriber x a
forall k a (x :: k). (a -> EventM x ()) -> Subscriber x a
terminalSubscriber ((a -> EventM x ()) -> Subscriber x a)
-> (a -> EventM x ()) -> Subscriber x a
forall a b. (a -> b) -> a -> b
$ EventM x () -> a -> EventM x ()
forall a b. a -> b -> a
const EventM x ()
clearParent
    Bool -> EventM x () -> EventM x ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
occ) EventM x ()
clearParent
  Event x a -> m (Event x a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event x a -> m (Event x a)) -> Event x a -> m (Event x a)
forall a b. (a -> b) -> a -> b
$ (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
forall k (x :: k) a.
(Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
Event ((Subscriber x a -> EventM x (EventSubscription x, Maybe a))
 -> Event x a)
-> (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
forall a b. (a -> b) -> a -> b
$ \sub :: Subscriber x a
sub ->
    IO (Maybe (Event x a)) -> EventM x (Maybe (Event x a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe (Event x a)) -> IO (Maybe (Event x a))
forall a. IORef a -> IO a
readIORef IORef (Maybe (Event x a))
parent) EventM x (Maybe (Event x a))
-> (Maybe (Event x a) -> EventM x (EventSubscription x, Maybe a))
-> EventM x (EventSubscription x, Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Nothing -> EventM x (EventSubscription x, Maybe a)
forall k (x :: k) a. EventM x (EventSubscription x, Maybe a)
subscribeAndReadNever
      Just e :: Event x a
e -> Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
forall x a.
HasSpiderTimeline x =>
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndReadHead Event x a
e Subscriber x a
sub

data CacheSubscribed x a
   = CacheSubscribed { CacheSubscribed x a -> FastWeakBag (Subscriber x a)
_cacheSubscribed_subscribers :: {-# UNPACK #-} !(FastWeakBag (Subscriber x a))
                     , CacheSubscribed x a -> EventSubscription x
_cacheSubscribed_parent :: {-# UNPACK #-} !(EventSubscription x)
                     , CacheSubscribed x a -> IORef (Maybe a)
_cacheSubscribed_occurrence :: {-# UNPACK #-} !(IORef (Maybe a))
#ifdef DEBUG_NODEIDS
                     , _cacheSubscribed_nodeId :: {-# UNPACK #-} !Int
#endif
                     }



-- | Construct an 'Event' whose value is guaranteed not to be recomputed
-- repeatedly
--
--TODO: Try a caching strategy where we subscribe directly to the parent when
--there's only one subscriber, and then build our own FastWeakBag only when a second
--subscriber joins
{-# NOINLINE [0] cacheEvent #-}
cacheEvent :: forall x a. HasSpiderTimeline x => Event x a -> Event x a
cacheEvent :: Event x a -> Event x a
cacheEvent e :: Event x a
e =
#ifdef DEBUG_TRACE_EVENTS
  withStackOneLine $ \callSite -> Event $
#else
  (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
forall k (x :: k) a.
(Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
Event ((Subscriber x a -> EventM x (EventSubscription x, Maybe a))
 -> Event x a)
-> (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
forall a b. (a -> b) -> a -> b
$
#endif
  IO (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
forall a. IO a -> a
unsafePerformIO (IO (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
 -> Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> IO (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Subscriber x a
-> EventM x (EventSubscription x, Maybe a)
forall a b. (a -> b) -> a -> b
$ do
    IORef (FastWeak (CacheSubscribed x a))
mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a))
        <- FastWeak (CacheSubscribed x a)
-> IO (IORef (FastWeak (CacheSubscribed x a)))
forall a. a -> IO (IORef a)
newIORef FastWeak (CacheSubscribed x a)
forall a. FastWeak a
emptyFastWeak
    (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> IO (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Subscriber x a -> EventM x (EventSubscription x, Maybe a))
 -> IO (Subscriber x a -> EventM x (EventSubscription x, Maybe a)))
-> (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> IO (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
forall a b. (a -> b) -> a -> b
$ \sub :: Subscriber x a
sub -> {-# SCC "cacheEvent" #-} do
#ifdef DEBUG_TRACE_EVENTS
          unless (BS8.null callSite) $ liftIO $ BS8.hPutStrLn stderr callSite
#endif
          FastWeakTicket (CacheSubscribed x a)
subscribedTicket <- IO (Maybe (FastWeakTicket (CacheSubscribed x a)))
-> EventM x (Maybe (FastWeakTicket (CacheSubscribed x a)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (FastWeak (CacheSubscribed x a))
-> IO (FastWeak (CacheSubscribed x a))
forall a. IORef a -> IO a
readIORef IORef (FastWeak (CacheSubscribed x a))
mSubscribedRef IO (FastWeak (CacheSubscribed x a))
-> (FastWeak (CacheSubscribed x a)
    -> IO (Maybe (FastWeakTicket (CacheSubscribed x a))))
-> IO (Maybe (FastWeakTicket (CacheSubscribed x a)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FastWeak (CacheSubscribed x a)
-> IO (Maybe (FastWeakTicket (CacheSubscribed x a)))
forall a. FastWeak a -> IO (Maybe (FastWeakTicket a))
getFastWeakTicket) EventM x (Maybe (FastWeakTicket (CacheSubscribed x a)))
-> (Maybe (FastWeakTicket (CacheSubscribed x a))
    -> EventM x (FastWeakTicket (CacheSubscribed x a)))
-> EventM x (FastWeakTicket (CacheSubscribed x a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just subscribedTicket :: FastWeakTicket (CacheSubscribed x a)
subscribedTicket -> FastWeakTicket (CacheSubscribed x a)
-> EventM x (FastWeakTicket (CacheSubscribed x a))
forall (m :: * -> *) a. Monad m => a -> m a
return FastWeakTicket (CacheSubscribed x a)
subscribedTicket
            Nothing -> do
#ifdef DEBUG_NODEIDS
              nodeId <- liftIO newNodeId
#endif
              FastWeakBag (Subscriber x a)
subscribers <- IO (FastWeakBag (Subscriber x a))
-> EventM x (FastWeakBag (Subscriber x a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (FastWeakBag (Subscriber x a))
forall a. IO (FastWeakBag a)
FastWeakBag.empty
              IORef (Maybe a)
occRef <- IO (IORef (Maybe a)) -> EventM x (IORef (Maybe a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe a)) -> EventM x (IORef (Maybe a)))
-> IO (IORef (Maybe a)) -> EventM x (IORef (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> IO (IORef (Maybe a))
forall a. a -> IO (IORef a)
newIORef Maybe a
forall a. Maybe a
Nothing -- This should never be read prior to being set below
#ifdef DEBUG_NODEIDS
              (parentSub, occ) <- subscribeAndRead e $ debugSubscriber' ("cacheEvent" <> showNodeId' nodeId) $ Subscriber
#else
              (parentSub :: EventSubscription x
parentSub, occ :: Maybe a
occ) <- Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
forall k (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead Event x a
e (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
forall a b. (a -> b) -> a -> b
$ $WSubscriber :: forall k (x :: k) a.
(a -> EventM x ())
-> (Height -> IO ()) -> (Height -> IO ()) -> Subscriber x a
Subscriber
#endif
                  { subscriberPropagate :: a -> EventM x ()
subscriberPropagate = \a :: a
a -> do
                      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe a) -> Maybe a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe a)
occRef (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
                      IORef (Maybe a) -> EventM x ()
forall (m :: * -> *) a.
Defer (Some Clear) m =>
IORef (Maybe a) -> m ()
scheduleClear IORef (Maybe a)
occRef
                      a -> FastWeakBag (Subscriber x a) -> EventM x ()
forall x a.
HasSpiderTimeline x =>
a -> FastWeakBag (Subscriber x a) -> EventM x ()
propagateFast a
a FastWeakBag (Subscriber x a)
subscribers
                  , subscriberInvalidateHeight :: Height -> IO ()
subscriberInvalidateHeight = FastWeakBag (Subscriber x a) -> (Subscriber x a -> IO ()) -> IO ()
forall a (m :: * -> *).
MonadIO m =>
FastWeakBag a -> (a -> m ()) -> m ()
FastWeakBag.traverse_ FastWeakBag (Subscriber x a)
subscribers ((Subscriber x a -> IO ()) -> IO ())
-> (Height -> Subscriber x a -> IO ()) -> Height -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Height -> Subscriber x a -> IO ()
forall k (x :: k) a. Height -> Subscriber x a -> IO ()
invalidateSubscriberHeight
                  , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = FastWeakBag (Subscriber x a) -> (Subscriber x a -> IO ()) -> IO ()
forall a (m :: * -> *).
MonadIO m =>
FastWeakBag a -> (a -> m ()) -> m ()
FastWeakBag.traverse_ FastWeakBag (Subscriber x a)
subscribers ((Subscriber x a -> IO ()) -> IO ())
-> (Height -> Subscriber x a -> IO ()) -> Height -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Height -> Subscriber x a -> IO ()
forall k (x :: k) a. Height -> Subscriber x a -> IO ()
recalculateSubscriberHeight
                  }
              Bool -> EventM x () -> EventM x ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
occ) (EventM x () -> EventM x ()) -> EventM x () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ do
                IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe a) -> Maybe a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe a)
occRef Maybe a
occ -- Set the initial value of occRef; we don't need to do this if occ is Nothing
                IORef (Maybe a) -> EventM x ()
forall (m :: * -> *) a.
Defer (Some Clear) m =>
IORef (Maybe a) -> m ()
scheduleClear IORef (Maybe a)
occRef
              let !subscribed :: CacheSubscribed x a
subscribed = $WCacheSubscribed :: forall k (x :: k) a.
FastWeakBag (Subscriber x a)
-> EventSubscription x -> IORef (Maybe a) -> CacheSubscribed x a
CacheSubscribed
                    { _cacheSubscribed_subscribers :: FastWeakBag (Subscriber x a)
_cacheSubscribed_subscribers = FastWeakBag (Subscriber x a)
subscribers
                    , _cacheSubscribed_parent :: EventSubscription x
_cacheSubscribed_parent = EventSubscription x
parentSub
                    , _cacheSubscribed_occurrence :: IORef (Maybe a)
_cacheSubscribed_occurrence = IORef (Maybe a)
occRef
#ifdef DEBUG_NODEIDS
                    , _cacheSubscribed_nodeId = nodeId
#endif
                    }
              FastWeakTicket (CacheSubscribed x a)
subscribedTicket <- IO (FastWeakTicket (CacheSubscribed x a))
-> EventM x (FastWeakTicket (CacheSubscribed x a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FastWeakTicket (CacheSubscribed x a))
 -> EventM x (FastWeakTicket (CacheSubscribed x a)))
-> IO (FastWeakTicket (CacheSubscribed x a))
-> EventM x (FastWeakTicket (CacheSubscribed x a))
forall a b. (a -> b) -> a -> b
$ CacheSubscribed x a -> IO (FastWeakTicket (CacheSubscribed x a))
forall a. a -> IO (FastWeakTicket a)
mkFastWeakTicket CacheSubscribed x a
subscribed
              IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (FastWeak (CacheSubscribed x a))
-> FastWeak (CacheSubscribed x a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (FastWeak (CacheSubscribed x a))
mSubscribedRef (FastWeak (CacheSubscribed x a) -> IO ())
-> IO (FastWeak (CacheSubscribed x a)) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FastWeakTicket (CacheSubscribed x a)
-> IO (FastWeak (CacheSubscribed x a))
forall a. FastWeakTicket a -> IO (FastWeak a)
getFastWeakTicketWeak FastWeakTicket (CacheSubscribed x a)
subscribedTicket
              FastWeakTicket (CacheSubscribed x a)
-> EventM x (FastWeakTicket (CacheSubscribed x a))
forall (m :: * -> *) a. Monad m => a -> m a
return FastWeakTicket (CacheSubscribed x a)
subscribedTicket
          IO (EventSubscription x, Maybe a)
-> EventM x (EventSubscription x, Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (EventSubscription x, Maybe a)
 -> EventM x (EventSubscription x, Maybe a))
-> IO (EventSubscription x, Maybe a)
-> EventM x (EventSubscription x, Maybe a)
forall a b. (a -> b) -> a -> b
$ Subscriber x a
-> IORef (FastWeak (CacheSubscribed x a))
-> FastWeakTicket (CacheSubscribed x a)
-> IO (EventSubscription x, Maybe a)
forall k (x :: k) a.
Subscriber x a
-> IORef (FastWeak (CacheSubscribed x a))
-> FastWeakTicket (CacheSubscribed x a)
-> IO (EventSubscription x, Maybe a)
cacheSubscription Subscriber x a
sub IORef (FastWeak (CacheSubscribed x a))
mSubscribedRef FastWeakTicket (CacheSubscribed x a)
subscribedTicket

cacheSubscription :: Subscriber x a -> IORef (FastWeak (CacheSubscribed x a))
                  -> FastWeakTicket (CacheSubscribed x a) -> IO (EventSubscription x, Maybe a)
cacheSubscription :: Subscriber x a
-> IORef (FastWeak (CacheSubscribed x a))
-> FastWeakTicket (CacheSubscribed x a)
-> IO (EventSubscription x, Maybe a)
cacheSubscription sub :: Subscriber x a
sub mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a))
mSubscribedRef subscribedTicket :: FastWeakTicket (CacheSubscribed x a)
subscribedTicket = do
  CacheSubscribed x a
subscribed <- FastWeakTicket (CacheSubscribed x a) -> IO (CacheSubscribed x a)
forall a. FastWeakTicket a -> IO a
getFastWeakTicketValue FastWeakTicket (CacheSubscribed x a)
subscribedTicket
  FastWeakBagTicket (Subscriber x a)
ticket <- Subscriber x a
-> FastWeakBag (Subscriber x a)
-> IO (FastWeakBagTicket (Subscriber x a))
forall a. a -> FastWeakBag a -> IO (FastWeakBagTicket a)
FastWeakBag.insert Subscriber x a
sub (FastWeakBag (Subscriber x a)
 -> IO (FastWeakBagTicket (Subscriber x a)))
-> FastWeakBag (Subscriber x a)
-> IO (FastWeakBagTicket (Subscriber x a))
forall a b. (a -> b) -> a -> b
$ CacheSubscribed x a -> FastWeakBag (Subscriber x a)
forall k (x :: k) a.
CacheSubscribed x a -> FastWeakBag (Subscriber x a)
_cacheSubscribed_subscribers CacheSubscribed x a
subscribed
  Maybe a
occ <- IORef (Maybe a) -> IO (Maybe a)
forall a. IORef a -> IO a
readIORef (IORef (Maybe a) -> IO (Maybe a))
-> IORef (Maybe a) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ CacheSubscribed x a -> IORef (Maybe a)
forall k (x :: k) a. CacheSubscribed x a -> IORef (Maybe a)
_cacheSubscribed_occurrence CacheSubscribed x a
subscribed

  let parentSub :: EventSubscription x
parentSub = CacheSubscribed x a -> EventSubscription x
forall k (x :: k) a. CacheSubscribed x a -> EventSubscription x
_cacheSubscribed_parent CacheSubscribed x a
subscribed
      es :: EventSubscription x
es = $WEventSubscription :: forall k (x :: k).
IO () -> EventSubscribed x -> EventSubscription x
EventSubscription
        { _eventSubscription_unsubscribe :: IO ()
_eventSubscription_unsubscribe = do
          FastWeakBagTicket (Subscriber x a) -> IO ()
forall a. FastWeakBagTicket a -> IO ()
FastWeakBag.remove FastWeakBagTicket (Subscriber x a)
ticket

          Bool
isEmpty <- FastWeakBag (Subscriber x a) -> IO Bool
forall a. FastWeakBag a -> IO Bool
FastWeakBag.isEmpty (FastWeakBag (Subscriber x a) -> IO Bool)
-> FastWeakBag (Subscriber x a) -> IO Bool
forall a b. (a -> b) -> a -> b
$ CacheSubscribed x a -> FastWeakBag (Subscriber x a)
forall k (x :: k) a.
CacheSubscribed x a -> FastWeakBag (Subscriber x a)
_cacheSubscribed_subscribers CacheSubscribed x a
subscribed
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isEmpty (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            IORef (FastWeak (CacheSubscribed x a))
-> FastWeak (CacheSubscribed x a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (FastWeak (CacheSubscribed x a))
mSubscribedRef FastWeak (CacheSubscribed x a)
forall a. FastWeak a
emptyFastWeak
            EventSubscription x -> IO ()
forall k (x :: k). EventSubscription x -> IO ()
unsubscribe EventSubscription x
parentSub
          FastWeakBagTicket (Subscriber x a) -> IO ()
forall (m :: * -> *) a. PrimMonad m => a -> m ()
touch FastWeakBagTicket (Subscriber x a)
ticket
          FastWeakTicket (CacheSubscribed x a) -> IO ()
forall (m :: * -> *) a. PrimMonad m => a -> m ()
touch FastWeakTicket (CacheSubscribed x a)
subscribedTicket
        , _eventSubscription_subscribed :: EventSubscribed x
_eventSubscription_subscribed = $WEventSubscribed :: forall k (x :: k). IORef Height -> Any -> EventSubscribed x
EventSubscribed
          { eventSubscribedHeightRef :: IORef Height
eventSubscribedHeightRef = EventSubscribed x -> IORef Height
forall k (x :: k). EventSubscribed x -> IORef Height
eventSubscribedHeightRef (EventSubscribed x -> IORef Height)
-> EventSubscribed x -> IORef Height
forall a b. (a -> b) -> a -> b
$ EventSubscription x -> EventSubscribed x
forall k (x :: k). EventSubscription x -> EventSubscribed x
_eventSubscription_subscribed EventSubscription x
parentSub
          , eventSubscribedRetained :: Any
eventSubscribedRetained = FastWeakTicket (CacheSubscribed x a) -> Any
forall a. a -> Any
toAny FastWeakTicket (CacheSubscribed x a)
subscribedTicket
#ifdef DEBUG_CYCLES
          , eventSubscribedGetParents = return [_eventSubscription_subscribed parentSub]
          , eventSubscribedHasOwnHeightRef = False
          , eventSubscribedWhoCreated = whoCreatedIORef mSubscribedRef
#endif
          }
        }
  (EventSubscription x, Maybe a) -> IO (EventSubscription x, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventSubscription x
es, Maybe a
occ)


subscribe :: Event x a -> Subscriber x a -> EventM x (EventSubscription x)
subscribe :: Event x a -> Subscriber x a -> EventM x (EventSubscription x)
subscribe e :: Event x a
e s :: Subscriber x a
s = (EventSubscription x, Maybe a) -> EventSubscription x
forall a b. (a, b) -> a
fst ((EventSubscription x, Maybe a) -> EventSubscription x)
-> EventM x (EventSubscription x, Maybe a)
-> EventM x (EventSubscription x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
forall k (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead Event x a
e Subscriber x a
s

{-# INLINE wrap #-}
wrap :: MonadIO m => (t -> EventSubscribed x) -> (Subscriber x a -> m (WeakBagTicket, t, Maybe a)) -> Subscriber x a -> m (EventSubscription x, Maybe a)
wrap :: (t -> EventSubscribed x)
-> (Subscriber x a -> m (WeakBagTicket, t, Maybe a))
-> Subscriber x a
-> m (EventSubscription x, Maybe a)
wrap tag :: t -> EventSubscribed x
tag getSpecificSubscribed :: Subscriber x a -> m (WeakBagTicket, t, Maybe a)
getSpecificSubscribed sub :: Subscriber x a
sub = do
  (sln :: WeakBagTicket
sln, subd :: t
subd, occ :: Maybe a
occ) <- Subscriber x a -> m (WeakBagTicket, t, Maybe a)
getSpecificSubscribed Subscriber x a
sub
  let es :: EventSubscribed x
es = t -> EventSubscribed x
tag t
subd
  (EventSubscription x, Maybe a) -> m (EventSubscription x, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> EventSubscribed x -> EventSubscription x
forall k (x :: k).
IO () -> EventSubscribed x -> EventSubscription x
EventSubscription (WeakBagTicket -> IO ()
WeakBag.remove WeakBagTicket
sln IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WeakBagTicket -> IO ()
forall (m :: * -> *) a. PrimMonad m => a -> m ()
touch WeakBagTicket
sln) EventSubscribed x
es, Maybe a
occ)

eventRoot :: (GCompare k, HasSpiderTimeline x) => k a -> Root x k -> Event x a
eventRoot :: k a -> Root x k -> Event x a
eventRoot !k a
k !Root x k
r = (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
forall k (x :: k) a.
(Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
Event ((Subscriber x a -> EventM x (EventSubscription x, Maybe a))
 -> Event x a)
-> (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
forall a b. (a -> b) -> a -> b
$ (RootSubscribed x a -> EventSubscribed x)
-> (Subscriber x a
    -> EventM x (WeakBagTicket, RootSubscribed x a, Maybe a))
-> Subscriber x a
-> EventM x (EventSubscription x, Maybe a)
forall k (m :: * -> *) t (x :: k) a.
MonadIO m =>
(t -> EventSubscribed x)
-> (Subscriber x a -> m (WeakBagTicket, t, Maybe a))
-> Subscriber x a
-> m (EventSubscription x, Maybe a)
wrap RootSubscribed x a -> EventSubscribed x
forall k (x :: k) a. RootSubscribed x a -> EventSubscribed x
eventSubscribedRoot ((Subscriber x a
  -> EventM x (WeakBagTicket, RootSubscribed x a, Maybe a))
 -> Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> (Subscriber x a
    -> EventM x (WeakBagTicket, RootSubscribed x a, Maybe a))
-> Subscriber x a
-> EventM x (EventSubscription x, Maybe a)
forall a b. (a -> b) -> a -> b
$ IO (WeakBagTicket, RootSubscribed x a, Maybe a)
-> EventM x (WeakBagTicket, RootSubscribed x a, Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (WeakBagTicket, RootSubscribed x a, Maybe a)
 -> EventM x (WeakBagTicket, RootSubscribed x a, Maybe a))
-> (Subscriber x a
    -> IO (WeakBagTicket, RootSubscribed x a, Maybe a))
-> Subscriber x a
-> EventM x (WeakBagTicket, RootSubscribed x a, Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k a
-> Root x k
-> Subscriber x a
-> IO (WeakBagTicket, RootSubscribed x a, Maybe a)
forall (k :: * -> *) x a.
(GCompare k, HasSpiderTimeline x) =>
k a
-> Root x k
-> Subscriber x a
-> IO (WeakBagTicket, RootSubscribed x a, Maybe a)
getRootSubscribed k a
k Root x k
r

subscribeAndReadNever :: EventM x (EventSubscription x, Maybe a)
subscribeAndReadNever :: EventM x (EventSubscription x, Maybe a)
subscribeAndReadNever = (EventSubscription x, Maybe a)
-> EventM x (EventSubscription x, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> EventSubscribed x -> EventSubscription x
forall k (x :: k).
IO () -> EventSubscribed x -> EventSubscription x
EventSubscription (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) EventSubscribed x
forall k (x :: k). EventSubscribed x
eventSubscribedNever, Maybe a
forall a. Maybe a
Nothing)

eventNever :: Event x a
eventNever :: Event x a
eventNever = (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
forall k (x :: k) a.
(Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
Event ((Subscriber x a -> EventM x (EventSubscription x, Maybe a))
 -> Event x a)
-> (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
forall a b. (a -> b) -> a -> b
$ EventM x (EventSubscription x, Maybe a)
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
forall a b. a -> b -> a
const EventM x (EventSubscription x, Maybe a)
forall k (x :: k) a. EventM x (EventSubscription x, Maybe a)
subscribeAndReadNever

eventFan :: (GCompare k, HasSpiderTimeline x) => k a -> Fan x k v -> Event x (v a)
eventFan :: k a -> Fan x k v -> Event x (v a)
eventFan !k a
k !Fan x k v
f = (Subscriber x (v a) -> EventM x (EventSubscription x, Maybe (v a)))
-> Event x (v a)
forall k (x :: k) a.
(Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
Event ((Subscriber x (v a)
  -> EventM x (EventSubscription x, Maybe (v a)))
 -> Event x (v a))
-> (Subscriber x (v a)
    -> EventM x (EventSubscription x, Maybe (v a)))
-> Event x (v a)
forall a b. (a -> b) -> a -> b
$ (FanSubscribed x k v -> EventSubscribed x)
-> (Subscriber x (v a)
    -> EventM x (WeakBagTicket, FanSubscribed x k v, Maybe (v a)))
-> Subscriber x (v a)
-> EventM x (EventSubscription x, Maybe (v a))
forall k (m :: * -> *) t (x :: k) a.
MonadIO m =>
(t -> EventSubscribed x)
-> (Subscriber x a -> m (WeakBagTicket, t, Maybe a))
-> Subscriber x a
-> m (EventSubscription x, Maybe a)
wrap FanSubscribed x k v -> EventSubscribed x
forall k k (x :: k) (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> EventSubscribed x
eventSubscribedFan ((Subscriber x (v a)
  -> EventM x (WeakBagTicket, FanSubscribed x k v, Maybe (v a)))
 -> Subscriber x (v a)
 -> EventM x (EventSubscription x, Maybe (v a)))
-> (Subscriber x (v a)
    -> EventM x (WeakBagTicket, FanSubscribed x k v, Maybe (v a)))
-> Subscriber x (v a)
-> EventM x (EventSubscription x, Maybe (v a))
forall a b. (a -> b) -> a -> b
$ k a
-> Fan x k v
-> Subscriber x (v a)
-> EventM x (WeakBagTicket, FanSubscribed x k v, Maybe (v a))
forall k x (k :: k -> *) (a :: k) (v :: k -> *).
(HasSpiderTimeline x, GCompare k) =>
k a
-> Fan x k v
-> Subscriber x (v a)
-> EventM x (WeakBagTicket, FanSubscribed x k v, Maybe (v a))
getFanSubscribed k a
k Fan x k v
f

eventSwitch :: HasSpiderTimeline x => Switch x a -> Event x a
eventSwitch :: Switch x a -> Event x a
eventSwitch !Switch x a
s = (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
forall k (x :: k) a.
(Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
Event ((Subscriber x a -> EventM x (EventSubscription x, Maybe a))
 -> Event x a)
-> (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
forall a b. (a -> b) -> a -> b
$ (SwitchSubscribed x a -> EventSubscribed x)
-> (Subscriber x a
    -> EventM x (WeakBagTicket, SwitchSubscribed x a, Maybe a))
-> Subscriber x a
-> EventM x (EventSubscription x, Maybe a)
forall k (m :: * -> *) t (x :: k) a.
MonadIO m =>
(t -> EventSubscribed x)
-> (Subscriber x a -> m (WeakBagTicket, t, Maybe a))
-> Subscriber x a
-> m (EventSubscription x, Maybe a)
wrap SwitchSubscribed x a -> EventSubscribed x
forall k (x :: k) a. SwitchSubscribed x a -> EventSubscribed x
eventSubscribedSwitch ((Subscriber x a
  -> EventM x (WeakBagTicket, SwitchSubscribed x a, Maybe a))
 -> Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> (Subscriber x a
    -> EventM x (WeakBagTicket, SwitchSubscribed x a, Maybe a))
-> Subscriber x a
-> EventM x (EventSubscription x, Maybe a)
forall a b. (a -> b) -> a -> b
$ Switch x a
-> Subscriber x a
-> EventM x (WeakBagTicket, SwitchSubscribed x a, Maybe a)
forall x a.
HasSpiderTimeline x =>
Switch x a
-> Subscriber x a
-> EventM x (WeakBagTicket, SwitchSubscribed x a, Maybe a)
getSwitchSubscribed Switch x a
s

eventCoincidence :: HasSpiderTimeline x => Coincidence x a -> Event x a
eventCoincidence :: Coincidence x a -> Event x a
eventCoincidence !Coincidence x a
c = (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
forall k (x :: k) a.
(Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
Event ((Subscriber x a -> EventM x (EventSubscription x, Maybe a))
 -> Event x a)
-> (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
forall a b. (a -> b) -> a -> b
$ (CoincidenceSubscribed x a -> EventSubscribed x)
-> (Subscriber x a
    -> EventM x (WeakBagTicket, CoincidenceSubscribed x a, Maybe a))
-> Subscriber x a
-> EventM x (EventSubscription x, Maybe a)
forall k (m :: * -> *) t (x :: k) a.
MonadIO m =>
(t -> EventSubscribed x)
-> (Subscriber x a -> m (WeakBagTicket, t, Maybe a))
-> Subscriber x a
-> m (EventSubscription x, Maybe a)
wrap CoincidenceSubscribed x a -> EventSubscribed x
forall k (x :: k) a. CoincidenceSubscribed x a -> EventSubscribed x
eventSubscribedCoincidence ((Subscriber x a
  -> EventM x (WeakBagTicket, CoincidenceSubscribed x a, Maybe a))
 -> Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> (Subscriber x a
    -> EventM x (WeakBagTicket, CoincidenceSubscribed x a, Maybe a))
-> Subscriber x a
-> EventM x (EventSubscription x, Maybe a)
forall a b. (a -> b) -> a -> b
$ Coincidence x a
-> Subscriber x a
-> EventM x (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)
forall x a.
HasSpiderTimeline x =>
Coincidence x a
-> Subscriber x a
-> EventM x (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)
getCoincidenceSubscribed Coincidence x a
c

eventHold :: Hold x p -> Event x p
eventHold :: Hold x p -> Event x p
eventHold !Hold x p
h = (Subscriber x p -> EventM x (EventSubscription x, Maybe p))
-> Event x p
forall k (x :: k) a.
(Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
Event ((Subscriber x p -> EventM x (EventSubscription x, Maybe p))
 -> Event x p)
-> (Subscriber x p -> EventM x (EventSubscription x, Maybe p))
-> Event x p
forall a b. (a -> b) -> a -> b
$ Hold x p
-> Subscriber x p -> EventM x (EventSubscription x, Maybe p)
forall k (x :: k) p.
Hold x p
-> Subscriber x p -> EventM x (EventSubscription x, Maybe p)
subscribeHoldEvent Hold x p
h

eventDyn :: (HasSpiderTimeline x, Patch p) => Dyn x p -> Event x p
eventDyn :: Dyn x p -> Event x p
eventDyn !Dyn x p
j = (Subscriber x p -> EventM x (EventSubscription x, Maybe p))
-> Event x p
forall k (x :: k) a.
(Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
Event ((Subscriber x p -> EventM x (EventSubscription x, Maybe p))
 -> Event x p)
-> (Subscriber x p -> EventM x (EventSubscription x, Maybe p))
-> Event x p
forall a b. (a -> b) -> a -> b
$ \sub :: Subscriber x p
sub -> Dyn x p -> EventM x (Hold x p)
forall x (m :: * -> *) p.
(Defer (SomeHoldInit x) m, Patch p) =>
Dyn x p -> m (Hold x p)
getDynHold Dyn x p
j EventM x (Hold x p)
-> (Hold x p -> EventM x (EventSubscription x, Maybe p))
-> EventM x (EventSubscription x, Maybe p)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \h :: Hold x p
h -> Hold x p
-> Subscriber x p -> EventM x (EventSubscription x, Maybe p)
forall k (x :: k) p.
Hold x p
-> Subscriber x p -> EventM x (EventSubscription x, Maybe p)
subscribeHoldEvent Hold x p
h Subscriber x p
sub

{-# INLINE subscribeCoincidenceInner #-}
subscribeCoincidenceInner :: HasSpiderTimeline x => Event x a -> Height -> CoincidenceSubscribed x a -> EventM x (Maybe a, Height, EventSubscribed x)
subscribeCoincidenceInner :: Event x a
-> Height
-> CoincidenceSubscribed x a
-> EventM x (Maybe a, Height, EventSubscribed x)
subscribeCoincidenceInner inner :: Event x a
inner outerHeight :: Height
outerHeight subscribedUnsafe :: CoincidenceSubscribed x a
subscribedUnsafe = do
  Subscriber x a
subInner <- IO (Subscriber x a) -> EventM x (Subscriber x a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Subscriber x a) -> EventM x (Subscriber x a))
-> IO (Subscriber x a) -> EventM x (Subscriber x a)
forall a b. (a -> b) -> a -> b
$ CoincidenceSubscribed x a -> IO (Subscriber x a)
forall x a.
HasSpiderTimeline x =>
CoincidenceSubscribed x a -> IO (Subscriber x a)
newSubscriberCoincidenceInner CoincidenceSubscribed x a
subscribedUnsafe
  (subscription :: EventSubscription x
subscription@(EventSubscription _ innerSubd :: EventSubscribed x
innerSubd), innerOcc :: Maybe a
innerOcc) <- Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
forall k (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead Event x a
inner Subscriber x a
subInner
  Height
innerHeight <- IO Height -> EventM x Height
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Height -> EventM x Height) -> IO Height -> EventM x Height
forall a b. (a -> b) -> a -> b
$ EventSubscribed x -> IO Height
forall k (x :: k). EventSubscribed x -> IO Height
getEventSubscribedHeight EventSubscribed x
innerSubd
  let height :: Height
height = Height -> Height -> Height
forall a. Ord a => a -> a -> a
max Height
innerHeight Height
outerHeight
  SomeResetCoincidence x -> EventM x ()
forall a (m :: * -> *). Defer a m => a -> m ()
defer (SomeResetCoincidence x -> EventM x ())
-> SomeResetCoincidence x -> EventM x ()
forall a b. (a -> b) -> a -> b
$ EventSubscription x
-> Maybe (CoincidenceSubscribed x a) -> SomeResetCoincidence x
forall k (x :: k) a.
EventSubscription x
-> Maybe (CoincidenceSubscribed x a) -> SomeResetCoincidence x
SomeResetCoincidence EventSubscription x
subscription (Maybe (CoincidenceSubscribed x a) -> SomeResetCoincidence x)
-> Maybe (CoincidenceSubscribed x a) -> SomeResetCoincidence x
forall a b. (a -> b) -> a -> b
$ if Height
height Height -> Height -> Bool
forall a. Ord a => a -> a -> Bool
> Height
outerHeight then CoincidenceSubscribed x a -> Maybe (CoincidenceSubscribed x a)
forall a. a -> Maybe a
Just CoincidenceSubscribed x a
subscribedUnsafe else Maybe (CoincidenceSubscribed x a)
forall a. Maybe a
Nothing
  (Maybe a, Height, EventSubscribed x)
-> EventM x (Maybe a, Height, EventSubscribed x)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
innerOcc, Height
height, EventSubscribed x
innerSubd)

--------------------------------------------------------------------------------
-- Subscriber
--------------------------------------------------------------------------------

data Subscriber x a = Subscriber
  { Subscriber x a -> a -> EventM x ()
subscriberPropagate :: !(a -> EventM x ())
  , Subscriber x a -> Height -> IO ()
subscriberInvalidateHeight :: !(Height -> IO ())
  , Subscriber x a -> Height -> IO ()
subscriberRecalculateHeight :: !(Height -> IO ())
  }

newSubscriberHold :: (HasSpiderTimeline x, Patch p) => Hold x p -> IO (Subscriber x p)
newSubscriberHold :: Hold x p -> IO (Subscriber x p)
newSubscriberHold h :: Hold x p
h = Subscriber x p -> IO (Subscriber x p)
forall (m :: * -> *) a. Monad m => a -> m a
return (Subscriber x p -> IO (Subscriber x p))
-> Subscriber x p -> IO (Subscriber x p)
forall a b. (a -> b) -> a -> b
$ $WSubscriber :: forall k (x :: k) a.
(a -> EventM x ())
-> (Height -> IO ()) -> (Height -> IO ()) -> Subscriber x a
Subscriber
  { subscriberPropagate :: p -> EventM x ()
subscriberPropagate = {-# SCC "traverseHold" #-} Hold x p -> p -> EventM x ()
forall x p.
(HasSpiderTimeline x, Patch p) =>
Hold x p -> p -> EventM x ()
propagateSubscriberHold Hold x p
h
  , subscriberInvalidateHeight :: Height -> IO ()
subscriberInvalidateHeight = \_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = \_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  }

newSubscriberFan :: forall x k v. (HasSpiderTimeline x, GCompare k) => FanSubscribed x k v -> IO (Subscriber x (DMap k v))
newSubscriberFan :: FanSubscribed x k v -> IO (Subscriber x (DMap k v))
newSubscriberFan subscribed :: FanSubscribed x k v
subscribed = String -> Subscriber x (DMap k v) -> IO (Subscriber x (DMap k v))
forall k (x :: k) a.
String -> Subscriber x a -> IO (Subscriber x a)
debugSubscriber ("SubscriberFan " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> FanSubscribed x k v -> String
forall a. a -> String
showNodeId FanSubscribed x k v
subscribed)  (Subscriber x (DMap k v) -> IO (Subscriber x (DMap k v)))
-> Subscriber x (DMap k v) -> IO (Subscriber x (DMap k v))
forall a b. (a -> b) -> a -> b
$ $WSubscriber :: forall k (x :: k) a.
(a -> EventM x ())
-> (Height -> IO ()) -> (Height -> IO ()) -> Subscriber x a
Subscriber
  { subscriberPropagate :: DMap k v -> EventM x ()
subscriberPropagate = \a :: DMap k v
a -> {-# SCC "traverseFan" #-} do
      DMap k (FanSubscribedChildren x k v)
subs <- IO (DMap k (FanSubscribedChildren x k v))
-> EventM x (DMap k (FanSubscribedChildren x k v))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DMap k (FanSubscribedChildren x k v))
 -> EventM x (DMap k (FanSubscribedChildren x k v)))
-> IO (DMap k (FanSubscribedChildren x k v))
-> EventM x (DMap k (FanSubscribedChildren x k v))
forall a b. (a -> b) -> a -> b
$ IORef (DMap k (FanSubscribedChildren x k v))
-> IO (DMap k (FanSubscribedChildren x k v))
forall a. IORef a -> IO a
readIORef (IORef (DMap k (FanSubscribedChildren x k v))
 -> IO (DMap k (FanSubscribedChildren x k v)))
-> IORef (DMap k (FanSubscribedChildren x k v))
-> IO (DMap k (FanSubscribedChildren x k v))
forall a b. (a -> b) -> a -> b
$ FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
fanSubscribedSubscribers FanSubscribed x k v
subscribed
      Proxy x -> String -> EventM x ()
forall x (m :: * -> *) (proxy :: * -> *).
CanTrace x m =>
proxy x -> String -> m ()
tracePropagate (Proxy x
forall k (t :: k). Proxy t
Proxy :: Proxy x) (String -> EventM x ()) -> String -> EventM x ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (DMap k (FanSubscribedChildren x k v) -> Int
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Int
DMap.size DMap k (FanSubscribedChildren x k v)
subs) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> " keys subscribed, " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (DMap k v -> Int
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Int
DMap.size DMap k v
a) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> " keys firing"
      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (DMap k v)) -> Maybe (DMap k v) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (FanSubscribed x k v -> IORef (Maybe (DMap k v))
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (Maybe (DMap k v))
fanSubscribedOccurrence FanSubscribed x k v
subscribed) (Maybe (DMap k v) -> IO ()) -> Maybe (DMap k v) -> IO ()
forall a b. (a -> b) -> a -> b
$ DMap k v -> Maybe (DMap k v)
forall a. a -> Maybe a
Just DMap k v
a
      IORef (Maybe (DMap k v)) -> EventM x ()
forall (m :: * -> *) a.
Defer (Some Clear) m =>
IORef (Maybe a) -> m ()
scheduleClear (IORef (Maybe (DMap k v)) -> EventM x ())
-> IORef (Maybe (DMap k v)) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ FanSubscribed x k v -> IORef (Maybe (DMap k v))
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (Maybe (DMap k v))
fanSubscribedOccurrence FanSubscribed x k v
subscribed
      let f :: p
-> Product f (FanSubscribedChildren x k f) a
-> EventM x (Constant () b)
f _ (Pair v :: f a
v subsubs :: FanSubscribedChildren x k f a
subsubs) = do
            f a -> WeakBag (Subscriber x (f a)) -> EventM x ()
forall x a.
HasSpiderTimeline x =>
a -> WeakBag (Subscriber x a) -> EventM x ()
propagate f a
v (WeakBag (Subscriber x (f a)) -> EventM x ())
-> WeakBag (Subscriber x (f a)) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ FanSubscribedChildren x k f a -> WeakBag (Subscriber x (f a))
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (a :: k).
FanSubscribedChildren x k v a -> WeakBag (Subscriber x (v a))
_fanSubscribedChildren_list FanSubscribedChildren x k f a
subsubs
            Constant () b -> EventM x (Constant () b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant () b -> EventM x (Constant () b))
-> Constant () b -> EventM x (Constant () b)
forall a b. (a -> b) -> a -> b
$ () -> Constant () b
forall k a (b :: k). a -> Constant a b
Constant ()
      DMap k (Constant ())
_ <- (forall (v :: k).
 k v
 -> Product v (FanSubscribedChildren x k v) v
 -> EventM x (Constant () v))
-> DMap k (Product v (FanSubscribedChildren x k v))
-> EventM x (DMap k (Constant ()))
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 (v :: k).
k v
-> Product v (FanSubscribedChildren x k v) v
-> EventM x (Constant () v)
forall k k x p (f :: k -> *) (k :: k -> *) (a :: k) (b :: k).
HasSpiderTimeline x =>
p
-> Product f (FanSubscribedChildren x k f) a
-> EventM x (Constant () b)
f (DMap k (Product v (FanSubscribedChildren x k v))
 -> EventM x (DMap k (Constant ())))
-> DMap k (Product v (FanSubscribedChildren x k v))
-> EventM x (DMap k (Constant ()))
forall a b. (a -> b) -> a -> b
$ (forall (v :: k).
 k v
 -> v v
 -> FanSubscribedChildren x k v v
 -> Product v (FanSubscribedChildren x k v) v)
-> DMap k v
-> DMap k (FanSubscribedChildren x k v)
-> DMap k (Product v (FanSubscribedChildren x k v))
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *)
       (h :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> g v -> h v)
-> DMap k2 f -> DMap k2 g -> DMap k2 h
DMap.intersectionWithKey (\_ -> v v
-> FanSubscribedChildren x k v v
-> Product v (FanSubscribedChildren x k v) v
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair) DMap k v
a DMap k (FanSubscribedChildren x k v)
subs --TODO: Would be nice to have DMap.traverse_
      () -> EventM x ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  , subscriberInvalidateHeight :: Height -> IO ()
subscriberInvalidateHeight = \old :: Height
old -> do
      DMap k (FanSubscribedChildren x k v)
subscribers <- IORef (DMap k (FanSubscribedChildren x k v))
-> IO (DMap k (FanSubscribedChildren x k v))
forall a. IORef a -> IO a
readIORef (IORef (DMap k (FanSubscribedChildren x k v))
 -> IO (DMap k (FanSubscribedChildren x k v)))
-> IORef (DMap k (FanSubscribedChildren x k v))
-> IO (DMap k (FanSubscribedChildren x k v))
forall a b. (a -> b) -> a -> b
$ FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
fanSubscribedSubscribers FanSubscribed x k v
subscribed
      [DSum k (FanSubscribedChildren x k v)]
-> (DSum k (FanSubscribedChildren x k v) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (DMap k (FanSubscribedChildren x k v)
-> [DSum k (FanSubscribedChildren x k v)]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toList DMap k (FanSubscribedChildren x k v)
subscribers) ((DSum k (FanSubscribedChildren x k v) -> IO ()) -> IO ())
-> (DSum k (FanSubscribedChildren x k v) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(_ :=> v :: FanSubscribedChildren x k v a
v) -> WeakBag (Subscriber x (v a))
-> (Subscriber x (v a) -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
WeakBag a -> (a -> m ()) -> m ()
WeakBag.traverse_ (FanSubscribedChildren x k v a -> WeakBag (Subscriber x (v a))
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (a :: k).
FanSubscribedChildren x k v a -> WeakBag (Subscriber x (v a))
_fanSubscribedChildren_list FanSubscribedChildren x k v a
v) ((Subscriber x (v a) -> IO ()) -> IO ())
-> (Subscriber x (v a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> Subscriber x (v a) -> IO ()
forall k (x :: k) a. Height -> Subscriber x a -> IO ()
invalidateSubscriberHeight Height
old
  , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = \new :: Height
new -> do
      DMap k (FanSubscribedChildren x k v)
subscribers <- IORef (DMap k (FanSubscribedChildren x k v))
-> IO (DMap k (FanSubscribedChildren x k v))
forall a. IORef a -> IO a
readIORef (IORef (DMap k (FanSubscribedChildren x k v))
 -> IO (DMap k (FanSubscribedChildren x k v)))
-> IORef (DMap k (FanSubscribedChildren x k v))
-> IO (DMap k (FanSubscribedChildren x k v))
forall a b. (a -> b) -> a -> b
$ FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
fanSubscribedSubscribers FanSubscribed x k v
subscribed
      [DSum k (FanSubscribedChildren x k v)]
-> (DSum k (FanSubscribedChildren x k v) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (DMap k (FanSubscribedChildren x k v)
-> [DSum k (FanSubscribedChildren x k v)]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toList DMap k (FanSubscribedChildren x k v)
subscribers) ((DSum k (FanSubscribedChildren x k v) -> IO ()) -> IO ())
-> (DSum k (FanSubscribedChildren x k v) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(_ :=> v :: FanSubscribedChildren x k v a
v) -> WeakBag (Subscriber x (v a))
-> (Subscriber x (v a) -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
WeakBag a -> (a -> m ()) -> m ()
WeakBag.traverse_ (FanSubscribedChildren x k v a -> WeakBag (Subscriber x (v a))
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (a :: k).
FanSubscribedChildren x k v a -> WeakBag (Subscriber x (v a))
_fanSubscribedChildren_list FanSubscribedChildren x k v a
v) ((Subscriber x (v a) -> IO ()) -> IO ())
-> (Subscriber x (v a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> Subscriber x (v a) -> IO ()
forall k (x :: k) a. Height -> Subscriber x a -> IO ()
recalculateSubscriberHeight Height
new
  }

newSubscriberSwitch :: forall x a. HasSpiderTimeline x => SwitchSubscribed x a -> IO (Subscriber x a)
newSubscriberSwitch :: SwitchSubscribed x a -> IO (Subscriber x a)
newSubscriberSwitch subscribed :: SwitchSubscribed x a
subscribed = String -> Subscriber x a -> IO (Subscriber x a)
forall k (x :: k) a.
String -> Subscriber x a -> IO (Subscriber x a)
debugSubscriber ("SubscriberCoincidenceOuter" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SwitchSubscribed x a -> String
forall a. a -> String
showNodeId SwitchSubscribed x a
subscribed) (Subscriber x a -> IO (Subscriber x a))
-> Subscriber x a -> IO (Subscriber x a)
forall a b. (a -> b) -> a -> b
$ $WSubscriber :: forall k (x :: k) a.
(a -> EventM x ())
-> (Height -> IO ()) -> (Height -> IO ()) -> Subscriber x a
Subscriber
  { subscriberPropagate :: a -> EventM x ()
subscriberPropagate = \a :: a
a -> {-# SCC "traverseSwitch" #-} do
      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe a) -> Maybe a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (SwitchSubscribed x a -> IORef (Maybe a)
forall k (x :: k) a. SwitchSubscribed x a -> IORef (Maybe a)
switchSubscribedOccurrence SwitchSubscribed x a
subscribed) (Maybe a -> IO ()) -> Maybe a -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
a
      IORef (Maybe a) -> EventM x ()
forall (m :: * -> *) a.
Defer (Some Clear) m =>
IORef (Maybe a) -> m ()
scheduleClear (IORef (Maybe a) -> EventM x ()) -> IORef (Maybe a) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ SwitchSubscribed x a -> IORef (Maybe a)
forall k (x :: k) a. SwitchSubscribed x a -> IORef (Maybe a)
switchSubscribedOccurrence SwitchSubscribed x a
subscribed
      a -> WeakBag (Subscriber x a) -> EventM x ()
forall x a.
HasSpiderTimeline x =>
a -> WeakBag (Subscriber x a) -> EventM x ()
propagate a
a (WeakBag (Subscriber x a) -> EventM x ())
-> WeakBag (Subscriber x a) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ SwitchSubscribed x a -> WeakBag (Subscriber x a)
forall k (x :: k) a.
SwitchSubscribed x a -> WeakBag (Subscriber x a)
switchSubscribedSubscribers SwitchSubscribed x a
subscribed
  , subscriberInvalidateHeight :: Height -> IO ()
subscriberInvalidateHeight = \_ -> do
      Height
oldHeight <- IORef Height -> IO Height
forall a. IORef a -> IO a
readIORef (IORef Height -> IO Height) -> IORef Height -> IO Height
forall a b. (a -> b) -> a -> b
$ SwitchSubscribed x a -> IORef Height
forall k (x :: k) a. SwitchSubscribed x a -> IORef Height
switchSubscribedHeight SwitchSubscribed x a
subscribed
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Height
oldHeight Height -> Height -> Bool
forall a. Eq a => a -> a -> Bool
/= Height
invalidHeight) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        IORef Height -> Height -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (SwitchSubscribed x a -> IORef Height
forall k (x :: k) a. SwitchSubscribed x a -> IORef Height
switchSubscribedHeight SwitchSubscribed x a
subscribed) (Height -> IO ()) -> Height -> IO ()
forall a b. (a -> b) -> a -> b
$! Height
invalidHeight
        WeakBag (Subscriber x a) -> (Subscriber x a -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
WeakBag a -> (a -> m ()) -> m ()
WeakBag.traverse_ (SwitchSubscribed x a -> WeakBag (Subscriber x a)
forall k (x :: k) a.
SwitchSubscribed x a -> WeakBag (Subscriber x a)
switchSubscribedSubscribers SwitchSubscribed x a
subscribed) ((Subscriber x a -> IO ()) -> IO ())
-> (Subscriber x a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> Subscriber x a -> IO ()
forall k (x :: k) a. Height -> Subscriber x a -> IO ()
invalidateSubscriberHeight Height
oldHeight
  , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = (Height -> SwitchSubscribed x a -> IO ()
forall k (x :: k) a. Height -> SwitchSubscribed x a -> IO ()
`updateSwitchHeight` SwitchSubscribed x a
subscribed)
    }

newSubscriberCoincidenceOuter :: forall x b. HasSpiderTimeline x => CoincidenceSubscribed x b -> IO (Subscriber x (Event x b))
newSubscriberCoincidenceOuter :: CoincidenceSubscribed x b -> IO (Subscriber x (Event x b))
newSubscriberCoincidenceOuter subscribed :: CoincidenceSubscribed x b
subscribed = String -> Subscriber x (Event x b) -> IO (Subscriber x (Event x b))
forall k (x :: k) a.
String -> Subscriber x a -> IO (Subscriber x a)
debugSubscriber ("SubscriberCoincidenceOuter" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> CoincidenceSubscribed x b -> String
forall a. a -> String
showNodeId CoincidenceSubscribed x b
subscribed) (Subscriber x (Event x b) -> IO (Subscriber x (Event x b)))
-> Subscriber x (Event x b) -> IO (Subscriber x (Event x b))
forall a b. (a -> b) -> a -> b
$ $WSubscriber :: forall k (x :: k) a.
(a -> EventM x ())
-> (Height -> IO ()) -> (Height -> IO ()) -> Subscriber x a
Subscriber
  { subscriberPropagate :: Event x b -> EventM x ()
subscriberPropagate = \a :: Event x b
a -> {-# SCC "traverseCoincidenceOuter" #-} do
      Height
outerHeight <- IO Height -> EventM x Height
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Height -> EventM x Height) -> IO Height -> EventM x Height
forall a b. (a -> b) -> a -> b
$ IORef Height -> IO Height
forall a. IORef a -> IO a
readIORef (IORef Height -> IO Height) -> IORef Height -> IO Height
forall a b. (a -> b) -> a -> b
$ CoincidenceSubscribed x b -> IORef Height
forall k (x :: k) a. CoincidenceSubscribed x a -> IORef Height
coincidenceSubscribedHeight CoincidenceSubscribed x b
subscribed
      Proxy x -> String -> EventM x ()
forall x (m :: * -> *) (proxy :: * -> *).
CanTrace x m =>
proxy x -> String -> m ()
tracePropagate (Proxy x
forall k (t :: k). Proxy t
Proxy :: Proxy x) (String -> EventM x ()) -> String -> EventM x ()
forall a b. (a -> b) -> a -> b
$ "  outerHeight = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Height -> String
forall a. Show a => a -> String
show Height
outerHeight
      (occ :: Maybe b
occ, innerHeight :: Height
innerHeight, innerSubd :: EventSubscribed x
innerSubd) <- Event x b
-> Height
-> CoincidenceSubscribed x b
-> EventM x (Maybe b, Height, EventSubscribed x)
forall x a.
HasSpiderTimeline x =>
Event x a
-> Height
-> CoincidenceSubscribed x a
-> EventM x (Maybe a, Height, EventSubscribed x)
subscribeCoincidenceInner Event x b
a Height
outerHeight CoincidenceSubscribed x b
subscribed
      Proxy x -> String -> EventM x ()
forall x (m :: * -> *) (proxy :: * -> *).
CanTrace x m =>
proxy x -> String -> m ()
tracePropagate (Proxy x
forall k (t :: k). Proxy t
Proxy :: Proxy x) (String -> EventM x ()) -> String -> EventM x ()
forall a b. (a -> b) -> a -> b
$ "  isJust occ = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Bool -> String
forall a. Show a => a -> String
show (Maybe b -> Bool
forall a. Maybe a -> Bool
isJust Maybe b
occ)
      Proxy x -> String -> EventM x ()
forall x (m :: * -> *) (proxy :: * -> *).
CanTrace x m =>
proxy x -> String -> m ()
tracePropagate (Proxy x
forall k (t :: k). Proxy t
Proxy :: Proxy x) (String -> EventM x ()) -> String -> EventM x ()
forall a b. (a -> b) -> a -> b
$ "  innerHeight = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Height -> String
forall a. Show a => a -> String
show Height
innerHeight

      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (EventSubscribed x))
-> Maybe (EventSubscribed x) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (CoincidenceSubscribed x b -> IORef (Maybe (EventSubscribed x))
forall k (x :: k) a.
CoincidenceSubscribed x a -> IORef (Maybe (EventSubscribed x))
coincidenceSubscribedInnerParent CoincidenceSubscribed x b
subscribed) (Maybe (EventSubscribed x) -> IO ())
-> Maybe (EventSubscribed x) -> IO ()
forall a b. (a -> b) -> a -> b
$ EventSubscribed x -> Maybe (EventSubscribed x)
forall a. a -> Maybe a
Just EventSubscribed x
innerSubd
      IORef (Maybe (EventSubscribed x)) -> EventM x ()
forall (m :: * -> *) a.
Defer (Some Clear) m =>
IORef (Maybe a) -> m ()
scheduleClear (IORef (Maybe (EventSubscribed x)) -> EventM x ())
-> IORef (Maybe (EventSubscribed x)) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ CoincidenceSubscribed x b -> IORef (Maybe (EventSubscribed x))
forall k (x :: k) a.
CoincidenceSubscribed x a -> IORef (Maybe (EventSubscribed x))
coincidenceSubscribedInnerParent CoincidenceSubscribed x b
subscribed
      case Maybe b
occ of
        Nothing ->
          Bool -> EventM x () -> EventM x ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Height
innerHeight Height -> Height -> Bool
forall a. Ord a => a -> a -> Bool
> Height
outerHeight) (EventM x () -> EventM x ()) -> EventM x () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ do -- If the event fires, it will fire at a later height
            IORef Height -> Height -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (CoincidenceSubscribed x b -> IORef Height
forall k (x :: k) a. CoincidenceSubscribed x a -> IORef Height
coincidenceSubscribedHeight CoincidenceSubscribed x b
subscribed) (Height -> IO ()) -> Height -> IO ()
forall a b. (a -> b) -> a -> b
$! Height
innerHeight
            WeakBag (Subscriber x b) -> (Subscriber x b -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
WeakBag a -> (a -> m ()) -> m ()
WeakBag.traverse_ (CoincidenceSubscribed x b -> WeakBag (Subscriber x b)
forall k (x :: k) a.
CoincidenceSubscribed x a -> WeakBag (Subscriber x a)
coincidenceSubscribedSubscribers CoincidenceSubscribed x b
subscribed) ((Subscriber x b -> IO ()) -> IO ())
-> (Subscriber x b -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> Subscriber x b -> IO ()
forall k (x :: k) a. Height -> Subscriber x a -> IO ()
invalidateSubscriberHeight Height
outerHeight
            WeakBag (Subscriber x b) -> (Subscriber x b -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
WeakBag a -> (a -> m ()) -> m ()
WeakBag.traverse_ (CoincidenceSubscribed x b -> WeakBag (Subscriber x b)
forall k (x :: k) a.
CoincidenceSubscribed x a -> WeakBag (Subscriber x a)
coincidenceSubscribedSubscribers CoincidenceSubscribed x b
subscribed) ((Subscriber x b -> IO ()) -> IO ())
-> (Subscriber x b -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> Subscriber x b -> IO ()
forall k (x :: k) a. Height -> Subscriber x a -> IO ()
recalculateSubscriberHeight Height
innerHeight
        Just o :: b
o -> do -- Since it's already firing, no need to adjust height
          IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe b) -> Maybe b -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (CoincidenceSubscribed x b -> IORef (Maybe b)
forall k (x :: k) a. CoincidenceSubscribed x a -> IORef (Maybe a)
coincidenceSubscribedOccurrence CoincidenceSubscribed x b
subscribed) Maybe b
occ
          IORef (Maybe b) -> EventM x ()
forall (m :: * -> *) a.
Defer (Some Clear) m =>
IORef (Maybe a) -> m ()
scheduleClear (IORef (Maybe b) -> EventM x ()) -> IORef (Maybe b) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ CoincidenceSubscribed x b -> IORef (Maybe b)
forall k (x :: k) a. CoincidenceSubscribed x a -> IORef (Maybe a)
coincidenceSubscribedOccurrence CoincidenceSubscribed x b
subscribed
          b -> WeakBag (Subscriber x b) -> EventM x ()
forall x a.
HasSpiderTimeline x =>
a -> WeakBag (Subscriber x a) -> EventM x ()
propagate b
o (WeakBag (Subscriber x b) -> EventM x ())
-> WeakBag (Subscriber x b) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ CoincidenceSubscribed x b -> WeakBag (Subscriber x b)
forall k (x :: k) a.
CoincidenceSubscribed x a -> WeakBag (Subscriber x a)
coincidenceSubscribedSubscribers CoincidenceSubscribed x b
subscribed
  , subscriberInvalidateHeight :: Height -> IO ()
subscriberInvalidateHeight  = \_ -> CoincidenceSubscribed x b -> IO ()
forall k (x :: k) a. CoincidenceSubscribed x a -> IO ()
invalidateCoincidenceHeight CoincidenceSubscribed x b
subscribed
  , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = \_ -> CoincidenceSubscribed x b -> IO ()
forall k (x :: k) a. CoincidenceSubscribed x a -> IO ()
recalculateCoincidenceHeight CoincidenceSubscribed x b
subscribed
  }

newSubscriberCoincidenceInner :: forall x a. HasSpiderTimeline x => CoincidenceSubscribed x a -> IO (Subscriber x a)
newSubscriberCoincidenceInner :: CoincidenceSubscribed x a -> IO (Subscriber x a)
newSubscriberCoincidenceInner subscribed :: CoincidenceSubscribed x a
subscribed = String -> Subscriber x a -> IO (Subscriber x a)
forall k (x :: k) a.
String -> Subscriber x a -> IO (Subscriber x a)
debugSubscriber ("SubscriberCoincidenceInner" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> CoincidenceSubscribed x a -> String
forall a. a -> String
showNodeId CoincidenceSubscribed x a
subscribed) (Subscriber x a -> IO (Subscriber x a))
-> Subscriber x a -> IO (Subscriber x a)
forall a b. (a -> b) -> a -> b
$ $WSubscriber :: forall k (x :: k) a.
(a -> EventM x ())
-> (Height -> IO ()) -> (Height -> IO ()) -> Subscriber x a
Subscriber
  { subscriberPropagate :: a -> EventM x ()
subscriberPropagate = \a :: a
a -> {-# SCC "traverseCoincidenceInner" #-} do
      Maybe a
occ <- IO (Maybe a) -> EventM x (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> EventM x (Maybe a))
-> IO (Maybe a) -> EventM x (Maybe a)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe a) -> IO (Maybe a)
forall a. IORef a -> IO a
readIORef (IORef (Maybe a) -> IO (Maybe a))
-> IORef (Maybe a) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ CoincidenceSubscribed x a -> IORef (Maybe a)
forall k (x :: k) a. CoincidenceSubscribed x a -> IORef (Maybe a)
coincidenceSubscribedOccurrence CoincidenceSubscribed x a
subscribed
      case Maybe a
occ of
        Just _ -> () -> EventM x ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- SubscriberCoincidenceOuter must have already propagated this event
        Nothing -> do
          IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe a) -> Maybe a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (CoincidenceSubscribed x a -> IORef (Maybe a)
forall k (x :: k) a. CoincidenceSubscribed x a -> IORef (Maybe a)
coincidenceSubscribedOccurrence CoincidenceSubscribed x a
subscribed) (Maybe a -> IO ()) -> Maybe a -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
a
          IORef (Maybe a) -> EventM x ()
forall (m :: * -> *) a.
Defer (Some Clear) m =>
IORef (Maybe a) -> m ()
scheduleClear (IORef (Maybe a) -> EventM x ()) -> IORef (Maybe a) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ CoincidenceSubscribed x a -> IORef (Maybe a)
forall k (x :: k) a. CoincidenceSubscribed x a -> IORef (Maybe a)
coincidenceSubscribedOccurrence CoincidenceSubscribed x a
subscribed
          a -> WeakBag (Subscriber x a) -> EventM x ()
forall x a.
HasSpiderTimeline x =>
a -> WeakBag (Subscriber x a) -> EventM x ()
propagate a
a (WeakBag (Subscriber x a) -> EventM x ())
-> WeakBag (Subscriber x a) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ CoincidenceSubscribed x a -> WeakBag (Subscriber x a)
forall k (x :: k) a.
CoincidenceSubscribed x a -> WeakBag (Subscriber x a)
coincidenceSubscribedSubscribers CoincidenceSubscribed x a
subscribed
  , subscriberInvalidateHeight :: Height -> IO ()
subscriberInvalidateHeight  = \_ -> CoincidenceSubscribed x a -> IO ()
forall k (x :: k) a. CoincidenceSubscribed x a -> IO ()
invalidateCoincidenceHeight CoincidenceSubscribed x a
subscribed
  , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = \_ -> CoincidenceSubscribed x a -> IO ()
forall k (x :: k) a. CoincidenceSubscribed x a -> IO ()
recalculateCoincidenceHeight CoincidenceSubscribed x a
subscribed
  }

invalidateSubscriberHeight :: Height -> Subscriber x a -> IO ()
invalidateSubscriberHeight :: Height -> Subscriber x a -> IO ()
invalidateSubscriberHeight = (Subscriber x a -> Height -> IO ())
-> Height -> Subscriber x a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Subscriber x a -> Height -> IO ()
forall k (x :: k) a. Subscriber x a -> Height -> IO ()
subscriberInvalidateHeight

recalculateSubscriberHeight :: Height -> Subscriber x a -> IO ()
recalculateSubscriberHeight :: Height -> Subscriber x a -> IO ()
recalculateSubscriberHeight = (Subscriber x a -> Height -> IO ())
-> Height -> Subscriber x a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Subscriber x a -> Height -> IO ()
forall k (x :: k) a. Subscriber x a -> Height -> IO ()
subscriberRecalculateHeight

-- | Propagate everything at the current height
propagate :: forall x a. HasSpiderTimeline x => a -> WeakBag (Subscriber x a) -> EventM x ()
propagate :: a -> WeakBag (Subscriber x a) -> EventM x ()
propagate a :: a
a subscribers :: WeakBag (Subscriber x a)
subscribers = Proxy x -> EventM x () -> EventM x ()
forall k k (proxy :: k -> *) (x :: k) (m :: k -> *) (a :: k).
proxy x -> m a -> m a
withIncreasedDepth (Proxy x
forall k (t :: k). Proxy t
Proxy::Proxy x) (EventM x () -> EventM x ()) -> EventM x () -> EventM x ()
forall a b. (a -> b) -> a -> b
$
  -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them
  --TODO: Should we check if nodes already have their values before propagating?  Maybe we're re-doing work
  WeakBag (Subscriber x a)
-> (Subscriber x a -> EventM x ()) -> EventM x ()
forall (m :: * -> *) a.
MonadIO m =>
WeakBag a -> (a -> m ()) -> m ()
WeakBag.traverse_ WeakBag (Subscriber x a)
subscribers ((Subscriber x a -> EventM x ()) -> EventM x ())
-> (Subscriber x a -> EventM x ()) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ \s :: Subscriber x a
s -> Subscriber x a -> a -> EventM x ()
forall k (x :: k) a. Subscriber x a -> a -> EventM x ()
subscriberPropagate Subscriber x a
s a
a

-- | Propagate everything at the current height
propagateFast :: forall x a. HasSpiderTimeline x => a -> FastWeakBag (Subscriber x a) -> EventM x ()
propagateFast :: a -> FastWeakBag (Subscriber x a) -> EventM x ()
propagateFast a :: a
a subscribers :: FastWeakBag (Subscriber x a)
subscribers = Proxy x -> EventM x () -> EventM x ()
forall k k (proxy :: k -> *) (x :: k) (m :: k -> *) (a :: k).
proxy x -> m a -> m a
withIncreasedDepth (Proxy x
forall k (t :: k). Proxy t
Proxy::Proxy x) (EventM x () -> EventM x ()) -> EventM x () -> EventM x ()
forall a b. (a -> b) -> a -> b
$
  -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them
  --TODO: Should we check if nodes already have their values before propagating?  Maybe we're re-doing work
  FastWeakBag (Subscriber x a)
-> (Subscriber x a -> EventM x ()) -> EventM x ()
forall a (m :: * -> *).
MonadIO m =>
FastWeakBag a -> (a -> m ()) -> m ()
FastWeakBag.traverse_ FastWeakBag (Subscriber x a)
subscribers ((Subscriber x a -> EventM x ()) -> EventM x ())
-> (Subscriber x a -> EventM x ()) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ \s :: Subscriber x a
s -> Subscriber x a -> a -> EventM x ()
forall k (x :: k) a. Subscriber x a -> a -> EventM x ()
subscriberPropagate Subscriber x a
s a
a

--------------------------------------------------------------------------------
-- EventSubscribed
--------------------------------------------------------------------------------

toAny :: a -> Any
toAny :: a -> Any
toAny = a -> Any
forall a b. a -> b
unsafeCoerce

-- Why do we use Any here, instead of just giving eventSubscribedRetained an
-- existential type? Sadly, GHC does not currently know how to unbox types
-- with existentially quantified fields. So instead we just coerce values
-- to type Any on the way in. Since we never coerce them back, this is
-- perfectly safe.
data EventSubscribed x = EventSubscribed
  { EventSubscribed x -> IORef Height
eventSubscribedHeightRef :: {-# UNPACK #-} !(IORef Height)
  , EventSubscribed x -> Any
eventSubscribedRetained :: {-# NOUNPACK #-} !Any
#ifdef DEBUG_CYCLES
  , eventSubscribedGetParents :: !(IO [EventSubscribed x]) -- For debugging loops
  , eventSubscribedHasOwnHeightRef :: !Bool
  , eventSubscribedWhoCreated :: !(IO [String])
#endif
  }

eventSubscribedRoot :: RootSubscribed x a -> EventSubscribed x
eventSubscribedRoot :: RootSubscribed x a -> EventSubscribed x
eventSubscribedRoot !RootSubscribed x a
r = $WEventSubscribed :: forall k (x :: k). IORef Height -> Any -> EventSubscribed x
EventSubscribed
  { eventSubscribedHeightRef :: IORef Height
eventSubscribedHeightRef = IORef Height
zeroRef
  , eventSubscribedRetained :: Any
eventSubscribedRetained = RootSubscribed x a -> Any
forall a. a -> Any
toAny RootSubscribed x a
r
#ifdef DEBUG_CYCLES
  , eventSubscribedGetParents = return []
  , eventSubscribedHasOwnHeightRef = False
  , eventSubscribedWhoCreated = return ["root"]
#endif
  }

eventSubscribedNever :: EventSubscribed x
eventSubscribedNever :: EventSubscribed x
eventSubscribedNever = $WEventSubscribed :: forall k (x :: k). IORef Height -> Any -> EventSubscribed x
EventSubscribed
  { eventSubscribedHeightRef :: IORef Height
eventSubscribedHeightRef = IORef Height
zeroRef
  , eventSubscribedRetained :: Any
eventSubscribedRetained = () -> Any
forall a. a -> Any
toAny ()
#ifdef DEBUG_CYCLES
  , eventSubscribedGetParents = return []
  , eventSubscribedHasOwnHeightRef = False
  , eventSubscribedWhoCreated = return ["never"]
#endif
  }

eventSubscribedFan :: FanSubscribed x k v -> EventSubscribed x
eventSubscribedFan :: FanSubscribed x k v -> EventSubscribed x
eventSubscribedFan !FanSubscribed x k v
subscribed = $WEventSubscribed :: forall k (x :: k). IORef Height -> Any -> EventSubscribed x
EventSubscribed
  { eventSubscribedHeightRef :: IORef Height
eventSubscribedHeightRef = EventSubscribed x -> IORef Height
forall k (x :: k). EventSubscribed x -> IORef Height
eventSubscribedHeightRef (EventSubscribed x -> IORef Height)
-> EventSubscribed x -> IORef Height
forall a b. (a -> b) -> a -> b
$ EventSubscription x -> EventSubscribed x
forall k (x :: k). EventSubscription x -> EventSubscribed x
_eventSubscription_subscribed (EventSubscription x -> EventSubscribed x)
-> EventSubscription x -> EventSubscribed x
forall a b. (a -> b) -> a -> b
$ FanSubscribed x k v -> EventSubscription x
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> EventSubscription x
fanSubscribedParent FanSubscribed x k v
subscribed
  , eventSubscribedRetained :: Any
eventSubscribedRetained = FanSubscribed x k v -> Any
forall a. a -> Any
toAny FanSubscribed x k v
subscribed
#ifdef DEBUG_CYCLES
  , eventSubscribedGetParents = return [_eventSubscription_subscribed $ fanSubscribedParent subscribed]
  , eventSubscribedHasOwnHeightRef = False
  , eventSubscribedWhoCreated = whoCreatedIORef $ fanSubscribedCachedSubscribed subscribed
#endif
  }

eventSubscribedSwitch :: SwitchSubscribed x a -> EventSubscribed x
eventSubscribedSwitch :: SwitchSubscribed x a -> EventSubscribed x
eventSubscribedSwitch !SwitchSubscribed x a
subscribed = $WEventSubscribed :: forall k (x :: k). IORef Height -> Any -> EventSubscribed x
EventSubscribed
  { eventSubscribedHeightRef :: IORef Height
eventSubscribedHeightRef = SwitchSubscribed x a -> IORef Height
forall k (x :: k) a. SwitchSubscribed x a -> IORef Height
switchSubscribedHeight SwitchSubscribed x a
subscribed
  , eventSubscribedRetained :: Any
eventSubscribedRetained = SwitchSubscribed x a -> Any
forall a. a -> Any
toAny SwitchSubscribed x a
subscribed
#ifdef DEBUG_CYCLES
  , eventSubscribedGetParents = do
      s <- readIORef $ switchSubscribedCurrentParent subscribed
      return [_eventSubscription_subscribed s]
  , eventSubscribedHasOwnHeightRef = True
  , eventSubscribedWhoCreated = whoCreatedIORef $ switchSubscribedCachedSubscribed subscribed
#endif
  }

eventSubscribedCoincidence :: CoincidenceSubscribed x a -> EventSubscribed x
eventSubscribedCoincidence :: CoincidenceSubscribed x a -> EventSubscribed x
eventSubscribedCoincidence !CoincidenceSubscribed x a
subscribed = $WEventSubscribed :: forall k (x :: k). IORef Height -> Any -> EventSubscribed x
EventSubscribed
  { eventSubscribedHeightRef :: IORef Height
eventSubscribedHeightRef = CoincidenceSubscribed x a -> IORef Height
forall k (x :: k) a. CoincidenceSubscribed x a -> IORef Height
coincidenceSubscribedHeight CoincidenceSubscribed x a
subscribed
  , eventSubscribedRetained :: Any
eventSubscribedRetained = CoincidenceSubscribed x a -> Any
forall a. a -> Any
toAny CoincidenceSubscribed x a
subscribed
#ifdef DEBUG_CYCLES
  , eventSubscribedGetParents = do
      innerSubscription <- readIORef $ coincidenceSubscribedInnerParent subscribed
      let outerParent = _eventSubscription_subscribed $ coincidenceSubscribedOuterParent subscribed
          innerParents = maybeToList $ innerSubscription
      return $ outerParent : innerParents
  , eventSubscribedHasOwnHeightRef = True
  , eventSubscribedWhoCreated = whoCreatedIORef $ coincidenceSubscribedCachedSubscribed subscribed
#endif
  }

getEventSubscribedHeight :: EventSubscribed x -> IO Height
getEventSubscribedHeight :: EventSubscribed x -> IO Height
getEventSubscribedHeight es :: EventSubscribed x
es = IORef Height -> IO Height
forall a. IORef a -> IO a
readIORef (IORef Height -> IO Height) -> IORef Height -> IO Height
forall a b. (a -> b) -> a -> b
$ EventSubscribed x -> IORef Height
forall k (x :: k). EventSubscribed x -> IORef Height
eventSubscribedHeightRef EventSubscribed x
es

#ifdef DEBUG_CYCLES
whoCreatedEventSubscribed :: EventSubscribed x -> IO [String]
whoCreatedEventSubscribed = eventSubscribedWhoCreated

walkInvalidHeightParents :: EventSubscribed x -> IO [EventSubscribed x]
walkInvalidHeightParents s0 = do
  subscribers <- flip execStateT mempty $ ($ s0) $ fix $ \loop s -> do
    h <- liftIO $ readIORef $ eventSubscribedHeightRef s
    when (h == invalidHeight) $ do
      when (eventSubscribedHasOwnHeightRef s) $ liftIO $ writeIORef (eventSubscribedHeightRef s) $! invalidHeightBeingTraversed
      modify (s :)
      mapM_ loop =<< liftIO (eventSubscribedGetParents s)
  forM_ subscribers $ \s -> writeIORef (eventSubscribedHeightRef s) $! invalidHeight
  return subscribers
#endif

{-# INLINE subscribeHoldEvent #-}
subscribeHoldEvent :: Hold x p -> Subscriber x p -> EventM x (EventSubscription x, Maybe p)
subscribeHoldEvent :: Hold x p
-> Subscriber x p -> EventM x (EventSubscription x, Maybe p)
subscribeHoldEvent = Event x p
-> Subscriber x p -> EventM x (EventSubscription x, Maybe p)
forall k (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead (Event x p
 -> Subscriber x p -> EventM x (EventSubscription x, Maybe p))
-> (Hold x p -> Event x p)
-> Hold x p
-> Subscriber x p
-> EventM x (EventSubscription x, Maybe p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hold x p -> Event x p
forall k (x :: k) p. Hold x p -> Event x p
holdEvent

--------------------------------------------------------------------------------
-- Behavior
--------------------------------------------------------------------------------

newtype Behavior x a = Behavior { Behavior x a -> BehaviorM x a
readBehaviorTracked :: BehaviorM x a }

behaviorHold :: Hold x p -> Behavior x (PatchTarget p)
behaviorHold :: Hold x p -> Behavior x (PatchTarget p)
behaviorHold !Hold x p
h = BehaviorM x (PatchTarget p) -> Behavior x (PatchTarget p)
forall k (x :: k) a. BehaviorM x a -> Behavior x a
Behavior (BehaviorM x (PatchTarget p) -> Behavior x (PatchTarget p))
-> BehaviorM x (PatchTarget p) -> Behavior x (PatchTarget p)
forall a b. (a -> b) -> a -> b
$ Hold x p -> BehaviorM x (PatchTarget p)
forall k (x :: k) p. Hold x p -> BehaviorM x (PatchTarget p)
readHoldTracked Hold x p
h

behaviorHoldIdentity :: Hold x (Identity a) -> Behavior x a
behaviorHoldIdentity :: Hold x (Identity a) -> Behavior x a
behaviorHoldIdentity = Hold x (Identity a) -> Behavior x a
forall k (x :: k) p. Hold x p -> Behavior x (PatchTarget p)
behaviorHold

behaviorConst :: a -> Behavior x a
behaviorConst :: a -> Behavior x a
behaviorConst !a
a = BehaviorM x a -> Behavior x a
forall k (x :: k) a. BehaviorM x a -> Behavior x a
Behavior (BehaviorM x a -> Behavior x a) -> BehaviorM x a -> Behavior x a
forall a b. (a -> b) -> a -> b
$ a -> BehaviorM x a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

behaviorPull :: Pull x a -> Behavior x a
behaviorPull :: Pull x a -> Behavior x a
behaviorPull !Pull x a
p = BehaviorM x a -> Behavior x a
forall k (x :: k) a. BehaviorM x a -> Behavior x a
Behavior (BehaviorM x a -> Behavior x a) -> BehaviorM x a -> Behavior x a
forall a b. (a -> b) -> a -> b
$ do
    Maybe (PullSubscribed x a)
val <- IO (Maybe (PullSubscribed x a))
-> BehaviorM x (Maybe (PullSubscribed x a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (PullSubscribed x a))
 -> BehaviorM x (Maybe (PullSubscribed x a)))
-> IO (Maybe (PullSubscribed x a))
-> BehaviorM x (Maybe (PullSubscribed x a))
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (PullSubscribed x a))
-> IO (Maybe (PullSubscribed x a))
forall a. IORef a -> IO a
readIORef (IORef (Maybe (PullSubscribed x a))
 -> IO (Maybe (PullSubscribed x a)))
-> IORef (Maybe (PullSubscribed x a))
-> IO (Maybe (PullSubscribed x a))
forall a b. (a -> b) -> a -> b
$ Pull x a -> IORef (Maybe (PullSubscribed x a))
forall k (x :: k) a. Pull x a -> IORef (Maybe (PullSubscribed x a))
pullValue Pull x a
p
    case Maybe (PullSubscribed x a)
val of
      Just subscribed :: PullSubscribed x a
subscribed -> do
        BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
forall k (x :: k).
BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
askParentsRef BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
-> (Maybe (IORef [SomeBehaviorSubscribed x]) -> BehaviorM x ())
-> BehaviorM x ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IORef [SomeBehaviorSubscribed x] -> BehaviorM x ())
-> Maybe (IORef [SomeBehaviorSubscribed x]) -> BehaviorM x ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\r :: IORef [SomeBehaviorSubscribed x]
r -> IO () -> BehaviorM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BehaviorM x ()) -> IO () -> BehaviorM x ()
forall a b. (a -> b) -> a -> b
$ IORef [SomeBehaviorSubscribed x]
-> ([SomeBehaviorSubscribed x] -> [SomeBehaviorSubscribed x])
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [SomeBehaviorSubscribed x]
r (Some (BehaviorSubscribed x) -> SomeBehaviorSubscribed x
forall k (x :: k).
Some (BehaviorSubscribed x) -> SomeBehaviorSubscribed x
SomeBehaviorSubscribed (BehaviorSubscribed x a -> Some (BehaviorSubscribed x)
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some (PullSubscribed x a -> BehaviorSubscribed x a
forall k (x :: k) a. PullSubscribed x a -> BehaviorSubscribed x a
BehaviorSubscribedPull PullSubscribed x a
subscribed)) SomeBehaviorSubscribed x
-> [SomeBehaviorSubscribed x] -> [SomeBehaviorSubscribed x]
forall a. a -> [a] -> [a]
:))
        BehaviorM x (Maybe (Weak (Invalidator x)))
forall k (x :: k). BehaviorM x (Maybe (Weak (Invalidator x)))
askInvalidator BehaviorM x (Maybe (Weak (Invalidator x)))
-> (Maybe (Weak (Invalidator x)) -> BehaviorM x ())
-> BehaviorM x ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Weak (Invalidator x) -> BehaviorM x ())
-> Maybe (Weak (Invalidator x)) -> BehaviorM x ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\wi :: Weak (Invalidator x)
wi -> IO () -> BehaviorM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BehaviorM x ()) -> IO () -> BehaviorM x ()
forall a b. (a -> b) -> a -> b
$ IORef [Weak (Invalidator x)]
-> ([Weak (Invalidator x)] -> [Weak (Invalidator x)]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (PullSubscribed x a -> IORef [Weak (Invalidator x)]
forall k (x :: k) a.
PullSubscribed x a -> IORef [Weak (Invalidator x)]
pullSubscribedInvalidators PullSubscribed x a
subscribed) (Weak (Invalidator x)
wiWeak (Invalidator x)
-> [Weak (Invalidator x)] -> [Weak (Invalidator x)]
forall a. a -> [a] -> [a]
:))
        IO () -> BehaviorM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BehaviorM x ()) -> IO () -> BehaviorM x ()
forall a b. (a -> b) -> a -> b
$ Invalidator x -> IO ()
forall (m :: * -> *) a. PrimMonad m => a -> m ()
touch (Invalidator x -> IO ()) -> Invalidator x -> IO ()
forall a b. (a -> b) -> a -> b
$ PullSubscribed x a -> Invalidator x
forall k (x :: k) a. PullSubscribed x a -> Invalidator x
pullSubscribedOwnInvalidator PullSubscribed x a
subscribed
        a -> BehaviorM x a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> BehaviorM x a) -> a -> BehaviorM x a
forall a b. (a -> b) -> a -> b
$ PullSubscribed x a -> a
forall k (x :: k) a. PullSubscribed x a -> a
pullSubscribedValue PullSubscribed x a
subscribed
      Nothing -> do
        Invalidator x
i <- IO (Invalidator x) -> BehaviorM x (Invalidator x)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Invalidator x) -> BehaviorM x (Invalidator x))
-> IO (Invalidator x) -> BehaviorM x (Invalidator x)
forall a b. (a -> b) -> a -> b
$ Pull x a -> IO (Invalidator x)
forall k (x :: k) a. Pull x a -> IO (Invalidator x)
newInvalidatorPull Pull x a
p
        Weak (Invalidator x)
wi <- IO (Weak (Invalidator x)) -> BehaviorM x (Weak (Invalidator x))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Weak (Invalidator x)) -> BehaviorM x (Weak (Invalidator x)))
-> IO (Weak (Invalidator x)) -> BehaviorM x (Weak (Invalidator x))
forall a b. (a -> b) -> a -> b
$ Invalidator x -> String -> IO (Weak (Invalidator x))
forall a. a -> String -> IO (Weak a)
mkWeakPtrWithDebug Invalidator x
i "InvalidatorPull"
        IORef [SomeBehaviorSubscribed x]
parentsRef <- IO (IORef [SomeBehaviorSubscribed x])
-> BehaviorM x (IORef [SomeBehaviorSubscribed x])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [SomeBehaviorSubscribed x])
 -> BehaviorM x (IORef [SomeBehaviorSubscribed x]))
-> IO (IORef [SomeBehaviorSubscribed x])
-> BehaviorM x (IORef [SomeBehaviorSubscribed x])
forall a b. (a -> b) -> a -> b
$ [SomeBehaviorSubscribed x] -> IO (IORef [SomeBehaviorSubscribed x])
forall a. a -> IO (IORef a)
newIORef []
        IORef [SomeHoldInit x]
holdInits <- BehaviorM x (IORef [SomeHoldInit x])
forall k (x :: k). BehaviorM x (IORef [SomeHoldInit x])
askBehaviorHoldInits
        a
a <- IO a -> BehaviorM x a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> BehaviorM x a) -> IO a -> BehaviorM x a
forall a b. (a -> b) -> a -> b
$ ReaderIO (BehaviorEnv x) a -> BehaviorEnv x -> IO a
forall e a. ReaderIO e a -> e -> IO a
runReaderIO (BehaviorM x a -> ReaderIO (BehaviorEnv x) a
forall k (x :: k) a. BehaviorM x a -> ReaderIO (BehaviorEnv x) a
unBehaviorM (BehaviorM x a -> ReaderIO (BehaviorEnv x) a)
-> BehaviorM x a -> ReaderIO (BehaviorEnv x) a
forall a b. (a -> b) -> a -> b
$ Pull x a -> BehaviorM x a
forall k (x :: k) a. Pull x a -> BehaviorM x a
pullCompute Pull x a
p) ((Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
-> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
forall a. a -> Maybe a
Just (Weak (Invalidator x)
wi, IORef [SomeBehaviorSubscribed x]
parentsRef), IORef [SomeHoldInit x]
holdInits)
        IORef [Weak (Invalidator x)]
invsRef <- IO (IORef [Weak (Invalidator x)])
-> BehaviorM x (IORef [Weak (Invalidator x)])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [Weak (Invalidator x)])
 -> BehaviorM x (IORef [Weak (Invalidator x)]))
-> (Maybe (Weak (Invalidator x))
    -> IO (IORef [Weak (Invalidator x)]))
-> Maybe (Weak (Invalidator x))
-> BehaviorM x (IORef [Weak (Invalidator x)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Weak (Invalidator x)] -> IO (IORef [Weak (Invalidator x)])
forall a. a -> IO (IORef a)
newIORef ([Weak (Invalidator x)] -> IO (IORef [Weak (Invalidator x)]))
-> (Maybe (Weak (Invalidator x)) -> [Weak (Invalidator x)])
-> Maybe (Weak (Invalidator x))
-> IO (IORef [Weak (Invalidator x)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Weak (Invalidator x)) -> [Weak (Invalidator x)]
forall a. Maybe a -> [a]
maybeToList (Maybe (Weak (Invalidator x))
 -> BehaviorM x (IORef [Weak (Invalidator x)]))
-> BehaviorM x (Maybe (Weak (Invalidator x)))
-> BehaviorM x (IORef [Weak (Invalidator x)])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BehaviorM x (Maybe (Weak (Invalidator x)))
forall k (x :: k). BehaviorM x (Maybe (Weak (Invalidator x)))
askInvalidator
        [SomeBehaviorSubscribed x]
parents <- IO [SomeBehaviorSubscribed x]
-> BehaviorM x [SomeBehaviorSubscribed x]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SomeBehaviorSubscribed x]
 -> BehaviorM x [SomeBehaviorSubscribed x])
-> IO [SomeBehaviorSubscribed x]
-> BehaviorM x [SomeBehaviorSubscribed x]
forall a b. (a -> b) -> a -> b
$ IORef [SomeBehaviorSubscribed x] -> IO [SomeBehaviorSubscribed x]
forall a. IORef a -> IO a
readIORef IORef [SomeBehaviorSubscribed x]
parentsRef
        let subscribed :: PullSubscribed x a
subscribed = $WPullSubscribed :: forall k (x :: k) a.
a
-> IORef [Weak (Invalidator x)]
-> Invalidator x
-> [SomeBehaviorSubscribed x]
-> PullSubscribed x a
PullSubscribed
              { pullSubscribedValue :: a
pullSubscribedValue = a
a
              , pullSubscribedInvalidators :: IORef [Weak (Invalidator x)]
pullSubscribedInvalidators = IORef [Weak (Invalidator x)]
invsRef
              , pullSubscribedOwnInvalidator :: Invalidator x
pullSubscribedOwnInvalidator = Invalidator x
i
              , pullSubscribedParents :: [SomeBehaviorSubscribed x]
pullSubscribedParents = [SomeBehaviorSubscribed x]
parents
              }
        IO () -> BehaviorM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BehaviorM x ()) -> IO () -> BehaviorM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (PullSubscribed x a))
-> Maybe (PullSubscribed x a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Pull x a -> IORef (Maybe (PullSubscribed x a))
forall k (x :: k) a. Pull x a -> IORef (Maybe (PullSubscribed x a))
pullValue Pull x a
p) (Maybe (PullSubscribed x a) -> IO ())
-> Maybe (PullSubscribed x a) -> IO ()
forall a b. (a -> b) -> a -> b
$ PullSubscribed x a -> Maybe (PullSubscribed x a)
forall a. a -> Maybe a
Just PullSubscribed x a
subscribed
        BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
forall k (x :: k).
BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
askParentsRef BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
-> (Maybe (IORef [SomeBehaviorSubscribed x]) -> BehaviorM x ())
-> BehaviorM x ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IORef [SomeBehaviorSubscribed x] -> BehaviorM x ())
-> Maybe (IORef [SomeBehaviorSubscribed x]) -> BehaviorM x ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\r :: IORef [SomeBehaviorSubscribed x]
r -> IO () -> BehaviorM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BehaviorM x ()) -> IO () -> BehaviorM x ()
forall a b. (a -> b) -> a -> b
$ IORef [SomeBehaviorSubscribed x]
-> ([SomeBehaviorSubscribed x] -> [SomeBehaviorSubscribed x])
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [SomeBehaviorSubscribed x]
r (Some (BehaviorSubscribed x) -> SomeBehaviorSubscribed x
forall k (x :: k).
Some (BehaviorSubscribed x) -> SomeBehaviorSubscribed x
SomeBehaviorSubscribed (BehaviorSubscribed x a -> Some (BehaviorSubscribed x)
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some (PullSubscribed x a -> BehaviorSubscribed x a
forall k (x :: k) a. PullSubscribed x a -> BehaviorSubscribed x a
BehaviorSubscribedPull PullSubscribed x a
subscribed)) SomeBehaviorSubscribed x
-> [SomeBehaviorSubscribed x] -> [SomeBehaviorSubscribed x]
forall a. a -> [a] -> [a]
:))
        a -> BehaviorM x a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

behaviorDyn :: Patch p => Dyn x p -> Behavior x (PatchTarget p)
behaviorDyn :: Dyn x p -> Behavior x (PatchTarget p)
behaviorDyn !Dyn x p
d = BehaviorM x (PatchTarget p) -> Behavior x (PatchTarget p)
forall k (x :: k) a. BehaviorM x a -> Behavior x a
Behavior (BehaviorM x (PatchTarget p) -> Behavior x (PatchTarget p))
-> BehaviorM x (PatchTarget p) -> Behavior x (PatchTarget p)
forall a b. (a -> b) -> a -> b
$ Hold x p -> BehaviorM x (PatchTarget p)
forall k (x :: k) p. Hold x p -> BehaviorM x (PatchTarget p)
readHoldTracked (Hold x p -> BehaviorM x (PatchTarget p))
-> BehaviorM x (Hold x p) -> BehaviorM x (PatchTarget p)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Dyn x p -> BehaviorM x (Hold x p)
forall x (m :: * -> *) p.
(Defer (SomeHoldInit x) m, Patch p) =>
Dyn x p -> m (Hold x p)
getDynHold Dyn x p
d

{-# INLINE readHoldTracked #-}
readHoldTracked :: Hold x p -> BehaviorM x (PatchTarget p)
readHoldTracked :: Hold x p -> BehaviorM x (PatchTarget p)
readHoldTracked h :: Hold x p
h = do
  PatchTarget p
result <- IO (PatchTarget p) -> BehaviorM x (PatchTarget p)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PatchTarget p) -> BehaviorM x (PatchTarget p))
-> IO (PatchTarget p) -> BehaviorM x (PatchTarget p)
forall a b. (a -> b) -> a -> b
$ IORef (PatchTarget p) -> IO (PatchTarget p)
forall a. IORef a -> IO a
readIORef (IORef (PatchTarget p) -> IO (PatchTarget p))
-> IORef (PatchTarget p) -> IO (PatchTarget p)
forall a b. (a -> b) -> a -> b
$ Hold x p -> IORef (PatchTarget p)
forall k (x :: k) p. Hold x p -> IORef (PatchTarget p)
holdValue Hold x p
h
  BehaviorM x (Maybe (Weak (Invalidator x)))
forall k (x :: k). BehaviorM x (Maybe (Weak (Invalidator x)))
askInvalidator BehaviorM x (Maybe (Weak (Invalidator x)))
-> (Maybe (Weak (Invalidator x)) -> BehaviorM x ())
-> BehaviorM x ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Weak (Invalidator x) -> BehaviorM x ())
-> Maybe (Weak (Invalidator x)) -> BehaviorM x ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\wi :: Weak (Invalidator x)
wi -> IO () -> BehaviorM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BehaviorM x ()) -> IO () -> BehaviorM x ()
forall a b. (a -> b) -> a -> b
$ IORef [Weak (Invalidator x)]
-> ([Weak (Invalidator x)] -> [Weak (Invalidator x)]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Hold x p -> IORef [Weak (Invalidator x)]
forall k (x :: k) p. Hold x p -> IORef [Weak (Invalidator x)]
holdInvalidators Hold x p
h) (Weak (Invalidator x)
wiWeak (Invalidator x)
-> [Weak (Invalidator x)] -> [Weak (Invalidator x)]
forall a. a -> [a] -> [a]
:))
  BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
forall k (x :: k).
BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
askParentsRef BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
-> (Maybe (IORef [SomeBehaviorSubscribed x]) -> BehaviorM x ())
-> BehaviorM x ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IORef [SomeBehaviorSubscribed x] -> BehaviorM x ())
-> Maybe (IORef [SomeBehaviorSubscribed x]) -> BehaviorM x ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\r :: IORef [SomeBehaviorSubscribed x]
r -> IO () -> BehaviorM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BehaviorM x ()) -> IO () -> BehaviorM x ()
forall a b. (a -> b) -> a -> b
$ IORef [SomeBehaviorSubscribed x]
-> ([SomeBehaviorSubscribed x] -> [SomeBehaviorSubscribed x])
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [SomeBehaviorSubscribed x]
r (Some (BehaviorSubscribed x) -> SomeBehaviorSubscribed x
forall k (x :: k).
Some (BehaviorSubscribed x) -> SomeBehaviorSubscribed x
SomeBehaviorSubscribed (BehaviorSubscribed x Any -> Some (BehaviorSubscribed x)
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Hold x p -> BehaviorSubscribed x Any
forall k (x :: k) a p. Hold x p -> BehaviorSubscribed x a
BehaviorSubscribedHold Hold x p
h)) SomeBehaviorSubscribed x
-> [SomeBehaviorSubscribed x] -> [SomeBehaviorSubscribed x]
forall a. a -> [a] -> [a]
:))
  IO () -> BehaviorM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BehaviorM x ()) -> IO () -> BehaviorM x ()
forall a b. (a -> b) -> a -> b
$ Hold x p -> IO ()
forall (m :: * -> *) a. PrimMonad m => a -> m ()
touch Hold x p
h -- Otherwise, if this gets inlined enough, the hold's parent reference may get collected
  PatchTarget p -> BehaviorM x (PatchTarget p)
forall (m :: * -> *) a. Monad m => a -> m a
return PatchTarget p
result

{-# INLINABLE readBehaviorUntracked #-}
readBehaviorUntracked :: Defer (SomeHoldInit x) m => Behavior x a -> m a
readBehaviorUntracked :: Behavior x a -> m a
readBehaviorUntracked b :: Behavior x a
b = do
  IORef [SomeHoldInit x]
holdInits <- m (IORef [SomeHoldInit x])
forall a (m :: * -> *). Defer a m => m (IORef [a])
getDeferralQueue
  IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ BehaviorM x a
-> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
-> IORef [SomeHoldInit x]
-> IO a
forall k (x :: k) a.
BehaviorM x a
-> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
-> IORef [SomeHoldInit x]
-> IO a
runBehaviorM (Behavior x a -> BehaviorM x a
forall k (x :: k) a. Behavior x a -> BehaviorM x a
readBehaviorTracked Behavior x a
b) Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
forall a. Maybe a
Nothing IORef [SomeHoldInit x]
holdInits --TODO: Specialize readBehaviorTracked to the Nothing and Just cases

--------------------------------------------------------------------------------
-- Dynamic
--------------------------------------------------------------------------------

type DynamicS x p = Dynamic x (PatchTarget p) p

data Dynamic x target p = Dynamic
  { Dynamic x target p -> Behavior x target
dynamicCurrent :: !(Behavior x target)
  , Dynamic x target p -> Event x p
dynamicUpdated :: Event x p -- This must be lazy; see the comment on holdEvent --TODO: Would this let us eliminate `Dyn`?
  }

deriving instance (HasSpiderTimeline x) => Functor (Dynamic x target)




dynamicHold :: Hold x p -> DynamicS x p
dynamicHold :: Hold x p -> DynamicS x p
dynamicHold !Hold x p
h = $WDynamic :: forall k (x :: k) target p.
Behavior x target -> Event x p -> Dynamic x target p
Dynamic
  { dynamicCurrent :: Behavior x (PatchTarget p)
dynamicCurrent = Hold x p -> Behavior x (PatchTarget p)
forall k (x :: k) p. Hold x p -> Behavior x (PatchTarget p)
behaviorHold Hold x p
h
  , dynamicUpdated :: Event x p
dynamicUpdated = Hold x p -> Event x p
forall k (x :: k) p. Hold x p -> Event x p
eventHold Hold x p
h
  }

dynamicHoldIdentity :: Hold x (Identity a) -> DynamicS x (Identity a)
dynamicHoldIdentity :: Hold x (Identity a) -> DynamicS x (Identity a)
dynamicHoldIdentity = Hold x (Identity a) -> DynamicS x (Identity a)
forall k (x :: k) p. Hold x p -> DynamicS x p
dynamicHold

dynamicConst :: PatchTarget p -> DynamicS x p
dynamicConst :: PatchTarget p -> DynamicS x p
dynamicConst !PatchTarget p
a = $WDynamic :: forall k (x :: k) target p.
Behavior x target -> Event x p -> Dynamic x target p
Dynamic
  { dynamicCurrent :: Behavior x (PatchTarget p)
dynamicCurrent = PatchTarget p -> Behavior x (PatchTarget p)
forall k a (x :: k). a -> Behavior x a
behaviorConst PatchTarget p
a
  , dynamicUpdated :: Event x p
dynamicUpdated = Event x p
forall k (x :: k) a. Event x a
eventNever
  }

dynamicDyn :: (HasSpiderTimeline x, Patch p) => Dyn x p -> DynamicS x p
dynamicDyn :: Dyn x p -> DynamicS x p
dynamicDyn !Dyn x p
d = $WDynamic :: forall k (x :: k) target p.
Behavior x target -> Event x p -> Dynamic x target p
Dynamic
  { dynamicCurrent :: Behavior x (PatchTarget p)
dynamicCurrent = Dyn x p -> Behavior x (PatchTarget p)
forall p x. Patch p => Dyn x p -> Behavior x (PatchTarget p)
behaviorDyn Dyn x p
d
  , dynamicUpdated :: Event x p
dynamicUpdated = Dyn x p -> Event x p
forall x p. (HasSpiderTimeline x, Patch p) => Dyn x p -> Event x p
eventDyn Dyn x p
d
  }

dynamicDynIdentity :: HasSpiderTimeline x => Dyn x (Identity a) -> DynamicS x (Identity a)
dynamicDynIdentity :: Dyn x (Identity a) -> DynamicS x (Identity a)
dynamicDynIdentity = Dyn x (Identity a) -> DynamicS x (Identity a)
forall x p.
(HasSpiderTimeline x, Patch p) =>
Dyn x p -> DynamicS x p
dynamicDyn

--------------------------------------------------------------------------------
-- Combinators
--------------------------------------------------------------------------------

--type role Hold representational
data Hold x p
   = Hold { Hold x p -> IORef (PatchTarget p)
holdValue :: !(IORef (PatchTarget p))
          , Hold x p -> IORef [Weak (Invalidator x)]
holdInvalidators :: !(IORef [Weak (Invalidator x)])
          , Hold x p -> Event x p
holdEvent :: Event x p -- This must be lazy, or holds cannot be defined before their input Events
          , Hold x p -> IORef (Maybe (EventSubscription x))
holdParent :: !(IORef (Maybe (EventSubscription x))) -- Keeps its parent alive (will be undefined until the hold is initialized) --TODO: Probably shouldn't be an IORef
#ifdef DEBUG_NODEIDS
          , holdNodeId :: Int
#endif
          }

-- | A statically allocated 'SpiderTimeline'
data Global

{-# NOINLINE globalSpiderTimelineEnv #-}
globalSpiderTimelineEnv :: SpiderTimelineEnv Global
globalSpiderTimelineEnv :: SpiderTimelineEnv Global
globalSpiderTimelineEnv = IO (SpiderTimelineEnv Global) -> SpiderTimelineEnv Global
forall a. IO a -> a
unsafePerformIO IO (SpiderTimelineEnv Global)
forall x. IO (SpiderTimelineEnv x)
unsafeNewSpiderTimelineEnv

-- | Stores all global data relevant to a particular Spider timeline; only one
-- value should exist for each type @x@
newtype SpiderTimelineEnv x = STE {SpiderTimelineEnv x -> SpiderTimelineEnv' x
unSTE :: SpiderTimelineEnv' x}
-- We implement SpiderTimelineEnv with a newtype wrapper so
-- we can get the coercions we want safely.
type role SpiderTimelineEnv nominal

data SpiderTimelineEnv' x = SpiderTimelineEnv
  { SpiderTimelineEnv' x -> MVar ()
_spiderTimeline_lock :: {-# UNPACK #-} !(MVar ())
  , SpiderTimelineEnv' x -> EventEnv x
_spiderTimeline_eventEnv :: {-# UNPACK #-} !(EventEnv x)
#ifdef DEBUG
  , _spiderTimeline_depth :: {-# UNPACK #-} !(IORef Int)
#endif
  }
type role SpiderTimelineEnv' phantom

instance Eq (SpiderTimelineEnv x) where
  _ == :: SpiderTimelineEnv x -> SpiderTimelineEnv x -> Bool
== _ = Bool
True -- Since only one exists of each type

instance GEq SpiderTimelineEnv where
  a :: SpiderTimelineEnv a
a geq :: SpiderTimelineEnv a -> SpiderTimelineEnv b -> Maybe (a :~: b)
`geq` b :: SpiderTimelineEnv b
b = if SpiderTimelineEnv' a -> MVar ()
forall x. SpiderTimelineEnv' x -> MVar ()
_spiderTimeline_lock (SpiderTimelineEnv a -> SpiderTimelineEnv' a
forall x. SpiderTimelineEnv x -> SpiderTimelineEnv' x
unSTE SpiderTimelineEnv a
a) MVar () -> MVar () -> Bool
forall a. Eq a => a -> a -> Bool
== SpiderTimelineEnv' b -> MVar ()
forall x. SpiderTimelineEnv' x -> MVar ()
_spiderTimeline_lock (SpiderTimelineEnv b -> SpiderTimelineEnv' b
forall x. SpiderTimelineEnv x -> SpiderTimelineEnv' x
unSTE SpiderTimelineEnv b
b)
              then (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just ((a :~: b) -> Maybe (a :~: b)) -> (a :~: b) -> Maybe (a :~: b)
forall a b. (a -> b) -> a -> b
$ (Any :~: Any) -> a :~: b
forall a b. a -> b
unsafeCoerce Any :~: Any
forall k (a :: k). a :~: a
Refl -- This unsafeCoerce is safe because the same SpiderTimelineEnv can't have two different 'x' arguments
              else Maybe (a :~: b)
forall a. Maybe a
Nothing

data EventEnv x
   = EventEnv { EventEnv x -> IORef [SomeAssignment x]
eventEnvAssignments :: !(IORef [SomeAssignment x]) -- Needed for Subscribe
              , EventEnv x -> IORef [SomeHoldInit x]
eventEnvHoldInits :: !(IORef [SomeHoldInit x]) -- Needed for Subscribe
              , EventEnv x -> IORef [SomeDynInit x]
eventEnvDynInits :: !(IORef [SomeDynInit x])
              , EventEnv x -> IORef [SomeMergeUpdate x]
eventEnvMergeUpdates :: !(IORef [SomeMergeUpdate x])
              , EventEnv x -> IORef [SomeMergeInit x]
eventEnvMergeInits :: !(IORef [SomeMergeInit x]) -- Needed for Subscribe
              , EventEnv x -> IORef [Some Clear]
eventEnvClears :: !(IORef [Some Clear]) -- Needed for Subscribe
              , EventEnv x -> IORef [Some IntClear]
eventEnvIntClears :: !(IORef [Some IntClear])
              , EventEnv x -> IORef [Some RootClear]
eventEnvRootClears :: !(IORef [Some RootClear])
              , EventEnv x -> IORef Height
eventEnvCurrentHeight :: !(IORef Height) -- Needed for Subscribe
              , EventEnv x -> IORef [SomeResetCoincidence x]
eventEnvResetCoincidences :: !(IORef [SomeResetCoincidence x]) -- Needed for Subscribe
              , EventEnv x -> IORef (IntMap [EventM x ()])
eventEnvDelayedMerges :: !(IORef (IntMap [EventM x ()]))
              }

{-# INLINE runEventM #-}
runEventM :: EventM x a -> IO a
runEventM :: EventM x a -> IO a
runEventM = EventM x a -> IO a
forall k (x :: k) a. EventM x a -> IO a
unEventM

asksEventEnv :: forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a
asksEventEnv :: (EventEnv x -> a) -> EventM x a
asksEventEnv f :: EventEnv x -> a
f = a -> EventM x a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> EventM x a) -> a -> EventM x a
forall a b. (a -> b) -> a -> b
$ EventEnv x -> a
f (EventEnv x -> a) -> EventEnv x -> a
forall a b. (a -> b) -> a -> b
$ SpiderTimelineEnv' x -> EventEnv x
forall x. SpiderTimelineEnv' x -> EventEnv x
_spiderTimeline_eventEnv (SpiderTimelineEnv x -> SpiderTimelineEnv' x
forall x. SpiderTimelineEnv x -> SpiderTimelineEnv' x
unSTE (SpiderTimelineEnv x
forall x. HasSpiderTimeline x => SpiderTimelineEnv x
spiderTimeline :: SpiderTimelineEnv x))

class MonadIO m => Defer a m where
  getDeferralQueue :: m (IORef [a])

{-# INLINE defer #-}
defer :: Defer a m => a -> m ()
defer :: a -> m ()
defer a :: a
a = do
  IORef [a]
q <- m (IORef [a])
forall a (m :: * -> *). Defer a m => m (IORef [a])
getDeferralQueue
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef [a] -> ([a] -> [a]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [a]
q (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)

instance HasSpiderTimeline x => Defer (SomeAssignment x) (EventM x) where
  {-# INLINE getDeferralQueue #-}
  getDeferralQueue :: EventM x (IORef [SomeAssignment x])
getDeferralQueue = (EventEnv x -> IORef [SomeAssignment x])
-> EventM x (IORef [SomeAssignment x])
forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a
asksEventEnv EventEnv x -> IORef [SomeAssignment x]
forall x. EventEnv x -> IORef [SomeAssignment x]
eventEnvAssignments

instance HasSpiderTimeline x => Defer (SomeHoldInit x) (EventM x) where
  {-# INLINE getDeferralQueue #-}
  getDeferralQueue :: EventM x (IORef [SomeHoldInit x])
getDeferralQueue = (EventEnv x -> IORef [SomeHoldInit x])
-> EventM x (IORef [SomeHoldInit x])
forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a
asksEventEnv EventEnv x -> IORef [SomeHoldInit x]
forall x. EventEnv x -> IORef [SomeHoldInit x]
eventEnvHoldInits

instance HasSpiderTimeline x => Defer (SomeDynInit x) (EventM x) where
  {-# INLINE getDeferralQueue #-}
  getDeferralQueue :: EventM x (IORef [SomeDynInit x])
getDeferralQueue = (EventEnv x -> IORef [SomeDynInit x])
-> EventM x (IORef [SomeDynInit x])
forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a
asksEventEnv EventEnv x -> IORef [SomeDynInit x]
forall x. EventEnv x -> IORef [SomeDynInit x]
eventEnvDynInits

instance Defer (SomeHoldInit x) (BehaviorM x) where
  {-# INLINE getDeferralQueue #-}
  getDeferralQueue :: BehaviorM x (IORef [SomeHoldInit x])
getDeferralQueue = ReaderIO (BehaviorEnv x) (IORef [SomeHoldInit x])
-> BehaviorM x (IORef [SomeHoldInit x])
forall k (x :: k) a. ReaderIO (BehaviorEnv x) a -> BehaviorM x a
BehaviorM (ReaderIO (BehaviorEnv x) (IORef [SomeHoldInit x])
 -> BehaviorM x (IORef [SomeHoldInit x]))
-> ReaderIO (BehaviorEnv x) (IORef [SomeHoldInit x])
-> BehaviorM x (IORef [SomeHoldInit x])
forall a b. (a -> b) -> a -> b
$ (BehaviorEnv x -> IORef [SomeHoldInit x])
-> ReaderIO (BehaviorEnv x) (IORef [SomeHoldInit x])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BehaviorEnv x -> IORef [SomeHoldInit x]
forall a b. (a, b) -> b
snd

instance HasSpiderTimeline x => Defer (SomeMergeUpdate x) (EventM x) where
  {-# INLINE getDeferralQueue #-}
  getDeferralQueue :: EventM x (IORef [SomeMergeUpdate x])
getDeferralQueue = (EventEnv x -> IORef [SomeMergeUpdate x])
-> EventM x (IORef [SomeMergeUpdate x])
forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a
asksEventEnv EventEnv x -> IORef [SomeMergeUpdate x]
forall x. EventEnv x -> IORef [SomeMergeUpdate x]
eventEnvMergeUpdates

instance HasSpiderTimeline x => Defer (SomeMergeInit x) (EventM x) where
  {-# INLINE getDeferralQueue #-}
  getDeferralQueue :: EventM x (IORef [SomeMergeInit x])
getDeferralQueue = (EventEnv x -> IORef [SomeMergeInit x])
-> EventM x (IORef [SomeMergeInit x])
forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a
asksEventEnv EventEnv x -> IORef [SomeMergeInit x]
forall x. EventEnv x -> IORef [SomeMergeInit x]
eventEnvMergeInits

class HasSpiderTimeline x => HasCurrentHeight x m | m -> x where
  getCurrentHeight :: m Height
  scheduleMerge :: Height -> EventM x () -> m ()

instance HasSpiderTimeline x => HasCurrentHeight x (EventM x) where
  {-# INLINE getCurrentHeight #-}
  getCurrentHeight :: EventM x Height
getCurrentHeight = do
    IORef Height
heightRef <- (EventEnv x -> IORef Height) -> EventM x (IORef Height)
forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a
asksEventEnv EventEnv x -> IORef Height
forall x. EventEnv x -> IORef Height
eventEnvCurrentHeight
    IO Height -> EventM x Height
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Height -> EventM x Height) -> IO Height -> EventM x Height
forall a b. (a -> b) -> a -> b
$ IORef Height -> IO Height
forall a. IORef a -> IO a
readIORef IORef Height
heightRef
  {-# INLINE scheduleMerge #-}
  scheduleMerge :: Height -> EventM x () -> EventM x ()
scheduleMerge height :: Height
height subscribed :: EventM x ()
subscribed = do
    IORef (IntMap [EventM x ()])
delayedRef <- (EventEnv x -> IORef (IntMap [EventM x ()]))
-> EventM x (IORef (IntMap [EventM x ()]))
forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a
asksEventEnv EventEnv x -> IORef (IntMap [EventM x ()])
forall x. EventEnv x -> IORef (IntMap [EventM x ()])
eventEnvDelayedMerges
    IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (IntMap [EventM x ()])
-> (IntMap [EventM x ()] -> IntMap [EventM x ()]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (IntMap [EventM x ()])
delayedRef ((IntMap [EventM x ()] -> IntMap [EventM x ()]) -> IO ())
-> (IntMap [EventM x ()] -> IntMap [EventM x ()]) -> IO ()
forall a b. (a -> b) -> a -> b
$ ([EventM x ()] -> [EventM x ()] -> [EventM x ()])
-> Int
-> [EventM x ()]
-> IntMap [EventM x ()]
-> IntMap [EventM x ()]
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IntMap.insertWith [EventM x ()] -> [EventM x ()] -> [EventM x ()]
forall a. [a] -> [a] -> [a]
(++) (Height -> Int
unHeight Height
height) [EventM x ()
subscribed]

class HasSpiderTimeline x where
  -- | Retrieve the current SpiderTimelineEnv
  spiderTimeline :: SpiderTimelineEnv x

instance HasSpiderTimeline Global where
  spiderTimeline :: SpiderTimelineEnv Global
spiderTimeline = SpiderTimelineEnv Global
globalSpiderTimelineEnv

putCurrentHeight :: HasSpiderTimeline x => Height -> EventM x ()
putCurrentHeight :: Height -> EventM x ()
putCurrentHeight h :: Height
h = do
  IORef Height
heightRef <- (EventEnv x -> IORef Height) -> EventM x (IORef Height)
forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a
asksEventEnv EventEnv x -> IORef Height
forall x. EventEnv x -> IORef Height
eventEnvCurrentHeight
  IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef Height -> Height -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Height
heightRef (Height -> IO ()) -> Height -> IO ()
forall a b. (a -> b) -> a -> b
$! Height
h

instance HasSpiderTimeline x => Defer (Some Clear) (EventM x) where
  {-# INLINE getDeferralQueue #-}
  getDeferralQueue :: EventM x (IORef [Some Clear])
getDeferralQueue = (EventEnv x -> IORef [Some Clear]) -> EventM x (IORef [Some Clear])
forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a
asksEventEnv EventEnv x -> IORef [Some Clear]
forall x. EventEnv x -> IORef [Some Clear]
eventEnvClears

{-# INLINE scheduleClear #-}
scheduleClear :: Defer (Some Clear) m => IORef (Maybe a) -> m ()
scheduleClear :: IORef (Maybe a) -> m ()
scheduleClear r :: IORef (Maybe a)
r = Some Clear -> m ()
forall a (m :: * -> *). Defer a m => a -> m ()
defer (Some Clear -> m ()) -> Some Clear -> m ()
forall a b. (a -> b) -> a -> b
$ Clear a -> Some Clear
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Clear a -> Some Clear) -> Clear a -> Some Clear
forall a b. (a -> b) -> a -> b
$ IORef (Maybe a) -> Clear a
forall a. IORef (Maybe a) -> Clear a
Clear IORef (Maybe a)
r

instance HasSpiderTimeline x => Defer (Some IntClear) (EventM x) where
  {-# INLINE getDeferralQueue #-}
  getDeferralQueue :: EventM x (IORef [Some IntClear])
getDeferralQueue = (EventEnv x -> IORef [Some IntClear])
-> EventM x (IORef [Some IntClear])
forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a
asksEventEnv EventEnv x -> IORef [Some IntClear]
forall x. EventEnv x -> IORef [Some IntClear]
eventEnvIntClears

{-# INLINE scheduleIntClear #-}
scheduleIntClear :: Defer (Some IntClear) m => IORef (IntMap a) -> m ()
scheduleIntClear :: IORef (IntMap a) -> m ()
scheduleIntClear r :: IORef (IntMap a)
r = Some IntClear -> m ()
forall a (m :: * -> *). Defer a m => a -> m ()
defer (Some IntClear -> m ()) -> Some IntClear -> m ()
forall a b. (a -> b) -> a -> b
$ IntClear a -> Some IntClear
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some (IntClear a -> Some IntClear) -> IntClear a -> Some IntClear
forall a b. (a -> b) -> a -> b
$ IORef (IntMap a) -> IntClear a
forall a. IORef (IntMap a) -> IntClear a
IntClear IORef (IntMap a)
r

instance HasSpiderTimeline x => Defer (Some RootClear) (EventM x) where
  {-# INLINE getDeferralQueue #-}
  getDeferralQueue :: EventM x (IORef [Some RootClear])
getDeferralQueue = (EventEnv x -> IORef [Some RootClear])
-> EventM x (IORef [Some RootClear])
forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a
asksEventEnv EventEnv x -> IORef [Some RootClear]
forall x. EventEnv x -> IORef [Some RootClear]
eventEnvRootClears

{-# INLINE scheduleRootClear #-}
scheduleRootClear :: Defer (Some RootClear) m => IORef (DMap k Identity) -> m ()
scheduleRootClear :: IORef (DMap k Identity) -> m ()
scheduleRootClear r :: IORef (DMap k Identity)
r = Some RootClear -> m ()
forall a (m :: * -> *). Defer a m => a -> m ()
defer (Some RootClear -> m ()) -> Some RootClear -> m ()
forall a b. (a -> b) -> a -> b
$ RootClear k -> Some RootClear
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some (RootClear k -> Some RootClear) -> RootClear k -> Some RootClear
forall a b. (a -> b) -> a -> b
$ IORef (DMap k Identity) -> RootClear k
forall (k :: * -> *). IORef (DMap k Identity) -> RootClear k
RootClear IORef (DMap k Identity)
r

instance HasSpiderTimeline x => Defer (SomeResetCoincidence x) (EventM x) where
  {-# INLINE getDeferralQueue #-}
  getDeferralQueue :: EventM x (IORef [SomeResetCoincidence x])
getDeferralQueue = (EventEnv x -> IORef [SomeResetCoincidence x])
-> EventM x (IORef [SomeResetCoincidence x])
forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a
asksEventEnv EventEnv x -> IORef [SomeResetCoincidence x]
forall x. EventEnv x -> IORef [SomeResetCoincidence x]
eventEnvResetCoincidences

-- Note: hold cannot examine its event until after the phase is over
{-# INLINE [1] hold #-}
hold :: (Patch p, Defer (SomeHoldInit x) m) => PatchTarget p -> Event x p -> m (Hold x p)
hold :: PatchTarget p -> Event x p -> m (Hold x p)
hold v0 :: PatchTarget p
v0 e :: Event x p
e = do
  IORef (PatchTarget p)
valRef <- IO (IORef (PatchTarget p)) -> m (IORef (PatchTarget p))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (PatchTarget p)) -> m (IORef (PatchTarget p)))
-> IO (IORef (PatchTarget p)) -> m (IORef (PatchTarget p))
forall a b. (a -> b) -> a -> b
$ PatchTarget p -> IO (IORef (PatchTarget p))
forall a. a -> IO (IORef a)
newIORef PatchTarget p
v0
  IORef [Weak (Invalidator x)]
invsRef <- IO (IORef [Weak (Invalidator x)])
-> m (IORef [Weak (Invalidator x)])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [Weak (Invalidator x)])
 -> m (IORef [Weak (Invalidator x)]))
-> IO (IORef [Weak (Invalidator x)])
-> m (IORef [Weak (Invalidator x)])
forall a b. (a -> b) -> a -> b
$ [Weak (Invalidator x)] -> IO (IORef [Weak (Invalidator x)])
forall a. a -> IO (IORef a)
newIORef []
  IORef (Maybe (EventSubscription x))
parentRef <- IO (IORef (Maybe (EventSubscription x)))
-> m (IORef (Maybe (EventSubscription x)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe (EventSubscription x)))
 -> m (IORef (Maybe (EventSubscription x))))
-> IO (IORef (Maybe (EventSubscription x)))
-> m (IORef (Maybe (EventSubscription x)))
forall a b. (a -> b) -> a -> b
$ Maybe (EventSubscription x)
-> IO (IORef (Maybe (EventSubscription x)))
forall a. a -> IO (IORef a)
newIORef Maybe (EventSubscription x)
forall a. Maybe a
Nothing
#ifdef DEBUG_NODEIDS
  nodeId <- liftIO newNodeId
#endif
  let h :: Hold x p
h = $WHold :: forall k (x :: k) p.
IORef (PatchTarget p)
-> IORef [Weak (Invalidator x)]
-> Event x p
-> IORef (Maybe (EventSubscription x))
-> Hold x p
Hold
        { holdValue :: IORef (PatchTarget p)
holdValue = IORef (PatchTarget p)
valRef
        , holdInvalidators :: IORef [Weak (Invalidator x)]
holdInvalidators = IORef [Weak (Invalidator x)]
invsRef
        , holdEvent :: Event x p
holdEvent = Event x p
e
        , holdParent :: IORef (Maybe (EventSubscription x))
holdParent = IORef (Maybe (EventSubscription x))
parentRef
#ifdef DEBUG_NODEIDS
        , holdNodeId = nodeId
#endif
        }
  SomeHoldInit x -> m ()
forall a (m :: * -> *). Defer a m => a -> m ()
defer (SomeHoldInit x -> m ()) -> SomeHoldInit x -> m ()
forall a b. (a -> b) -> a -> b
$ Hold x p -> SomeHoldInit x
forall k (x :: k) p. Patch p => Hold x p -> SomeHoldInit x
SomeHoldInit Hold x p
h
  Hold x p -> m (Hold x p)
forall (m :: * -> *) a. Monad m => a -> m a
return Hold x p
h

{-# INLINE getHoldEventSubscription #-}
getHoldEventSubscription :: forall p x. (HasSpiderTimeline x, Patch p) => Hold x p -> EventM x (EventSubscription x)
getHoldEventSubscription :: Hold x p -> EventM x (EventSubscription x)
getHoldEventSubscription h :: Hold x p
h = do
  Maybe (EventSubscription x)
ep <- IO (Maybe (EventSubscription x))
-> EventM x (Maybe (EventSubscription x))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (EventSubscription x))
 -> EventM x (Maybe (EventSubscription x)))
-> IO (Maybe (EventSubscription x))
-> EventM x (Maybe (EventSubscription x))
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (EventSubscription x))
-> IO (Maybe (EventSubscription x))
forall a. IORef a -> IO a
readIORef (IORef (Maybe (EventSubscription x))
 -> IO (Maybe (EventSubscription x)))
-> IORef (Maybe (EventSubscription x))
-> IO (Maybe (EventSubscription x))
forall a b. (a -> b) -> a -> b
$ Hold x p -> IORef (Maybe (EventSubscription x))
forall k (x :: k) p.
Hold x p -> IORef (Maybe (EventSubscription x))
holdParent Hold x p
h
  case Maybe (EventSubscription x)
ep of
    Just subd :: EventSubscription x
subd -> EventSubscription x -> EventM x (EventSubscription x)
forall (m :: * -> *) a. Monad m => a -> m a
return EventSubscription x
subd
    Nothing -> do
      let e :: Event x p
e = Hold x p -> Event x p
forall k (x :: k) p. Hold x p -> Event x p
holdEvent Hold x p
h
      IORef (EventSubscription x)
subscriptionRef <- IO (IORef (EventSubscription x))
-> EventM x (IORef (EventSubscription x))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (EventSubscription x))
 -> EventM x (IORef (EventSubscription x)))
-> IO (IORef (EventSubscription x))
-> EventM x (IORef (EventSubscription x))
forall a b. (a -> b) -> a -> b
$ EventSubscription x -> IO (IORef (EventSubscription x))
forall a. a -> IO (IORef a)
newIORef (EventSubscription x -> IO (IORef (EventSubscription x)))
-> EventSubscription x -> IO (IORef (EventSubscription x))
forall a b. (a -> b) -> a -> b
$ String -> EventSubscription x
forall a. HasCallStack => String -> a
error "getHoldEventSubscription: subdRef uninitialized"
      (subscription :: EventSubscription x
subscription@(EventSubscription _ _), occ :: Maybe p
occ) <- Event x p
-> Subscriber x p -> EventM x (EventSubscription x, Maybe p)
forall k (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead Event x p
e (Subscriber x p -> EventM x (EventSubscription x, Maybe p))
-> EventM x (Subscriber x p)
-> EventM x (EventSubscription x, Maybe p)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Subscriber x p) -> EventM x (Subscriber x p)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Hold x p -> IO (Subscriber x p)
forall x p.
(HasSpiderTimeline x, Patch p) =>
Hold x p -> IO (Subscriber x p)
newSubscriberHold Hold x p
h)
      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (EventSubscription x) -> EventSubscription x -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (EventSubscription x)
subscriptionRef (EventSubscription x -> IO ()) -> EventSubscription x -> IO ()
forall a b. (a -> b) -> a -> b
$! EventSubscription x
subscription
      case Maybe p
occ of
        Nothing -> () -> EventM x ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just o :: p
o -> do
          PatchTarget p
old <- IO (PatchTarget p) -> EventM x (PatchTarget p)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PatchTarget p) -> EventM x (PatchTarget p))
-> IO (PatchTarget p) -> EventM x (PatchTarget p)
forall a b. (a -> b) -> a -> b
$ IORef (PatchTarget p) -> IO (PatchTarget p)
forall a. IORef a -> IO a
readIORef (IORef (PatchTarget p) -> IO (PatchTarget p))
-> IORef (PatchTarget p) -> IO (PatchTarget p)
forall a b. (a -> b) -> a -> b
$ Hold x p -> IORef (PatchTarget p)
forall k (x :: k) p. Hold x p -> IORef (PatchTarget p)
holdValue Hold x p
h
          case p -> PatchTarget p -> Maybe (PatchTarget p)
forall p. Patch p => p -> PatchTarget p -> Maybe (PatchTarget p)
apply p
o PatchTarget p
old of
            Nothing -> () -> EventM x ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just new :: PatchTarget p
new -> do
              -- Need to evaluate these so that we don't retain the Hold itself
              IORef (PatchTarget p)
v <- IO (IORef (PatchTarget p)) -> EventM x (IORef (PatchTarget p))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (PatchTarget p)) -> EventM x (IORef (PatchTarget p)))
-> IO (IORef (PatchTarget p)) -> EventM x (IORef (PatchTarget p))
forall a b. (a -> b) -> a -> b
$ IORef (PatchTarget p) -> IO (IORef (PatchTarget p))
forall a. a -> IO a
evaluate (IORef (PatchTarget p) -> IO (IORef (PatchTarget p)))
-> IORef (PatchTarget p) -> IO (IORef (PatchTarget p))
forall a b. (a -> b) -> a -> b
$ Hold x p -> IORef (PatchTarget p)
forall k (x :: k) p. Hold x p -> IORef (PatchTarget p)
holdValue Hold x p
h
              IORef [Weak (Invalidator x)]
i <- IO (IORef [Weak (Invalidator x)])
-> EventM x (IORef [Weak (Invalidator x)])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [Weak (Invalidator x)])
 -> EventM x (IORef [Weak (Invalidator x)]))
-> IO (IORef [Weak (Invalidator x)])
-> EventM x (IORef [Weak (Invalidator x)])
forall a b. (a -> b) -> a -> b
$ IORef [Weak (Invalidator x)] -> IO (IORef [Weak (Invalidator x)])
forall a. a -> IO a
evaluate (IORef [Weak (Invalidator x)] -> IO (IORef [Weak (Invalidator x)]))
-> IORef [Weak (Invalidator x)]
-> IO (IORef [Weak (Invalidator x)])
forall a b. (a -> b) -> a -> b
$ Hold x p -> IORef [Weak (Invalidator x)]
forall k (x :: k) p. Hold x p -> IORef [Weak (Invalidator x)]
holdInvalidators Hold x p
h
              SomeAssignment x -> EventM x ()
forall a (m :: * -> *). Defer a m => a -> m ()
defer (SomeAssignment x -> EventM x ())
-> SomeAssignment x -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (PatchTarget p)
-> IORef [Weak (Invalidator x)]
-> PatchTarget p
-> SomeAssignment x
forall k (x :: k) a.
IORef a -> IORef [Weak (Invalidator x)] -> a -> SomeAssignment x
SomeAssignment IORef (PatchTarget p)
v IORef [Weak (Invalidator x)]
i PatchTarget p
new
      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (EventSubscription x))
-> Maybe (EventSubscription x) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Hold x p -> IORef (Maybe (EventSubscription x))
forall k (x :: k) p.
Hold x p -> IORef (Maybe (EventSubscription x))
holdParent Hold x p
h) (Maybe (EventSubscription x) -> IO ())
-> Maybe (EventSubscription x) -> IO ()
forall a b. (a -> b) -> a -> b
$ EventSubscription x -> Maybe (EventSubscription x)
forall a. a -> Maybe a
Just EventSubscription x
subscription
      EventSubscription x -> EventM x (EventSubscription x)
forall (m :: * -> *) a. Monad m => a -> m a
return EventSubscription x
subscription

type BehaviorEnv x = (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]), IORef [SomeHoldInit x])

-- BehaviorM can sample behaviors
newtype BehaviorM x a = BehaviorM { BehaviorM x a -> ReaderIO (BehaviorEnv x) a
unBehaviorM :: ReaderIO (BehaviorEnv x) a }
  deriving (a -> BehaviorM x b -> BehaviorM x a
(a -> b) -> BehaviorM x a -> BehaviorM x b
(forall a b. (a -> b) -> BehaviorM x a -> BehaviorM x b)
-> (forall a b. a -> BehaviorM x b -> BehaviorM x a)
-> Functor (BehaviorM x)
forall k (x :: k) a b. a -> BehaviorM x b -> BehaviorM x a
forall k (x :: k) a b. (a -> b) -> BehaviorM x a -> BehaviorM x b
forall a b. a -> BehaviorM x b -> BehaviorM x a
forall a b. (a -> b) -> BehaviorM x a -> BehaviorM x b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BehaviorM x b -> BehaviorM x a
$c<$ :: forall k (x :: k) a b. a -> BehaviorM x b -> BehaviorM x a
fmap :: (a -> b) -> BehaviorM x a -> BehaviorM x b
$cfmap :: forall k (x :: k) a b. (a -> b) -> BehaviorM x a -> BehaviorM x b
Functor, Functor (BehaviorM x)
a -> BehaviorM x a
Functor (BehaviorM x) =>
(forall a. a -> BehaviorM x a)
-> (forall a b.
    BehaviorM x (a -> b) -> BehaviorM x a -> BehaviorM x b)
-> (forall a b c.
    (a -> b -> c) -> BehaviorM x a -> BehaviorM x b -> BehaviorM x c)
-> (forall a b. BehaviorM x a -> BehaviorM x b -> BehaviorM x b)
-> (forall a b. BehaviorM x a -> BehaviorM x b -> BehaviorM x a)
-> Applicative (BehaviorM x)
BehaviorM x a -> BehaviorM x b -> BehaviorM x b
BehaviorM x a -> BehaviorM x b -> BehaviorM x a
BehaviorM x (a -> b) -> BehaviorM x a -> BehaviorM x b
(a -> b -> c) -> BehaviorM x a -> BehaviorM x b -> BehaviorM x c
forall a. a -> BehaviorM x a
forall k (x :: k). Functor (BehaviorM x)
forall k (x :: k) a. a -> BehaviorM x a
forall k (x :: k) a b.
BehaviorM x a -> BehaviorM x b -> BehaviorM x a
forall k (x :: k) a b.
BehaviorM x a -> BehaviorM x b -> BehaviorM x b
forall k (x :: k) a b.
BehaviorM x (a -> b) -> BehaviorM x a -> BehaviorM x b
forall k (x :: k) a b c.
(a -> b -> c) -> BehaviorM x a -> BehaviorM x b -> BehaviorM x c
forall a b. BehaviorM x a -> BehaviorM x b -> BehaviorM x a
forall a b. BehaviorM x a -> BehaviorM x b -> BehaviorM x b
forall a b. BehaviorM x (a -> b) -> BehaviorM x a -> BehaviorM x b
forall a b c.
(a -> b -> c) -> BehaviorM x a -> BehaviorM x b -> BehaviorM x c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: BehaviorM x a -> BehaviorM x b -> BehaviorM x a
$c<* :: forall k (x :: k) a b.
BehaviorM x a -> BehaviorM x b -> BehaviorM x a
*> :: BehaviorM x a -> BehaviorM x b -> BehaviorM x b
$c*> :: forall k (x :: k) a b.
BehaviorM x a -> BehaviorM x b -> BehaviorM x b
liftA2 :: (a -> b -> c) -> BehaviorM x a -> BehaviorM x b -> BehaviorM x c
$cliftA2 :: forall k (x :: k) a b c.
(a -> b -> c) -> BehaviorM x a -> BehaviorM x b -> BehaviorM x c
<*> :: BehaviorM x (a -> b) -> BehaviorM x a -> BehaviorM x b
$c<*> :: forall k (x :: k) a b.
BehaviorM x (a -> b) -> BehaviorM x a -> BehaviorM x b
pure :: a -> BehaviorM x a
$cpure :: forall k (x :: k) a. a -> BehaviorM x a
$cp1Applicative :: forall k (x :: k). Functor (BehaviorM x)
Applicative, Monad (BehaviorM x)
Monad (BehaviorM x) =>
(forall a. IO a -> BehaviorM x a) -> MonadIO (BehaviorM x)
IO a -> BehaviorM x a
forall a. IO a -> BehaviorM x a
forall k (x :: k). Monad (BehaviorM x)
forall k (x :: k) a. IO a -> BehaviorM x a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> BehaviorM x a
$cliftIO :: forall k (x :: k) a. IO a -> BehaviorM x a
$cp1MonadIO :: forall k (x :: k). Monad (BehaviorM x)
MonadIO, Monad (BehaviorM x)
Monad (BehaviorM x) =>
(forall a. (a -> BehaviorM x a) -> BehaviorM x a)
-> MonadFix (BehaviorM x)
(a -> BehaviorM x a) -> BehaviorM x a
forall a. (a -> BehaviorM x a) -> BehaviorM x a
forall k (x :: k). Monad (BehaviorM x)
forall k (x :: k) a. (a -> BehaviorM x a) -> BehaviorM x a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> BehaviorM x a) -> BehaviorM x a
$cmfix :: forall k (x :: k) a. (a -> BehaviorM x a) -> BehaviorM x a
$cp1MonadFix :: forall k (x :: k). Monad (BehaviorM x)
MonadFix, MonadReader (BehaviorEnv x))

instance Monad (BehaviorM x) where
  {-# INLINE (>>=) #-}
  BehaviorM x :: ReaderIO (BehaviorEnv x) a
x >>= :: BehaviorM x a -> (a -> BehaviorM x b) -> BehaviorM x b
>>= f :: a -> BehaviorM x b
f = ReaderIO (BehaviorEnv x) b -> BehaviorM x b
forall k (x :: k) a. ReaderIO (BehaviorEnv x) a -> BehaviorM x a
BehaviorM (ReaderIO (BehaviorEnv x) b -> BehaviorM x b)
-> ReaderIO (BehaviorEnv x) b -> BehaviorM x b
forall a b. (a -> b) -> a -> b
$ ReaderIO (BehaviorEnv x) a
x ReaderIO (BehaviorEnv x) a
-> (a -> ReaderIO (BehaviorEnv x) b) -> ReaderIO (BehaviorEnv x) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BehaviorM x b -> ReaderIO (BehaviorEnv x) b
forall k (x :: k) a. BehaviorM x a -> ReaderIO (BehaviorEnv x) a
unBehaviorM (BehaviorM x b -> ReaderIO (BehaviorEnv x) b)
-> (a -> BehaviorM x b) -> a -> ReaderIO (BehaviorEnv x) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BehaviorM x b
f
  {-# INLINE (>>) #-}
  BehaviorM x :: ReaderIO (BehaviorEnv x) a
x >> :: BehaviorM x a -> BehaviorM x b -> BehaviorM x b
>> BehaviorM y :: ReaderIO (BehaviorEnv x) b
y = ReaderIO (BehaviorEnv x) b -> BehaviorM x b
forall k (x :: k) a. ReaderIO (BehaviorEnv x) a -> BehaviorM x a
BehaviorM (ReaderIO (BehaviorEnv x) b -> BehaviorM x b)
-> ReaderIO (BehaviorEnv x) b -> BehaviorM x b
forall a b. (a -> b) -> a -> b
$ ReaderIO (BehaviorEnv x) a
x ReaderIO (BehaviorEnv x) a
-> ReaderIO (BehaviorEnv x) b -> ReaderIO (BehaviorEnv x) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderIO (BehaviorEnv x) b
y
  {-# INLINE return #-}
  return :: a -> BehaviorM x a
return x :: a
x = ReaderIO (BehaviorEnv x) a -> BehaviorM x a
forall k (x :: k) a. ReaderIO (BehaviorEnv x) a -> BehaviorM x a
BehaviorM (ReaderIO (BehaviorEnv x) a -> BehaviorM x a)
-> ReaderIO (BehaviorEnv x) a -> BehaviorM x a
forall a b. (a -> b) -> a -> b
$ a -> ReaderIO (BehaviorEnv x) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
#if !MIN_VERSION_base(4,13,0)
  {-# INLINE fail #-}
  fail s = BehaviorM $ fail s
#endif

data BehaviorSubscribed x a
   = forall p. BehaviorSubscribedHold (Hold x p)
   | BehaviorSubscribedPull (PullSubscribed x a)

newtype SomeBehaviorSubscribed x = SomeBehaviorSubscribed (Some (BehaviorSubscribed x))

--type role PullSubscribed representational
data PullSubscribed x a
   = PullSubscribed { PullSubscribed x a -> a
pullSubscribedValue :: !a
                    , PullSubscribed x a -> IORef [Weak (Invalidator x)]
pullSubscribedInvalidators :: !(IORef [Weak (Invalidator x)])
                    , PullSubscribed x a -> Invalidator x
pullSubscribedOwnInvalidator :: !(Invalidator x)
                    , PullSubscribed x a -> [SomeBehaviorSubscribed x]
pullSubscribedParents :: ![SomeBehaviorSubscribed x] -- Need to keep parent behaviors alive, or they won't let us know when they're invalidated
                    }

--type role Pull representational
data Pull x a
   = Pull { Pull x a -> IORef (Maybe (PullSubscribed x a))
pullValue :: !(IORef (Maybe (PullSubscribed x a)))
          , Pull x a -> BehaviorM x a
pullCompute :: !(BehaviorM x a)
#ifdef DEBUG_NODEIDS
          , pullNodeId :: Int
#endif
          }

data Invalidator x
   = forall a. InvalidatorPull (Pull x a)
   | forall a. InvalidatorSwitch (SwitchSubscribed x a)

data RootSubscribed x a = forall k. GCompare k => RootSubscribed
  { ()
rootSubscribedKey :: !(k a)
  , ()
rootSubscribedCachedSubscribed :: !(IORef (DMap k (RootSubscribed x))) -- From the original Root
  , RootSubscribed x a -> WeakBag (Subscriber x a)
rootSubscribedSubscribers :: !(WeakBag (Subscriber x a))
  , RootSubscribed x a -> IO (Maybe a)
rootSubscribedOccurrence :: !(IO (Maybe a)) -- Lookup from rootOccurrence
  , RootSubscribed x a -> IO ()
rootSubscribedUninit :: IO ()
  , RootSubscribed x a -> IORef (Weak (RootSubscribed x a))
rootSubscribedWeakSelf :: !(IORef (Weak (RootSubscribed x a))) --TODO: Can we make this a lazy non-IORef and then force it manually to avoid an indirection each time we use it?
#ifdef DEBUG_NODEIDS
  , rootSubscribedNodeId :: Int
#endif
  }

data Root x k
   = Root { Root x k -> IORef (DMap k Identity)
rootOccurrence :: !(IORef (DMap k Identity)) -- The currently-firing occurrence of this event
          , Root x k -> IORef (DMap k (RootSubscribed x))
rootSubscribed :: !(IORef (DMap k (RootSubscribed x)))
          , Root x k -> forall a. k a -> RootTrigger x a -> IO (IO ())
rootInit :: !(forall a. k a -> RootTrigger x a -> IO (IO ()))
          }

data SomeHoldInit x = forall p. Patch p => SomeHoldInit !(Hold x p)

data SomeDynInit x = forall p. Patch p => SomeDynInit !(Dyn x p)

data SomeMergeUpdate x = SomeMergeUpdate
  { SomeMergeUpdate x -> EventM x [EventSubscription x]
_someMergeUpdate_update :: !(EventM x [EventSubscription x])
  , SomeMergeUpdate x -> IO ()
_someMergeUpdate_invalidateHeight :: !(IO ())
  , SomeMergeUpdate x -> IO ()
_someMergeUpdate_recalculateHeight :: !(IO ())
  }

newtype SomeMergeInit x = SomeMergeInit { SomeMergeInit x -> EventM x ()
unSomeMergeInit :: EventM x () }

-- EventM can do everything BehaviorM can, plus create holds
newtype EventM x a = EventM { EventM x a -> IO a
unEventM :: IO a } deriving (a -> EventM x b -> EventM x a
(a -> b) -> EventM x a -> EventM x b
(forall a b. (a -> b) -> EventM x a -> EventM x b)
-> (forall a b. a -> EventM x b -> EventM x a)
-> Functor (EventM x)
forall k (x :: k) a b. a -> EventM x b -> EventM x a
forall k (x :: k) a b. (a -> b) -> EventM x a -> EventM x b
forall a b. a -> EventM x b -> EventM x a
forall a b. (a -> b) -> EventM x a -> EventM x b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> EventM x b -> EventM x a
$c<$ :: forall k (x :: k) a b. a -> EventM x b -> EventM x a
fmap :: (a -> b) -> EventM x a -> EventM x b
$cfmap :: forall k (x :: k) a b. (a -> b) -> EventM x a -> EventM x b
Functor, Functor (EventM x)
a -> EventM x a
Functor (EventM x) =>
(forall a. a -> EventM x a)
-> (forall a b. EventM x (a -> b) -> EventM x a -> EventM x b)
-> (forall a b c.
    (a -> b -> c) -> EventM x a -> EventM x b -> EventM x c)
-> (forall a b. EventM x a -> EventM x b -> EventM x b)
-> (forall a b. EventM x a -> EventM x b -> EventM x a)
-> Applicative (EventM x)
EventM x a -> EventM x b -> EventM x b
EventM x a -> EventM x b -> EventM x a
EventM x (a -> b) -> EventM x a -> EventM x b
(a -> b -> c) -> EventM x a -> EventM x b -> EventM x c
forall a. a -> EventM x a
forall k (x :: k). Functor (EventM x)
forall k (x :: k) a. a -> EventM x a
forall k (x :: k) a b. EventM x a -> EventM x b -> EventM x a
forall k (x :: k) a b. EventM x a -> EventM x b -> EventM x b
forall k (x :: k) a b.
EventM x (a -> b) -> EventM x a -> EventM x b
forall k (x :: k) a b c.
(a -> b -> c) -> EventM x a -> EventM x b -> EventM x c
forall a b. EventM x a -> EventM x b -> EventM x a
forall a b. EventM x a -> EventM x b -> EventM x b
forall a b. EventM x (a -> b) -> EventM x a -> EventM x b
forall a b c.
(a -> b -> c) -> EventM x a -> EventM x b -> EventM x c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: EventM x a -> EventM x b -> EventM x a
$c<* :: forall k (x :: k) a b. EventM x a -> EventM x b -> EventM x a
*> :: EventM x a -> EventM x b -> EventM x b
$c*> :: forall k (x :: k) a b. EventM x a -> EventM x b -> EventM x b
liftA2 :: (a -> b -> c) -> EventM x a -> EventM x b -> EventM x c
$cliftA2 :: forall k (x :: k) a b c.
(a -> b -> c) -> EventM x a -> EventM x b -> EventM x c
<*> :: EventM x (a -> b) -> EventM x a -> EventM x b
$c<*> :: forall k (x :: k) a b.
EventM x (a -> b) -> EventM x a -> EventM x b
pure :: a -> EventM x a
$cpure :: forall k (x :: k) a. a -> EventM x a
$cp1Applicative :: forall k (x :: k). Functor (EventM x)
Applicative, Applicative (EventM x)
a -> EventM x a
Applicative (EventM x) =>
(forall a b. EventM x a -> (a -> EventM x b) -> EventM x b)
-> (forall a b. EventM x a -> EventM x b -> EventM x b)
-> (forall a. a -> EventM x a)
-> Monad (EventM x)
EventM x a -> (a -> EventM x b) -> EventM x b
EventM x a -> EventM x b -> EventM x b
forall a. a -> EventM x a
forall k (x :: k). Applicative (EventM x)
forall k (x :: k) a. a -> EventM x a
forall k (x :: k) a b. EventM x a -> EventM x b -> EventM x b
forall k (x :: k) a b.
EventM x a -> (a -> EventM x b) -> EventM x b
forall a b. EventM x a -> EventM x b -> EventM x b
forall a b. EventM x a -> (a -> EventM x b) -> EventM x b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> EventM x a
$creturn :: forall k (x :: k) a. a -> EventM x a
>> :: EventM x a -> EventM x b -> EventM x b
$c>> :: forall k (x :: k) a b. EventM x a -> EventM x b -> EventM x b
>>= :: EventM x a -> (a -> EventM x b) -> EventM x b
$c>>= :: forall k (x :: k) a b.
EventM x a -> (a -> EventM x b) -> EventM x b
$cp1Monad :: forall k (x :: k). Applicative (EventM x)
Monad, Monad (EventM x)
Monad (EventM x) =>
(forall a. IO a -> EventM x a) -> MonadIO (EventM x)
IO a -> EventM x a
forall a. IO a -> EventM x a
forall k (x :: k). Monad (EventM x)
forall k (x :: k) a. IO a -> EventM x a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> EventM x a
$cliftIO :: forall k (x :: k) a. IO a -> EventM x a
$cp1MonadIO :: forall k (x :: k). Monad (EventM x)
MonadIO, Monad (EventM x)
Monad (EventM x) =>
(forall a. (a -> EventM x a) -> EventM x a) -> MonadFix (EventM x)
(a -> EventM x a) -> EventM x a
forall a. (a -> EventM x a) -> EventM x a
forall k (x :: k). Monad (EventM x)
forall k (x :: k) a. (a -> EventM x a) -> EventM x a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> EventM x a) -> EventM x a
$cmfix :: forall k (x :: k) a. (a -> EventM x a) -> EventM x a
$cp1MonadFix :: forall k (x :: k). Monad (EventM x)
MonadFix, Monad (EventM x)
e -> EventM x a
Monad (EventM x) =>
(forall e a. Exception e => e -> EventM x a)
-> (forall e a.
    Exception e =>
    EventM x a -> (e -> EventM x a) -> EventM x a)
-> (forall a b. EventM x a -> EventM x b -> EventM x a)
-> MonadException (EventM x)
EventM x a -> (e -> EventM x a) -> EventM x a
EventM x a -> EventM x b -> EventM x a
forall k (x :: k). Monad (EventM x)
forall k (x :: k) e a. Exception e => e -> EventM x a
forall k (x :: k) e a.
Exception e =>
EventM x a -> (e -> EventM x a) -> EventM x a
forall k (x :: k) a b. EventM x a -> EventM x b -> EventM x a
forall e a. Exception e => e -> EventM x a
forall e a.
Exception e =>
EventM x a -> (e -> EventM x a) -> EventM x a
forall a b. EventM x a -> EventM x b -> EventM x a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a)
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. m a -> m b -> m a)
-> MonadException m
finally :: EventM x a -> EventM x b -> EventM x a
$cfinally :: forall k (x :: k) a b. EventM x a -> EventM x b -> EventM x a
catch :: EventM x a -> (e -> EventM x a) -> EventM x a
$ccatch :: forall k (x :: k) e a.
Exception e =>
EventM x a -> (e -> EventM x a) -> EventM x a
throw :: e -> EventM x a
$cthrow :: forall k (x :: k) e a. Exception e => e -> EventM x a
$cp1MonadException :: forall k (x :: k). Monad (EventM x)
MonadException, MonadIO (EventM x)
MonadException (EventM x)
(MonadIO (EventM x), MonadException (EventM x)) =>
(forall b.
 ((forall a. EventM x a -> EventM x a) -> EventM x b) -> EventM x b)
-> MonadAsyncException (EventM x)
((forall a. EventM x a -> EventM x a) -> EventM x b) -> EventM x b
forall b.
((forall a. EventM x a -> EventM x a) -> EventM x b) -> EventM x b
forall k (x :: k). MonadIO (EventM x)
forall k (x :: k). MonadException (EventM x)
forall k (x :: k) b.
((forall a. EventM x a -> EventM x a) -> EventM x b) -> EventM x b
forall (m :: * -> *).
(MonadIO m, MonadException m) =>
(forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> MonadAsyncException m
mask :: ((forall a. EventM x a -> EventM x a) -> EventM x b) -> EventM x b
$cmask :: forall k (x :: k) b.
((forall a. EventM x a -> EventM x a) -> EventM x b) -> EventM x b
$cp2MonadAsyncException :: forall k (x :: k). MonadException (EventM x)
$cp1MonadAsyncException :: forall k (x :: k). MonadIO (EventM x)
MonadAsyncException)

newtype MergeSubscribedParent x a = MergeSubscribedParent { MergeSubscribedParent x a -> EventSubscription x
unMergeSubscribedParent :: EventSubscription x }

data MergeSubscribedParentWithMove x k a = MergeSubscribedParentWithMove
  { MergeSubscribedParentWithMove x k a -> EventSubscription x
_mergeSubscribedParentWithMove_subscription :: !(EventSubscription x)
  , MergeSubscribedParentWithMove x k a -> IORef (k a)
_mergeSubscribedParentWithMove_key :: !(IORef (k a))
  }

data HeightBag = HeightBag
  { HeightBag -> Int
_heightBag_size :: {-# UNPACK #-} !Int
  , HeightBag -> IntMap Word
_heightBag_contents :: !(IntMap Word) -- Number of excess in each bucket
  }
  deriving (Int -> HeightBag -> String -> String
[HeightBag] -> String -> String
HeightBag -> String
(Int -> HeightBag -> String -> String)
-> (HeightBag -> String)
-> ([HeightBag] -> String -> String)
-> Show HeightBag
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [HeightBag] -> String -> String
$cshowList :: [HeightBag] -> String -> String
show :: HeightBag -> String
$cshow :: HeightBag -> String
showsPrec :: Int -> HeightBag -> String -> String
$cshowsPrec :: Int -> HeightBag -> String -> String
Show, ReadPrec [HeightBag]
ReadPrec HeightBag
Int -> ReadS HeightBag
ReadS [HeightBag]
(Int -> ReadS HeightBag)
-> ReadS [HeightBag]
-> ReadPrec HeightBag
-> ReadPrec [HeightBag]
-> Read HeightBag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HeightBag]
$creadListPrec :: ReadPrec [HeightBag]
readPrec :: ReadPrec HeightBag
$creadPrec :: ReadPrec HeightBag
readList :: ReadS [HeightBag]
$creadList :: ReadS [HeightBag]
readsPrec :: Int -> ReadS HeightBag
$creadsPrec :: Int -> ReadS HeightBag
Read, HeightBag -> HeightBag -> Bool
(HeightBag -> HeightBag -> Bool)
-> (HeightBag -> HeightBag -> Bool) -> Eq HeightBag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeightBag -> HeightBag -> Bool
$c/= :: HeightBag -> HeightBag -> Bool
== :: HeightBag -> HeightBag -> Bool
$c== :: HeightBag -> HeightBag -> Bool
Eq, Eq HeightBag
Eq HeightBag =>
(HeightBag -> HeightBag -> Ordering)
-> (HeightBag -> HeightBag -> Bool)
-> (HeightBag -> HeightBag -> Bool)
-> (HeightBag -> HeightBag -> Bool)
-> (HeightBag -> HeightBag -> Bool)
-> (HeightBag -> HeightBag -> HeightBag)
-> (HeightBag -> HeightBag -> HeightBag)
-> Ord HeightBag
HeightBag -> HeightBag -> Bool
HeightBag -> HeightBag -> Ordering
HeightBag -> HeightBag -> HeightBag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HeightBag -> HeightBag -> HeightBag
$cmin :: HeightBag -> HeightBag -> HeightBag
max :: HeightBag -> HeightBag -> HeightBag
$cmax :: HeightBag -> HeightBag -> HeightBag
>= :: HeightBag -> HeightBag -> Bool
$c>= :: HeightBag -> HeightBag -> Bool
> :: HeightBag -> HeightBag -> Bool
$c> :: HeightBag -> HeightBag -> Bool
<= :: HeightBag -> HeightBag -> Bool
$c<= :: HeightBag -> HeightBag -> Bool
< :: HeightBag -> HeightBag -> Bool
$c< :: HeightBag -> HeightBag -> Bool
compare :: HeightBag -> HeightBag -> Ordering
$ccompare :: HeightBag -> HeightBag -> Ordering
$cp1Ord :: Eq HeightBag
Ord)

heightBagEmpty :: HeightBag
heightBagEmpty :: HeightBag
heightBagEmpty = HeightBag -> HeightBag
heightBagVerify (HeightBag -> HeightBag) -> HeightBag -> HeightBag
forall a b. (a -> b) -> a -> b
$ Int -> IntMap Word -> HeightBag
HeightBag 0 IntMap Word
forall a. IntMap a
IntMap.empty

heightBagSize :: HeightBag -> Int
heightBagSize :: HeightBag -> Int
heightBagSize = HeightBag -> Int
_heightBag_size

heightBagFromList :: [Height] -> HeightBag
heightBagFromList :: [Height] -> HeightBag
heightBagFromList heights :: [Height]
heights = HeightBag -> HeightBag
heightBagVerify (HeightBag -> HeightBag) -> HeightBag -> HeightBag
forall a b. (a -> b) -> a -> b
$ (HeightBag -> Height -> HeightBag)
-> HeightBag -> [Height] -> HeightBag
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Height -> HeightBag -> HeightBag)
-> HeightBag -> Height -> HeightBag
forall a b c. (a -> b -> c) -> b -> a -> c
flip Height -> HeightBag -> HeightBag
heightBagAdd) HeightBag
heightBagEmpty [Height]
heights

heightBagAdd :: Height -> HeightBag -> HeightBag
heightBagAdd :: Height -> HeightBag -> HeightBag
heightBagAdd (Height h :: Int
h) (HeightBag s :: Int
s c :: IntMap Word
c) = HeightBag -> HeightBag
heightBagVerify (HeightBag -> HeightBag) -> HeightBag -> HeightBag
forall a b. (a -> b) -> a -> b
$ Int -> IntMap Word -> HeightBag
HeightBag (Int -> Int
forall a. Enum a => a -> a
succ Int
s) (IntMap Word -> HeightBag) -> IntMap Word -> HeightBag
forall a b. (a -> b) -> a -> b
$
  (Int -> Word -> Word -> Word)
-> Int -> Word -> IntMap Word -> IntMap Word
forall a. (Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IntMap.insertWithKey (\_ _ old :: Word
old -> Word -> Word
forall a. Enum a => a -> a
succ Word
old) Int
h 0 IntMap Word
c

heightBagRemove :: Height -> HeightBag -> HeightBag
heightBagRemove :: Height -> HeightBag -> HeightBag
heightBagRemove (Height h :: Int
h) b :: HeightBag
b@(HeightBag s :: Int
s c :: IntMap Word
c) = HeightBag -> HeightBag
heightBagVerify (HeightBag -> HeightBag) -> HeightBag -> HeightBag
forall a b. (a -> b) -> a -> b
$ case Int -> IntMap Word -> Maybe Word
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
h IntMap Word
c of
  Nothing -> String -> HeightBag
forall a. HasCallStack => String -> a
error (String -> HeightBag) -> String -> HeightBag
forall a b. (a -> b) -> a -> b
$ "heightBagRemove: Height " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
h String -> String -> String
forall a. Semigroup a => a -> a -> a
<> " not present in bag " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HeightBag -> String
forall a. Show a => a -> String
show HeightBag
b
  Just old :: Word
old -> Int -> IntMap Word -> HeightBag
HeightBag (Int -> Int
forall a. Enum a => a -> a
pred Int
s) (IntMap Word -> HeightBag) -> IntMap Word -> HeightBag
forall a b. (a -> b) -> a -> b
$ case Word
old of
    0 -> Int -> IntMap Word -> IntMap Word
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
h IntMap Word
c
    _ -> Int -> Word -> IntMap Word -> IntMap Word
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
h (Word -> Word
forall a. Enum a => a -> a
pred Word
old) IntMap Word
c

heightBagRemoveMaybe :: Height -> HeightBag -> Maybe HeightBag
heightBagRemoveMaybe :: Height -> HeightBag -> Maybe HeightBag
heightBagRemoveMaybe (Height h :: Int
h) b :: HeightBag
b@(HeightBag s :: Int
s c :: IntMap Word
c) = HeightBag -> HeightBag
heightBagVerify (HeightBag -> HeightBag)
-> (Word -> HeightBag) -> Word -> HeightBag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> HeightBag
removed (Word -> HeightBag) -> Maybe Word -> Maybe HeightBag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IntMap Word -> Maybe Word
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
h IntMap Word
c where
  removed :: Word -> HeightBag
removed old :: Word
old = Int -> IntMap Word -> HeightBag
HeightBag (Int -> Int
forall a. Enum a => a -> a
pred Int
s) (IntMap Word -> HeightBag) -> IntMap Word -> HeightBag
forall a b. (a -> b) -> a -> b
$ case Word
old of
    0 -> Int -> IntMap Word -> IntMap Word
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
h IntMap Word
c
    _ -> Int -> Word -> IntMap Word -> IntMap Word
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
h (Word -> Word
forall a. Enum a => a -> a
pred Word
old) IntMap Word
c


heightBagMax :: HeightBag -> Height
heightBagMax :: HeightBag -> Height
heightBagMax (HeightBag _ c :: IntMap Word
c) = case IntMap Word -> Maybe ((Int, Word), IntMap Word)
forall a. IntMap a -> Maybe ((Int, a), IntMap a)
IntMap.maxViewWithKey IntMap Word
c of
  Just ((h :: Int
h, _), _) -> Int -> Height
Height Int
h
  Nothing -> Height
zeroHeight

heightBagVerify :: HeightBag -> HeightBag
#ifdef DEBUG
heightBagVerify b@(HeightBag s c) = if
  | s /= IntMap.size c + fromIntegral (sum (IntMap.elems c))
    -> error $ "heightBagVerify: size doesn't match: " <> show b
  | unHeight invalidHeight `IntMap.member` c
    -> error $ "heightBagVerify: contains invalid height: " <> show b
  | otherwise -> b
#else
heightBagVerify :: HeightBag -> HeightBag
heightBagVerify = HeightBag -> HeightBag
forall a. a -> a
id
#endif

data FanSubscribedChildren x k v a = FanSubscribedChildren
  { FanSubscribedChildren x k v a -> WeakBag (Subscriber x (v a))
_fanSubscribedChildren_list :: !(WeakBag (Subscriber x (v a)))
  , FanSubscribedChildren x k v a -> (k a, FanSubscribed x k v)
_fanSubscribedChildren_self :: {-# NOUNPACK #-} !(k a, FanSubscribed x k v)
  , FanSubscribedChildren x k v a
-> IORef (Weak (k a, FanSubscribed x k v))
_fanSubscribedChildren_weakSelf :: !(IORef (Weak (k a, FanSubscribed x k v)))
  }

data FanSubscribed x k v
   = FanSubscribed { FanSubscribed x k v -> IORef (Maybe (FanSubscribed x k v))
fanSubscribedCachedSubscribed :: !(IORef (Maybe (FanSubscribed x k v)))
                   , FanSubscribed x k v -> IORef (Maybe (DMap k v))
fanSubscribedOccurrence :: !(IORef (Maybe (DMap k v)))
                   , FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
fanSubscribedSubscribers :: !(IORef (DMap k (FanSubscribedChildren x k v))) -- This DMap should never be empty
                   , FanSubscribed x k v -> EventSubscription x
fanSubscribedParent :: !(EventSubscription x)
#ifdef DEBUG_NODEIDS
                   , fanSubscribedNodeId :: Int
#endif
                   }

data Fan x k v
   = Fan { Fan x k v -> Event x (DMap k v)
fanParent :: !(Event x (DMap k v))
         , Fan x k v -> IORef (Maybe (FanSubscribed x k v))
fanSubscribed :: !(IORef (Maybe (FanSubscribed x k v)))
         }

data SwitchSubscribed x a
   = SwitchSubscribed { SwitchSubscribed x a -> IORef (Maybe (SwitchSubscribed x a))
switchSubscribedCachedSubscribed :: !(IORef (Maybe (SwitchSubscribed x a)))
                      , SwitchSubscribed x a -> IORef (Maybe a)
switchSubscribedOccurrence :: !(IORef (Maybe a))
                      , SwitchSubscribed x a -> IORef Height
switchSubscribedHeight :: !(IORef Height)
                      , SwitchSubscribed x a -> WeakBag (Subscriber x a)
switchSubscribedSubscribers :: !(WeakBag (Subscriber x a))
                      , SwitchSubscribed x a -> Invalidator x
switchSubscribedOwnInvalidator :: {-# NOUNPACK #-} !(Invalidator x)
                      , SwitchSubscribed x a -> IORef (Weak (Invalidator x))
switchSubscribedOwnWeakInvalidator :: !(IORef (Weak (Invalidator x)))
                      , SwitchSubscribed x a -> IORef [SomeBehaviorSubscribed x]
switchSubscribedBehaviorParents :: !(IORef [SomeBehaviorSubscribed x])
                      , SwitchSubscribed x a -> Behavior x (Event x a)
switchSubscribedParent :: !(Behavior x (Event x a))
                      , SwitchSubscribed x a -> IORef (EventSubscription x)
switchSubscribedCurrentParent :: !(IORef (EventSubscription x))
                      , SwitchSubscribed x a -> IORef (Weak (SwitchSubscribed x a))
switchSubscribedWeakSelf :: !(IORef (Weak (SwitchSubscribed x a)))
#ifdef DEBUG_NODEIDS
                      , switchSubscribedNodeId :: Int
#endif
                      }

data Switch x a
   = Switch { Switch x a -> Behavior x (Event x a)
switchParent :: !(Behavior x (Event x a))
            , Switch x a -> IORef (Maybe (SwitchSubscribed x a))
switchSubscribed :: !(IORef (Maybe (SwitchSubscribed x a)))
            }

#ifdef USE_TEMPLATE_HASKELL
{-# ANN CoincidenceSubscribed "HLint: ignore Redundant bracket" #-}
#endif
data CoincidenceSubscribed x a
   = CoincidenceSubscribed { CoincidenceSubscribed x a
-> IORef (Maybe (CoincidenceSubscribed x a))
coincidenceSubscribedCachedSubscribed :: !(IORef (Maybe (CoincidenceSubscribed x a)))
                           , CoincidenceSubscribed x a -> IORef (Maybe a)
coincidenceSubscribedOccurrence :: !(IORef (Maybe a))
                           , CoincidenceSubscribed x a -> WeakBag (Subscriber x a)
coincidenceSubscribedSubscribers :: !(WeakBag (Subscriber x a))
                           , CoincidenceSubscribed x a -> IORef Height
coincidenceSubscribedHeight :: !(IORef Height)
                           , CoincidenceSubscribed x a -> Subscriber x (Event x a)
coincidenceSubscribedOuter :: {-# NOUNPACK #-} (Subscriber x (Event x a))
                           , CoincidenceSubscribed x a -> EventSubscription x
coincidenceSubscribedOuterParent :: !(EventSubscription x)
                           , CoincidenceSubscribed x a -> IORef (Maybe (EventSubscribed x))
coincidenceSubscribedInnerParent :: !(IORef (Maybe (EventSubscribed x)))
                           , CoincidenceSubscribed x a
-> IORef (Weak (CoincidenceSubscribed x a))
coincidenceSubscribedWeakSelf :: !(IORef (Weak (CoincidenceSubscribed x a)))
#ifdef DEBUG_NODEIDS
                           , coincidenceSubscribedNodeId :: Int
#endif
                           }

data Coincidence x a
   = Coincidence { Coincidence x a -> Event x (Event x a)
coincidenceParent :: !(Event x (Event x a))
                 , Coincidence x a -> IORef (Maybe (CoincidenceSubscribed x a))
coincidenceSubscribed :: !(IORef (Maybe (CoincidenceSubscribed x a)))
                 }

{-# NOINLINE newInvalidatorSwitch #-}
newInvalidatorSwitch :: SwitchSubscribed x a -> IO (Invalidator x)
newInvalidatorSwitch :: SwitchSubscribed x a -> IO (Invalidator x)
newInvalidatorSwitch subd :: SwitchSubscribed x a
subd = Invalidator x -> IO (Invalidator x)
forall (m :: * -> *) a. Monad m => a -> m a
return (Invalidator x -> IO (Invalidator x))
-> Invalidator x -> IO (Invalidator x)
forall a b. (a -> b) -> a -> b
$! SwitchSubscribed x a -> Invalidator x
forall k (x :: k) a. SwitchSubscribed x a -> Invalidator x
InvalidatorSwitch SwitchSubscribed x a
subd

{-# NOINLINE newInvalidatorPull #-}
newInvalidatorPull :: Pull x a -> IO (Invalidator x)
newInvalidatorPull :: Pull x a -> IO (Invalidator x)
newInvalidatorPull p :: Pull x a
p = Invalidator x -> IO (Invalidator x)
forall (m :: * -> *) a. Monad m => a -> m a
return (Invalidator x -> IO (Invalidator x))
-> Invalidator x -> IO (Invalidator x)
forall a b. (a -> b) -> a -> b
$! Pull x a -> Invalidator x
forall k (x :: k) a. Pull x a -> Invalidator x
InvalidatorPull Pull x a
p

instance HasSpiderTimeline x => Filterable (Event x) where
  mapMaybe :: (a -> Maybe b) -> Event x a -> Event x b
mapMaybe f :: a -> Maybe b
f = (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
forall x a b.
HasSpiderTimeline x =>
(a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
push ((a -> ComputeM x (Maybe b)) -> Event x a -> Event x b)
-> (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
forall a b. (a -> b) -> a -> b
$ Maybe b -> ComputeM x (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> ComputeM x (Maybe b))
-> (a -> Maybe b) -> a -> ComputeM x (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
f

instance HasSpiderTimeline x => Align (Event x) where
  nil :: Event x a
nil = Event x a
forall k (x :: k) a. Event x a
eventNever
#if MIN_VERSION_these(0, 8, 0)
instance HasSpiderTimeline x => Semialign (Event x) where
#endif
  align :: Event x a -> Event x b -> Event x (These a b)
align ea :: Event x a
ea eb :: Event x b
eb = (DMap (EitherTag a b) Identity -> Maybe (These a b))
-> Event x (DMap (EitherTag a b) Identity) -> Event x (These a b)
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe DMap (EitherTag a b) Identity -> Maybe (These a b)
forall a b. DMap (EitherTag a b) Identity -> Maybe (These a b)
dmapToThese (Event x (DMap (EitherTag a b) Identity) -> Event x (These a b))
-> Event x (DMap (EitherTag a b) Identity) -> Event x (These a b)
forall a b. (a -> b) -> a -> b
$ (forall a. Event x a -> Event x (Identity a))
-> DynamicS x (PatchDMap (EitherTag a b) (Event x))
-> Event x (DMap (EitherTag a b) Identity)
forall k (k :: k -> *) (q :: k -> *) x (v :: k -> *).
(HasSpiderTimeline x, GCompare k) =>
(forall (a :: k). q a -> Event x (v a))
-> DynamicS x (PatchDMap k q) -> Event x (DMap k v)
mergeG forall a. Event x a -> Event x (Identity a)
forall a b. Coercible a b => a -> b
coerce (DynamicS x (PatchDMap (EitherTag a b) (Event x))
 -> Event x (DMap (EitherTag a b) Identity))
-> DynamicS x (PatchDMap (EitherTag a b) (Event x))
-> Event x (DMap (EitherTag a b) Identity)
forall a b. (a -> b) -> a -> b
$ PatchTarget (PatchDMap (EitherTag a b) (Event x))
-> DynamicS x (PatchDMap (EitherTag a b) (Event x))
forall k p (x :: k). PatchTarget p -> DynamicS x p
dynamicConst (PatchTarget (PatchDMap (EitherTag a b) (Event x))
 -> DynamicS x (PatchDMap (EitherTag a b) (Event x)))
-> PatchTarget (PatchDMap (EitherTag a b) (Event x))
-> DynamicS x (PatchDMap (EitherTag a b) (Event x))
forall a b. (a -> b) -> a -> b
$
     [DSum (EitherTag a b) (Event x)] -> DMap (EitherTag a b) (Event x)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). [DSum k2 f] -> DMap k2 f
DMap.fromDistinctAscList [EitherTag a b a
forall k (l :: k) (r :: k). EitherTag l r l
LeftTag EitherTag a b a -> Event x a -> DSum (EitherTag a b) (Event x)
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> Event x a
ea, EitherTag a b b
forall k (l :: k) (r :: k). EitherTag l r r
RightTag EitherTag a b b -> Event x b -> DSum (EitherTag a b) (Event x)
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> Event x b
eb]

#ifdef MIN_VERSION_semialign
#if MIN_VERSION_semialign(1,1,0)
instance HasSpiderTimeline x => Zip (Event x) where
#endif
  zip :: Event x a -> Event x b -> Event x (a, b)
zip x :: Event x a
x y :: Event x b
y = (These a b -> Maybe (a, b))
-> Event x (These a b) -> Event x (a, b)
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe These a b -> Maybe (a, b)
forall a b. These a b -> Maybe (a, b)
justThese (Event x (These a b) -> Event x (a, b))
-> Event x (These a b) -> Event x (a, b)
forall a b. (a -> b) -> a -> b
$ Event x a -> Event x b -> Event x (These a b)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Event x a
x Event x b
y
#endif

data DynType x p = UnsafeDyn !(BehaviorM x (PatchTarget p), Event x p)
                 | BuildDyn  !(EventM x (PatchTarget p), Event x p)
                 | HoldDyn   !(Hold x p)

newtype Dyn (x :: Type) p = Dyn { Dyn x p -> IORef (DynType x p)
unDyn :: IORef (DynType x p) }

newMapDyn :: HasSpiderTimeline x => (a -> b) -> DynamicS x (Identity a) -> DynamicS x (Identity b)
newMapDyn :: (a -> b) -> DynamicS x (Identity a) -> DynamicS x (Identity b)
newMapDyn f :: a -> b
f d :: DynamicS x (Identity a)
d = Dyn x (Identity b) -> DynamicS x (Identity b)
forall x a.
HasSpiderTimeline x =>
Dyn x (Identity a) -> DynamicS x (Identity a)
dynamicDynIdentity (Dyn x (Identity b) -> DynamicS x (Identity b))
-> Dyn x (Identity b) -> DynamicS x (Identity b)
forall a b. (a -> b) -> a -> b
$ BehaviorM x (PatchTarget (Identity b))
-> Event x (Identity b) -> Dyn x (Identity b)
forall x p. BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
unsafeBuildDynamic ((a -> b) -> BehaviorM x a -> BehaviorM x b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (BehaviorM x a -> BehaviorM x (PatchTarget (Identity b)))
-> BehaviorM x a -> BehaviorM x (PatchTarget (Identity b))
forall a b. (a -> b) -> a -> b
$ Behavior x a -> BehaviorM x a
forall k (x :: k) a. Behavior x a -> BehaviorM x a
readBehaviorTracked (Behavior x a -> BehaviorM x a) -> Behavior x a -> BehaviorM x a
forall a b. (a -> b) -> a -> b
$ Dynamic x a (Identity a) -> Behavior x a
forall k (x :: k) target p. Dynamic x target p -> Behavior x target
dynamicCurrent Dynamic x a (Identity a)
DynamicS x (Identity a)
d) (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (Identity a -> b) -> Identity a -> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f (a -> b) -> (Identity a -> a) -> Identity a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> Identity b)
-> Event x (Identity a) -> Event x (Identity b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic x a (Identity a) -> Event x (Identity a)
forall k (x :: k) target p. Dynamic x target p -> Event x p
dynamicUpdated Dynamic x a (Identity a)
DynamicS x (Identity a)
d)

--TODO: Avoid the duplication between this and R.zipDynWith
zipDynWith :: HasSpiderTimeline x => (a -> b -> c) -> DynamicS x (Identity a) -> DynamicS x (Identity b) -> DynamicS x (Identity c)
zipDynWith :: (a -> b -> c)
-> DynamicS x (Identity a)
-> DynamicS x (Identity b)
-> DynamicS x (Identity c)
zipDynWith f :: a -> b -> c
f da :: DynamicS x (Identity a)
da db :: DynamicS x (Identity b)
db =
  let eab :: Event x (These (Identity a) (Identity b))
eab = Event x (Identity a)
-> Event x (Identity b)
-> Event x (These (Identity a) (Identity b))
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align (Dynamic x a (Identity a) -> Event x (Identity a)
forall k (x :: k) target p. Dynamic x target p -> Event x p
dynamicUpdated Dynamic x a (Identity a)
DynamicS x (Identity a)
da) (Dynamic x b (Identity b) -> Event x (Identity b)
forall k (x :: k) target p. Dynamic x target p -> Event x p
dynamicUpdated Dynamic x b (Identity b)
DynamicS x (Identity b)
db)
      ec :: Event x (Identity c)
ec = ((These (Identity a) (Identity b)
  -> ComputeM x (Maybe (Identity c)))
 -> Event x (These (Identity a) (Identity b))
 -> Event x (Identity c))
-> Event x (These (Identity a) (Identity b))
-> (These (Identity a) (Identity b)
    -> ComputeM x (Maybe (Identity c)))
-> Event x (Identity c)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (These (Identity a) (Identity b)
 -> ComputeM x (Maybe (Identity c)))
-> Event x (These (Identity a) (Identity b))
-> Event x (Identity c)
forall x a b.
HasSpiderTimeline x =>
(a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
push Event x (These (Identity a) (Identity b))
eab ((These (Identity a) (Identity b)
  -> ComputeM x (Maybe (Identity c)))
 -> Event x (Identity c))
-> (These (Identity a) (Identity b)
    -> ComputeM x (Maybe (Identity c)))
-> Event x (Identity c)
forall a b. (a -> b) -> a -> b
$ \o :: These (Identity a) (Identity b)
o -> do
        (a :: a
a, b :: b
b) <- case These (Identity a) (Identity b)
o of
          This (Identity a :: a
a) -> do
            b
b <- Behavior x b -> EventM x b
forall k (x :: k) (m :: * -> *) a.
Defer (SomeHoldInit x) m =>
Behavior x a -> m a
readBehaviorUntracked (Behavior x b -> EventM x b) -> Behavior x b -> EventM x b
forall a b. (a -> b) -> a -> b
$ Dynamic x b (Identity b) -> Behavior x b
forall k (x :: k) target p. Dynamic x target p -> Behavior x target
dynamicCurrent Dynamic x b (Identity b)
DynamicS x (Identity b)
db
            (a, b) -> EventM x (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)
          That (Identity b :: b
b) -> do
            a
a <- Behavior x a -> EventM x a
forall k (x :: k) (m :: * -> *) a.
Defer (SomeHoldInit x) m =>
Behavior x a -> m a
readBehaviorUntracked (Behavior x a -> EventM x a) -> Behavior x a -> EventM x a
forall a b. (a -> b) -> a -> b
$ Dynamic x a (Identity a) -> Behavior x a
forall k (x :: k) target p. Dynamic x target p -> Behavior x target
dynamicCurrent Dynamic x a (Identity a)
DynamicS x (Identity a)
da
            (a, b) -> EventM x (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)
          These (Identity a :: a
a) (Identity b :: b
b) -> (a, b) -> EventM x (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)
        Maybe (Identity c) -> ComputeM x (Maybe (Identity c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Identity c) -> ComputeM x (Maybe (Identity c)))
-> Maybe (Identity c) -> ComputeM x (Maybe (Identity c))
forall a b. (a -> b) -> a -> b
$ Identity c -> Maybe (Identity c)
forall a. a -> Maybe a
Just (Identity c -> Maybe (Identity c))
-> Identity c -> Maybe (Identity c)
forall a b. (a -> b) -> a -> b
$ c -> Identity c
forall a. a -> Identity a
Identity (c -> Identity c) -> c -> Identity c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
a b
b
  in Dyn x (Identity c) -> DynamicS x (Identity c)
forall x a.
HasSpiderTimeline x =>
Dyn x (Identity a) -> DynamicS x (Identity a)
dynamicDynIdentity (Dyn x (Identity c) -> DynamicS x (Identity c))
-> Dyn x (Identity c) -> DynamicS x (Identity c)
forall a b. (a -> b) -> a -> b
$ BehaviorM x (PatchTarget (Identity c))
-> Event x (Identity c) -> Dyn x (Identity c)
forall x p. BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
unsafeBuildDynamic (a -> b -> c
f (a -> b -> c) -> BehaviorM x a -> BehaviorM x (b -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior x a -> BehaviorM x a
forall k (x :: k) (m :: * -> *) a.
Defer (SomeHoldInit x) m =>
Behavior x a -> m a
readBehaviorUntracked (Dynamic x a (Identity a) -> Behavior x a
forall k (x :: k) target p. Dynamic x target p -> Behavior x target
dynamicCurrent Dynamic x a (Identity a)
DynamicS x (Identity a)
da) BehaviorM x (b -> c) -> BehaviorM x b -> BehaviorM x c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior x b -> BehaviorM x b
forall k (x :: k) (m :: * -> *) a.
Defer (SomeHoldInit x) m =>
Behavior x a -> m a
readBehaviorUntracked (Dynamic x b (Identity b) -> Behavior x b
forall k (x :: k) target p. Dynamic x target p -> Behavior x target
dynamicCurrent Dynamic x b (Identity b)
DynamicS x (Identity b)
db)) Event x (Identity c)
ec

buildDynamic :: (Defer (SomeDynInit x) m, Patch p) => EventM x (PatchTarget p) -> Event x p -> m (Dyn x p)
buildDynamic :: EventM x (PatchTarget p) -> Event x p -> m (Dyn x p)
buildDynamic readV0 :: EventM x (PatchTarget p)
readV0 v' :: Event x p
v' = do
  IORef (DynType x p)
result <- IO (IORef (DynType x p)) -> m (IORef (DynType x p))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (DynType x p)) -> m (IORef (DynType x p)))
-> IO (IORef (DynType x p)) -> m (IORef (DynType x p))
forall a b. (a -> b) -> a -> b
$ DynType x p -> IO (IORef (DynType x p))
forall a. a -> IO (IORef a)
newIORef (DynType x p -> IO (IORef (DynType x p)))
-> DynType x p -> IO (IORef (DynType x p))
forall a b. (a -> b) -> a -> b
$ (EventM x (PatchTarget p), Event x p) -> DynType x p
forall k (x :: k) p.
(EventM x (PatchTarget p), Event x p) -> DynType x p
BuildDyn (EventM x (PatchTarget p)
readV0, Event x p
v')
  let !d :: Dyn x p
d = IORef (DynType x p) -> Dyn x p
forall x p. IORef (DynType x p) -> Dyn x p
Dyn IORef (DynType x p)
result
  SomeDynInit x -> m ()
forall a (m :: * -> *). Defer a m => a -> m ()
defer (SomeDynInit x -> m ()) -> SomeDynInit x -> m ()
forall a b. (a -> b) -> a -> b
$ Dyn x p -> SomeDynInit x
forall x p. Patch p => Dyn x p -> SomeDynInit x
SomeDynInit Dyn x p
d
  Dyn x p -> m (Dyn x p)
forall (m :: * -> *) a. Monad m => a -> m a
return Dyn x p
d

unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
unsafeBuildDynamic readV0 :: BehaviorM x (PatchTarget p)
readV0 v' :: Event x p
v' =
  IORef (DynType x p) -> Dyn x p
forall x p. IORef (DynType x p) -> Dyn x p
Dyn (IORef (DynType x p) -> Dyn x p) -> IORef (DynType x p) -> Dyn x p
forall a b. (a -> b) -> a -> b
$ IO (IORef (DynType x p)) -> IORef (DynType x p)
forall a. IO a -> a
unsafePerformIO (IO (IORef (DynType x p)) -> IORef (DynType x p))
-> IO (IORef (DynType x p)) -> IORef (DynType x p)
forall a b. (a -> b) -> a -> b
$ DynType x p -> IO (IORef (DynType x p))
forall a. a -> IO (IORef a)
newIORef (DynType x p -> IO (IORef (DynType x p)))
-> DynType x p -> IO (IORef (DynType x p))
forall a b. (a -> b) -> a -> b
$ (BehaviorM x (PatchTarget p), Event x p) -> DynType x p
forall k (x :: k) p.
(BehaviorM x (PatchTarget p), Event x p) -> DynType x p
UnsafeDyn (BehaviorM x (PatchTarget p)
readV0, Event x p
v')

-- ResultM can read behaviors and events
type ResultM = EventM

instance HasSpiderTimeline x => Functor (Event x) where
  fmap :: (a -> b) -> Event x a -> Event x b
fmap f :: a -> b
f = (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
forall x a b.
HasSpiderTimeline x =>
(a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
push ((a -> ComputeM x (Maybe b)) -> Event x a -> Event x b)
-> (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
forall a b. (a -> b) -> a -> b
$ Maybe b -> ComputeM x (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> ComputeM x (Maybe b))
-> (a -> Maybe b) -> a -> ComputeM x (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> (a -> b) -> a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

instance Functor (Behavior x) where
  fmap :: (a -> b) -> Behavior x a -> Behavior x b
fmap f :: a -> b
f = BehaviorM x b -> Behavior x b
forall k (x :: k) a. BehaviorM x a -> Behavior x a
pull (BehaviorM x b -> Behavior x b)
-> (Behavior x a -> BehaviorM x b) -> Behavior x a -> Behavior x b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> BehaviorM x a -> BehaviorM x b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (BehaviorM x a -> BehaviorM x b)
-> (Behavior x a -> BehaviorM x a) -> Behavior x a -> BehaviorM x b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior x a -> BehaviorM x a
forall k (x :: k) a. Behavior x a -> BehaviorM x a
readBehaviorTracked

{-# INLINE push #-}
push :: HasSpiderTimeline x => (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
push :: (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
push f :: a -> ComputeM x (Maybe b)
f e :: Event x a
e = Event x b -> Event x b
forall x a. HasSpiderTimeline x => Event x a -> Event x a
cacheEvent ((a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
forall x a b.
HasSpiderTimeline x =>
(a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
pushCheap a -> ComputeM x (Maybe b)
f Event x a
e)

{-# INLINABLE pull #-}
pull :: BehaviorM x a -> Behavior x a
pull :: BehaviorM x a -> Behavior x a
pull a :: BehaviorM x a
a = IO (Behavior x a) -> Behavior x a
forall a. IO a -> a
unsafePerformIO (IO (Behavior x a) -> Behavior x a)
-> IO (Behavior x a) -> Behavior x a
forall a b. (a -> b) -> a -> b
$ do
  IORef (Maybe (PullSubscribed x a))
ref <- Maybe (PullSubscribed x a)
-> IO (IORef (Maybe (PullSubscribed x a)))
forall a. a -> IO (IORef a)
newIORef Maybe (PullSubscribed x a)
forall a. Maybe a
Nothing
#ifdef DEBUG_NODEIDS
  nid <- newNodeId
#endif
  Behavior x a -> IO (Behavior x a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Behavior x a -> IO (Behavior x a))
-> Behavior x a -> IO (Behavior x a)
forall a b. (a -> b) -> a -> b
$ Pull x a -> Behavior x a
forall k (x :: k) a. Pull x a -> Behavior x a
behaviorPull (Pull x a -> Behavior x a) -> Pull x a -> Behavior x a
forall a b. (a -> b) -> a -> b
$ $WPull :: forall k (x :: k) a.
IORef (Maybe (PullSubscribed x a)) -> BehaviorM x a -> Pull x a
Pull
    { pullCompute :: BehaviorM x a
pullCompute = BehaviorM x a
a
    , pullValue :: IORef (Maybe (PullSubscribed x a))
pullValue = IORef (Maybe (PullSubscribed x a))
ref
#ifdef DEBUG_NODEIDS
    , pullNodeId = nid
#endif
    }

{-# INLINABLE switch #-}
switch :: HasSpiderTimeline x => Behavior x (Event x a) -> Event x a
switch :: Behavior x (Event x a) -> Event x a
switch a :: Behavior x (Event x a)
a = IO (Event x a) -> Event x a
forall a. IO a -> a
unsafePerformIO (IO (Event x a) -> Event x a) -> IO (Event x a) -> Event x a
forall a b. (a -> b) -> a -> b
$ do
  IORef (Maybe (SwitchSubscribed x a))
ref <- Maybe (SwitchSubscribed x a)
-> IO (IORef (Maybe (SwitchSubscribed x a)))
forall a. a -> IO (IORef a)
newIORef Maybe (SwitchSubscribed x a)
forall a. Maybe a
Nothing
  Event x a -> IO (Event x a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event x a -> IO (Event x a)) -> Event x a -> IO (Event x a)
forall a b. (a -> b) -> a -> b
$ Switch x a -> Event x a
forall x a. HasSpiderTimeline x => Switch x a -> Event x a
eventSwitch (Switch x a -> Event x a) -> Switch x a -> Event x a
forall a b. (a -> b) -> a -> b
$ $WSwitch :: forall k (x :: k) a.
Behavior x (Event x a)
-> IORef (Maybe (SwitchSubscribed x a)) -> Switch x a
Switch
    { switchParent :: Behavior x (Event x a)
switchParent = Behavior x (Event x a)
a
    , switchSubscribed :: IORef (Maybe (SwitchSubscribed x a))
switchSubscribed = IORef (Maybe (SwitchSubscribed x a))
ref
    }

coincidence :: HasSpiderTimeline x => Event x (Event x a) -> Event x a
coincidence :: Event x (Event x a) -> Event x a
coincidence a :: Event x (Event x a)
a = IO (Event x a) -> Event x a
forall a. IO a -> a
unsafePerformIO (IO (Event x a) -> Event x a) -> IO (Event x a) -> Event x a
forall a b. (a -> b) -> a -> b
$ do
  IORef (Maybe (CoincidenceSubscribed x a))
ref <- Maybe (CoincidenceSubscribed x a)
-> IO (IORef (Maybe (CoincidenceSubscribed x a)))
forall a. a -> IO (IORef a)
newIORef Maybe (CoincidenceSubscribed x a)
forall a. Maybe a
Nothing
  Event x a -> IO (Event x a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event x a -> IO (Event x a)) -> Event x a -> IO (Event x a)
forall a b. (a -> b) -> a -> b
$ Coincidence x a -> Event x a
forall x a. HasSpiderTimeline x => Coincidence x a -> Event x a
eventCoincidence (Coincidence x a -> Event x a) -> Coincidence x a -> Event x a
forall a b. (a -> b) -> a -> b
$ $WCoincidence :: forall k (x :: k) a.
Event x (Event x a)
-> IORef (Maybe (CoincidenceSubscribed x a)) -> Coincidence x a
Coincidence
    { coincidenceParent :: Event x (Event x a)
coincidenceParent = Event x (Event x a)
a
    , coincidenceSubscribed :: IORef (Maybe (CoincidenceSubscribed x a))
coincidenceSubscribed = IORef (Maybe (CoincidenceSubscribed x a))
ref
    }

-- Propagate the given event occurrence; before cleaning up, run the given action, which may read the state of events and behaviors
run :: forall x b. HasSpiderTimeline x => [DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b
run :: [DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b
run roots :: [DSum (RootTrigger x) Identity]
roots after :: ResultM x b
after = do
  Proxy x -> String -> SpiderHost x ()
forall x (m :: * -> *) (proxy :: * -> *).
CanTrace x m =>
proxy x -> String -> m ()
tracePropagate (Proxy x
forall k (t :: k). Proxy t
Proxy :: Proxy x) (String -> SpiderHost x ()) -> String -> SpiderHost x ()
forall a b. (a -> b) -> a -> b
$ "Running an event frame with " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([DSum (RootTrigger x) Identity] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DSum (RootTrigger x) Identity]
roots) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> " events"
  let t :: SpiderTimelineEnv x
t = SpiderTimelineEnv x
forall x. HasSpiderTimeline x => SpiderTimelineEnv x
spiderTimeline :: SpiderTimelineEnv x
  b
result <- IO b -> SpiderHost x b
forall x a. IO a -> SpiderHost x a
SpiderHost (IO b -> SpiderHost x b) -> IO b -> SpiderHost x b
forall a b. (a -> b) -> a -> b
$ MVar () -> (() -> IO b) -> IO b
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (SpiderTimelineEnv' x -> MVar ()
forall x. SpiderTimelineEnv' x -> MVar ()
_spiderTimeline_lock (SpiderTimelineEnv x -> SpiderTimelineEnv' x
forall x. SpiderTimelineEnv x -> SpiderTimelineEnv' x
unSTE SpiderTimelineEnv x
t)) ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \_ -> SpiderHost x b -> IO b
forall x a. SpiderHost x a -> IO a
unSpiderHost (SpiderHost x b -> IO b) -> SpiderHost x b -> IO b
forall a b. (a -> b) -> a -> b
$ ResultM x b -> SpiderHost x b
forall x a. HasSpiderTimeline x => EventM x a -> SpiderHost x a
runFrame (ResultM x b -> SpiderHost x b) -> ResultM x b -> SpiderHost x b
forall a b. (a -> b) -> a -> b
$ do
    [Maybe (DSum (RootTrigger x) Identity)]
rootsToPropagate <- [DSum (RootTrigger x) Identity]
-> (DSum (RootTrigger x) Identity
    -> EventM x (Maybe (DSum (RootTrigger x) Identity)))
-> EventM x [Maybe (DSum (RootTrigger x) Identity)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [DSum (RootTrigger x) Identity]
roots ((DSum (RootTrigger x) Identity
  -> EventM x (Maybe (DSum (RootTrigger x) Identity)))
 -> EventM x [Maybe (DSum (RootTrigger x) Identity)])
-> (DSum (RootTrigger x) Identity
    -> EventM x (Maybe (DSum (RootTrigger x) Identity)))
-> EventM x [Maybe (DSum (RootTrigger x) Identity)]
forall a b. (a -> b) -> a -> b
$ \r :: DSum (RootTrigger x) Identity
r@(RootTrigger (_, occRef :: IORef (DMap k Identity)
occRef, k :: k a
k) :=> a :: Identity a
a) -> do
      DMap k Identity
occBefore <- IO (DMap k Identity) -> EventM x (DMap k Identity)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DMap k Identity) -> EventM x (DMap k Identity))
-> IO (DMap k Identity) -> EventM x (DMap k Identity)
forall a b. (a -> b) -> a -> b
$ do
        DMap k Identity
occBefore <- IORef (DMap k Identity) -> IO (DMap k Identity)
forall a. IORef a -> IO a
readIORef IORef (DMap k Identity)
occRef
        IORef (DMap k Identity) -> DMap k Identity -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (DMap k Identity)
occRef (DMap k Identity -> IO ()) -> DMap k Identity -> IO ()
forall a b. (a -> b) -> a -> b
$! k a -> Identity a -> DMap k Identity -> DMap k Identity
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> f v -> DMap k2 f -> DMap k2 f
DMap.insert k a
k Identity a
a DMap k Identity
occBefore
        DMap k Identity -> IO (DMap k Identity)
forall (m :: * -> *) a. Monad m => a -> m a
return DMap k Identity
occBefore
      if DMap k Identity -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap.null DMap k Identity
occBefore
        then do IORef (DMap k Identity) -> EventM x ()
forall (m :: * -> *) (k :: * -> *).
Defer (Some RootClear) m =>
IORef (DMap k Identity) -> m ()
scheduleRootClear IORef (DMap k Identity)
occRef
                Maybe (DSum (RootTrigger x) Identity)
-> EventM x (Maybe (DSum (RootTrigger x) Identity))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (DSum (RootTrigger x) Identity)
 -> EventM x (Maybe (DSum (RootTrigger x) Identity)))
-> Maybe (DSum (RootTrigger x) Identity)
-> EventM x (Maybe (DSum (RootTrigger x) Identity))
forall a b. (a -> b) -> a -> b
$ DSum (RootTrigger x) Identity
-> Maybe (DSum (RootTrigger x) Identity)
forall a. a -> Maybe a
Just DSum (RootTrigger x) Identity
r
        else Maybe (DSum (RootTrigger x) Identity)
-> EventM x (Maybe (DSum (RootTrigger x) Identity))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (DSum (RootTrigger x) Identity)
forall a. Maybe a
Nothing
    [DSum (RootTrigger x) Identity]
-> (DSum (RootTrigger x) Identity -> EventM x ()) -> EventM x ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Maybe (DSum (RootTrigger x) Identity)]
-> [DSum (RootTrigger x) Identity]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (DSum (RootTrigger x) Identity)]
rootsToPropagate) ((DSum (RootTrigger x) Identity -> EventM x ()) -> EventM x ())
-> (DSum (RootTrigger x) Identity -> EventM x ()) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ \(RootTrigger (subscribersRef, _, _) :=> Identity a) -> do
      a -> WeakBag (Subscriber x a) -> EventM x ()
forall x a.
HasSpiderTimeline x =>
a -> WeakBag (Subscriber x a) -> EventM x ()
propagate a
a WeakBag (Subscriber x a)
subscribersRef
    IORef (IntMap [EventM x ()])
delayedRef <- (EventEnv x -> IORef (IntMap [EventM x ()]))
-> EventM x (IORef (IntMap [EventM x ()]))
forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a
asksEventEnv EventEnv x -> IORef (IntMap [EventM x ()])
forall x. EventEnv x -> IORef (IntMap [EventM x ()])
eventEnvDelayedMerges
    let go :: EventM x ()
go = do
          IntMap [EventM x ()]
delayed <- IO (IntMap [EventM x ()]) -> EventM x (IntMap [EventM x ()])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IntMap [EventM x ()]) -> EventM x (IntMap [EventM x ()]))
-> IO (IntMap [EventM x ()]) -> EventM x (IntMap [EventM x ()])
forall a b. (a -> b) -> a -> b
$ IORef (IntMap [EventM x ()]) -> IO (IntMap [EventM x ()])
forall a. IORef a -> IO a
readIORef IORef (IntMap [EventM x ()])
delayedRef
          case IntMap [EventM x ()]
-> Maybe ((Int, [EventM x ()]), IntMap [EventM x ()])
forall a. IntMap a -> Maybe ((Int, a), IntMap a)
IntMap.minViewWithKey IntMap [EventM x ()]
delayed of
            Nothing -> () -> EventM x ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just ((currentHeight :: Int
currentHeight, cur :: [EventM x ()]
cur), future :: IntMap [EventM x ()]
future) -> do
              Proxy x -> String -> EventM x ()
forall x (m :: * -> *) (proxy :: * -> *).
CanTrace x m =>
proxy x -> String -> m ()
tracePropagate (Proxy x
forall k (t :: k). Proxy t
Proxy :: Proxy x) (String -> EventM x ()) -> String -> EventM x ()
forall a b. (a -> b) -> a -> b
$ "Running height " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
currentHeight
              Height -> EventM x ()
forall x. HasSpiderTimeline x => Height -> EventM x ()
putCurrentHeight (Height -> EventM x ()) -> Height -> EventM x ()
forall a b. (a -> b) -> a -> b
$ Int -> Height
Height Int
currentHeight
              IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (IntMap [EventM x ()]) -> IntMap [EventM x ()] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (IntMap [EventM x ()])
delayedRef (IntMap [EventM x ()] -> IO ()) -> IntMap [EventM x ()] -> IO ()
forall a b. (a -> b) -> a -> b
$! IntMap [EventM x ()]
future
              [EventM x ()] -> EventM x ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [EventM x ()]
cur
              EventM x ()
go
    EventM x ()
go
    Height -> EventM x ()
forall x. HasSpiderTimeline x => Height -> EventM x ()
putCurrentHeight Height
forall a. Bounded a => a
maxBound
    ResultM x b
after
  Proxy x -> String -> SpiderHost x ()
forall x (m :: * -> *) (proxy :: * -> *).
CanTrace x m =>
proxy x -> String -> m ()
tracePropagate (Proxy x
forall k (t :: k). Proxy t
Proxy :: Proxy x) "Done running an event frame"
  b -> SpiderHost x b
forall (m :: * -> *) a. Monad m => a -> m a
return b
result

scheduleMerge' :: HasSpiderTimeline x => Height -> IORef Height -> EventM x () -> EventM x ()
scheduleMerge' :: Height -> IORef Height -> EventM x () -> EventM x ()
scheduleMerge' initialHeight :: Height
initialHeight heightRef :: IORef Height
heightRef a :: EventM x ()
a = Height -> EventM x () -> EventM x ()
forall x (m :: * -> *).
HasCurrentHeight x m =>
Height -> EventM x () -> m ()
scheduleMerge Height
initialHeight (EventM x () -> EventM x ()) -> EventM x () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ do
  Height
height <- IO Height -> EventM x Height
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Height -> EventM x Height) -> IO Height -> EventM x Height
forall a b. (a -> b) -> a -> b
$ IORef Height -> IO Height
forall a. IORef a -> IO a
readIORef IORef Height
heightRef
  Height
currentHeight <- EventM x Height
forall x (m :: * -> *). HasCurrentHeight x m => m Height
getCurrentHeight
  case Height
height Height -> Height -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Height
currentHeight of
    LT -> String -> EventM x ()
forall a. HasCallStack => String -> a
error "Somehow a merge's height has been decreased after it was scheduled"
    GT -> Height -> IORef Height -> EventM x () -> EventM x ()
forall x.
HasSpiderTimeline x =>
Height -> IORef Height -> EventM x () -> EventM x ()
scheduleMerge' Height
height IORef Height
heightRef EventM x ()
a -- The height has been increased (by a coincidence event; TODO: is this the only way?)
    EQ -> EventM x ()
a

newtype Clear a = Clear (IORef (Maybe a))

newtype IntClear a = IntClear (IORef (IntMap a))

newtype RootClear k = RootClear (IORef (DMap k Identity))

data SomeAssignment x = forall a. SomeAssignment {-# UNPACK #-} !(IORef a) {-# UNPACK #-} !(IORef [Weak (Invalidator x)]) a

debugFinalize :: Bool
debugFinalize :: Bool
debugFinalize = Bool
False

mkWeakPtrWithDebug :: a -> String -> IO (Weak a)
mkWeakPtrWithDebug :: a -> String -> IO (Weak a)
mkWeakPtrWithDebug x :: a
x debugNote :: String
debugNote = do
  a
x' <- a -> IO a
forall a. a -> IO a
evaluate a
x
  a -> Maybe (IO ()) -> IO (Weak a)
forall k. k -> Maybe (IO ()) -> IO (Weak k)
mkWeakPtr a
x' (Maybe (IO ()) -> IO (Weak a)) -> Maybe (IO ()) -> IO (Weak a)
forall a b. (a -> b) -> a -> b
$
    if Bool
debugFinalize
    then IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ String -> IO ()
debugStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "finalizing: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
debugNote
    else Maybe (IO ())
forall a. Maybe a
Nothing

type WeakList a = [Weak a]

type CanTrace x m = (HasSpiderTimeline x, MonadIO m)




#ifdef DEBUG

debugSubscriber :: forall x a. HasSpiderTimeline x => String -> Subscriber x a -> IO (Subscriber x a)
debugSubscriber description = return . debugSubscriber' description

debugSubscriber' :: forall x a. HasSpiderTimeline x => String -> Subscriber x a -> Subscriber x a
debugSubscriber' description subscribed = Subscriber
  {
    subscriberPropagate = \m -> do
      tracePropagate (Proxy :: Proxy x) ("subscriberPropagate: " <> description)
      subscriberPropagate subscribed m
  , subscriberInvalidateHeight = \old -> do
      traceInvalidateHeight $ "invalidateSubscriberHeight: " <> description <> ", old = " <> show (unHeight old)
      subscriberInvalidateHeight subscribed old
      traceInvalidateHeight $ "invalidateSubscriberHeight: " <> description <> ", done"
  , subscriberRecalculateHeight = \new -> do
      traceInvalidateHeight $ "subscriberRecalculateHeight: " <> description <> ", new = " <> show (unHeight new)
      subscriberRecalculateHeight subscribed new
      traceInvalidateHeight $ "subscriberRecalculateHeight: " <> description <> ", done"
  }


{-# INLINE withIncreasedDepth #-}
withIncreasedDepth :: forall proxy x m a. CanTrace x m => proxy x -> m a -> m a
withIncreasedDepth _ a = do
  liftIO $ modifyIORef' (_spiderTimeline_depth $ unSTE (spiderTimeline :: SpiderTimelineEnv x)) succ
  result <- a
  liftIO $ modifyIORef' (_spiderTimeline_depth $ unSTE (spiderTimeline :: SpiderTimelineEnv x)) pred
  return result

{-# INLINE tracePropagate #-}
tracePropagate :: (CanTrace x m) => proxy x -> String -> m ()
tracePropagate p = when debugPropagate . trace p

{-# INLINE traceInvalidate #-}
traceInvalidate :: String -> IO ()
traceInvalidate = when debugInvalidate . liftIO . debugStrLn

{-# INLINE traceInvalidateHeight #-}
traceInvalidateHeight :: String -> IO ()
traceInvalidateHeight = when debugInvalidateHeight . liftIO . debugStrLn

{-# INLINE trace #-}
trace :: (CanTrace x m) => proxy x ->  String -> m ()
trace p message = traceM p $ return message

{-# INLINE traceM #-}
traceM :: forall x proxy m. (CanTrace x m) => proxy x -> m String -> m ()
traceM _ getMessage = do
  message <- getMessage
  d <- liftIO $ readIORef $ _spiderTimeline_depth $ unSTE (spiderTimeline :: SpiderTimelineEnv x)
  liftIO $ debugStrLn $ replicate d ' ' <> message

#else

{-# INLINE withIncreasedDepth #-}
withIncreasedDepth ::  proxy x -> m a -> m a
withIncreasedDepth :: proxy x -> m a -> m a
withIncreasedDepth _ = m a -> m a
forall a. a -> a
id

{-# INLINE tracePropagate #-}
tracePropagate :: (CanTrace x m) => proxy x -> String -> m ()
tracePropagate :: proxy x -> String -> m ()
tracePropagate _ _ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# INLINE traceInvalidate #-}
traceInvalidate :: String -> IO ()
traceInvalidate :: String -> IO ()
traceInvalidate _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# INLINE traceInvalidateHeight #-}
traceInvalidateHeight :: String -> IO ()
traceInvalidateHeight :: String -> IO ()
traceInvalidateHeight _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# INLINE debugSubscriber #-}
debugSubscriber :: String -> Subscriber x a -> IO (Subscriber x a)
debugSubscriber :: String -> Subscriber x a -> IO (Subscriber x a)
debugSubscriber _ = Subscriber x a -> IO (Subscriber x a)
forall (m :: * -> *) a. Monad m => a -> m a
return

{-# INLINE debugSubscriber' #-}
debugSubscriber' :: String -> Subscriber x a -> Subscriber x a
debugSubscriber' :: String -> Subscriber x a -> Subscriber x a
debugSubscriber' _ = Subscriber x a -> Subscriber x a
forall a. a -> a
id



{-# INLINE trace #-}
trace :: (CanTrace x m) => proxy x ->  String -> m ()
trace :: proxy x -> String -> m ()
trace _ _ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# INLINE traceM #-}
traceM :: (CanTrace x m) => proxy x -> m String -> m ()
traceM :: proxy x -> m String -> m ()
traceM _ _ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#endif

whoCreatedIORef :: IORef a -> IO [String]
whoCreatedIORef :: IORef a -> IO [String]
whoCreatedIORef (IORef a :: STRef RealWorld a
a) = STRef RealWorld a -> IO [String]
forall a. a -> IO [String]
whoCreated (STRef RealWorld a -> IO [String])
-> STRef RealWorld a -> IO [String]
forall a b. (a -> b) -> a -> b
$! STRef RealWorld a
a

groupByHead :: Eq a => [NonEmpty a] -> [(a, NonEmpty [a])]
groupByHead :: [NonEmpty a] -> [(a, NonEmpty [a])]
groupByHead = \case
  [] -> []
  (x :: a
x :| xs :: [a]
xs) : t :: [NonEmpty a]
t -> case [NonEmpty a] -> [(a, NonEmpty [a])]
forall a. Eq a => [NonEmpty a] -> [(a, NonEmpty [a])]
groupByHead [NonEmpty a]
t of
    [] -> [(a
x, [a]
xs [a] -> [[a]] -> NonEmpty [a]
forall a. a -> [a] -> NonEmpty a
:| [])]
    l :: [(a, NonEmpty [a])]
l@((y :: a
y, yss :: NonEmpty [a]
yss) : t' :: [(a, NonEmpty [a])]
t')
      | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y -> (a
x, [a]
xs [a] -> NonEmpty [a] -> NonEmpty [a]
forall a. a -> NonEmpty a -> NonEmpty a
`NonEmpty.cons` NonEmpty [a]
yss) (a, NonEmpty [a]) -> [(a, NonEmpty [a])] -> [(a, NonEmpty [a])]
forall a. a -> [a] -> [a]
: [(a, NonEmpty [a])]
t'
      | Bool
otherwise -> (a
x, [a]
xs [a] -> [[a]] -> NonEmpty [a]
forall a. a -> [a] -> NonEmpty a
:| []) (a, NonEmpty [a]) -> [(a, NonEmpty [a])] -> [(a, NonEmpty [a])]
forall a. a -> [a] -> [a]
: [(a, NonEmpty [a])]
l

listsToForest :: Eq a => [[a]] -> Forest a
listsToForest :: [[a]] -> Forest a
listsToForest lists :: [[a]]
lists = (a, NonEmpty [a]) -> Tree a
forall a (t :: * -> *). (Eq a, Foldable t) => (a, t [a]) -> Tree a
buildForest ((a, NonEmpty [a]) -> Tree a) -> [(a, NonEmpty [a])] -> Forest a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NonEmpty a] -> [(a, NonEmpty [a])]
forall a. Eq a => [NonEmpty a] -> [(a, NonEmpty [a])]
groupByHead (([a] -> Maybe (NonEmpty a)) -> [[a]] -> [NonEmpty a]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [[a]]
lists)
    where buildForest :: (a, t [a]) -> Tree a
buildForest (a :: a
a, lists' :: t [a]
lists') = a -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
Node a
a (Forest a -> Tree a) -> Forest a -> Tree a
forall a b. (a -> b) -> a -> b
$ [[a]] -> Forest a
forall a. Eq a => [[a]] -> Forest a
listsToForest ([[a]] -> Forest a) -> [[a]] -> Forest a
forall a b. (a -> b) -> a -> b
$ t [a] -> [[a]]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t [a]
lists'

showStacks :: [[String]] -> String
showStacks :: [[String]] -> String
showStacks = Forest String -> String
drawForest (Forest String -> String)
-> ([[String]] -> Forest String) -> [[String]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> Forest String
forall a. Eq a => [[a]] -> Forest a
listsToForest ([[String]] -> Forest String)
-> ([[String]] -> [[String]]) -> [[String]] -> Forest String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [String]) -> [[String]] -> [[String]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> [String] -> [String]
filterStack "Reflex.Spider.Internal")

filterStack :: String -> [String] -> [String]
#ifdef DEBUG_HIDE_INTERNALS
filterStack prefix = filter (not . (prefix `isPrefixOf`))
#else
filterStack :: String -> [String] -> [String]
filterStack prefix :: String
prefix = [String] -> [String]
forall a. a -> a
id
#endif

#ifdef DEBUG_CYCLES

data EventLoopException = EventLoopException [[String]]
instance Exception EventLoopException

instance Show EventLoopException where
  show (EventLoopException stacks) = "causality loop detected:\n" <> if null stacks
    then "no location information, compile with profiling enabled for stack tree"
    else showStacks stacks

#else

data EventLoopException = EventLoopException
instance Exception EventLoopException

instance Show EventLoopException where
  show :: EventLoopException -> String
show EventLoopException = "causality loop detected: \n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
    "compile reflex with flag 'debug-cycles' and compile with profiling enabled for stack tree"

#endif


{-# INLINE propagateSubscriberHold #-}
propagateSubscriberHold :: forall x p. (HasSpiderTimeline x, Patch p) => Hold x p -> p -> EventM x ()
propagateSubscriberHold :: Hold x p -> p -> EventM x ()
propagateSubscriberHold h :: Hold x p
h a :: p
a = do
  {-# SCC "trace" #-} Bool -> EventM x () -> EventM x ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugPropagate (EventM x () -> EventM x ()) -> EventM x () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ Proxy x -> EventM x String -> EventM x ()
forall x (m :: * -> *) (proxy :: * -> *).
CanTrace x m =>
proxy x -> m String -> m ()
traceM (Proxy x
forall k (t :: k). Proxy t
Proxy :: Proxy x) (EventM x String -> EventM x ()) -> EventM x String -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IO String -> EventM x String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> EventM x String) -> IO String -> EventM x String
forall a b. (a -> b) -> a -> b
$ do
    [Weak (Invalidator x)]
invalidators <- IO [Weak (Invalidator x)] -> IO [Weak (Invalidator x)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Weak (Invalidator x)] -> IO [Weak (Invalidator x)])
-> IO [Weak (Invalidator x)] -> IO [Weak (Invalidator x)]
forall a b. (a -> b) -> a -> b
$ IORef [Weak (Invalidator x)] -> IO [Weak (Invalidator x)]
forall a. IORef a -> IO a
readIORef (IORef [Weak (Invalidator x)] -> IO [Weak (Invalidator x)])
-> IORef [Weak (Invalidator x)] -> IO [Weak (Invalidator x)]
forall a b. (a -> b) -> a -> b
$ Hold x p -> IORef [Weak (Invalidator x)]
forall k (x :: k) p. Hold x p -> IORef [Weak (Invalidator x)]
holdInvalidators Hold x p
h
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ "SubscriberHold" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Hold x p -> String
forall a. a -> String
showNodeId Hold x p
h String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Weak (Invalidator x)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Weak (Invalidator x)]
invalidators)

  PatchTarget p
v <- {-# SCC "read" #-} IO (PatchTarget p) -> EventM x (PatchTarget p)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PatchTarget p) -> EventM x (PatchTarget p))
-> IO (PatchTarget p) -> EventM x (PatchTarget p)
forall a b. (a -> b) -> a -> b
$ IORef (PatchTarget p) -> IO (PatchTarget p)
forall a. IORef a -> IO a
readIORef (IORef (PatchTarget p) -> IO (PatchTarget p))
-> IORef (PatchTarget p) -> IO (PatchTarget p)
forall a b. (a -> b) -> a -> b
$ Hold x p -> IORef (PatchTarget p)
forall k (x :: k) p. Hold x p -> IORef (PatchTarget p)
holdValue Hold x p
h
  case {-# SCC "apply" #-} p -> PatchTarget p -> Maybe (PatchTarget p)
forall p. Patch p => p -> PatchTarget p -> Maybe (PatchTarget p)
apply p
a PatchTarget p
v of
    Nothing -> () -> EventM x ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just v' :: PatchTarget p
v' -> do
      {-# SCC "trace2" #-} Proxy x -> EventM x () -> EventM x ()
forall k k (proxy :: k -> *) (x :: k) (m :: k -> *) (a :: k).
proxy x -> m a -> m a
withIncreasedDepth (Proxy x
forall k (t :: k). Proxy t
Proxy :: Proxy x) (EventM x () -> EventM x ()) -> EventM x () -> EventM x ()
forall a b. (a -> b) -> a -> b
$
        Proxy x -> String -> EventM x ()
forall x (m :: * -> *) (proxy :: * -> *).
CanTrace x m =>
proxy x -> String -> m ()
tracePropagate (Proxy x
forall k (t :: k). Proxy t
Proxy :: Proxy x) ("propagateSubscriberHold: assigning Hold" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Hold x p -> String
forall a. a -> String
showNodeId Hold x p
h)
      IORef (PatchTarget p)
vRef <- {-# SCC "vRef" #-} IO (IORef (PatchTarget p)) -> EventM x (IORef (PatchTarget p))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (PatchTarget p)) -> EventM x (IORef (PatchTarget p)))
-> IO (IORef (PatchTarget p)) -> EventM x (IORef (PatchTarget p))
forall a b. (a -> b) -> a -> b
$ IORef (PatchTarget p) -> IO (IORef (PatchTarget p))
forall a. a -> IO a
evaluate (IORef (PatchTarget p) -> IO (IORef (PatchTarget p)))
-> IORef (PatchTarget p) -> IO (IORef (PatchTarget p))
forall a b. (a -> b) -> a -> b
$ Hold x p -> IORef (PatchTarget p)
forall k (x :: k) p. Hold x p -> IORef (PatchTarget p)
holdValue Hold x p
h
      IORef [Weak (Invalidator x)]
iRef <- {-# SCC "iRef" #-} IO (IORef [Weak (Invalidator x)])
-> EventM x (IORef [Weak (Invalidator x)])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [Weak (Invalidator x)])
 -> EventM x (IORef [Weak (Invalidator x)]))
-> IO (IORef [Weak (Invalidator x)])
-> EventM x (IORef [Weak (Invalidator x)])
forall a b. (a -> b) -> a -> b
$ IORef [Weak (Invalidator x)] -> IO (IORef [Weak (Invalidator x)])
forall a. a -> IO a
evaluate (IORef [Weak (Invalidator x)] -> IO (IORef [Weak (Invalidator x)]))
-> IORef [Weak (Invalidator x)]
-> IO (IORef [Weak (Invalidator x)])
forall a b. (a -> b) -> a -> b
$ Hold x p -> IORef [Weak (Invalidator x)]
forall k (x :: k) p. Hold x p -> IORef [Weak (Invalidator x)]
holdInvalidators Hold x p
h
      SomeAssignment x -> EventM x ()
forall a (m :: * -> *). Defer a m => a -> m ()
defer (SomeAssignment x -> EventM x ())
-> SomeAssignment x -> EventM x ()
forall a b. (a -> b) -> a -> b
$ {-# SCC "assignment" #-} IORef (PatchTarget p)
-> IORef [Weak (Invalidator x)]
-> PatchTarget p
-> SomeAssignment x
forall k (x :: k) a.
IORef a -> IORef [Weak (Invalidator x)] -> a -> SomeAssignment x
SomeAssignment IORef (PatchTarget p)
vRef IORef [Weak (Invalidator x)]
iRef PatchTarget p
v'

data SomeResetCoincidence x = forall a. SomeResetCoincidence !(EventSubscription x) !(Maybe (CoincidenceSubscribed x a)) -- The CoincidenceSubscriber will be present only if heights need to be reset

runBehaviorM :: BehaviorM x a -> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]) -> IORef [SomeHoldInit x] -> IO a
runBehaviorM :: BehaviorM x a
-> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
-> IORef [SomeHoldInit x]
-> IO a
runBehaviorM a :: BehaviorM x a
a mwi :: Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
mwi holdInits :: IORef [SomeHoldInit x]
holdInits = ReaderIO (BehaviorEnv x) a -> BehaviorEnv x -> IO a
forall e a. ReaderIO e a -> e -> IO a
runReaderIO (BehaviorM x a -> ReaderIO (BehaviorEnv x) a
forall k (x :: k) a. BehaviorM x a -> ReaderIO (BehaviorEnv x) a
unBehaviorM BehaviorM x a
a) (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
mwi, IORef [SomeHoldInit x]
holdInits)

askInvalidator :: BehaviorM x (Maybe (Weak (Invalidator x)))
askInvalidator :: BehaviorM x (Maybe (Weak (Invalidator x)))
askInvalidator = do
  (!Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
m, _) <- BehaviorM
  x
  (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]),
   IORef [SomeHoldInit x])
forall r (m :: * -> *). MonadReader r m => m r
ask
  case Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
m of
    Nothing -> Maybe (Weak (Invalidator x))
-> BehaviorM x (Maybe (Weak (Invalidator x)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Weak (Invalidator x))
forall a. Maybe a
Nothing
    Just (!Weak (Invalidator x)
wi, _) -> Maybe (Weak (Invalidator x))
-> BehaviorM x (Maybe (Weak (Invalidator x)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Weak (Invalidator x))
 -> BehaviorM x (Maybe (Weak (Invalidator x))))
-> Maybe (Weak (Invalidator x))
-> BehaviorM x (Maybe (Weak (Invalidator x)))
forall a b. (a -> b) -> a -> b
$ Weak (Invalidator x) -> Maybe (Weak (Invalidator x))
forall a. a -> Maybe a
Just Weak (Invalidator x)
wi

askParentsRef :: BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
askParentsRef :: BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
askParentsRef = do
  (!Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
m, _) <- BehaviorM
  x
  (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]),
   IORef [SomeHoldInit x])
forall r (m :: * -> *). MonadReader r m => m r
ask
  case Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
m of
    Nothing -> Maybe (IORef [SomeBehaviorSubscribed x])
-> BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IORef [SomeBehaviorSubscribed x])
forall a. Maybe a
Nothing
    Just (_, !IORef [SomeBehaviorSubscribed x]
p) -> Maybe (IORef [SomeBehaviorSubscribed x])
-> BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (IORef [SomeBehaviorSubscribed x])
 -> BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x])))
-> Maybe (IORef [SomeBehaviorSubscribed x])
-> BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
forall a b. (a -> b) -> a -> b
$ IORef [SomeBehaviorSubscribed x]
-> Maybe (IORef [SomeBehaviorSubscribed x])
forall a. a -> Maybe a
Just IORef [SomeBehaviorSubscribed x]
p

askBehaviorHoldInits :: BehaviorM x (IORef [SomeHoldInit x])
askBehaviorHoldInits :: BehaviorM x (IORef [SomeHoldInit x])
askBehaviorHoldInits = do
  (_, !IORef [SomeHoldInit x]
his) <- BehaviorM
  x
  (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]),
   IORef [SomeHoldInit x])
forall r (m :: * -> *). MonadReader r m => m r
ask
  IORef [SomeHoldInit x] -> BehaviorM x (IORef [SomeHoldInit x])
forall (m :: * -> *) a. Monad m => a -> m a
return IORef [SomeHoldInit x]
his

{-# INLINE getDynHold #-}
getDynHold :: (Defer (SomeHoldInit x) m, Patch p) => Dyn x p -> m (Hold x p)
getDynHold :: Dyn x p -> m (Hold x p)
getDynHold d :: Dyn x p
d = do
  DynType x p
mh <- IO (DynType x p) -> m (DynType x p)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DynType x p) -> m (DynType x p))
-> IO (DynType x p) -> m (DynType x p)
forall a b. (a -> b) -> a -> b
$ IORef (DynType x p) -> IO (DynType x p)
forall a. IORef a -> IO a
readIORef (IORef (DynType x p) -> IO (DynType x p))
-> IORef (DynType x p) -> IO (DynType x p)
forall a b. (a -> b) -> a -> b
$ Dyn x p -> IORef (DynType x p)
forall x p. Dyn x p -> IORef (DynType x p)
unDyn Dyn x p
d
  case DynType x p
mh of
    HoldDyn h :: Hold x p
h -> Hold x p -> m (Hold x p)
forall (m :: * -> *) a. Monad m => a -> m a
return Hold x p
h
    UnsafeDyn (readV0 :: BehaviorM x (PatchTarget p)
readV0, v' :: Event x p
v') -> do
      IORef [SomeHoldInit x]
holdInits <- m (IORef [SomeHoldInit x])
forall a (m :: * -> *). Defer a m => m (IORef [a])
getDeferralQueue
      PatchTarget p
v0 <- IO (PatchTarget p) -> m (PatchTarget p)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PatchTarget p) -> m (PatchTarget p))
-> IO (PatchTarget p) -> m (PatchTarget p)
forall a b. (a -> b) -> a -> b
$ BehaviorM x (PatchTarget p)
-> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
-> IORef [SomeHoldInit x]
-> IO (PatchTarget p)
forall k (x :: k) a.
BehaviorM x a
-> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
-> IORef [SomeHoldInit x]
-> IO a
runBehaviorM BehaviorM x (PatchTarget p)
readV0 Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
forall a. Maybe a
Nothing IORef [SomeHoldInit x]
holdInits
      PatchTarget p -> Event x p -> m (Hold x p)
hold' PatchTarget p
v0 Event x p
v'
    BuildDyn (readV0 :: EventM x (PatchTarget p)
readV0, v' :: Event x p
v') -> do
      PatchTarget p
v0 <- IO (PatchTarget p) -> m (PatchTarget p)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PatchTarget p) -> m (PatchTarget p))
-> IO (PatchTarget p) -> m (PatchTarget p)
forall a b. (a -> b) -> a -> b
$ EventM x (PatchTarget p) -> IO (PatchTarget p)
forall k (x :: k) a. EventM x a -> IO a
runEventM EventM x (PatchTarget p)
readV0
      PatchTarget p -> Event x p -> m (Hold x p)
hold' PatchTarget p
v0 Event x p
v'
  where
    hold' :: PatchTarget p -> Event x p -> m (Hold x p)
hold' v0 :: PatchTarget p
v0 v' :: Event x p
v' = do
      Hold x p
h <- PatchTarget p -> Event x p -> m (Hold x p)
forall k p (x :: k) (m :: * -> *).
(Patch p, Defer (SomeHoldInit x) m) =>
PatchTarget p -> Event x p -> m (Hold x p)
hold PatchTarget p
v0 Event x p
v'
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (DynType x p) -> DynType x p -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Dyn x p -> IORef (DynType x p)
forall x p. Dyn x p -> IORef (DynType x p)
unDyn Dyn x p
d) (DynType x p -> IO ()) -> DynType x p -> IO ()
forall a b. (a -> b) -> a -> b
$ Hold x p -> DynType x p
forall k (x :: k) p. Hold x p -> DynType x p
HoldDyn Hold x p
h
      Hold x p -> m (Hold x p)
forall (m :: * -> *) a. Monad m => a -> m a
return Hold x p
h


-- Always refers to 0
{-# NOINLINE zeroRef #-}
zeroRef :: IORef Height
zeroRef :: IORef Height
zeroRef = IO (IORef Height) -> IORef Height
forall a. IO a -> a
unsafePerformIO (IO (IORef Height) -> IORef Height)
-> IO (IORef Height) -> IORef Height
forall a b. (a -> b) -> a -> b
$ Height -> IO (IORef Height)
forall a. a -> IO (IORef a)
newIORef Height
zeroHeight

getRootSubscribed :: forall k x a. (GCompare k, HasSpiderTimeline x) => k a -> Root x k -> Subscriber x a -> IO (WeakBagTicket, RootSubscribed x a, Maybe a)
getRootSubscribed :: k a
-> Root x k
-> Subscriber x a
-> IO (WeakBagTicket, RootSubscribed x a, Maybe a)
getRootSubscribed k :: k a
k r :: Root x k
r sub :: Subscriber x a
sub = do
  DMap k (RootSubscribed x)
mSubscribed <- IORef (DMap k (RootSubscribed x)) -> IO (DMap k (RootSubscribed x))
forall a. IORef a -> IO a
readIORef (IORef (DMap k (RootSubscribed x))
 -> IO (DMap k (RootSubscribed x)))
-> IORef (DMap k (RootSubscribed x))
-> IO (DMap k (RootSubscribed x))
forall a b. (a -> b) -> a -> b
$ Root x k -> IORef (DMap k (RootSubscribed x))
forall k (x :: k) (k :: * -> *).
Root x k -> IORef (DMap k (RootSubscribed x))
rootSubscribed Root x k
r
  let getOcc :: IO (Maybe a)
getOcc = (DMap k Identity -> Maybe a)
-> IO (DMap k Identity) -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe (Identity a) -> Maybe a
forall a b. Coercible a b => a -> b
coerce (Maybe (Identity a) -> Maybe a)
-> (DMap k Identity -> Maybe (Identity a))
-> DMap k Identity
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k a -> DMap k Identity -> Maybe (Identity a)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
DMap.lookup k a
k) (IO (DMap k Identity) -> IO (Maybe a))
-> IO (DMap k Identity) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ IORef (DMap k Identity) -> IO (DMap k Identity)
forall a. IORef a -> IO a
readIORef (IORef (DMap k Identity) -> IO (DMap k Identity))
-> IORef (DMap k Identity) -> IO (DMap k Identity)
forall a b. (a -> b) -> a -> b
$ Root x k -> IORef (DMap k Identity)
forall k (x :: k) (k :: * -> *).
Root x k -> IORef (DMap k Identity)
rootOccurrence Root x k
r
  case k a -> DMap k (RootSubscribed x) -> Maybe (RootSubscribed x a)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
DMap.lookup k a
k DMap k (RootSubscribed x)
mSubscribed of
    Just subscribed :: RootSubscribed x a
subscribed -> {-# SCC "hitRoot" #-} do
      WeakBagTicket
sln <- RootSubscribed x a -> Subscriber x a -> IO WeakBagTicket
forall k (x :: k) a.
RootSubscribed x a -> Subscriber x a -> IO WeakBagTicket
subscribeRootSubscribed RootSubscribed x a
subscribed Subscriber x a
sub
      Maybe a
occ <- IO (Maybe a)
getOcc
      (WeakBagTicket, RootSubscribed x a, Maybe a)
-> IO (WeakBagTicket, RootSubscribed x a, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (WeakBagTicket
sln, RootSubscribed x a
subscribed, Maybe a
occ)
    Nothing -> {-# SCC "missRoot" #-} do
      IORef (Weak (RootSubscribed x a))
weakSelf <- Weak (RootSubscribed x a) -> IO (IORef (Weak (RootSubscribed x a)))
forall a. a -> IO (IORef a)
newIORef (Weak (RootSubscribed x a)
 -> IO (IORef (Weak (RootSubscribed x a))))
-> Weak (RootSubscribed x a)
-> IO (IORef (Weak (RootSubscribed x a)))
forall a b. (a -> b) -> a -> b
$ String -> Weak (RootSubscribed x a)
forall a. HasCallStack => String -> a
error "getRootSubscribed: weakSelfRef not initialized"
      let !cached :: IORef (DMap k (RootSubscribed x))
cached = Root x k -> IORef (DMap k (RootSubscribed x))
forall k (x :: k) (k :: * -> *).
Root x k -> IORef (DMap k (RootSubscribed x))
rootSubscribed Root x k
r
      IORef (IO ())
uninitRef <- IO () -> IO (IORef (IO ()))
forall a. a -> IO (IORef a)
newIORef (IO () -> IO (IORef (IO ()))) -> IO () -> IO (IORef (IO ()))
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error "getRootsubscribed: uninitRef not initialized"
      (subs :: WeakBag (Subscriber x a)
subs, sln :: WeakBagTicket
sln) <- Subscriber x a
-> IORef (Weak (RootSubscribed x a))
-> (RootSubscribed x a -> IO ())
-> IO (WeakBag (Subscriber x a), WeakBagTicket)
forall a b.
a
-> IORef (Weak b) -> (b -> IO ()) -> IO (WeakBag a, WeakBagTicket)
WeakBag.singleton Subscriber x a
sub IORef (Weak (RootSubscribed x a))
weakSelf RootSubscribed x a -> IO ()
forall k (x :: k) a. RootSubscribed x a -> IO ()
cleanupRootSubscribed

      Proxy x -> String -> IO ()
forall x (m :: * -> *) (proxy :: * -> *).
CanTrace x m =>
proxy x -> String -> m ()
tracePropagate (Proxy x
forall k (t :: k). Proxy t
Proxy::Proxy x) (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$  "getRootSubscribed: calling rootInit"

      IO ()
uninit <- Root x k -> k a -> RootTrigger x a -> IO (IO ())
forall k (x :: k) (k :: * -> *).
Root x k -> forall a. k a -> RootTrigger x a -> IO (IO ())
rootInit Root x k
r k a
k (RootTrigger x a -> IO (IO ())) -> RootTrigger x a -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ (WeakBag (Subscriber x a), IORef (DMap k Identity), k a)
-> RootTrigger x a
forall k (x :: k) a (k :: * -> *).
GCompare k =>
(WeakBag (Subscriber x a), IORef (DMap k Identity), k a)
-> RootTrigger x a
RootTrigger (WeakBag (Subscriber x a)
subs, Root x k -> IORef (DMap k Identity)
forall k (x :: k) (k :: * -> *).
Root x k -> IORef (DMap k Identity)
rootOccurrence Root x k
r, k a
k)
      IORef (IO ()) -> IO () -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (IO ())
uninitRef (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$! IO ()
uninit
#ifdef DEBUG_NODEIDS
      nid <- newNodeId
#endif
      let !subscribed :: RootSubscribed x a
subscribed = $WRootSubscribed :: forall k (x :: k) a (k :: * -> *).
GCompare k =>
k a
-> IORef (DMap k (RootSubscribed x))
-> WeakBag (Subscriber x a)
-> IO (Maybe a)
-> IO ()
-> IORef (Weak (RootSubscribed x a))
-> RootSubscribed x a
RootSubscribed
            { rootSubscribedKey :: k a
rootSubscribedKey = k a
k
            , rootSubscribedCachedSubscribed :: IORef (DMap k (RootSubscribed x))
rootSubscribedCachedSubscribed = IORef (DMap k (RootSubscribed x))
cached
            , rootSubscribedOccurrence :: IO (Maybe a)
rootSubscribedOccurrence = IO (Maybe a)
getOcc
            , rootSubscribedSubscribers :: WeakBag (Subscriber x a)
rootSubscribedSubscribers = WeakBag (Subscriber x a)
subs
            , rootSubscribedUninit :: IO ()
rootSubscribedUninit = IO ()
uninit
            , rootSubscribedWeakSelf :: IORef (Weak (RootSubscribed x a))
rootSubscribedWeakSelf = IORef (Weak (RootSubscribed x a))
weakSelf
#ifdef DEBUG_NODEIDS
            , rootSubscribedNodeId = nid
#endif
            }
          -- If we die at the same moment that all our children die, they will
          -- try to clean us up but will fail because their Weak reference to us
          -- will also be dead.  So, if we are dying, check if there are any
          -- children; since children don't bother cleaning themselves up if
          -- their parents are already dead, I don't think there's a race
          -- condition here.  However, if there are any children, then we can
          -- infer that we need to clean ourselves up, so we do.
          finalCleanup :: IO ()
finalCleanup = do
            IntMap (Weak (Subscriber x a))
cs <- IORef (IntMap (Weak (Subscriber x a)))
-> IO (IntMap (Weak (Subscriber x a)))
forall a. IORef a -> IO a
readIORef (IORef (IntMap (Weak (Subscriber x a)))
 -> IO (IntMap (Weak (Subscriber x a))))
-> IORef (IntMap (Weak (Subscriber x a)))
-> IO (IntMap (Weak (Subscriber x a)))
forall a b. (a -> b) -> a -> b
$ WeakBag (Subscriber x a) -> IORef (IntMap (Weak (Subscriber x a)))
forall a. WeakBag a -> IORef (IntMap (Weak a))
_weakBag_children WeakBag (Subscriber x a)
subs
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IntMap (Weak (Subscriber x a)) -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap (Weak (Subscriber x a))
cs) (RootSubscribed x a -> IO ()
forall k (x :: k) a. RootSubscribed x a -> IO ()
cleanupRootSubscribed RootSubscribed x a
subscribed)
      IORef (Weak (RootSubscribed x a))
-> Weak (RootSubscribed x a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Weak (RootSubscribed x a))
weakSelf (Weak (RootSubscribed x a) -> IO ())
-> IO (Weak (RootSubscribed x a)) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Weak (RootSubscribed x a) -> IO (Weak (RootSubscribed x a))
forall a. a -> IO a
evaluate (Weak (RootSubscribed x a) -> IO (Weak (RootSubscribed x a)))
-> IO (Weak (RootSubscribed x a)) -> IO (Weak (RootSubscribed x a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RootSubscribed x a
-> Maybe (IO ()) -> IO (Weak (RootSubscribed x a))
forall k. k -> Maybe (IO ()) -> IO (Weak k)
mkWeakPtr RootSubscribed x a
subscribed (IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just IO ()
finalCleanup)
      IORef (DMap k (RootSubscribed x))
-> (DMap k (RootSubscribed x) -> DMap k (RootSubscribed x))
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Root x k -> IORef (DMap k (RootSubscribed x))
forall k (x :: k) (k :: * -> *).
Root x k -> IORef (DMap k (RootSubscribed x))
rootSubscribed Root x k
r) ((DMap k (RootSubscribed x) -> DMap k (RootSubscribed x)) -> IO ())
-> (DMap k (RootSubscribed x) -> DMap k (RootSubscribed x))
-> IO ()
forall a b. (a -> b) -> a -> b
$ (RootSubscribed x a -> RootSubscribed x a -> RootSubscribed x a)
-> k a
-> RootSubscribed x a
-> DMap k (RootSubscribed x)
-> DMap k (RootSubscribed x)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
(f v -> f v -> f v) -> k2 v -> f v -> DMap k2 f -> DMap k2 f
DMap.insertWith (String
-> RootSubscribed x a -> RootSubscribed x a -> RootSubscribed x a
forall a. HasCallStack => String -> a
error (String
 -> RootSubscribed x a -> RootSubscribed x a -> RootSubscribed x a)
-> String
-> RootSubscribed x a
-> RootSubscribed x a
-> RootSubscribed x a
forall a b. (a -> b) -> a -> b
$ "getRootSubscribed: duplicate key inserted into Root") k a
k RootSubscribed x a
subscribed --TODO: I think we can just write back mSubscribed rather than re-reading it
      Maybe a
occ <- IO (Maybe a)
getOcc
      (WeakBagTicket, RootSubscribed x a, Maybe a)
-> IO (WeakBagTicket, RootSubscribed x a, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (WeakBagTicket
sln, RootSubscribed x a
subscribed, Maybe a
occ)

#ifdef USE_TEMPLATE_HASKELL
{-# ANN cleanupRootSubscribed "HLint: ignore Redundant bracket" #-}
#endif
cleanupRootSubscribed :: RootSubscribed x a -> IO ()
cleanupRootSubscribed :: RootSubscribed x a -> IO ()
cleanupRootSubscribed self :: RootSubscribed x a
self@RootSubscribed { rootSubscribedKey :: ()
rootSubscribedKey = k a
k, rootSubscribedCachedSubscribed :: ()
rootSubscribedCachedSubscribed = IORef (DMap k (RootSubscribed x))
cached } = do
  RootSubscribed x a -> IO ()
forall k (x :: k) a. RootSubscribed x a -> IO ()
rootSubscribedUninit RootSubscribed x a
self
  IORef (DMap k (RootSubscribed x))
-> (DMap k (RootSubscribed x) -> DMap k (RootSubscribed x))
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (DMap k (RootSubscribed x))
cached ((DMap k (RootSubscribed x) -> DMap k (RootSubscribed x)) -> IO ())
-> (DMap k (RootSubscribed x) -> DMap k (RootSubscribed x))
-> IO ()
forall a b. (a -> b) -> a -> b
$ k a -> DMap k (RootSubscribed x) -> DMap k (RootSubscribed x)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> DMap k2 f
DMap.delete k a
k

{-# INLINE subscribeRootSubscribed #-}
subscribeRootSubscribed :: RootSubscribed x a -> Subscriber x a -> IO WeakBagTicket
subscribeRootSubscribed :: RootSubscribed x a -> Subscriber x a -> IO WeakBagTicket
subscribeRootSubscribed subscribed :: RootSubscribed x a
subscribed sub :: Subscriber x a
sub = Subscriber x a
-> WeakBag (Subscriber x a)
-> IORef (Weak (RootSubscribed x a))
-> (RootSubscribed x a -> IO ())
-> IO WeakBagTicket
forall a b.
a
-> WeakBag a -> IORef (Weak b) -> (b -> IO ()) -> IO WeakBagTicket
WeakBag.insert Subscriber x a
sub (RootSubscribed x a -> WeakBag (Subscriber x a)
forall k (x :: k) a. RootSubscribed x a -> WeakBag (Subscriber x a)
rootSubscribedSubscribers RootSubscribed x a
subscribed) (RootSubscribed x a -> IORef (Weak (RootSubscribed x a))
forall k (x :: k) a.
RootSubscribed x a -> IORef (Weak (RootSubscribed x a))
rootSubscribedWeakSelf RootSubscribed x a
subscribed) RootSubscribed x a -> IO ()
forall k (x :: k) a. RootSubscribed x a -> IO ()
cleanupRootSubscribed

newtype EventSelectorInt x a = EventSelectorInt { EventSelectorInt x a -> Int -> Event x a
selectInt :: Int -> Event x a }

data FanInt x a = FanInt
  { FanInt x a -> FastMutableIntMap (FastWeakBag (Subscriber x a))
_fanInt_subscribers :: {-# UNPACK #-} !(FastMutableIntMap (FastWeakBag (Subscriber x a))) --TODO: Clean up the keys in here when their child weak bags get empty --TODO: Remove our own subscription when the subscribers list is completely empty
  , FanInt x a -> IORef (EventSubscription x)
_fanInt_subscriptionRef :: {-# UNPACK #-} !(IORef (EventSubscription x)) -- This should have a valid subscription iff subscribers is non-empty
  , FanInt x a -> IORef (IntMap a)
_fanInt_occRef :: {-# UNPACK #-} !(IORef (IntMap a))
#ifdef DEBUG_NODEIDS
  , _fanInt_nodeId :: {-# UNPACK #-} !Int
#endif
  }

newFanInt :: IO (FanInt x a)
newFanInt :: IO (FanInt x a)
newFanInt = do
  FastMutableIntMap (FastWeakBag (Subscriber x a))
subscribers <- IO (FastMutableIntMap (FastWeakBag (Subscriber x a)))
forall a. IO (FastMutableIntMap a)
FastMutableIntMap.newEmpty --TODO: Clean up the keys in here when their child weak bags get empty --TODO: Remove our own subscription when the subscribers list is completely empty
  IORef (EventSubscription x)
subscriptionRef <- EventSubscription x -> IO (IORef (EventSubscription x))
forall a. a -> IO (IORef a)
newIORef (EventSubscription x -> IO (IORef (EventSubscription x)))
-> EventSubscription x -> IO (IORef (EventSubscription x))
forall a b. (a -> b) -> a -> b
$ String -> EventSubscription x
forall a. HasCallStack => String -> a
error "fanInt: no subscription"
  IORef (IntMap a)
occRef <- IntMap a -> IO (IORef (IntMap a))
forall a. a -> IO (IORef a)
newIORef (IntMap a -> IO (IORef (IntMap a)))
-> IntMap a -> IO (IORef (IntMap a))
forall a b. (a -> b) -> a -> b
$ String -> IntMap a
forall a. HasCallStack => String -> a
error "fanInt: no occurrence"
#ifdef DEBUG_NODEIDS
  nodeId <- newNodeId
#endif
  FanInt x a -> IO (FanInt x a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FanInt x a -> IO (FanInt x a)) -> FanInt x a -> IO (FanInt x a)
forall a b. (a -> b) -> a -> b
$ $WFanInt :: forall k (x :: k) a.
FastMutableIntMap (FastWeakBag (Subscriber x a))
-> IORef (EventSubscription x) -> IORef (IntMap a) -> FanInt x a
FanInt
    { _fanInt_subscribers :: FastMutableIntMap (FastWeakBag (Subscriber x a))
_fanInt_subscribers = FastMutableIntMap (FastWeakBag (Subscriber x a))
subscribers
    , _fanInt_subscriptionRef :: IORef (EventSubscription x)
_fanInt_subscriptionRef = IORef (EventSubscription x)
subscriptionRef
    , _fanInt_occRef :: IORef (IntMap a)
_fanInt_occRef = IORef (IntMap a)
occRef
#ifdef DEBUG_NODEIDS
    , _fanInt_nodeId = nodeId
#endif
    }

fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a
fanInt :: Event x (IntMap a) -> EventSelectorInt x a
fanInt p :: Event x (IntMap a)
p = IO (EventSelectorInt x a) -> EventSelectorInt x a
forall a. IO a -> a
unsafePerformIO (IO (EventSelectorInt x a) -> EventSelectorInt x a)
-> IO (EventSelectorInt x a) -> EventSelectorInt x a
forall a b. (a -> b) -> a -> b
$ do
  FanInt x a
self <- IO (FanInt x a)
forall k (x :: k) a. IO (FanInt x a)
newFanInt
  EventSelectorInt x a -> IO (EventSelectorInt x a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EventSelectorInt x a -> IO (EventSelectorInt x a))
-> EventSelectorInt x a -> IO (EventSelectorInt x a)
forall a b. (a -> b) -> a -> b
$ (Int -> Event x a) -> EventSelectorInt x a
forall k (x :: k) a. (Int -> Event x a) -> EventSelectorInt x a
EventSelectorInt ((Int -> Event x a) -> EventSelectorInt x a)
-> (Int -> Event x a) -> EventSelectorInt x a
forall a b. (a -> b) -> a -> b
$ \k :: Int
k -> (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
forall k (x :: k) a.
(Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
Event ((Subscriber x a -> EventM x (EventSubscription x, Maybe a))
 -> Event x a)
-> (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
forall a b. (a -> b) -> a -> b
$ \sub :: Subscriber x a
sub -> do
    Bool
isEmpty <- IO Bool -> EventM x Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> EventM x Bool) -> IO Bool -> EventM x Bool
forall a b. (a -> b) -> a -> b
$ FastMutableIntMap (FastWeakBag (Subscriber x a)) -> IO Bool
forall a. FastMutableIntMap a -> IO Bool
FastMutableIntMap.isEmpty (FanInt x a -> FastMutableIntMap (FastWeakBag (Subscriber x a))
forall k (x :: k) a.
FanInt x a -> FastMutableIntMap (FastWeakBag (Subscriber x a))
_fanInt_subscribers FanInt x a
self)
    Bool -> EventM x () -> EventM x ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isEmpty (EventM x () -> EventM x ()) -> EventM x () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ do -- This is the first subscriber, so we need to subscribe to our input
      let desc :: String
desc = "fanInt" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> FanInt x a -> String
forall a. a -> String
showNodeId FanInt x a
self String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ", k = "  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
k
      (subscription :: EventSubscription x
subscription, parentOcc :: Maybe (IntMap a)
parentOcc) <- Event x (IntMap a)
-> Subscriber x (IntMap a)
-> EventM x (EventSubscription x, Maybe (IntMap a))
forall k (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead Event x (IntMap a)
p (Subscriber x (IntMap a)
 -> EventM x (EventSubscription x, Maybe (IntMap a)))
-> Subscriber x (IntMap a)
-> EventM x (EventSubscription x, Maybe (IntMap a))
forall a b. (a -> b) -> a -> b
$ String -> Subscriber x (IntMap a) -> Subscriber x (IntMap a)
forall k (x :: k) a. String -> Subscriber x a -> Subscriber x a
debugSubscriber' String
desc (Subscriber x (IntMap a) -> Subscriber x (IntMap a))
-> Subscriber x (IntMap a) -> Subscriber x (IntMap a)
forall a b. (a -> b) -> a -> b
$ $WSubscriber :: forall k (x :: k) a.
(a -> EventM x ())
-> (Height -> IO ()) -> (Height -> IO ()) -> Subscriber x a
Subscriber
        { subscriberPropagate :: IntMap a -> EventM x ()
subscriberPropagate = \m :: IntMap a
m -> do
            IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (IntMap a) -> IntMap a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (FanInt x a -> IORef (IntMap a)
forall k (x :: k) a. FanInt x a -> IORef (IntMap a)
_fanInt_occRef FanInt x a
self) IntMap a
m
            IORef (IntMap a) -> EventM x ()
forall (m :: * -> *) a.
Defer (Some IntClear) m =>
IORef (IntMap a) -> m ()
scheduleIntClear (IORef (IntMap a) -> EventM x ())
-> IORef (IntMap a) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ FanInt x a -> IORef (IntMap a)
forall k (x :: k) a. FanInt x a -> IORef (IntMap a)
_fanInt_occRef FanInt x a
self
            FastMutableIntMap (FastWeakBag (Subscriber x a))
-> IntMap a
-> (FastWeakBag (Subscriber x a) -> a -> EventM x ())
-> EventM x ()
forall (m :: * -> *) a b.
MonadIO m =>
FastMutableIntMap a -> IntMap b -> (a -> b -> m ()) -> m ()
FastMutableIntMap.forIntersectionWithImmutable_ (FanInt x a -> FastMutableIntMap (FastWeakBag (Subscriber x a))
forall k (x :: k) a.
FanInt x a -> FastMutableIntMap (FastWeakBag (Subscriber x a))
_fanInt_subscribers FanInt x a
self) IntMap a
m ((FastWeakBag (Subscriber x a) -> a -> EventM x ()) -> EventM x ())
-> (FastWeakBag (Subscriber x a) -> a -> EventM x ())
-> EventM x ()
forall a b. (a -> b) -> a -> b
$ \b :: FastWeakBag (Subscriber x a)
b v :: a
v ->  --TODO: Do we need to know that no subscribers are being added as we traverse?
              FastWeakBag (Subscriber x a)
-> (Subscriber x a -> EventM x ()) -> EventM x ()
forall a (m :: * -> *).
MonadIO m =>
FastWeakBag a -> (a -> m ()) -> m ()
FastWeakBag.traverse_ FastWeakBag (Subscriber x a)
b ((Subscriber x a -> EventM x ()) -> EventM x ())
-> (Subscriber x a -> EventM x ()) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ \s :: Subscriber x a
s ->
                Subscriber x a -> a -> EventM x ()
forall k (x :: k) a. Subscriber x a -> a -> EventM x ()
subscriberPropagate Subscriber x a
s a
v
        , subscriberInvalidateHeight :: Height -> IO ()
subscriberInvalidateHeight = \old :: Height
old ->
            FastMutableIntMap (FastWeakBag (Subscriber x a))
-> (FastWeakBag (Subscriber x a) -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
FastMutableIntMap a -> (a -> m ()) -> m ()
FastMutableIntMap.for_ (FanInt x a -> FastMutableIntMap (FastWeakBag (Subscriber x a))
forall k (x :: k) a.
FanInt x a -> FastMutableIntMap (FastWeakBag (Subscriber x a))
_fanInt_subscribers FanInt x a
self) ((FastWeakBag (Subscriber x a) -> IO ()) -> IO ())
-> (FastWeakBag (Subscriber x a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \b :: FastWeakBag (Subscriber x a)
b ->
              FastWeakBag (Subscriber x a) -> (Subscriber x a -> IO ()) -> IO ()
forall a (m :: * -> *).
MonadIO m =>
FastWeakBag a -> (a -> m ()) -> m ()
FastWeakBag.traverse_ FastWeakBag (Subscriber x a)
b ((Subscriber x a -> IO ()) -> IO ())
-> (Subscriber x a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \s :: Subscriber x a
s ->
                Subscriber x a -> Height -> IO ()
forall k (x :: k) a. Subscriber x a -> Height -> IO ()
subscriberInvalidateHeight Subscriber x a
s Height
old
        , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = \new :: Height
new ->
            FastMutableIntMap (FastWeakBag (Subscriber x a))
-> (FastWeakBag (Subscriber x a) -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
FastMutableIntMap a -> (a -> m ()) -> m ()
FastMutableIntMap.for_ (FanInt x a -> FastMutableIntMap (FastWeakBag (Subscriber x a))
forall k (x :: k) a.
FanInt x a -> FastMutableIntMap (FastWeakBag (Subscriber x a))
_fanInt_subscribers FanInt x a
self) ((FastWeakBag (Subscriber x a) -> IO ()) -> IO ())
-> (FastWeakBag (Subscriber x a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \b :: FastWeakBag (Subscriber x a)
b ->
              FastWeakBag (Subscriber x a) -> (Subscriber x a -> IO ()) -> IO ()
forall a (m :: * -> *).
MonadIO m =>
FastWeakBag a -> (a -> m ()) -> m ()
FastWeakBag.traverse_ FastWeakBag (Subscriber x a)
b ((Subscriber x a -> IO ()) -> IO ())
-> (Subscriber x a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \s :: Subscriber x a
s ->
                Subscriber x a -> Height -> IO ()
forall k (x :: k) a. Subscriber x a -> Height -> IO ()
subscriberRecalculateHeight Subscriber x a
s Height
new
        }
      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ do
        IORef (EventSubscription x) -> EventSubscription x -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (FanInt x a -> IORef (EventSubscription x)
forall k (x :: k) a. FanInt x a -> IORef (EventSubscription x)
_fanInt_subscriptionRef FanInt x a
self) EventSubscription x
subscription
        IORef (IntMap a) -> IntMap a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (FanInt x a -> IORef (IntMap a)
forall k (x :: k) a. FanInt x a -> IORef (IntMap a)
_fanInt_occRef FanInt x a
self) (IntMap a -> IO ()) -> IntMap a -> IO ()
forall a b. (a -> b) -> a -> b
$ IntMap a -> Maybe (IntMap a) -> IntMap a
forall a. a -> Maybe a -> a
fromMaybe IntMap a
forall a. IntMap a
IntMap.empty Maybe (IntMap a)
parentOcc
      IORef (IntMap a) -> EventM x ()
forall (m :: * -> *) a.
Defer (Some IntClear) m =>
IORef (IntMap a) -> m ()
scheduleIntClear (IORef (IntMap a) -> EventM x ())
-> IORef (IntMap a) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ FanInt x a -> IORef (IntMap a)
forall k (x :: k) a. FanInt x a -> IORef (IntMap a)
_fanInt_occRef FanInt x a
self
    IO (EventSubscription x, Maybe a)
-> EventM x (EventSubscription x, Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (EventSubscription x, Maybe a)
 -> EventM x (EventSubscription x, Maybe a))
-> IO (EventSubscription x, Maybe a)
-> EventM x (EventSubscription x, Maybe a)
forall a b. (a -> b) -> a -> b
$ do
      FastWeakBag (Subscriber x a)
b <- FastMutableIntMap (FastWeakBag (Subscriber x a))
-> Int -> IO (Maybe (FastWeakBag (Subscriber x a)))
forall a. FastMutableIntMap a -> Int -> IO (Maybe a)
FastMutableIntMap.lookup (FanInt x a -> FastMutableIntMap (FastWeakBag (Subscriber x a))
forall k (x :: k) a.
FanInt x a -> FastMutableIntMap (FastWeakBag (Subscriber x a))
_fanInt_subscribers FanInt x a
self) Int
k IO (Maybe (FastWeakBag (Subscriber x a)))
-> (Maybe (FastWeakBag (Subscriber x a))
    -> IO (FastWeakBag (Subscriber x a)))
-> IO (FastWeakBag (Subscriber x a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Nothing -> do
          FastWeakBag (Subscriber x a)
b <- IO (FastWeakBag (Subscriber x a))
forall a. IO (FastWeakBag a)
FastWeakBag.empty
          FastMutableIntMap (FastWeakBag (Subscriber x a))
-> Int -> FastWeakBag (Subscriber x a) -> IO ()
forall a. FastMutableIntMap a -> Int -> a -> IO ()
FastMutableIntMap.insert (FanInt x a -> FastMutableIntMap (FastWeakBag (Subscriber x a))
forall k (x :: k) a.
FanInt x a -> FastMutableIntMap (FastWeakBag (Subscriber x a))
_fanInt_subscribers FanInt x a
self) Int
k FastWeakBag (Subscriber x a)
b
          FastWeakBag (Subscriber x a) -> IO (FastWeakBag (Subscriber x a))
forall (m :: * -> *) a. Monad m => a -> m a
return FastWeakBag (Subscriber x a)
b
        Just b :: FastWeakBag (Subscriber x a)
b -> FastWeakBag (Subscriber x a) -> IO (FastWeakBag (Subscriber x a))
forall (m :: * -> *) a. Monad m => a -> m a
return FastWeakBag (Subscriber x a)
b
      FastWeakBagTicket (Subscriber x a)
ticket <- IO (FastWeakBagTicket (Subscriber x a))
-> IO (FastWeakBagTicket (Subscriber x a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FastWeakBagTicket (Subscriber x a))
 -> IO (FastWeakBagTicket (Subscriber x a)))
-> IO (FastWeakBagTicket (Subscriber x a))
-> IO (FastWeakBagTicket (Subscriber x a))
forall a b. (a -> b) -> a -> b
$ Subscriber x a
-> FastWeakBag (Subscriber x a)
-> IO (FastWeakBagTicket (Subscriber x a))
forall a. a -> FastWeakBag a -> IO (FastWeakBagTicket a)
FastWeakBag.insert Subscriber x a
sub FastWeakBag (Subscriber x a)
b
      IntMap a
currentOcc <- IORef (IntMap a) -> IO (IntMap a)
forall a. IORef a -> IO a
readIORef (FanInt x a -> IORef (IntMap a)
forall k (x :: k) a. FanInt x a -> IORef (IntMap a)
_fanInt_occRef FanInt x a
self)

      EventSubscribed x
subscribed <- FastWeakBagTicket (Subscriber x a)
-> FanInt x a -> IO (EventSubscribed x)
forall k k (x :: k) a.
FastWeakBagTicket k -> FanInt x a -> IO (EventSubscribed x)
fanIntSubscribed FastWeakBagTicket (Subscriber x a)
ticket FanInt x a
self
      (EventSubscription x, Maybe a) -> IO (EventSubscription x, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> EventSubscribed x -> EventSubscription x
forall k (x :: k).
IO () -> EventSubscribed x -> EventSubscription x
EventSubscription (FastWeakBagTicket (Subscriber x a) -> IO ()
forall a. FastWeakBagTicket a -> IO ()
FastWeakBag.remove FastWeakBagTicket (Subscriber x a)
ticket) EventSubscribed x
subscribed, Int -> IntMap a -> Maybe a
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
k IntMap a
currentOcc)

fanIntSubscribed :: FastWeakBagTicket k -> FanInt x a -> IO (EventSubscribed x)
fanIntSubscribed :: FastWeakBagTicket k -> FanInt x a -> IO (EventSubscribed x)
fanIntSubscribed ticket :: FastWeakBagTicket k
ticket self :: FanInt x a
self = do
  EventSubscribed x
subscribedParent <- EventSubscription x -> EventSubscribed x
forall k (x :: k). EventSubscription x -> EventSubscribed x
_eventSubscription_subscribed (EventSubscription x -> EventSubscribed x)
-> IO (EventSubscription x) -> IO (EventSubscribed x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (EventSubscription x) -> IO (EventSubscription x)
forall a. IORef a -> IO a
readIORef (FanInt x a -> IORef (EventSubscription x)
forall k (x :: k) a. FanInt x a -> IORef (EventSubscription x)
_fanInt_subscriptionRef FanInt x a
self)
  EventSubscribed x -> IO (EventSubscribed x)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventSubscribed x -> IO (EventSubscribed x))
-> EventSubscribed x -> IO (EventSubscribed x)
forall a b. (a -> b) -> a -> b
$ $WEventSubscribed :: forall k (x :: k). IORef Height -> Any -> EventSubscribed x
EventSubscribed
    { eventSubscribedHeightRef :: IORef Height
eventSubscribedHeightRef = EventSubscribed x -> IORef Height
forall k (x :: k). EventSubscribed x -> IORef Height
eventSubscribedHeightRef EventSubscribed x
subscribedParent
    , eventSubscribedRetained :: Any
eventSubscribedRetained = (IORef (EventSubscription x), FastWeakBagTicket k) -> Any
forall a. a -> Any
toAny (FanInt x a -> IORef (EventSubscription x)
forall k (x :: k) a. FanInt x a -> IORef (EventSubscription x)
_fanInt_subscriptionRef FanInt x a
self, FastWeakBagTicket k
ticket)
#ifdef DEBUG_CYCLES
    , eventSubscribedGetParents = return [subscribedParent]
    , eventSubscribedHasOwnHeightRef = False
    , eventSubscribedWhoCreated = whoCreatedIORef $ _fanInt_subscriptionRef self
#endif
    }


{-# INLINABLE getFanSubscribed #-}
getFanSubscribed :: (HasSpiderTimeline x, GCompare k) => k a -> Fan x k v -> Subscriber x (v a) -> EventM x (WeakBagTicket, FanSubscribed x k v, Maybe (v a))
getFanSubscribed :: k a
-> Fan x k v
-> Subscriber x (v a)
-> EventM x (WeakBagTicket, FanSubscribed x k v, Maybe (v a))
getFanSubscribed k :: k a
k f :: Fan x k v
f sub :: Subscriber x (v a)
sub = do
  Maybe (FanSubscribed x k v)
mSubscribed <- IO (Maybe (FanSubscribed x k v))
-> EventM x (Maybe (FanSubscribed x k v))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (FanSubscribed x k v))
 -> EventM x (Maybe (FanSubscribed x k v)))
-> IO (Maybe (FanSubscribed x k v))
-> EventM x (Maybe (FanSubscribed x k v))
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (FanSubscribed x k v))
-> IO (Maybe (FanSubscribed x k v))
forall a. IORef a -> IO a
readIORef (IORef (Maybe (FanSubscribed x k v))
 -> IO (Maybe (FanSubscribed x k v)))
-> IORef (Maybe (FanSubscribed x k v))
-> IO (Maybe (FanSubscribed x k v))
forall a b. (a -> b) -> a -> b
$ Fan x k v -> IORef (Maybe (FanSubscribed x k v))
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
Fan x k v -> IORef (Maybe (FanSubscribed x k v))
fanSubscribed Fan x k v
f
  case Maybe (FanSubscribed x k v)
mSubscribed of
    Just subscribed :: FanSubscribed x k v
subscribed -> {-# SCC "hitFan" #-} IO (WeakBagTicket, FanSubscribed x k v, Maybe (v a))
-> EventM x (WeakBagTicket, FanSubscribed x k v, Maybe (v a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (WeakBagTicket, FanSubscribed x k v, Maybe (v a))
 -> EventM x (WeakBagTicket, FanSubscribed x k v, Maybe (v a)))
-> IO (WeakBagTicket, FanSubscribed x k v, Maybe (v a))
-> EventM x (WeakBagTicket, FanSubscribed x k v, Maybe (v a))
forall a b. (a -> b) -> a -> b
$ do
      WeakBagTicket
sln <- k a
-> FanSubscribed x k v -> Subscriber x (v a) -> IO WeakBagTicket
forall k k (k :: k -> *) (a :: k) (x :: k) (v :: k -> *).
GCompare k =>
k a
-> FanSubscribed x k v -> Subscriber x (v a) -> IO WeakBagTicket
subscribeFanSubscribed k a
k FanSubscribed x k v
subscribed Subscriber x (v a)
sub
      Maybe (DMap k v)
occ <- IORef (Maybe (DMap k v)) -> IO (Maybe (DMap k v))
forall a. IORef a -> IO a
readIORef (IORef (Maybe (DMap k v)) -> IO (Maybe (DMap k v)))
-> IORef (Maybe (DMap k v)) -> IO (Maybe (DMap k v))
forall a b. (a -> b) -> a -> b
$ FanSubscribed x k v -> IORef (Maybe (DMap k v))
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (Maybe (DMap k v))
fanSubscribedOccurrence FanSubscribed x k v
subscribed
      (WeakBagTicket, FanSubscribed x k v, Maybe (v a))
-> IO (WeakBagTicket, FanSubscribed x k v, Maybe (v a))
forall (m :: * -> *) a. Monad m => a -> m a
return (WeakBagTicket
sln, FanSubscribed x k v
subscribed, Maybe (v a) -> Maybe (v a)
forall a b. Coercible a b => a -> b
coerce (Maybe (v a) -> Maybe (v a)) -> Maybe (v a) -> Maybe (v a)
forall a b. (a -> b) -> a -> b
$ k a -> DMap k v -> Maybe (v a)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
DMap.lookup k a
k (DMap k v -> Maybe (v a)) -> Maybe (DMap k v) -> Maybe (v a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (DMap k v)
occ)
    Nothing -> {-# SCC "missFan" #-} do
      IORef (FanSubscribed x k v)
subscribedRef <- IO (IORef (FanSubscribed x k v))
-> EventM x (IORef (FanSubscribed x k v))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (FanSubscribed x k v))
 -> EventM x (IORef (FanSubscribed x k v)))
-> IO (IORef (FanSubscribed x k v))
-> EventM x (IORef (FanSubscribed x k v))
forall a b. (a -> b) -> a -> b
$ FanSubscribed x k v -> IO (IORef (FanSubscribed x k v))
forall a. a -> IO (IORef a)
newIORef (FanSubscribed x k v -> IO (IORef (FanSubscribed x k v)))
-> FanSubscribed x k v -> IO (IORef (FanSubscribed x k v))
forall a b. (a -> b) -> a -> b
$ String -> FanSubscribed x k v
forall a. HasCallStack => String -> a
error "getFanSubscribed: subscribedRef not yet initialized"
      FanSubscribed x k v
subscribedUnsafe <- IO (FanSubscribed x k v) -> EventM x (FanSubscribed x k v)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FanSubscribed x k v) -> EventM x (FanSubscribed x k v))
-> IO (FanSubscribed x k v) -> EventM x (FanSubscribed x k v)
forall a b. (a -> b) -> a -> b
$ IO (FanSubscribed x k v) -> IO (FanSubscribed x k v)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (FanSubscribed x k v) -> IO (FanSubscribed x k v))
-> IO (FanSubscribed x k v) -> IO (FanSubscribed x k v)
forall a b. (a -> b) -> a -> b
$ IORef (FanSubscribed x k v) -> IO (FanSubscribed x k v)
forall a. IORef a -> IO a
readIORef IORef (FanSubscribed x k v)
subscribedRef
      Subscriber x (DMap k v)
s <- IO (Subscriber x (DMap k v)) -> EventM x (Subscriber x (DMap k v))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Subscriber x (DMap k v))
 -> EventM x (Subscriber x (DMap k v)))
-> IO (Subscriber x (DMap k v))
-> EventM x (Subscriber x (DMap k v))
forall a b. (a -> b) -> a -> b
$ FanSubscribed x k v -> IO (Subscriber x (DMap k v))
forall k x (k :: k -> *) (v :: k -> *).
(HasSpiderTimeline x, GCompare k) =>
FanSubscribed x k v -> IO (Subscriber x (DMap k v))
newSubscriberFan FanSubscribed x k v
subscribedUnsafe
      (subscription :: EventSubscription x
subscription, parentOcc :: Maybe (DMap k v)
parentOcc) <- Event x (DMap k v)
-> Subscriber x (DMap k v)
-> EventM x (EventSubscription x, Maybe (DMap k v))
forall k (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead (Fan x k v -> Event x (DMap k v)
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
Fan x k v -> Event x (DMap k v)
fanParent Fan x k v
f) Subscriber x (DMap k v)
s
      IORef (Weak (k a, FanSubscribed x k v))
weakSelf <- IO (IORef (Weak (k a, FanSubscribed x k v)))
-> EventM x (IORef (Weak (k a, FanSubscribed x k v)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Weak (k a, FanSubscribed x k v)))
 -> EventM x (IORef (Weak (k a, FanSubscribed x k v))))
-> IO (IORef (Weak (k a, FanSubscribed x k v)))
-> EventM x (IORef (Weak (k a, FanSubscribed x k v)))
forall a b. (a -> b) -> a -> b
$ Weak (k a, FanSubscribed x k v)
-> IO (IORef (Weak (k a, FanSubscribed x k v)))
forall a. a -> IO (IORef a)
newIORef (Weak (k a, FanSubscribed x k v)
 -> IO (IORef (Weak (k a, FanSubscribed x k v))))
-> Weak (k a, FanSubscribed x k v)
-> IO (IORef (Weak (k a, FanSubscribed x k v)))
forall a b. (a -> b) -> a -> b
$ String -> Weak (k a, FanSubscribed x k v)
forall a. HasCallStack => String -> a
error "getFanSubscribed: weakSelf not yet initialized"
      (subsForK :: WeakBag (Subscriber x (v a))
subsForK, slnForSub :: WeakBagTicket
slnForSub) <- IO (WeakBag (Subscriber x (v a)), WeakBagTicket)
-> EventM x (WeakBag (Subscriber x (v a)), WeakBagTicket)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (WeakBag (Subscriber x (v a)), WeakBagTicket)
 -> EventM x (WeakBag (Subscriber x (v a)), WeakBagTicket))
-> IO (WeakBag (Subscriber x (v a)), WeakBagTicket)
-> EventM x (WeakBag (Subscriber x (v a)), WeakBagTicket)
forall a b. (a -> b) -> a -> b
$ Subscriber x (v a)
-> IORef (Weak (k a, FanSubscribed x k v))
-> ((k a, FanSubscribed x k v) -> IO ())
-> IO (WeakBag (Subscriber x (v a)), WeakBagTicket)
forall a b.
a
-> IORef (Weak b) -> (b -> IO ()) -> IO (WeakBag a, WeakBagTicket)
WeakBag.singleton Subscriber x (v a)
sub IORef (Weak (k a, FanSubscribed x k v))
weakSelf (k a, FanSubscribed x k v) -> IO ()
forall k k (k :: k -> *) (a :: k) (x :: k) (v :: k -> *).
GCompare k =>
(k a, FanSubscribed x k v) -> IO ()
cleanupFanSubscribed
      IORef (DMap k (FanSubscribedChildren x k v))
subscribersRef <- IO (IORef (DMap k (FanSubscribedChildren x k v)))
-> EventM x (IORef (DMap k (FanSubscribedChildren x k v)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (DMap k (FanSubscribedChildren x k v)))
 -> EventM x (IORef (DMap k (FanSubscribedChildren x k v))))
-> IO (IORef (DMap k (FanSubscribedChildren x k v)))
-> EventM x (IORef (DMap k (FanSubscribedChildren x k v)))
forall a b. (a -> b) -> a -> b
$ DMap k (FanSubscribedChildren x k v)
-> IO (IORef (DMap k (FanSubscribedChildren x k v)))
forall a. a -> IO (IORef a)
newIORef (DMap k (FanSubscribedChildren x k v)
 -> IO (IORef (DMap k (FanSubscribedChildren x k v))))
-> DMap k (FanSubscribedChildren x k v)
-> IO (IORef (DMap k (FanSubscribedChildren x k v)))
forall a b. (a -> b) -> a -> b
$ String -> DMap k (FanSubscribedChildren x k v)
forall a. HasCallStack => String -> a
error "getFanSubscribed: subscribersRef not yet initialized"
      IORef (Maybe (DMap k v))
occRef <- IO (IORef (Maybe (DMap k v)))
-> EventM x (IORef (Maybe (DMap k v)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe (DMap k v)))
 -> EventM x (IORef (Maybe (DMap k v))))
-> IO (IORef (Maybe (DMap k v)))
-> EventM x (IORef (Maybe (DMap k v)))
forall a b. (a -> b) -> a -> b
$ Maybe (DMap k v) -> IO (IORef (Maybe (DMap k v)))
forall a. a -> IO (IORef a)
newIORef Maybe (DMap k v)
parentOcc
      Bool -> EventM x () -> EventM x ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (DMap k v) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (DMap k v)
parentOcc) (EventM x () -> EventM x ()) -> EventM x () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (DMap k v)) -> EventM x ()
forall (m :: * -> *) a.
Defer (Some Clear) m =>
IORef (Maybe a) -> m ()
scheduleClear IORef (Maybe (DMap k v))
occRef
#ifdef DEBUG_NODEIDS
      nid <- liftIO newNodeId
#endif
      let subscribed :: FanSubscribed x k v
subscribed = $WFanSubscribed :: forall k k (x :: k) (k :: k -> *) (v :: k -> *).
IORef (Maybe (FanSubscribed x k v))
-> IORef (Maybe (DMap k v))
-> IORef (DMap k (FanSubscribedChildren x k v))
-> EventSubscription x
-> FanSubscribed x k v
FanSubscribed
            { fanSubscribedCachedSubscribed :: IORef (Maybe (FanSubscribed x k v))
fanSubscribedCachedSubscribed = Fan x k v -> IORef (Maybe (FanSubscribed x k v))
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
Fan x k v -> IORef (Maybe (FanSubscribed x k v))
fanSubscribed Fan x k v
f
            , fanSubscribedOccurrence :: IORef (Maybe (DMap k v))
fanSubscribedOccurrence = IORef (Maybe (DMap k v))
occRef
            , fanSubscribedParent :: EventSubscription x
fanSubscribedParent = EventSubscription x
subscription
            , fanSubscribedSubscribers :: IORef (DMap k (FanSubscribedChildren x k v))
fanSubscribedSubscribers = IORef (DMap k (FanSubscribedChildren x k v))
subscribersRef
#ifdef DEBUG_NODEIDS
            , fanSubscribedNodeId = nid
#endif
            }
      let !self :: (k a, FanSubscribed x k v)
self = (k a
k, FanSubscribed x k v
subscribed)
      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (DMap k (FanSubscribedChildren x k v))
-> DMap k (FanSubscribedChildren x k v) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (DMap k (FanSubscribedChildren x k v))
subscribersRef (DMap k (FanSubscribedChildren x k v) -> IO ())
-> DMap k (FanSubscribedChildren x k v) -> IO ()
forall a b. (a -> b) -> a -> b
$! k a
-> FanSubscribedChildren x k v a
-> DMap k (FanSubscribedChildren x k v)
forall k1 (k2 :: k1 -> *) (v :: k1) (f :: k1 -> *).
k2 v -> f v -> DMap k2 f
DMap.singleton k a
k (FanSubscribedChildren x k v a
 -> DMap k (FanSubscribedChildren x k v))
-> FanSubscribedChildren x k v a
-> DMap k (FanSubscribedChildren x k v)
forall a b. (a -> b) -> a -> b
$ WeakBag (Subscriber x (v a))
-> (k a, FanSubscribed x k v)
-> IORef (Weak (k a, FanSubscribed x k v))
-> FanSubscribedChildren x k v a
forall k k (x :: k) (k :: k -> *) (v :: k -> *) (a :: k).
WeakBag (Subscriber x (v a))
-> (k a, FanSubscribed x k v)
-> IORef (Weak (k a, FanSubscribed x k v))
-> FanSubscribedChildren x k v a
FanSubscribedChildren WeakBag (Subscriber x (v a))
subsForK (k a, FanSubscribed x k v)
self IORef (Weak (k a, FanSubscribed x k v))
weakSelf
      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Weak (k a, FanSubscribed x k v))
-> Weak (k a, FanSubscribed x k v) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Weak (k a, FanSubscribed x k v))
weakSelf (Weak (k a, FanSubscribed x k v) -> IO ())
-> IO (Weak (k a, FanSubscribed x k v)) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Weak (k a, FanSubscribed x k v)
-> IO (Weak (k a, FanSubscribed x k v))
forall a. a -> IO a
evaluate (Weak (k a, FanSubscribed x k v)
 -> IO (Weak (k a, FanSubscribed x k v)))
-> IO (Weak (k a, FanSubscribed x k v))
-> IO (Weak (k a, FanSubscribed x k v))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (k a, FanSubscribed x k v)
-> String -> IO (Weak (k a, FanSubscribed x k v))
forall a. a -> String -> IO (Weak a)
mkWeakPtrWithDebug (k a, FanSubscribed x k v)
self "FanSubscribed"
      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (FanSubscribed x k v) -> FanSubscribed x k v -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (FanSubscribed x k v)
subscribedRef (FanSubscribed x k v -> IO ()) -> FanSubscribed x k v -> IO ()
forall a b. (a -> b) -> a -> b
$! FanSubscribed x k v
subscribed
      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (FanSubscribed x k v))
-> Maybe (FanSubscribed x k v) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Fan x k v -> IORef (Maybe (FanSubscribed x k v))
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
Fan x k v -> IORef (Maybe (FanSubscribed x k v))
fanSubscribed Fan x k v
f) (Maybe (FanSubscribed x k v) -> IO ())
-> Maybe (FanSubscribed x k v) -> IO ()
forall a b. (a -> b) -> a -> b
$ FanSubscribed x k v -> Maybe (FanSubscribed x k v)
forall a. a -> Maybe a
Just FanSubscribed x k v
subscribed
      (WeakBagTicket, FanSubscribed x k v, Maybe (v a))
-> EventM x (WeakBagTicket, FanSubscribed x k v, Maybe (v a))
forall (m :: * -> *) a. Monad m => a -> m a
return (WeakBagTicket
slnForSub, FanSubscribed x k v
subscribed, Maybe (v a) -> Maybe (v a)
forall a b. Coercible a b => a -> b
coerce (Maybe (v a) -> Maybe (v a)) -> Maybe (v a) -> Maybe (v a)
forall a b. (a -> b) -> a -> b
$ k a -> DMap k v -> Maybe (v a)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
DMap.lookup k a
k (DMap k v -> Maybe (v a)) -> Maybe (DMap k v) -> Maybe (v a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (DMap k v)
parentOcc)

cleanupFanSubscribed :: GCompare k => (k a, FanSubscribed x k v) -> IO ()
cleanupFanSubscribed :: (k a, FanSubscribed x k v) -> IO ()
cleanupFanSubscribed (k :: k a
k, subscribed :: FanSubscribed x k v
subscribed) = do
  DMap k (FanSubscribedChildren x k v)
subscribers <- IORef (DMap k (FanSubscribedChildren x k v))
-> IO (DMap k (FanSubscribedChildren x k v))
forall a. IORef a -> IO a
readIORef (IORef (DMap k (FanSubscribedChildren x k v))
 -> IO (DMap k (FanSubscribedChildren x k v)))
-> IORef (DMap k (FanSubscribedChildren x k v))
-> IO (DMap k (FanSubscribedChildren x k v))
forall a b. (a -> b) -> a -> b
$ FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
fanSubscribedSubscribers FanSubscribed x k v
subscribed
  let reducedSubscribers :: DMap k (FanSubscribedChildren x k v)
reducedSubscribers = k a
-> DMap k (FanSubscribedChildren x k v)
-> DMap k (FanSubscribedChildren x k v)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> DMap k2 f
DMap.delete k a
k DMap k (FanSubscribedChildren x k v)
subscribers
  if DMap k (FanSubscribedChildren x k v) -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap.null DMap k (FanSubscribedChildren x k v)
reducedSubscribers
    then do
      EventSubscription x -> IO ()
forall k (x :: k). EventSubscription x -> IO ()
unsubscribe (EventSubscription x -> IO ()) -> EventSubscription x -> IO ()
forall a b. (a -> b) -> a -> b
$ FanSubscribed x k v -> EventSubscription x
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> EventSubscription x
fanSubscribedParent FanSubscribed x k v
subscribed
      -- Not necessary in this case, because this whole FanSubscribed is dead: writeIORef (fanSubscribedSubscribers subscribed) reducedSubscribers
      IORef (Maybe (FanSubscribed x k v))
-> Maybe (FanSubscribed x k v) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (FanSubscribed x k v -> IORef (Maybe (FanSubscribed x k v))
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (Maybe (FanSubscribed x k v))
fanSubscribedCachedSubscribed FanSubscribed x k v
subscribed) Maybe (FanSubscribed x k v)
forall a. Maybe a
Nothing
    else IORef (DMap k (FanSubscribedChildren x k v))
-> DMap k (FanSubscribedChildren x k v) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
fanSubscribedSubscribers FanSubscribed x k v
subscribed) (DMap k (FanSubscribedChildren x k v) -> IO ())
-> DMap k (FanSubscribedChildren x k v) -> IO ()
forall a b. (a -> b) -> a -> b
$! DMap k (FanSubscribedChildren x k v)
reducedSubscribers

{-# INLINE subscribeFanSubscribed #-}
subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed x k v -> Subscriber x (v a) -> IO WeakBagTicket
subscribeFanSubscribed :: k a
-> FanSubscribed x k v -> Subscriber x (v a) -> IO WeakBagTicket
subscribeFanSubscribed k :: k a
k subscribed :: FanSubscribed x k v
subscribed sub :: Subscriber x (v a)
sub = do
  DMap k (FanSubscribedChildren x k v)
subscribers <- IORef (DMap k (FanSubscribedChildren x k v))
-> IO (DMap k (FanSubscribedChildren x k v))
forall a. IORef a -> IO a
readIORef (IORef (DMap k (FanSubscribedChildren x k v))
 -> IO (DMap k (FanSubscribedChildren x k v)))
-> IORef (DMap k (FanSubscribedChildren x k v))
-> IO (DMap k (FanSubscribedChildren x k v))
forall a b. (a -> b) -> a -> b
$ FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
fanSubscribedSubscribers FanSubscribed x k v
subscribed
  case k a
-> DMap k (FanSubscribedChildren x k v)
-> Maybe (FanSubscribedChildren x k v a)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
DMap.lookup k a
k DMap k (FanSubscribedChildren x k v)
subscribers of
    Nothing -> {-# SCC "missSubscribeFanSubscribed" #-} do
      let !self :: (k a, FanSubscribed x k v)
self = (k a
k, FanSubscribed x k v
subscribed)
      IORef (Weak (k a, FanSubscribed x k v))
weakSelf <- Weak (k a, FanSubscribed x k v)
-> IO (IORef (Weak (k a, FanSubscribed x k v)))
forall a. a -> IO (IORef a)
newIORef (Weak (k a, FanSubscribed x k v)
 -> IO (IORef (Weak (k a, FanSubscribed x k v))))
-> IO (Weak (k a, FanSubscribed x k v))
-> IO (IORef (Weak (k a, FanSubscribed x k v)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (k a, FanSubscribed x k v)
-> String -> IO (Weak (k a, FanSubscribed x k v))
forall a. a -> String -> IO (Weak a)
mkWeakPtrWithDebug (k a, FanSubscribed x k v)
self "FanSubscribed"
      (list :: WeakBag (Subscriber x (v a))
list, sln :: WeakBagTicket
sln) <- Subscriber x (v a)
-> IORef (Weak (k a, FanSubscribed x k v))
-> ((k a, FanSubscribed x k v) -> IO ())
-> IO (WeakBag (Subscriber x (v a)), WeakBagTicket)
forall a b.
a
-> IORef (Weak b) -> (b -> IO ()) -> IO (WeakBag a, WeakBagTicket)
WeakBag.singleton Subscriber x (v a)
sub IORef (Weak (k a, FanSubscribed x k v))
weakSelf (k a, FanSubscribed x k v) -> IO ()
forall k k (k :: k -> *) (a :: k) (x :: k) (v :: k -> *).
GCompare k =>
(k a, FanSubscribed x k v) -> IO ()
cleanupFanSubscribed
      IORef (DMap k (FanSubscribedChildren x k v))
-> DMap k (FanSubscribedChildren x k v) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
fanSubscribedSubscribers FanSubscribed x k v
subscribed) (DMap k (FanSubscribedChildren x k v) -> IO ())
-> DMap k (FanSubscribedChildren x k v) -> IO ()
forall a b. (a -> b) -> a -> b
$! (FanSubscribedChildren x k v a
 -> FanSubscribedChildren x k v a -> FanSubscribedChildren x k v a)
-> k a
-> FanSubscribedChildren x k v a
-> DMap k (FanSubscribedChildren x k v)
-> DMap k (FanSubscribedChildren x k v)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
(f v -> f v -> f v) -> k2 v -> f v -> DMap k2 f -> DMap k2 f
DMap.insertWith (String
-> FanSubscribedChildren x k v a
-> FanSubscribedChildren x k v a
-> FanSubscribedChildren x k v a
forall a. HasCallStack => String -> a
error "subscribeFanSubscribed: key that we just failed to find is present - should be impossible") k a
k (WeakBag (Subscriber x (v a))
-> (k a, FanSubscribed x k v)
-> IORef (Weak (k a, FanSubscribed x k v))
-> FanSubscribedChildren x k v a
forall k k (x :: k) (k :: k -> *) (v :: k -> *) (a :: k).
WeakBag (Subscriber x (v a))
-> (k a, FanSubscribed x k v)
-> IORef (Weak (k a, FanSubscribed x k v))
-> FanSubscribedChildren x k v a
FanSubscribedChildren WeakBag (Subscriber x (v a))
list (k a, FanSubscribed x k v)
self IORef (Weak (k a, FanSubscribed x k v))
weakSelf) DMap k (FanSubscribedChildren x k v)
subscribers
      WeakBagTicket -> IO WeakBagTicket
forall (m :: * -> *) a. Monad m => a -> m a
return WeakBagTicket
sln
    Just (FanSubscribedChildren list :: WeakBag (Subscriber x (v a))
list _ weakSelf :: IORef (Weak (k a, FanSubscribed x k v))
weakSelf) -> {-# SCC "hitSubscribeFanSubscribed" #-} Subscriber x (v a)
-> WeakBag (Subscriber x (v a))
-> IORef (Weak (k a, FanSubscribed x k v))
-> ((k a, FanSubscribed x k v) -> IO ())
-> IO WeakBagTicket
forall a b.
a
-> WeakBag a -> IORef (Weak b) -> (b -> IO ()) -> IO WeakBagTicket
WeakBag.insert Subscriber x (v a)
sub WeakBag (Subscriber x (v a))
list IORef (Weak (k a, FanSubscribed x k v))
weakSelf (k a, FanSubscribed x k v) -> IO ()
forall k k (k :: k -> *) (a :: k) (x :: k) (v :: k -> *).
GCompare k =>
(k a, FanSubscribed x k v) -> IO ()
cleanupFanSubscribed

{-# INLINABLE getSwitchSubscribed #-}
getSwitchSubscribed :: HasSpiderTimeline x => Switch x a -> Subscriber x a -> EventM x (WeakBagTicket, SwitchSubscribed x a, Maybe a)
getSwitchSubscribed :: Switch x a
-> Subscriber x a
-> EventM x (WeakBagTicket, SwitchSubscribed x a, Maybe a)
getSwitchSubscribed s :: Switch x a
s sub :: Subscriber x a
sub = do
  Maybe (SwitchSubscribed x a)
mSubscribed <- IO (Maybe (SwitchSubscribed x a))
-> EventM x (Maybe (SwitchSubscribed x a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (SwitchSubscribed x a))
 -> EventM x (Maybe (SwitchSubscribed x a)))
-> IO (Maybe (SwitchSubscribed x a))
-> EventM x (Maybe (SwitchSubscribed x a))
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (SwitchSubscribed x a))
-> IO (Maybe (SwitchSubscribed x a))
forall a. IORef a -> IO a
readIORef (IORef (Maybe (SwitchSubscribed x a))
 -> IO (Maybe (SwitchSubscribed x a)))
-> IORef (Maybe (SwitchSubscribed x a))
-> IO (Maybe (SwitchSubscribed x a))
forall a b. (a -> b) -> a -> b
$ Switch x a -> IORef (Maybe (SwitchSubscribed x a))
forall k (x :: k) a.
Switch x a -> IORef (Maybe (SwitchSubscribed x a))
switchSubscribed Switch x a
s
  case Maybe (SwitchSubscribed x a)
mSubscribed of
    Just subscribed :: SwitchSubscribed x a
subscribed -> {-# SCC "hitSwitch" #-} IO (WeakBagTicket, SwitchSubscribed x a, Maybe a)
-> EventM x (WeakBagTicket, SwitchSubscribed x a, Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (WeakBagTicket, SwitchSubscribed x a, Maybe a)
 -> EventM x (WeakBagTicket, SwitchSubscribed x a, Maybe a))
-> IO (WeakBagTicket, SwitchSubscribed x a, Maybe a)
-> EventM x (WeakBagTicket, SwitchSubscribed x a, Maybe a)
forall a b. (a -> b) -> a -> b
$ do
      WeakBagTicket
sln <- SwitchSubscribed x a -> Subscriber x a -> IO WeakBagTicket
forall k (x :: k) a.
SwitchSubscribed x a -> Subscriber x a -> IO WeakBagTicket
subscribeSwitchSubscribed SwitchSubscribed x a
subscribed Subscriber x a
sub
      Maybe a
occ <- IORef (Maybe a) -> IO (Maybe a)
forall a. IORef a -> IO a
readIORef (IORef (Maybe a) -> IO (Maybe a))
-> IORef (Maybe a) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ SwitchSubscribed x a -> IORef (Maybe a)
forall k (x :: k) a. SwitchSubscribed x a -> IORef (Maybe a)
switchSubscribedOccurrence SwitchSubscribed x a
subscribed
      (WeakBagTicket, SwitchSubscribed x a, Maybe a)
-> IO (WeakBagTicket, SwitchSubscribed x a, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (WeakBagTicket
sln, SwitchSubscribed x a
subscribed, Maybe a
occ)
    Nothing -> {-# SCC "missSwitch" #-} do
      IORef (SwitchSubscribed x a)
subscribedRef <- IO (IORef (SwitchSubscribed x a))
-> EventM x (IORef (SwitchSubscribed x a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (SwitchSubscribed x a))
 -> EventM x (IORef (SwitchSubscribed x a)))
-> IO (IORef (SwitchSubscribed x a))
-> EventM x (IORef (SwitchSubscribed x a))
forall a b. (a -> b) -> a -> b
$ SwitchSubscribed x a -> IO (IORef (SwitchSubscribed x a))
forall a. a -> IO (IORef a)
newIORef (SwitchSubscribed x a -> IO (IORef (SwitchSubscribed x a)))
-> SwitchSubscribed x a -> IO (IORef (SwitchSubscribed x a))
forall a b. (a -> b) -> a -> b
$ String -> SwitchSubscribed x a
forall a. HasCallStack => String -> a
error "getSwitchSubscribed: subscribed has not yet been created"
      SwitchSubscribed x a
subscribedUnsafe <- IO (SwitchSubscribed x a) -> EventM x (SwitchSubscribed x a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SwitchSubscribed x a) -> EventM x (SwitchSubscribed x a))
-> IO (SwitchSubscribed x a) -> EventM x (SwitchSubscribed x a)
forall a b. (a -> b) -> a -> b
$ IO (SwitchSubscribed x a) -> IO (SwitchSubscribed x a)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (SwitchSubscribed x a) -> IO (SwitchSubscribed x a))
-> IO (SwitchSubscribed x a) -> IO (SwitchSubscribed x a)
forall a b. (a -> b) -> a -> b
$ IORef (SwitchSubscribed x a) -> IO (SwitchSubscribed x a)
forall a. IORef a -> IO a
readIORef IORef (SwitchSubscribed x a)
subscribedRef
      Invalidator x
i <- IO (Invalidator x) -> EventM x (Invalidator x)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Invalidator x) -> EventM x (Invalidator x))
-> IO (Invalidator x) -> EventM x (Invalidator x)
forall a b. (a -> b) -> a -> b
$ SwitchSubscribed x a -> IO (Invalidator x)
forall k (x :: k) a. SwitchSubscribed x a -> IO (Invalidator x)
newInvalidatorSwitch SwitchSubscribed x a
subscribedUnsafe
      Subscriber x a
mySub <- IO (Subscriber x a) -> EventM x (Subscriber x a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Subscriber x a) -> EventM x (Subscriber x a))
-> IO (Subscriber x a) -> EventM x (Subscriber x a)
forall a b. (a -> b) -> a -> b
$ SwitchSubscribed x a -> IO (Subscriber x a)
forall x a.
HasSpiderTimeline x =>
SwitchSubscribed x a -> IO (Subscriber x a)
newSubscriberSwitch SwitchSubscribed x a
subscribedUnsafe
      Weak (Invalidator x)
wi <- IO (Weak (Invalidator x)) -> EventM x (Weak (Invalidator x))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Weak (Invalidator x)) -> EventM x (Weak (Invalidator x)))
-> IO (Weak (Invalidator x)) -> EventM x (Weak (Invalidator x))
forall a b. (a -> b) -> a -> b
$ Invalidator x -> String -> IO (Weak (Invalidator x))
forall a. a -> String -> IO (Weak a)
mkWeakPtrWithDebug Invalidator x
i "InvalidatorSwitch"
      IORef (Weak (Invalidator x))
wiRef <- IO (IORef (Weak (Invalidator x)))
-> EventM x (IORef (Weak (Invalidator x)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Weak (Invalidator x)))
 -> EventM x (IORef (Weak (Invalidator x))))
-> IO (IORef (Weak (Invalidator x)))
-> EventM x (IORef (Weak (Invalidator x)))
forall a b. (a -> b) -> a -> b
$ Weak (Invalidator x) -> IO (IORef (Weak (Invalidator x)))
forall a. a -> IO (IORef a)
newIORef Weak (Invalidator x)
wi
      IORef [SomeBehaviorSubscribed x]
parentsRef <- IO (IORef [SomeBehaviorSubscribed x])
-> EventM x (IORef [SomeBehaviorSubscribed x])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [SomeBehaviorSubscribed x])
 -> EventM x (IORef [SomeBehaviorSubscribed x]))
-> IO (IORef [SomeBehaviorSubscribed x])
-> EventM x (IORef [SomeBehaviorSubscribed x])
forall a b. (a -> b) -> a -> b
$ [SomeBehaviorSubscribed x] -> IO (IORef [SomeBehaviorSubscribed x])
forall a. a -> IO (IORef a)
newIORef [] --TODO: This should be unnecessary, because it will always be filled with just the single parent behavior
      IORef [SomeHoldInit x]
holdInits <- EventM x (IORef [SomeHoldInit x])
forall a (m :: * -> *). Defer a m => m (IORef [a])
getDeferralQueue
      Event x a
e <- IO (Event x a) -> EventM x (Event x a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Event x a) -> EventM x (Event x a))
-> IO (Event x a) -> EventM x (Event x a)
forall a b. (a -> b) -> a -> b
$ BehaviorM x (Event x a)
-> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
-> IORef [SomeHoldInit x]
-> IO (Event x a)
forall k (x :: k) a.
BehaviorM x a
-> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
-> IORef [SomeHoldInit x]
-> IO a
runBehaviorM (Behavior x (Event x a) -> BehaviorM x (Event x a)
forall k (x :: k) a. Behavior x a -> BehaviorM x a
readBehaviorTracked (Switch x a -> Behavior x (Event x a)
forall k (x :: k) a. Switch x a -> Behavior x (Event x a)
switchParent Switch x a
s)) ((Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
-> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
forall a. a -> Maybe a
Just (Weak (Invalidator x)
wi, IORef [SomeBehaviorSubscribed x]
parentsRef)) IORef [SomeHoldInit x]
holdInits
      (subscription :: EventSubscription x
subscription@(EventSubscription _ subd :: EventSubscribed x
subd), parentOcc :: Maybe a
parentOcc) <- Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
forall k (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead Event x a
e Subscriber x a
mySub
      IORef Height
heightRef <- IO (IORef Height) -> EventM x (IORef Height)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Height) -> EventM x (IORef Height))
-> IO (IORef Height) -> EventM x (IORef Height)
forall a b. (a -> b) -> a -> b
$ Height -> IO (IORef Height)
forall a. a -> IO (IORef a)
newIORef (Height -> IO (IORef Height)) -> IO Height -> IO (IORef Height)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EventSubscribed x -> IO Height
forall k (x :: k). EventSubscribed x -> IO Height
getEventSubscribedHeight EventSubscribed x
subd
      IORef (EventSubscription x)
subscriptionRef <- IO (IORef (EventSubscription x))
-> EventM x (IORef (EventSubscription x))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (EventSubscription x))
 -> EventM x (IORef (EventSubscription x)))
-> IO (IORef (EventSubscription x))
-> EventM x (IORef (EventSubscription x))
forall a b. (a -> b) -> a -> b
$ EventSubscription x -> IO (IORef (EventSubscription x))
forall a. a -> IO (IORef a)
newIORef EventSubscription x
subscription
      IORef (Maybe a)
occRef <- IO (IORef (Maybe a)) -> EventM x (IORef (Maybe a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe a)) -> EventM x (IORef (Maybe a)))
-> IO (IORef (Maybe a)) -> EventM x (IORef (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> IO (IORef (Maybe a))
forall a. a -> IO (IORef a)
newIORef Maybe a
parentOcc
      Bool -> EventM x () -> EventM x ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
parentOcc) (EventM x () -> EventM x ()) -> EventM x () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe a) -> EventM x ()
forall (m :: * -> *) a.
Defer (Some Clear) m =>
IORef (Maybe a) -> m ()
scheduleClear IORef (Maybe a)
occRef
      IORef (Weak (SwitchSubscribed x a))
weakSelf <- IO (IORef (Weak (SwitchSubscribed x a)))
-> EventM x (IORef (Weak (SwitchSubscribed x a)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Weak (SwitchSubscribed x a)))
 -> EventM x (IORef (Weak (SwitchSubscribed x a))))
-> IO (IORef (Weak (SwitchSubscribed x a)))
-> EventM x (IORef (Weak (SwitchSubscribed x a)))
forall a b. (a -> b) -> a -> b
$ Weak (SwitchSubscribed x a)
-> IO (IORef (Weak (SwitchSubscribed x a)))
forall a. a -> IO (IORef a)
newIORef (Weak (SwitchSubscribed x a)
 -> IO (IORef (Weak (SwitchSubscribed x a))))
-> Weak (SwitchSubscribed x a)
-> IO (IORef (Weak (SwitchSubscribed x a)))
forall a b. (a -> b) -> a -> b
$ String -> Weak (SwitchSubscribed x a)
forall a. HasCallStack => String -> a
error "getSwitchSubscribed: weakSelf not yet initialized"
      (subs :: WeakBag (Subscriber x a)
subs, slnForSub :: WeakBagTicket
slnForSub) <- IO (WeakBag (Subscriber x a), WeakBagTicket)
-> EventM x (WeakBag (Subscriber x a), WeakBagTicket)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (WeakBag (Subscriber x a), WeakBagTicket)
 -> EventM x (WeakBag (Subscriber x a), WeakBagTicket))
-> IO (WeakBag (Subscriber x a), WeakBagTicket)
-> EventM x (WeakBag (Subscriber x a), WeakBagTicket)
forall a b. (a -> b) -> a -> b
$ Subscriber x a
-> IORef (Weak (SwitchSubscribed x a))
-> (SwitchSubscribed x a -> IO ())
-> IO (WeakBag (Subscriber x a), WeakBagTicket)
forall a b.
a
-> IORef (Weak b) -> (b -> IO ()) -> IO (WeakBag a, WeakBagTicket)
WeakBag.singleton Subscriber x a
sub IORef (Weak (SwitchSubscribed x a))
weakSelf SwitchSubscribed x a -> IO ()
forall k (x :: k) a. SwitchSubscribed x a -> IO ()
cleanupSwitchSubscribed
#ifdef DEBUG_NODEIDS
      nid <- liftIO newNodeId
#endif
      let !subscribed :: SwitchSubscribed x a
subscribed = $WSwitchSubscribed :: forall k (x :: k) a.
IORef (Maybe (SwitchSubscribed x a))
-> IORef (Maybe a)
-> IORef Height
-> WeakBag (Subscriber x a)
-> Invalidator x
-> IORef (Weak (Invalidator x))
-> IORef [SomeBehaviorSubscribed x]
-> Behavior x (Event x a)
-> IORef (EventSubscription x)
-> IORef (Weak (SwitchSubscribed x a))
-> SwitchSubscribed x a
SwitchSubscribed
            { switchSubscribedCachedSubscribed :: IORef (Maybe (SwitchSubscribed x a))
switchSubscribedCachedSubscribed = Switch x a -> IORef (Maybe (SwitchSubscribed x a))
forall k (x :: k) a.
Switch x a -> IORef (Maybe (SwitchSubscribed x a))
switchSubscribed Switch x a
s
            , switchSubscribedOccurrence :: IORef (Maybe a)
switchSubscribedOccurrence = IORef (Maybe a)
occRef
            , switchSubscribedHeight :: IORef Height
switchSubscribedHeight = IORef Height
heightRef
            , switchSubscribedSubscribers :: WeakBag (Subscriber x a)
switchSubscribedSubscribers = WeakBag (Subscriber x a)
subs
            , switchSubscribedOwnInvalidator :: Invalidator x
switchSubscribedOwnInvalidator = Invalidator x
i
            , switchSubscribedOwnWeakInvalidator :: IORef (Weak (Invalidator x))
switchSubscribedOwnWeakInvalidator = IORef (Weak (Invalidator x))
wiRef
            , switchSubscribedBehaviorParents :: IORef [SomeBehaviorSubscribed x]
switchSubscribedBehaviorParents = IORef [SomeBehaviorSubscribed x]
parentsRef
            , switchSubscribedParent :: Behavior x (Event x a)
switchSubscribedParent = Switch x a -> Behavior x (Event x a)
forall k (x :: k) a. Switch x a -> Behavior x (Event x a)
switchParent Switch x a
s
            , switchSubscribedCurrentParent :: IORef (EventSubscription x)
switchSubscribedCurrentParent = IORef (EventSubscription x)
subscriptionRef
            , switchSubscribedWeakSelf :: IORef (Weak (SwitchSubscribed x a))
switchSubscribedWeakSelf = IORef (Weak (SwitchSubscribed x a))
weakSelf
#ifdef DEBUG_NODEIDS
            , switchSubscribedNodeId = nid
#endif
            }
      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Weak (SwitchSubscribed x a))
-> Weak (SwitchSubscribed x a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Weak (SwitchSubscribed x a))
weakSelf (Weak (SwitchSubscribed x a) -> IO ())
-> IO (Weak (SwitchSubscribed x a)) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Weak (SwitchSubscribed x a) -> IO (Weak (SwitchSubscribed x a))
forall a. a -> IO a
evaluate (Weak (SwitchSubscribed x a) -> IO (Weak (SwitchSubscribed x a)))
-> IO (Weak (SwitchSubscribed x a))
-> IO (Weak (SwitchSubscribed x a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SwitchSubscribed x a -> String -> IO (Weak (SwitchSubscribed x a))
forall a. a -> String -> IO (Weak a)
mkWeakPtrWithDebug SwitchSubscribed x a
subscribed "switchSubscribedWeakSelf"
      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (SwitchSubscribed x a) -> SwitchSubscribed x a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (SwitchSubscribed x a)
subscribedRef (SwitchSubscribed x a -> IO ()) -> SwitchSubscribed x a -> IO ()
forall a b. (a -> b) -> a -> b
$! SwitchSubscribed x a
subscribed
      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (SwitchSubscribed x a))
-> Maybe (SwitchSubscribed x a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Switch x a -> IORef (Maybe (SwitchSubscribed x a))
forall k (x :: k) a.
Switch x a -> IORef (Maybe (SwitchSubscribed x a))
switchSubscribed Switch x a
s) (Maybe (SwitchSubscribed x a) -> IO ())
-> Maybe (SwitchSubscribed x a) -> IO ()
forall a b. (a -> b) -> a -> b
$ SwitchSubscribed x a -> Maybe (SwitchSubscribed x a)
forall a. a -> Maybe a
Just SwitchSubscribed x a
subscribed
      (WeakBagTicket, SwitchSubscribed x a, Maybe a)
-> EventM x (WeakBagTicket, SwitchSubscribed x a, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (WeakBagTicket
slnForSub, SwitchSubscribed x a
subscribed, Maybe a
parentOcc)

cleanupSwitchSubscribed :: SwitchSubscribed x a -> IO ()
cleanupSwitchSubscribed :: SwitchSubscribed x a -> IO ()
cleanupSwitchSubscribed subscribed :: SwitchSubscribed x a
subscribed = do
  EventSubscription x -> IO ()
forall k (x :: k). EventSubscription x -> IO ()
unsubscribe (EventSubscription x -> IO ()) -> IO (EventSubscription x) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (EventSubscription x) -> IO (EventSubscription x)
forall a. IORef a -> IO a
readIORef (SwitchSubscribed x a -> IORef (EventSubscription x)
forall k (x :: k) a.
SwitchSubscribed x a -> IORef (EventSubscription x)
switchSubscribedCurrentParent SwitchSubscribed x a
subscribed)
  Weak (Invalidator x) -> IO ()
forall v. Weak v -> IO ()
finalize (Weak (Invalidator x) -> IO ())
-> IO (Weak (Invalidator x)) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (Weak (Invalidator x)) -> IO (Weak (Invalidator x))
forall a. IORef a -> IO a
readIORef (SwitchSubscribed x a -> IORef (Weak (Invalidator x))
forall k (x :: k) a.
SwitchSubscribed x a -> IORef (Weak (Invalidator x))
switchSubscribedOwnWeakInvalidator SwitchSubscribed x a
subscribed) -- We don't need to get invalidated if we're dead
  IORef (Maybe (SwitchSubscribed x a))
-> Maybe (SwitchSubscribed x a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (SwitchSubscribed x a -> IORef (Maybe (SwitchSubscribed x a))
forall k (x :: k) a.
SwitchSubscribed x a -> IORef (Maybe (SwitchSubscribed x a))
switchSubscribedCachedSubscribed SwitchSubscribed x a
subscribed) Maybe (SwitchSubscribed x a)
forall a. Maybe a
Nothing

{-# INLINE subscribeSwitchSubscribed #-}
subscribeSwitchSubscribed :: SwitchSubscribed x a -> Subscriber x a -> IO WeakBagTicket
subscribeSwitchSubscribed :: SwitchSubscribed x a -> Subscriber x a -> IO WeakBagTicket
subscribeSwitchSubscribed subscribed :: SwitchSubscribed x a
subscribed sub :: Subscriber x a
sub = Subscriber x a
-> WeakBag (Subscriber x a)
-> IORef (Weak (SwitchSubscribed x a))
-> (SwitchSubscribed x a -> IO ())
-> IO WeakBagTicket
forall a b.
a
-> WeakBag a -> IORef (Weak b) -> (b -> IO ()) -> IO WeakBagTicket
WeakBag.insert Subscriber x a
sub (SwitchSubscribed x a -> WeakBag (Subscriber x a)
forall k (x :: k) a.
SwitchSubscribed x a -> WeakBag (Subscriber x a)
switchSubscribedSubscribers SwitchSubscribed x a
subscribed) (SwitchSubscribed x a -> IORef (Weak (SwitchSubscribed x a))
forall k (x :: k) a.
SwitchSubscribed x a -> IORef (Weak (SwitchSubscribed x a))
switchSubscribedWeakSelf SwitchSubscribed x a
subscribed) SwitchSubscribed x a -> IO ()
forall k (x :: k) a. SwitchSubscribed x a -> IO ()
cleanupSwitchSubscribed

{-# INLINABLE getCoincidenceSubscribed #-}
getCoincidenceSubscribed :: forall x a. HasSpiderTimeline x => Coincidence x a -> Subscriber x a -> EventM x (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)
getCoincidenceSubscribed :: Coincidence x a
-> Subscriber x a
-> EventM x (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)
getCoincidenceSubscribed c :: Coincidence x a
c sub :: Subscriber x a
sub = do
  Maybe (CoincidenceSubscribed x a)
mSubscribed <- IO (Maybe (CoincidenceSubscribed x a))
-> EventM x (Maybe (CoincidenceSubscribed x a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (CoincidenceSubscribed x a))
 -> EventM x (Maybe (CoincidenceSubscribed x a)))
-> IO (Maybe (CoincidenceSubscribed x a))
-> EventM x (Maybe (CoincidenceSubscribed x a))
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (CoincidenceSubscribed x a))
-> IO (Maybe (CoincidenceSubscribed x a))
forall a. IORef a -> IO a
readIORef (IORef (Maybe (CoincidenceSubscribed x a))
 -> IO (Maybe (CoincidenceSubscribed x a)))
-> IORef (Maybe (CoincidenceSubscribed x a))
-> IO (Maybe (CoincidenceSubscribed x a))
forall a b. (a -> b) -> a -> b
$ Coincidence x a -> IORef (Maybe (CoincidenceSubscribed x a))
forall k (x :: k) a.
Coincidence x a -> IORef (Maybe (CoincidenceSubscribed x a))
coincidenceSubscribed Coincidence x a
c
  case Maybe (CoincidenceSubscribed x a)
mSubscribed of
    Just subscribed :: CoincidenceSubscribed x a
subscribed -> {-# SCC "hitCoincidence" #-} IO (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)
-> EventM x (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)
 -> EventM x (WeakBagTicket, CoincidenceSubscribed x a, Maybe a))
-> IO (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)
-> EventM x (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)
forall a b. (a -> b) -> a -> b
$ do
      WeakBagTicket
sln <- CoincidenceSubscribed x a -> Subscriber x a -> IO WeakBagTicket
forall k (x :: k) a.
CoincidenceSubscribed x a -> Subscriber x a -> IO WeakBagTicket
subscribeCoincidenceSubscribed CoincidenceSubscribed x a
subscribed Subscriber x a
sub
      Maybe a
occ <- IORef (Maybe a) -> IO (Maybe a)
forall a. IORef a -> IO a
readIORef (IORef (Maybe a) -> IO (Maybe a))
-> IORef (Maybe a) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ CoincidenceSubscribed x a -> IORef (Maybe a)
forall k (x :: k) a. CoincidenceSubscribed x a -> IORef (Maybe a)
coincidenceSubscribedOccurrence CoincidenceSubscribed x a
subscribed
      (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)
-> IO (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (WeakBagTicket
sln, CoincidenceSubscribed x a
subscribed, Maybe a
occ)
    Nothing -> {-# SCC "missCoincidence" #-} do
      IORef (CoincidenceSubscribed x a)
subscribedRef <- IO (IORef (CoincidenceSubscribed x a))
-> EventM x (IORef (CoincidenceSubscribed x a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (CoincidenceSubscribed x a))
 -> EventM x (IORef (CoincidenceSubscribed x a)))
-> IO (IORef (CoincidenceSubscribed x a))
-> EventM x (IORef (CoincidenceSubscribed x a))
forall a b. (a -> b) -> a -> b
$ CoincidenceSubscribed x a -> IO (IORef (CoincidenceSubscribed x a))
forall a. a -> IO (IORef a)
newIORef (CoincidenceSubscribed x a
 -> IO (IORef (CoincidenceSubscribed x a)))
-> CoincidenceSubscribed x a
-> IO (IORef (CoincidenceSubscribed x a))
forall a b. (a -> b) -> a -> b
$ String -> CoincidenceSubscribed x a
forall a. HasCallStack => String -> a
error "getCoincidenceSubscribed: subscribed has not yet been created"
      CoincidenceSubscribed x a
subscribedUnsafe <- IO (CoincidenceSubscribed x a)
-> EventM x (CoincidenceSubscribed x a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (CoincidenceSubscribed x a)
 -> EventM x (CoincidenceSubscribed x a))
-> IO (CoincidenceSubscribed x a)
-> EventM x (CoincidenceSubscribed x a)
forall a b. (a -> b) -> a -> b
$ IO (CoincidenceSubscribed x a) -> IO (CoincidenceSubscribed x a)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (CoincidenceSubscribed x a) -> IO (CoincidenceSubscribed x a))
-> IO (CoincidenceSubscribed x a) -> IO (CoincidenceSubscribed x a)
forall a b. (a -> b) -> a -> b
$ IORef (CoincidenceSubscribed x a) -> IO (CoincidenceSubscribed x a)
forall a. IORef a -> IO a
readIORef IORef (CoincidenceSubscribed x a)
subscribedRef
      Subscriber x (Event x a)
subOuter <- IO (Subscriber x (Event x a))
-> EventM x (Subscriber x (Event x a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Subscriber x (Event x a))
 -> EventM x (Subscriber x (Event x a)))
-> IO (Subscriber x (Event x a))
-> EventM x (Subscriber x (Event x a))
forall a b. (a -> b) -> a -> b
$ CoincidenceSubscribed x a -> IO (Subscriber x (Event x a))
forall x b.
HasSpiderTimeline x =>
CoincidenceSubscribed x b -> IO (Subscriber x (Event x b))
newSubscriberCoincidenceOuter CoincidenceSubscribed x a
subscribedUnsafe
      (outerSubscription :: EventSubscription x
outerSubscription@(EventSubscription _ outerSubd :: EventSubscribed x
outerSubd), outerOcc :: Maybe (Event x a)
outerOcc) <- Event x (Event x a)
-> Subscriber x (Event x a)
-> EventM x (EventSubscription x, Maybe (Event x a))
forall k (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead (Coincidence x a -> Event x (Event x a)
forall k (x :: k) a. Coincidence x a -> Event x (Event x a)
coincidenceParent Coincidence x a
c) Subscriber x (Event x a)
subOuter
      Height
outerHeight <- IO Height -> EventM x Height
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Height -> EventM x Height) -> IO Height -> EventM x Height
forall a b. (a -> b) -> a -> b
$ EventSubscribed x -> IO Height
forall k (x :: k). EventSubscribed x -> IO Height
getEventSubscribedHeight EventSubscribed x
outerSubd
      (occ :: Maybe a
occ, height :: Height
height, mInnerSubd :: Maybe (EventSubscribed x)
mInnerSubd) <- case Maybe (Event x a)
outerOcc of
        Nothing -> (Maybe a, Height, Maybe (EventSubscribed x))
-> EventM x (Maybe a, Height, Maybe (EventSubscribed x))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
forall a. Maybe a
Nothing, Height
outerHeight, Maybe (EventSubscribed x)
forall a. Maybe a
Nothing)
        Just o :: Event x a
o -> do
          (occ :: Maybe a
occ, height :: Height
height, innerSubd :: EventSubscribed x
innerSubd) <- Event x a
-> Height
-> CoincidenceSubscribed x a
-> EventM x (Maybe a, Height, EventSubscribed x)
forall x a.
HasSpiderTimeline x =>
Event x a
-> Height
-> CoincidenceSubscribed x a
-> EventM x (Maybe a, Height, EventSubscribed x)
subscribeCoincidenceInner Event x a
o Height
outerHeight CoincidenceSubscribed x a
subscribedUnsafe
          (Maybe a, Height, Maybe (EventSubscribed x))
-> EventM x (Maybe a, Height, Maybe (EventSubscribed x))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
occ, Height
height, EventSubscribed x -> Maybe (EventSubscribed x)
forall a. a -> Maybe a
Just EventSubscribed x
innerSubd)
      IORef (Maybe a)
occRef <- IO (IORef (Maybe a)) -> EventM x (IORef (Maybe a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe a)) -> EventM x (IORef (Maybe a)))
-> IO (IORef (Maybe a)) -> EventM x (IORef (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> IO (IORef (Maybe a))
forall a. a -> IO (IORef a)
newIORef Maybe a
occ
      Bool -> EventM x () -> EventM x ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
occ) (EventM x () -> EventM x ()) -> EventM x () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe a) -> EventM x ()
forall (m :: * -> *) a.
Defer (Some Clear) m =>
IORef (Maybe a) -> m ()
scheduleClear IORef (Maybe a)
occRef
      IORef Height
heightRef <- IO (IORef Height) -> EventM x (IORef Height)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Height) -> EventM x (IORef Height))
-> IO (IORef Height) -> EventM x (IORef Height)
forall a b. (a -> b) -> a -> b
$ Height -> IO (IORef Height)
forall a. a -> IO (IORef a)
newIORef Height
height
      IORef (Maybe (EventSubscribed x))
innerSubdRef <- IO (IORef (Maybe (EventSubscribed x)))
-> EventM x (IORef (Maybe (EventSubscribed x)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe (EventSubscribed x)))
 -> EventM x (IORef (Maybe (EventSubscribed x))))
-> IO (IORef (Maybe (EventSubscribed x)))
-> EventM x (IORef (Maybe (EventSubscribed x)))
forall a b. (a -> b) -> a -> b
$ Maybe (EventSubscribed x) -> IO (IORef (Maybe (EventSubscribed x)))
forall a. a -> IO (IORef a)
newIORef Maybe (EventSubscribed x)
mInnerSubd
      IORef (Maybe (EventSubscribed x)) -> EventM x ()
forall (m :: * -> *) a.
Defer (Some Clear) m =>
IORef (Maybe a) -> m ()
scheduleClear IORef (Maybe (EventSubscribed x))
innerSubdRef
      IORef (Weak (CoincidenceSubscribed x a))
weakSelf <- IO (IORef (Weak (CoincidenceSubscribed x a)))
-> EventM x (IORef (Weak (CoincidenceSubscribed x a)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Weak (CoincidenceSubscribed x a)))
 -> EventM x (IORef (Weak (CoincidenceSubscribed x a))))
-> IO (IORef (Weak (CoincidenceSubscribed x a)))
-> EventM x (IORef (Weak (CoincidenceSubscribed x a)))
forall a b. (a -> b) -> a -> b
$ Weak (CoincidenceSubscribed x a)
-> IO (IORef (Weak (CoincidenceSubscribed x a)))
forall a. a -> IO (IORef a)
newIORef (Weak (CoincidenceSubscribed x a)
 -> IO (IORef (Weak (CoincidenceSubscribed x a))))
-> Weak (CoincidenceSubscribed x a)
-> IO (IORef (Weak (CoincidenceSubscribed x a)))
forall a b. (a -> b) -> a -> b
$ String -> Weak (CoincidenceSubscribed x a)
forall a. HasCallStack => String -> a
error "getCoincidenceSubscribed: weakSelf not yet implemented"
      (subs :: WeakBag (Subscriber x a)
subs, slnForSub :: WeakBagTicket
slnForSub) <- IO (WeakBag (Subscriber x a), WeakBagTicket)
-> EventM x (WeakBag (Subscriber x a), WeakBagTicket)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (WeakBag (Subscriber x a), WeakBagTicket)
 -> EventM x (WeakBag (Subscriber x a), WeakBagTicket))
-> IO (WeakBag (Subscriber x a), WeakBagTicket)
-> EventM x (WeakBag (Subscriber x a), WeakBagTicket)
forall a b. (a -> b) -> a -> b
$ Subscriber x a
-> IORef (Weak (CoincidenceSubscribed x a))
-> (CoincidenceSubscribed x a -> IO ())
-> IO (WeakBag (Subscriber x a), WeakBagTicket)
forall a b.
a
-> IORef (Weak b) -> (b -> IO ()) -> IO (WeakBag a, WeakBagTicket)
WeakBag.singleton Subscriber x a
sub IORef (Weak (CoincidenceSubscribed x a))
weakSelf CoincidenceSubscribed x a -> IO ()
forall k (x :: k) a. CoincidenceSubscribed x a -> IO ()
cleanupCoincidenceSubscribed
#ifdef DEBUG_NODEIDS
      nid <- liftIO newNodeId
#endif
      let subscribed :: CoincidenceSubscribed x a
subscribed = $WCoincidenceSubscribed :: forall k (x :: k) a.
IORef (Maybe (CoincidenceSubscribed x a))
-> IORef (Maybe a)
-> WeakBag (Subscriber x a)
-> IORef Height
-> Subscriber x (Event x a)
-> EventSubscription x
-> IORef (Maybe (EventSubscribed x))
-> IORef (Weak (CoincidenceSubscribed x a))
-> CoincidenceSubscribed x a
CoincidenceSubscribed
            { coincidenceSubscribedCachedSubscribed :: IORef (Maybe (CoincidenceSubscribed x a))
coincidenceSubscribedCachedSubscribed = Coincidence x a -> IORef (Maybe (CoincidenceSubscribed x a))
forall k (x :: k) a.
Coincidence x a -> IORef (Maybe (CoincidenceSubscribed x a))
coincidenceSubscribed Coincidence x a
c
            , coincidenceSubscribedOccurrence :: IORef (Maybe a)
coincidenceSubscribedOccurrence = IORef (Maybe a)
occRef
            , coincidenceSubscribedHeight :: IORef Height
coincidenceSubscribedHeight = IORef Height
heightRef
            , coincidenceSubscribedSubscribers :: WeakBag (Subscriber x a)
coincidenceSubscribedSubscribers = WeakBag (Subscriber x a)
subs
            , coincidenceSubscribedOuter :: Subscriber x (Event x a)
coincidenceSubscribedOuter = Subscriber x (Event x a)
subOuter
            , coincidenceSubscribedOuterParent :: EventSubscription x
coincidenceSubscribedOuterParent = EventSubscription x
outerSubscription
            , coincidenceSubscribedInnerParent :: IORef (Maybe (EventSubscribed x))
coincidenceSubscribedInnerParent = IORef (Maybe (EventSubscribed x))
innerSubdRef
            , coincidenceSubscribedWeakSelf :: IORef (Weak (CoincidenceSubscribed x a))
coincidenceSubscribedWeakSelf = IORef (Weak (CoincidenceSubscribed x a))
weakSelf
#ifdef DEBUG_NODEIDS
            , coincidenceSubscribedNodeId = nid
#endif
            }
      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Weak (CoincidenceSubscribed x a))
-> Weak (CoincidenceSubscribed x a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Weak (CoincidenceSubscribed x a))
weakSelf (Weak (CoincidenceSubscribed x a) -> IO ())
-> IO (Weak (CoincidenceSubscribed x a)) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Weak (CoincidenceSubscribed x a)
-> IO (Weak (CoincidenceSubscribed x a))
forall a. a -> IO a
evaluate (Weak (CoincidenceSubscribed x a)
 -> IO (Weak (CoincidenceSubscribed x a)))
-> IO (Weak (CoincidenceSubscribed x a))
-> IO (Weak (CoincidenceSubscribed x a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CoincidenceSubscribed x a
-> String -> IO (Weak (CoincidenceSubscribed x a))
forall a. a -> String -> IO (Weak a)
mkWeakPtrWithDebug CoincidenceSubscribed x a
subscribed "CoincidenceSubscribed"
      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (CoincidenceSubscribed x a)
-> CoincidenceSubscribed x a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (CoincidenceSubscribed x a)
subscribedRef (CoincidenceSubscribed x a -> IO ())
-> CoincidenceSubscribed x a -> IO ()
forall a b. (a -> b) -> a -> b
$! CoincidenceSubscribed x a
subscribed
      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (CoincidenceSubscribed x a))
-> Maybe (CoincidenceSubscribed x a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Coincidence x a -> IORef (Maybe (CoincidenceSubscribed x a))
forall k (x :: k) a.
Coincidence x a -> IORef (Maybe (CoincidenceSubscribed x a))
coincidenceSubscribed Coincidence x a
c) (Maybe (CoincidenceSubscribed x a) -> IO ())
-> Maybe (CoincidenceSubscribed x a) -> IO ()
forall a b. (a -> b) -> a -> b
$ CoincidenceSubscribed x a -> Maybe (CoincidenceSubscribed x a)
forall a. a -> Maybe a
Just CoincidenceSubscribed x a
subscribed
      (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)
-> EventM x (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (WeakBagTicket
slnForSub, CoincidenceSubscribed x a
subscribed, Maybe a
occ)

cleanupCoincidenceSubscribed :: CoincidenceSubscribed x a -> IO ()
cleanupCoincidenceSubscribed :: CoincidenceSubscribed x a -> IO ()
cleanupCoincidenceSubscribed subscribed :: CoincidenceSubscribed x a
subscribed = do
  EventSubscription x -> IO ()
forall k (x :: k). EventSubscription x -> IO ()
unsubscribe (EventSubscription x -> IO ()) -> EventSubscription x -> IO ()
forall a b. (a -> b) -> a -> b
$ CoincidenceSubscribed x a -> EventSubscription x
forall k (x :: k) a.
CoincidenceSubscribed x a -> EventSubscription x
coincidenceSubscribedOuterParent CoincidenceSubscribed x a
subscribed
  IORef (Maybe (CoincidenceSubscribed x a))
-> Maybe (CoincidenceSubscribed x a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (CoincidenceSubscribed x a
-> IORef (Maybe (CoincidenceSubscribed x a))
forall k (x :: k) a.
CoincidenceSubscribed x a
-> IORef (Maybe (CoincidenceSubscribed x a))
coincidenceSubscribedCachedSubscribed CoincidenceSubscribed x a
subscribed) Maybe (CoincidenceSubscribed x a)
forall a. Maybe a
Nothing

{-# INLINE subscribeCoincidenceSubscribed #-}
subscribeCoincidenceSubscribed :: CoincidenceSubscribed x a -> Subscriber x a -> IO WeakBagTicket
subscribeCoincidenceSubscribed :: CoincidenceSubscribed x a -> Subscriber x a -> IO WeakBagTicket
subscribeCoincidenceSubscribed subscribed :: CoincidenceSubscribed x a
subscribed sub :: Subscriber x a
sub = Subscriber x a
-> WeakBag (Subscriber x a)
-> IORef (Weak (CoincidenceSubscribed x a))
-> (CoincidenceSubscribed x a -> IO ())
-> IO WeakBagTicket
forall a b.
a
-> WeakBag a -> IORef (Weak b) -> (b -> IO ()) -> IO WeakBagTicket
WeakBag.insert Subscriber x a
sub (CoincidenceSubscribed x a -> WeakBag (Subscriber x a)
forall k (x :: k) a.
CoincidenceSubscribed x a -> WeakBag (Subscriber x a)
coincidenceSubscribedSubscribers CoincidenceSubscribed x a
subscribed) (CoincidenceSubscribed x a
-> IORef (Weak (CoincidenceSubscribed x a))
forall k (x :: k) a.
CoincidenceSubscribed x a
-> IORef (Weak (CoincidenceSubscribed x a))
coincidenceSubscribedWeakSelf CoincidenceSubscribed x a
subscribed) CoincidenceSubscribed x a -> IO ()
forall k (x :: k) a. CoincidenceSubscribed x a -> IO ()
cleanupCoincidenceSubscribed

{-# INLINE mergeG #-}
mergeG :: forall k q x v. (HasSpiderTimeline x, GCompare k)
  => (forall a. q a -> Event x (v a))
  -> DynamicS x (PatchDMap k q) -> Event x (DMap k v)
mergeG :: (forall (a :: k). q a -> Event x (v a))
-> DynamicS x (PatchDMap k q) -> Event x (DMap k v)
mergeG nt :: forall (a :: k). q a -> Event x (v a)
nt d :: DynamicS x (PatchDMap k q)
d = Event x (DMap k v) -> Event x (DMap k v)
forall x a. HasSpiderTimeline x => Event x a -> Event x a
cacheEvent ((forall (a :: k). q a -> Event x (v a))
-> DynamicS x (PatchDMap k q) -> Event x (DMap k v)
forall k (k :: k -> *) x (q :: k -> *) (v :: k -> *).
(HasSpiderTimeline x, GCompare k) =>
(forall (a :: k). q a -> Event x (v a))
-> DynamicS x (PatchDMap k q) -> Event x (DMap k v)
mergeCheap forall (a :: k). q a -> Event x (v a)
nt DynamicS x (PatchDMap k q)
d)

{-# INLINE mergeWithMove #-}
mergeWithMove :: forall k v q x. (HasSpiderTimeline x, GCompare k)
  => (forall a. q a -> Event x (v a))
  -> DynamicS x (PatchDMapWithMove k q) -> Event x (DMap k v)
mergeWithMove :: (forall (a :: k). q a -> Event x (v a))
-> DynamicS x (PatchDMapWithMove k q) -> Event x (DMap k v)
mergeWithMove nt :: forall (a :: k). q a -> Event x (v a)
nt d :: DynamicS x (PatchDMapWithMove k q)
d = Event x (DMap k v) -> Event x (DMap k v)
forall x a. HasSpiderTimeline x => Event x a -> Event x a
cacheEvent ((forall (a :: k). q a -> Event x (v a))
-> DynamicS x (PatchDMapWithMove k q) -> Event x (DMap k v)
forall k (k :: k -> *) x (v :: k -> *) (q :: k -> *).
(HasSpiderTimeline x, GCompare k) =>
(forall (a :: k). q a -> Event x (v a))
-> DynamicS x (PatchDMapWithMove k q) -> Event x (DMap k v)
mergeCheapWithMove forall (a :: k). q a -> Event x (v a)
nt DynamicS x (PatchDMapWithMove k q)
d)

{-# INLINE [1] mergeCheap #-}
mergeCheap
  :: forall k x q v. (HasSpiderTimeline x, GCompare k)
  => (forall a. q a -> Event x (v a))
  -> DynamicS x (PatchDMap k q)
  -> Event x (DMap k v)
mergeCheap :: (forall (a :: k). q a -> Event x (v a))
-> DynamicS x (PatchDMap k q) -> Event x (DMap k v)
mergeCheap nt :: forall (a :: k). q a -> Event x (v a)
nt = MergeGetSubscription x (MergeSubscribedParent x)
-> MergeInitFunc k v q x (MergeSubscribedParent x)
-> MergeUpdateFunc k v x (PatchDMap k q) (MergeSubscribedParent x)
-> MergeDestroyFunc k (MergeSubscribedParent x)
-> DynamicS x (PatchDMap k q)
-> Event x (DMap k v)
forall k (k :: k -> *) (v :: k -> *) x p (s :: k -> *)
       (q :: k -> *).
(HasSpiderTimeline x, GCompare k, PatchTarget p ~ DMap k q) =>
MergeGetSubscription x s
-> MergeInitFunc k v q x s
-> MergeUpdateFunc k v x p s
-> MergeDestroyFunc k s
-> DynamicS x p
-> Event x (DMap k v)
mergeGCheap' MergeGetSubscription x (MergeSubscribedParent x)
forall k (x :: k) k (a :: k).
MergeSubscribedParent x a -> EventSubscription x
unMergeSubscribedParent MergeInitFunc k v q x (MergeSubscribedParent x)
getInitialSubscribers MergeUpdateFunc k v x (PatchDMap k q) (MergeSubscribedParent x)
updateMe MergeDestroyFunc k (MergeSubscribedParent x)
destroy
  where
      updateMe :: MergeUpdateFunc k v x (PatchDMap k q) (MergeSubscribedParent x)
      updateMe :: MergeUpdateFunc k v x (PatchDMap k q) (MergeSubscribedParent x)
updateMe subscriber :: forall (a :: k). EventM x (k a) -> Subscriber x (v a)
subscriber heightBagRef :: IORef HeightBag
heightBagRef oldParents :: DMap k (MergeSubscribedParent x)
oldParents (PatchDMap p :: DMap k (ComposeMaybe q)
p) = do
        let f :: ([EventSubscription x], DMap k (MergeSubscribedParent x))
-> DSum k (ComposeMaybe q)
-> EventM
     x ([EventSubscription x], DMap k (MergeSubscribedParent x))
f (subscriptionsToKill :: [EventSubscription x]
subscriptionsToKill, ps :: DMap k (MergeSubscribedParent x)
ps) (k :: k a
k :=> ComposeMaybe me) = do
              (mOldSubd :: Maybe (MergeSubscribedParent x a)
mOldSubd, newPs :: DMap k (MergeSubscribedParent x)
newPs) <- case Maybe (q a)
me of
                Nothing -> (Maybe (MergeSubscribedParent x a),
 DMap k (MergeSubscribedParent x))
-> EventM
     x
     (Maybe (MergeSubscribedParent x a),
      DMap k (MergeSubscribedParent x))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe (MergeSubscribedParent x a),
  DMap k (MergeSubscribedParent x))
 -> EventM
      x
      (Maybe (MergeSubscribedParent x a),
       DMap k (MergeSubscribedParent x)))
-> (Maybe (MergeSubscribedParent x a),
    DMap k (MergeSubscribedParent x))
-> EventM
     x
     (Maybe (MergeSubscribedParent x a),
      DMap k (MergeSubscribedParent x))
forall a b. (a -> b) -> a -> b
$ (k a
 -> MergeSubscribedParent x a -> Maybe (MergeSubscribedParent x a))
-> k a
-> DMap k (MergeSubscribedParent x)
-> (Maybe (MergeSubscribedParent x a),
    DMap k (MergeSubscribedParent x))
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
(k2 v -> f v -> Maybe (f v))
-> k2 v -> DMap k2 f -> (Maybe (f v), DMap k2 f)
DMap.updateLookupWithKey (\_ _ -> Maybe (MergeSubscribedParent x a)
forall a. Maybe a
Nothing) k a
k DMap k (MergeSubscribedParent x)
ps
                Just e :: q a
e -> do
                  let s :: Subscriber x (v a)
s = EventM x (k a) -> Subscriber x (v a)
forall (a :: k). EventM x (k a) -> Subscriber x (v a)
subscriber (EventM x (k a) -> Subscriber x (v a))
-> EventM x (k a) -> Subscriber x (v a)
forall a b. (a -> b) -> a -> b
$ k a -> EventM x (k a)
forall (m :: * -> *) a. Monad m => a -> m a
return k a
k
                  subscription :: EventSubscription x
subscription@(EventSubscription _ subd :: EventSubscribed x
subd) <- Event x (v a)
-> Subscriber x (v a) -> EventM x (EventSubscription x)
forall k (x :: k) a.
Event x a -> Subscriber x a -> EventM x (EventSubscription x)
subscribe (q a -> Event x (v a)
forall (a :: k). q a -> Event x (v a)
nt q a
e) Subscriber x (v a)
s
                  Height
newParentHeight <- IO Height -> EventM x Height
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Height -> EventM x Height) -> IO Height -> EventM x Height
forall a b. (a -> b) -> a -> b
$ EventSubscribed x -> IO Height
forall k (x :: k). EventSubscribed x -> IO Height
getEventSubscribedHeight EventSubscribed x
subd
                  let newParent :: MergeSubscribedParent x a
newParent = EventSubscription x -> MergeSubscribedParent x a
forall k k (x :: k) (a :: k).
EventSubscription x -> MergeSubscribedParent x a
MergeSubscribedParent EventSubscription x
subscription
                  IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef HeightBag -> (HeightBag -> HeightBag) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef HeightBag
heightBagRef ((HeightBag -> HeightBag) -> IO ())
-> (HeightBag -> HeightBag) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> HeightBag -> HeightBag
heightBagAdd Height
newParentHeight
                  (Maybe (MergeSubscribedParent x a),
 DMap k (MergeSubscribedParent x))
-> EventM
     x
     (Maybe (MergeSubscribedParent x a),
      DMap k (MergeSubscribedParent x))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe (MergeSubscribedParent x a),
  DMap k (MergeSubscribedParent x))
 -> EventM
      x
      (Maybe (MergeSubscribedParent x a),
       DMap k (MergeSubscribedParent x)))
-> (Maybe (MergeSubscribedParent x a),
    DMap k (MergeSubscribedParent x))
-> EventM
     x
     (Maybe (MergeSubscribedParent x a),
      DMap k (MergeSubscribedParent x))
forall a b. (a -> b) -> a -> b
$ (k a
 -> MergeSubscribedParent x a
 -> MergeSubscribedParent x a
 -> MergeSubscribedParent x a)
-> k a
-> MergeSubscribedParent x a
-> DMap k (MergeSubscribedParent x)
-> (Maybe (MergeSubscribedParent x a),
    DMap k (MergeSubscribedParent x))
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
(k2 v -> f v -> f v -> f v)
-> k2 v -> f v -> DMap k2 f -> (Maybe (f v), DMap k2 f)
DMap.insertLookupWithKey' (\_ new :: MergeSubscribedParent x a
new _ -> MergeSubscribedParent x a
new) k a
k MergeSubscribedParent x a
newParent DMap k (MergeSubscribedParent x)
ps
              Maybe (MergeSubscribedParent x a)
-> (MergeSubscribedParent x a -> EventM x ()) -> EventM x ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (MergeSubscribedParent x a)
mOldSubd ((MergeSubscribedParent x a -> EventM x ()) -> EventM x ())
-> (MergeSubscribedParent x a -> EventM x ()) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ \oldSubd :: MergeSubscribedParent x a
oldSubd -> do
                Height
oldHeight <- IO Height -> EventM x Height
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Height -> EventM x Height) -> IO Height -> EventM x Height
forall a b. (a -> b) -> a -> b
$ EventSubscribed x -> IO Height
forall k (x :: k). EventSubscribed x -> IO Height
getEventSubscribedHeight (EventSubscribed x -> IO Height) -> EventSubscribed x -> IO Height
forall a b. (a -> b) -> a -> b
$
                  EventSubscription x -> EventSubscribed x
forall k (x :: k). EventSubscription x -> EventSubscribed x
_eventSubscription_subscribed (EventSubscription x -> EventSubscribed x)
-> EventSubscription x -> EventSubscribed x
forall a b. (a -> b) -> a -> b
$ MergeSubscribedParent x a -> EventSubscription x
forall k (x :: k) k (a :: k).
MergeSubscribedParent x a -> EventSubscription x
unMergeSubscribedParent MergeSubscribedParent x a
oldSubd

                IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef HeightBag -> (HeightBag -> HeightBag) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef HeightBag
heightBagRef ((HeightBag -> HeightBag) -> IO ())
-> (HeightBag -> HeightBag) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> HeightBag -> HeightBag
heightBagRemove Height
oldHeight
              ([EventSubscription x], DMap k (MergeSubscribedParent x))
-> EventM
     x ([EventSubscription x], DMap k (MergeSubscribedParent x))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (EventSubscription x) -> [EventSubscription x]
forall a. Maybe a -> [a]
maybeToList (MergeSubscribedParent x a -> EventSubscription x
forall k (x :: k) k (a :: k).
MergeSubscribedParent x a -> EventSubscription x
unMergeSubscribedParent (MergeSubscribedParent x a -> EventSubscription x)
-> Maybe (MergeSubscribedParent x a) -> Maybe (EventSubscription x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (MergeSubscribedParent x a)
mOldSubd) [EventSubscription x]
-> [EventSubscription x] -> [EventSubscription x]
forall a. [a] -> [a] -> [a]
++ [EventSubscription x]
subscriptionsToKill, DMap k (MergeSubscribedParent x)
newPs)
        (([EventSubscription x], DMap k (MergeSubscribedParent x))
 -> DSum k (ComposeMaybe q)
 -> EventM
      x ([EventSubscription x], DMap k (MergeSubscribedParent x)))
-> ([EventSubscription x], DMap k (MergeSubscribedParent x))
-> [DSum k (ComposeMaybe q)]
-> EventM
     x ([EventSubscription x], DMap k (MergeSubscribedParent x))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([EventSubscription x], DMap k (MergeSubscribedParent x))
-> DSum k (ComposeMaybe q)
-> EventM
     x ([EventSubscription x], DMap k (MergeSubscribedParent x))
f ([], DMap k (MergeSubscribedParent x)
oldParents) ([DSum k (ComposeMaybe q)]
 -> EventM
      x ([EventSubscription x], DMap k (MergeSubscribedParent x)))
-> [DSum k (ComposeMaybe q)]
-> EventM
     x ([EventSubscription x], DMap k (MergeSubscribedParent x))
forall a b. (a -> b) -> a -> b
$ DMap k (ComposeMaybe q) -> [DSum k (ComposeMaybe q)]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toList DMap k (ComposeMaybe q)
p

      getInitialSubscribers :: MergeInitFunc k v q x (MergeSubscribedParent x)
      getInitialSubscribers :: MergeInitFunc k v q x (MergeSubscribedParent x)
getInitialSubscribers initialParents :: DMap k q
initialParents subscriber :: forall (a :: k). EventM x (k a) -> Subscriber x (v a)
subscriber = do
        [(Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x))]
subscribers <- [DSum k q]
-> (DSum k q
    -> EventM
         x (Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x)))
-> EventM
     x [(Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (DMap k q -> [DSum k q]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toList DMap k q
initialParents) ((DSum k q
  -> EventM
       x (Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x)))
 -> EventM
      x [(Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x))])
-> (DSum k q
    -> EventM
         x (Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x)))
-> EventM
     x [(Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x))]
forall a b. (a -> b) -> a -> b
$ \(k :: k a
k :=> e :: q a
e) -> do
          let s :: Subscriber x (v a)
s = EventM x (k a) -> Subscriber x (v a)
forall (a :: k). EventM x (k a) -> Subscriber x (v a)
subscriber (EventM x (k a) -> Subscriber x (v a))
-> EventM x (k a) -> Subscriber x (v a)
forall a b. (a -> b) -> a -> b
$ k a -> EventM x (k a)
forall (m :: * -> *) a. Monad m => a -> m a
return k a
k
          (subscription :: EventSubscription x
subscription@(EventSubscription _ parentSubd :: EventSubscribed x
parentSubd), parentOcc :: Maybe (v a)
parentOcc) <- Event x (v a)
-> Subscriber x (v a)
-> EventM x (EventSubscription x, Maybe (v a))
forall k (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead (q a -> Event x (v a)
forall (a :: k). q a -> Event x (v a)
nt q a
e) Subscriber x (v a)
s
          Height
height <- IO Height -> EventM x Height
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Height -> EventM x Height) -> IO Height -> EventM x Height
forall a b. (a -> b) -> a -> b
$ EventSubscribed x -> IO Height
forall k (x :: k). EventSubscribed x -> IO Height
getEventSubscribedHeight EventSubscribed x
parentSubd
          (Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x))
-> EventM
     x (Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x))
forall (m :: * -> *) a. Monad m => a -> m a
return ((v a -> DSum k v) -> Maybe (v a) -> Maybe (DSum k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k a
k k a -> v a -> DSum k v
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=>) Maybe (v a)
parentOcc, Height
height, k a
k k a
-> MergeSubscribedParent x a -> DSum k (MergeSubscribedParent x)
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> EventSubscription x -> MergeSubscribedParent x a
forall k k (x :: k) (a :: k).
EventSubscription x -> MergeSubscribedParent x a
MergeSubscribedParent EventSubscription x
subscription)
        (DMap k v, [Height], DMap k (MergeSubscribedParent x))
-> EventM x (DMap k v, [Height], DMap k (MergeSubscribedParent x))
forall (m :: * -> *) a. Monad m => a -> m a
return ( [DSum k v] -> DMap k v
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). [DSum k2 f] -> DMap k2 f
DMap.fromDistinctAscList ([DSum k v] -> DMap k v) -> [DSum k v] -> DMap k v
forall a b. (a -> b) -> a -> b
$ ((Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x))
 -> Maybe (DSum k v))
-> [(Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x))]
-> [DSum k v]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (\(x :: Maybe (DSum k v)
x, _, _) -> Maybe (DSum k v)
x) [(Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x))]
subscribers
               , ((Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x))
 -> Height)
-> [(Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x))]
-> [Height]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(_, h :: Height
h, _) -> Height
h) [(Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x))]
subscribers --TODO: Assert that there's no invalidHeight in here
               , [DSum k (MergeSubscribedParent x)]
-> DMap k (MergeSubscribedParent x)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). [DSum k2 f] -> DMap k2 f
DMap.fromDistinctAscList ([DSum k (MergeSubscribedParent x)]
 -> DMap k (MergeSubscribedParent x))
-> [DSum k (MergeSubscribedParent x)]
-> DMap k (MergeSubscribedParent x)
forall a b. (a -> b) -> a -> b
$ ((Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x))
 -> DSum k (MergeSubscribedParent x))
-> [(Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x))]
-> [DSum k (MergeSubscribedParent x)]
forall a b. (a -> b) -> [a] -> [b]
map (\(_, _, x :: DSum k (MergeSubscribedParent x)
x) -> DSum k (MergeSubscribedParent x)
x) [(Maybe (DSum k v), Height, DSum k (MergeSubscribedParent x))]
subscribers
               )

      destroy :: MergeDestroyFunc k (MergeSubscribedParent x)
      destroy :: MergeDestroyFunc k (MergeSubscribedParent x)
destroy s :: DMap k (MergeSubscribedParent x)
s = [DSum k (MergeSubscribedParent x)]
-> (DSum k (MergeSubscribedParent x) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (DMap k (MergeSubscribedParent x)
-> [DSum k (MergeSubscribedParent x)]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toList DMap k (MergeSubscribedParent x)
s) ((DSum k (MergeSubscribedParent x) -> IO ()) -> IO ())
-> (DSum k (MergeSubscribedParent x) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(_ :=> MergeSubscribedParent sub :: EventSubscription x
sub) -> EventSubscription x -> IO ()
forall k (x :: k). EventSubscription x -> IO ()
unsubscribe EventSubscription x
sub

{-# INLINE [1] mergeCheapWithMove #-}
mergeCheapWithMove :: forall k x v q. (HasSpiderTimeline x, GCompare k)
  => (forall a. q a -> Event x (v a))
  -> DynamicS x (PatchDMapWithMove k q)
  -> Event x (DMap k v)
mergeCheapWithMove :: (forall (a :: k). q a -> Event x (v a))
-> DynamicS x (PatchDMapWithMove k q) -> Event x (DMap k v)
mergeCheapWithMove nt :: forall (a :: k). q a -> Event x (v a)
nt = MergeGetSubscription x (MergeSubscribedParentWithMove x k)
-> MergeInitFunc k v q x (MergeSubscribedParentWithMove x k)
-> MergeUpdateFunc
     k v x (PatchDMapWithMove k q) (MergeSubscribedParentWithMove x k)
-> MergeDestroyFunc k (MergeSubscribedParentWithMove x k)
-> DynamicS x (PatchDMapWithMove k q)
-> Event x (DMap k v)
forall k (k :: k -> *) (v :: k -> *) x p (s :: k -> *)
       (q :: k -> *).
(HasSpiderTimeline x, GCompare k, PatchTarget p ~ DMap k q) =>
MergeGetSubscription x s
-> MergeInitFunc k v q x s
-> MergeUpdateFunc k v x p s
-> MergeDestroyFunc k s
-> DynamicS x p
-> Event x (DMap k v)
mergeGCheap' MergeGetSubscription x (MergeSubscribedParentWithMove x k)
forall k (x :: k) k (k :: k -> *) (a :: k).
MergeSubscribedParentWithMove x k a -> EventSubscription x
_mergeSubscribedParentWithMove_subscription MergeInitFunc k v q x (MergeSubscribedParentWithMove x k)
getInitialSubscribers MergeUpdateFunc
  k v x (PatchDMapWithMove k q) (MergeSubscribedParentWithMove x k)
updateMe MergeDestroyFunc k (MergeSubscribedParentWithMove x k)
destroy
  where
      updateMe :: MergeUpdateFunc k v x (PatchDMapWithMove k q) (MergeSubscribedParentWithMove x k)
      updateMe :: MergeUpdateFunc
  k v x (PatchDMapWithMove k q) (MergeSubscribedParentWithMove x k)
updateMe subscriber :: forall (a :: k). EventM x (k a) -> Subscriber x (v a)
subscriber heightBagRef :: IORef HeightBag
heightBagRef oldParents :: DMap k (MergeSubscribedParentWithMove x k)
oldParents p :: PatchDMapWithMove k q
p = do
        -- Prepare new parents for insertion
        let subscribeParent :: forall a. k a -> Event x (v a) -> EventM x (MergeSubscribedParentWithMove x k a)
            subscribeParent :: k a
-> Event x (v a) -> EventM x (MergeSubscribedParentWithMove x k a)
subscribeParent k :: k a
k e :: Event x (v a)
e = do
              IORef (k a)
keyRef <- IO (IORef (k a)) -> EventM x (IORef (k a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (k a)) -> EventM x (IORef (k a)))
-> IO (IORef (k a)) -> EventM x (IORef (k a))
forall a b. (a -> b) -> a -> b
$ k a -> IO (IORef (k a))
forall a. a -> IO (IORef a)
newIORef k a
k
              let s :: Subscriber x (v a)
s = EventM x (k a) -> Subscriber x (v a)
forall (a :: k). EventM x (k a) -> Subscriber x (v a)
subscriber (EventM x (k a) -> Subscriber x (v a))
-> EventM x (k a) -> Subscriber x (v a)
forall a b. (a -> b) -> a -> b
$ IO (k a) -> EventM x (k a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (k a) -> EventM x (k a)) -> IO (k a) -> EventM x (k a)
forall a b. (a -> b) -> a -> b
$ IORef (k a) -> IO (k a)
forall a. IORef a -> IO a
readIORef IORef (k a)
keyRef
              subscription :: EventSubscription x
subscription@(EventSubscription _ subd :: EventSubscribed x
subd) <- Event x (v a)
-> Subscriber x (v a) -> EventM x (EventSubscription x)
forall k (x :: k) a.
Event x a -> Subscriber x a -> EventM x (EventSubscription x)
subscribe Event x (v a)
e Subscriber x (v a)
s
              IO (MergeSubscribedParentWithMove x k a)
-> EventM x (MergeSubscribedParentWithMove x k a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MergeSubscribedParentWithMove x k a)
 -> EventM x (MergeSubscribedParentWithMove x k a))
-> IO (MergeSubscribedParentWithMove x k a)
-> EventM x (MergeSubscribedParentWithMove x k a)
forall a b. (a -> b) -> a -> b
$ do
                Height
newParentHeight <- EventSubscribed x -> IO Height
forall k (x :: k). EventSubscribed x -> IO Height
getEventSubscribedHeight EventSubscribed x
subd
                IORef HeightBag -> (HeightBag -> HeightBag) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef HeightBag
heightBagRef ((HeightBag -> HeightBag) -> IO ())
-> (HeightBag -> HeightBag) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> HeightBag -> HeightBag
heightBagAdd Height
newParentHeight
                MergeSubscribedParentWithMove x k a
-> IO (MergeSubscribedParentWithMove x k a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MergeSubscribedParentWithMove x k a
 -> IO (MergeSubscribedParentWithMove x k a))
-> MergeSubscribedParentWithMove x k a
-> IO (MergeSubscribedParentWithMove x k a)
forall a b. (a -> b) -> a -> b
$ EventSubscription x
-> IORef (k a) -> MergeSubscribedParentWithMove x k a
forall k k (x :: k) (k :: k -> *) (a :: k).
EventSubscription x
-> IORef (k a) -> MergeSubscribedParentWithMove x k a
MergeSubscribedParentWithMove EventSubscription x
subscription IORef (k a)
keyRef
        PatchDMapWithMove k (MergeSubscribedParentWithMove x k)
p' <- (forall (a :: k).
 k a -> q a -> EventM x (MergeSubscribedParentWithMove x k a))
-> PatchDMapWithMove k q
-> EventM
     x (PatchDMapWithMove k (MergeSubscribedParentWithMove x k))
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')
PatchDMapWithMove.traversePatchDMapWithMoveWithKey (\k :: k a
k q :: q a
q -> k a
-> Event x (v a) -> EventM x (MergeSubscribedParentWithMove x k a)
forall (a :: k).
k a
-> Event x (v a) -> EventM x (MergeSubscribedParentWithMove x k a)
subscribeParent k a
k (q a -> Event x (v a)
forall (a :: k). q a -> Event x (v a)
nt q a
q)) PatchDMapWithMove k q
p
        -- Collect old parents for deletion and update the keys of moved parents
        let moveOrDelete :: forall a. k a -> PatchDMapWithMove.NodeInfo k q a -> MergeSubscribedParentWithMove x k a -> Constant (EventM x (Maybe (EventSubscription x))) a
            moveOrDelete :: k a
-> NodeInfo k q a
-> MergeSubscribedParentWithMove x k a
-> Constant (EventM x (Maybe (EventSubscription x))) a
moveOrDelete _ ni :: NodeInfo k q a
ni parent :: MergeSubscribedParentWithMove x k a
parent = EventM x (Maybe (EventSubscription x))
-> Constant (EventM x (Maybe (EventSubscription x))) a
forall k a (b :: k). a -> Constant a b
Constant (EventM x (Maybe (EventSubscription x))
 -> Constant (EventM x (Maybe (EventSubscription x))) a)
-> EventM x (Maybe (EventSubscription x))
-> Constant (EventM x (Maybe (EventSubscription x))) a
forall a b. (a -> b) -> a -> b
$ case ComposeMaybe k a -> Maybe (k a)
forall k (f :: k -> *) (a :: k). ComposeMaybe f a -> Maybe (f a)
getComposeMaybe (ComposeMaybe k a -> Maybe (k a))
-> ComposeMaybe k a -> Maybe (k a)
forall a b. (a -> b) -> a -> b
$ NodeInfo k q a -> ComposeMaybe k a
forall k1 (k2 :: k1 -> *) (v :: k1 -> *) (a :: k1).
NodeInfo k2 v a -> To k2 a
PatchDMapWithMove._nodeInfo_to NodeInfo k q a
ni of
              Nothing -> do
                Height
oldHeight <- IO Height -> EventM x Height
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Height -> EventM x Height) -> IO Height -> EventM x Height
forall a b. (a -> b) -> a -> b
$ EventSubscribed x -> IO Height
forall k (x :: k). EventSubscribed x -> IO Height
getEventSubscribedHeight (EventSubscribed x -> IO Height) -> EventSubscribed x -> IO Height
forall a b. (a -> b) -> a -> b
$ EventSubscription x -> EventSubscribed x
forall k (x :: k). EventSubscription x -> EventSubscribed x
_eventSubscription_subscribed (EventSubscription x -> EventSubscribed x)
-> EventSubscription x -> EventSubscribed x
forall a b. (a -> b) -> a -> b
$
                  MergeSubscribedParentWithMove x k a -> EventSubscription x
forall k (x :: k) k (k :: k -> *) (a :: k).
MergeSubscribedParentWithMove x k a -> EventSubscription x
_mergeSubscribedParentWithMove_subscription MergeSubscribedParentWithMove x k a
parent

                IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef HeightBag -> (HeightBag -> HeightBag) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef HeightBag
heightBagRef ((HeightBag -> HeightBag) -> IO ())
-> (HeightBag -> HeightBag) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> HeightBag -> HeightBag
heightBagRemove Height
oldHeight
                Maybe (EventSubscription x)
-> EventM x (Maybe (EventSubscription x))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (EventSubscription x)
 -> EventM x (Maybe (EventSubscription x)))
-> Maybe (EventSubscription x)
-> EventM x (Maybe (EventSubscription x))
forall a b. (a -> b) -> a -> b
$ EventSubscription x -> Maybe (EventSubscription x)
forall a. a -> Maybe a
Just (EventSubscription x -> Maybe (EventSubscription x))
-> EventSubscription x -> Maybe (EventSubscription x)
forall a b. (a -> b) -> a -> b
$ MergeSubscribedParentWithMove x k a -> EventSubscription x
forall k (x :: k) k (k :: k -> *) (a :: k).
MergeSubscribedParentWithMove x k a -> EventSubscription x
_mergeSubscribedParentWithMove_subscription MergeSubscribedParentWithMove x k a
parent
              Just toKey :: k a
toKey -> do
                IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (k a) -> k a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (MergeSubscribedParentWithMove x k a -> IORef (k a)
forall k (x :: k) k (k :: k -> *) (a :: k).
MergeSubscribedParentWithMove x k a -> IORef (k a)
_mergeSubscribedParentWithMove_key MergeSubscribedParentWithMove x k a
parent) (k a -> IO ()) -> k a -> IO ()
forall a b. (a -> b) -> a -> b
$! k a
toKey
                Maybe (EventSubscription x)
-> EventM x (Maybe (EventSubscription x))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (EventSubscription x)
forall a. Maybe a
Nothing
        [EventSubscription x]
toDelete <- ([Maybe (EventSubscription x)] -> [EventSubscription x])
-> EventM x [Maybe (EventSubscription x)]
-> EventM x [EventSubscription x]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (EventSubscription x)] -> [EventSubscription x]
forall a. [Maybe a] -> [a]
catMaybes (EventM x [Maybe (EventSubscription x)]
 -> EventM x [EventSubscription x])
-> EventM x [Maybe (EventSubscription x)]
-> EventM x [EventSubscription x]
forall a b. (a -> b) -> a -> b
$ (DSum k (Constant (EventM x (Maybe (EventSubscription x))))
 -> EventM x (Maybe (EventSubscription x)))
-> [DSum k (Constant (EventM x (Maybe (EventSubscription x))))]
-> EventM x [Maybe (EventSubscription x)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(_ :=> v :: Constant (EventM x (Maybe (EventSubscription x))) a
v) -> Constant (EventM x (Maybe (EventSubscription x))) a
-> EventM x (Maybe (EventSubscription x))
forall a k (b :: k). Constant a b -> a
getConstant Constant (EventM x (Maybe (EventSubscription x))) a
v) ([DSum k (Constant (EventM x (Maybe (EventSubscription x))))]
 -> EventM x [Maybe (EventSubscription x)])
-> [DSum k (Constant (EventM x (Maybe (EventSubscription x))))]
-> EventM x [Maybe (EventSubscription x)]
forall a b. (a -> b) -> a -> b
$ DMap k (Constant (EventM x (Maybe (EventSubscription x))))
-> [DSum k (Constant (EventM x (Maybe (EventSubscription x))))]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toList (DMap k (Constant (EventM x (Maybe (EventSubscription x))))
 -> [DSum k (Constant (EventM x (Maybe (EventSubscription x))))])
-> DMap k (Constant (EventM x (Maybe (EventSubscription x))))
-> [DSum k (Constant (EventM x (Maybe (EventSubscription x))))]
forall a b. (a -> b) -> a -> b
$
          (forall (v :: k).
 k v
 -> NodeInfo k q v
 -> MergeSubscribedParentWithMove x k v
 -> Constant (EventM x (Maybe (EventSubscription x))) v)
-> DMap k (NodeInfo k q)
-> DMap k (MergeSubscribedParentWithMove x k)
-> DMap k (Constant (EventM x (Maybe (EventSubscription x))))
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *)
       (h :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> g v -> h v)
-> DMap k2 f -> DMap k2 g -> DMap k2 h
DMap.intersectionWithKey forall (v :: k).
k v
-> NodeInfo k q v
-> MergeSubscribedParentWithMove x k v
-> Constant (EventM x (Maybe (EventSubscription x))) v
moveOrDelete (PatchDMapWithMove k q -> DMap k (NodeInfo k q)
forall k1 (k2 :: k1 -> *) (v :: k1 -> *).
PatchDMapWithMove k2 v -> DMap k2 (NodeInfo k2 v)
unPatchDMapWithMove PatchDMapWithMove k q
p) DMap k (MergeSubscribedParentWithMove x k)
oldParents

        ([EventSubscription x], DMap k (MergeSubscribedParentWithMove x k))
-> EventM
     x
     ([EventSubscription x], DMap k (MergeSubscribedParentWithMove x k))
forall (m :: * -> *) a. Monad m => a -> m a
return ([EventSubscription x]
toDelete, PatchDMapWithMove k (MergeSubscribedParentWithMove x k)
-> PatchTarget
     (PatchDMapWithMove k (MergeSubscribedParentWithMove x k))
-> PatchTarget
     (PatchDMapWithMove k (MergeSubscribedParentWithMove x k))
forall p. Patch p => p -> PatchTarget p -> PatchTarget p
applyAlways PatchDMapWithMove k (MergeSubscribedParentWithMove x k)
p' DMap k (MergeSubscribedParentWithMove x k)
PatchTarget
  (PatchDMapWithMove k (MergeSubscribedParentWithMove x k))
oldParents)
      getInitialSubscribers :: MergeInitFunc k v q x (MergeSubscribedParentWithMove x k)
      getInitialSubscribers :: MergeInitFunc k v q x (MergeSubscribedParentWithMove x k)
getInitialSubscribers initialParents :: DMap k q
initialParents subscriber :: forall (a :: k). EventM x (k a) -> Subscriber x (v a)
subscriber = do
        [(Maybe (DSum k v), Height,
  DSum k (MergeSubscribedParentWithMove x k))]
subscribers <- [DSum k q]
-> (DSum k q
    -> EventM
         x
         (Maybe (DSum k v), Height,
          DSum k (MergeSubscribedParentWithMove x k)))
-> EventM
     x
     [(Maybe (DSum k v), Height,
       DSum k (MergeSubscribedParentWithMove x k))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (DMap k q -> [DSum k q]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toList DMap k q
initialParents) ((DSum k q
  -> EventM
       x
       (Maybe (DSum k v), Height,
        DSum k (MergeSubscribedParentWithMove x k)))
 -> EventM
      x
      [(Maybe (DSum k v), Height,
        DSum k (MergeSubscribedParentWithMove x k))])
-> (DSum k q
    -> EventM
         x
         (Maybe (DSum k v), Height,
          DSum k (MergeSubscribedParentWithMove x k)))
-> EventM
     x
     [(Maybe (DSum k v), Height,
       DSum k (MergeSubscribedParentWithMove x k))]
forall a b. (a -> b) -> a -> b
$ \(k :: k a
k :=> e :: q a
e) -> do
          IORef (k a)
keyRef <- IO (IORef (k a)) -> EventM x (IORef (k a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (k a)) -> EventM x (IORef (k a)))
-> IO (IORef (k a)) -> EventM x (IORef (k a))
forall a b. (a -> b) -> a -> b
$ k a -> IO (IORef (k a))
forall a. a -> IO (IORef a)
newIORef k a
k
          let s :: Subscriber x (v a)
s = EventM x (k a) -> Subscriber x (v a)
forall (a :: k). EventM x (k a) -> Subscriber x (v a)
subscriber (EventM x (k a) -> Subscriber x (v a))
-> EventM x (k a) -> Subscriber x (v a)
forall a b. (a -> b) -> a -> b
$ IO (k a) -> EventM x (k a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (k a) -> EventM x (k a)) -> IO (k a) -> EventM x (k a)
forall a b. (a -> b) -> a -> b
$ IORef (k a) -> IO (k a)
forall a. IORef a -> IO a
readIORef IORef (k a)
keyRef
          (subscription :: EventSubscription x
subscription@(EventSubscription _ parentSubd :: EventSubscribed x
parentSubd), parentOcc :: Maybe (v a)
parentOcc) <- Event x (v a)
-> Subscriber x (v a)
-> EventM x (EventSubscription x, Maybe (v a))
forall k (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead (q a -> Event x (v a)
forall (a :: k). q a -> Event x (v a)
nt q a
e) Subscriber x (v a)
s
          Height
height <- IO Height -> EventM x Height
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Height -> EventM x Height) -> IO Height -> EventM x Height
forall a b. (a -> b) -> a -> b
$ EventSubscribed x -> IO Height
forall k (x :: k). EventSubscribed x -> IO Height
getEventSubscribedHeight EventSubscribed x
parentSubd
          (Maybe (DSum k v), Height,
 DSum k (MergeSubscribedParentWithMove x k))
-> EventM
     x
     (Maybe (DSum k v), Height,
      DSum k (MergeSubscribedParentWithMove x k))
forall (m :: * -> *) a. Monad m => a -> m a
return ((v a -> DSum k v) -> Maybe (v a) -> Maybe (DSum k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k a
k k a -> v a -> DSum k v
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=>) Maybe (v a)
parentOcc, Height
height, k a
k k a
-> MergeSubscribedParentWithMove x k a
-> DSum k (MergeSubscribedParentWithMove x k)
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> EventSubscription x
-> IORef (k a) -> MergeSubscribedParentWithMove x k a
forall k k (x :: k) (k :: k -> *) (a :: k).
EventSubscription x
-> IORef (k a) -> MergeSubscribedParentWithMove x k a
MergeSubscribedParentWithMove EventSubscription x
subscription IORef (k a)
keyRef)
        (DMap k v, [Height], DMap k (MergeSubscribedParentWithMove x k))
-> EventM
     x (DMap k v, [Height], DMap k (MergeSubscribedParentWithMove x k))
forall (m :: * -> *) a. Monad m => a -> m a
return ( [DSum k v] -> DMap k v
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). [DSum k2 f] -> DMap k2 f
DMap.fromDistinctAscList ([DSum k v] -> DMap k v) -> [DSum k v] -> DMap k v
forall a b. (a -> b) -> a -> b
$ ((Maybe (DSum k v), Height,
  DSum k (MergeSubscribedParentWithMove x k))
 -> Maybe (DSum k v))
-> [(Maybe (DSum k v), Height,
     DSum k (MergeSubscribedParentWithMove x k))]
-> [DSum k v]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (\(x :: Maybe (DSum k v)
x, _, _) -> Maybe (DSum k v)
x) [(Maybe (DSum k v), Height,
  DSum k (MergeSubscribedParentWithMove x k))]
subscribers
               , ((Maybe (DSum k v), Height,
  DSum k (MergeSubscribedParentWithMove x k))
 -> Height)
-> [(Maybe (DSum k v), Height,
     DSum k (MergeSubscribedParentWithMove x k))]
-> [Height]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(_, h :: Height
h, _) -> Height
h) [(Maybe (DSum k v), Height,
  DSum k (MergeSubscribedParentWithMove x k))]
subscribers --TODO: Assert that there's no invalidHeight in here
               , [DSum k (MergeSubscribedParentWithMove x k)]
-> DMap k (MergeSubscribedParentWithMove x k)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). [DSum k2 f] -> DMap k2 f
DMap.fromDistinctAscList ([DSum k (MergeSubscribedParentWithMove x k)]
 -> DMap k (MergeSubscribedParentWithMove x k))
-> [DSum k (MergeSubscribedParentWithMove x k)]
-> DMap k (MergeSubscribedParentWithMove x k)
forall a b. (a -> b) -> a -> b
$ ((Maybe (DSum k v), Height,
  DSum k (MergeSubscribedParentWithMove x k))
 -> DSum k (MergeSubscribedParentWithMove x k))
-> [(Maybe (DSum k v), Height,
     DSum k (MergeSubscribedParentWithMove x k))]
-> [DSum k (MergeSubscribedParentWithMove x k)]
forall a b. (a -> b) -> [a] -> [b]
map (\(_, _, x :: DSum k (MergeSubscribedParentWithMove x k)
x) -> DSum k (MergeSubscribedParentWithMove x k)
x) [(Maybe (DSum k v), Height,
  DSum k (MergeSubscribedParentWithMove x k))]
subscribers
               )

      destroy :: MergeDestroyFunc k (MergeSubscribedParentWithMove x k)
      destroy :: MergeDestroyFunc k (MergeSubscribedParentWithMove x k)
destroy s :: DMap k (MergeSubscribedParentWithMove x k)
s = [DSum k (MergeSubscribedParentWithMove x k)]
-> (DSum k (MergeSubscribedParentWithMove x k) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (DMap k (MergeSubscribedParentWithMove x k)
-> [DSum k (MergeSubscribedParentWithMove x k)]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toList DMap k (MergeSubscribedParentWithMove x k)
s) ((DSum k (MergeSubscribedParentWithMove x k) -> IO ()) -> IO ())
-> (DSum k (MergeSubscribedParentWithMove x k) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(_ :=> MergeSubscribedParentWithMove sub :: EventSubscription x
sub _) -> EventSubscription x -> IO ()
forall k (x :: k). EventSubscription x -> IO ()
unsubscribe EventSubscription x
sub

type MergeUpdateFunc k v x p s
   = (forall a. EventM x (k a) -> Subscriber x (v a))
  -> IORef HeightBag
  -> DMap k s
  -> p
  -> EventM x ([EventSubscription x], DMap k s)

type MergeGetSubscription x s = forall a. s a -> EventSubscription x

type MergeInitFunc k v q x s
   = DMap k q
  -> (forall a. EventM x (k a) -> Subscriber x (v a))
  -> EventM x (DMap k v, [Height], DMap k s)

type MergeDestroyFunc k s
   = DMap k s
  -> IO ()

data Merge x k v s = Merge
  { Merge x k v s -> IORef (DMap k s)
_merge_parentsRef :: {-# UNPACK #-} !(IORef (DMap k s))
  , Merge x k v s -> IORef HeightBag
_merge_heightBagRef :: {-# UNPACK #-} !(IORef HeightBag)
  , Merge x k v s -> IORef Height
_merge_heightRef :: {-# UNPACK #-} !(IORef Height)
  , Merge x k v s -> Subscriber x (DMap k v)
_merge_sub :: {-# UNPACK #-} !(Subscriber x (DMap k v))
  , Merge x k v s -> IORef (DMap k v)
_merge_accumRef :: {-# UNPACK #-} !(IORef (DMap k v))
  }

invalidateMergeHeight :: Merge x k v s -> IO ()
invalidateMergeHeight :: Merge x k v s -> IO ()
invalidateMergeHeight m :: Merge x k v s
m = IORef Height -> Subscriber x (DMap k v) -> IO ()
forall k (x :: k) a. IORef Height -> Subscriber x a -> IO ()
invalidateMergeHeight' (Merge x k v s -> IORef Height
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef Height
_merge_heightRef Merge x k v s
m) (Merge x k v s -> Subscriber x (DMap k v)
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> Subscriber x (DMap k v)
_merge_sub Merge x k v s
m)

invalidateMergeHeight' :: IORef Height -> Subscriber x a -> IO ()
invalidateMergeHeight' :: IORef Height -> Subscriber x a -> IO ()
invalidateMergeHeight' heightRef :: IORef Height
heightRef sub :: Subscriber x a
sub = do
  Height
oldHeight <- IORef Height -> IO Height
forall a. IORef a -> IO a
readIORef IORef Height
heightRef
  -- If the height used to be valid, it must be invalid now; we should never have *more* heights than we have parents
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Height
oldHeight Height -> Height -> Bool
forall a. Eq a => a -> a -> Bool
/= Height
invalidHeight) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    IORef Height -> Height -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Height
heightRef (Height -> IO ()) -> Height -> IO ()
forall a b. (a -> b) -> a -> b
$! Height
invalidHeight
    Subscriber x a -> Height -> IO ()
forall k (x :: k) a. Subscriber x a -> Height -> IO ()
subscriberInvalidateHeight Subscriber x a
sub Height
oldHeight

revalidateMergeHeight :: Merge x k v s -> IO ()
revalidateMergeHeight :: Merge x k v s -> IO ()
revalidateMergeHeight m :: Merge x k v s
m = do
  Height
currentHeight <- IORef Height -> IO Height
forall a. IORef a -> IO a
readIORef (IORef Height -> IO Height) -> IORef Height -> IO Height
forall a b. (a -> b) -> a -> b
$ Merge x k v s -> IORef Height
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef Height
_merge_heightRef Merge x k v s
m

  -- revalidateMergeHeight may be called multiple times; perhaps the's a way to finesse it to avoid this check
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Height
currentHeight Height -> Height -> Bool
forall a. Eq a => a -> a -> Bool
== Height
invalidHeight) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    HeightBag
heights <- IORef HeightBag -> IO HeightBag
forall a. IORef a -> IO a
readIORef (IORef HeightBag -> IO HeightBag)
-> IORef HeightBag -> IO HeightBag
forall a b. (a -> b) -> a -> b
$ Merge x k v s -> IORef HeightBag
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef HeightBag
_merge_heightBagRef Merge x k v s
m
    DMap k s
parents <- IORef (DMap k s) -> IO (DMap k s)
forall a. IORef a -> IO a
readIORef (IORef (DMap k s) -> IO (DMap k s))
-> IORef (DMap k s) -> IO (DMap k s)
forall a b. (a -> b) -> a -> b
$ Merge x k v s -> IORef (DMap k s)
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef (DMap k s)
_merge_parentsRef Merge x k v s
m
    -- When the number of heights in the bag reaches the number of parents, we should have a valid height
    case HeightBag -> Int
heightBagSize HeightBag
heights Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` DMap k s -> Int
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Int
DMap.size DMap k s
parents of
      LT -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      EQ -> do
        let height :: Height
height = Height -> Height
succHeight (Height -> Height) -> Height -> Height
forall a b. (a -> b) -> a -> b
$ HeightBag -> Height
heightBagMax HeightBag
heights
        String -> IO ()
traceInvalidateHeight (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "recalculateSubscriberHeight: height: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Height -> String
forall a. Show a => a -> String
show Height
height
        IORef Height -> Height -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Merge x k v s -> IORef Height
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef Height
_merge_heightRef Merge x k v s
m) (Height -> IO ()) -> Height -> IO ()
forall a b. (a -> b) -> a -> b
$! Height
height
        Subscriber x (DMap k v) -> Height -> IO ()
forall k (x :: k) a. Subscriber x a -> Height -> IO ()
subscriberRecalculateHeight (Merge x k v s -> Subscriber x (DMap k v)
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> Subscriber x (DMap k v)
_merge_sub Merge x k v s
m) Height
height
      GT -> String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "revalidateMergeHeight: more heights (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (HeightBag -> Int
heightBagSize HeightBag
heights) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ") than parents (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (DMap k s -> Int
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Int
DMap.size DMap k s
parents) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ") for Merge"

scheduleMergeSelf :: HasSpiderTimeline x => Merge x k v s -> Height -> EventM x ()
scheduleMergeSelf :: Merge x k v s -> Height -> EventM x ()
scheduleMergeSelf m :: Merge x k v s
m height :: Height
height = Height -> IORef Height -> EventM x () -> EventM x ()
forall x.
HasSpiderTimeline x =>
Height -> IORef Height -> EventM x () -> EventM x ()
scheduleMerge' Height
height (Merge x k v s -> IORef Height
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef Height
_merge_heightRef Merge x k v s
m) (EventM x () -> EventM x ()) -> EventM x () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ do
  DMap k v
vals <- IO (DMap k v) -> EventM x (DMap k v)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DMap k v) -> EventM x (DMap k v))
-> IO (DMap k v) -> EventM x (DMap k v)
forall a b. (a -> b) -> a -> b
$ IORef (DMap k v) -> IO (DMap k v)
forall a. IORef a -> IO a
readIORef (IORef (DMap k v) -> IO (DMap k v))
-> IORef (DMap k v) -> IO (DMap k v)
forall a b. (a -> b) -> a -> b
$ Merge x k v s -> IORef (DMap k v)
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef (DMap k v)
_merge_accumRef Merge x k v s
m
  -- Once we're done with this, we can clear it immediately, because if there's a cacheEvent in front of us,
  -- it'll handle subsequent subscribers, and if not, we won't get subsequent subscribers
  IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (DMap k v) -> DMap k v -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Merge x k v s -> IORef (DMap k v)
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef (DMap k v)
_merge_accumRef Merge x k v s
m) (DMap k v -> IO ()) -> DMap k v -> IO ()
forall a b. (a -> b) -> a -> b
$! DMap k v
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f
DMap.empty
  --TODO: Assert that m is not empty
  Subscriber x (DMap k v) -> DMap k v -> EventM x ()
forall k (x :: k) a. Subscriber x a -> a -> EventM x ()
subscriberPropagate (Merge x k v s -> Subscriber x (DMap k v)
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> Subscriber x (DMap k v)
_merge_sub Merge x k v s
m) DMap k v
vals

checkCycle :: HasSpiderTimeline x => EventSubscribed x -> EventM x ()
checkCycle :: EventSubscribed x -> EventM x ()
checkCycle subscribed :: EventSubscribed x
subscribed = IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ do
    Height
height <- IORef Height -> IO Height
forall a. IORef a -> IO a
readIORef (EventSubscribed x -> IORef Height
forall k (x :: k). EventSubscribed x -> IORef Height
eventSubscribedHeightRef EventSubscribed x
subscribed)

    -- currentHeight <- getCurrentHeight
    -- when (height <= currentHeight) $ if height /= invalidHeight
    --     then do
    --       myStack <- liftIO $ whoCreatedIORef undefined --TODO
    --       error $ "Height (" ++ show height ++ ") is not greater than current height (" ++ show currentHeight ++ ")\n" ++ unlines (reverse myStack)
    --     else liftIO $
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Height
height Height -> Height -> Bool
forall a. Eq a => a -> a -> Bool
== Height
invalidHeight) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
#ifdef DEBUG_CYCLES
          do
            nodesInvolvedInCycle <- walkInvalidHeightParents subscribed
            stacks <- forM nodesInvolvedInCycle whoCreatedEventSubscribed
            throwIO (EventLoopException stacks)
#else
          EventLoopException -> IO ()
forall e a. Exception e => e -> IO a
throwIO EventLoopException
EventLoopException
#endif


mergeSubscriber :: forall x k v s a. (HasSpiderTimeline x, GCompare k) => EventSubscribed x -> Merge x k v s -> EventM x (k a) -> Subscriber x (v a)
mergeSubscriber :: EventSubscribed x
-> Merge x k v s -> EventM x (k a) -> Subscriber x (v a)
mergeSubscriber subscribed :: EventSubscribed x
subscribed m :: Merge x k v s
m getKey :: EventM x (k a)
getKey = $WSubscriber :: forall k (x :: k) a.
(a -> EventM x ())
-> (Height -> IO ()) -> (Height -> IO ()) -> Subscriber x a
Subscriber
  { subscriberPropagate :: v a -> EventM x ()
subscriberPropagate = \a :: v a
a -> do
      DMap k v
oldM <- IO (DMap k v) -> EventM x (DMap k v)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DMap k v) -> EventM x (DMap k v))
-> IO (DMap k v) -> EventM x (DMap k v)
forall a b. (a -> b) -> a -> b
$ IORef (DMap k v) -> IO (DMap k v)
forall a. IORef a -> IO a
readIORef (IORef (DMap k v) -> IO (DMap k v))
-> IORef (DMap k v) -> IO (DMap k v)
forall a b. (a -> b) -> a -> b
$ Merge x k v s -> IORef (DMap k v)
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef (DMap k v)
_merge_accumRef Merge x k v s
m
      k a
k <- EventM x (k a)
getKey
      let newM :: DMap k v
newM = (v a -> v a -> v a) -> k a -> v a -> DMap k v -> DMap k v
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
(f v -> f v -> f v) -> k2 v -> f v -> DMap k2 f -> DMap k2 f
DMap.insertWith (String -> v a -> v a -> v a
forall a. HasCallStack => String -> a
error "Same key fired multiple times for Merge") k a
k v a
a DMap k v
oldM
      Proxy x -> String -> EventM x ()
forall x (m :: * -> *) (proxy :: * -> *).
CanTrace x m =>
proxy x -> String -> m ()
tracePropagate (Proxy x
forall k (t :: k). Proxy t
Proxy :: Proxy x) (String -> EventM x ()) -> String -> EventM x ()
forall a b. (a -> b) -> a -> b
$ "  DMap.size oldM = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (DMap k v -> Int
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Int
DMap.size DMap k v
oldM) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "; DMap.size newM = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (DMap k v -> Int
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Int
DMap.size DMap k v
newM)
      IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (DMap k v) -> DMap k v -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Merge x k v s -> IORef (DMap k v)
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef (DMap k v)
_merge_accumRef Merge x k v s
m) (DMap k v -> IO ()) -> DMap k v -> IO ()
forall a b. (a -> b) -> a -> b
$! DMap k v
newM
      Bool -> EventM x () -> EventM x ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DMap k v -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap.null DMap k v
oldM) (EventM x () -> EventM x ()) -> EventM x () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ do -- Only schedule the firing once
        Height
height <- IO Height -> EventM x Height
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Height -> EventM x Height) -> IO Height -> EventM x Height
forall a b. (a -> b) -> a -> b
$ IORef Height -> IO Height
forall a. IORef a -> IO a
readIORef (IORef Height -> IO Height) -> IORef Height -> IO Height
forall a b. (a -> b) -> a -> b
$ Merge x k v s -> IORef Height
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef Height
_merge_heightRef Merge x k v s
m
        EventSubscribed x -> EventM x ()
forall x. HasSpiderTimeline x => EventSubscribed x -> EventM x ()
checkCycle EventSubscribed x
subscribed

        Merge x k v s -> Height -> EventM x ()
forall k x (k :: k -> *) (v :: k -> *) (s :: k -> *).
HasSpiderTimeline x =>
Merge x k v s -> Height -> EventM x ()
scheduleMergeSelf Merge x k v s
m Height
height
  , subscriberInvalidateHeight :: Height -> IO ()
subscriberInvalidateHeight = \old :: Height
old -> do --TODO: When removing a parent doesn't actually change the height, maybe we can avoid invalidating
      IORef HeightBag -> (HeightBag -> HeightBag) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Merge x k v s -> IORef HeightBag
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef HeightBag
_merge_heightBagRef Merge x k v s
m) ((HeightBag -> HeightBag) -> IO ())
-> (HeightBag -> HeightBag) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> HeightBag -> HeightBag
heightBagRemove Height
old
      Merge x k v s -> IO ()
forall k k (x :: k) (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IO ()
invalidateMergeHeight Merge x k v s
m
  , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = \new :: Height
new -> do
      IORef HeightBag -> (HeightBag -> HeightBag) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Merge x k v s -> IORef HeightBag
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef HeightBag
_merge_heightBagRef Merge x k v s
m) ((HeightBag -> HeightBag) -> IO ())
-> (HeightBag -> HeightBag) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> HeightBag -> HeightBag
heightBagAdd Height
new
      Merge x k v s -> IO ()
forall k k (x :: k) (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IO ()
revalidateMergeHeight Merge x k v s
m
  }

--TODO: Be able to run as much of this as possible promptly
updateMerge :: (HasSpiderTimeline x, GCompare k) => EventSubscribed x -> Merge x k v s -> MergeUpdateFunc k v x p s -> p -> SomeMergeUpdate x
updateMerge :: EventSubscribed x
-> Merge x k v s
-> MergeUpdateFunc k v x p s
-> p
-> SomeMergeUpdate x
updateMerge subscribed :: EventSubscribed x
subscribed m :: Merge x k v s
m updateFunc :: MergeUpdateFunc k v x p s
updateFunc p :: p
p = EventM x [EventSubscription x]
-> IO () -> IO () -> SomeMergeUpdate x
forall k (x :: k).
EventM x [EventSubscription x]
-> IO () -> IO () -> SomeMergeUpdate x
SomeMergeUpdate EventM x [EventSubscription x]
updateMe (Merge x k v s -> IO ()
forall k k (x :: k) (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IO ()
invalidateMergeHeight Merge x k v s
m) (Merge x k v s -> IO ()
forall k k (x :: k) (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IO ()
revalidateMergeHeight Merge x k v s
m)
  where updateMe :: EventM x [EventSubscription x]
updateMe = do
          DMap k s
oldParents <- IO (DMap k s) -> EventM x (DMap k s)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DMap k s) -> EventM x (DMap k s))
-> IO (DMap k s) -> EventM x (DMap k s)
forall a b. (a -> b) -> a -> b
$ IORef (DMap k s) -> IO (DMap k s)
forall a. IORef a -> IO a
readIORef (IORef (DMap k s) -> IO (DMap k s))
-> IORef (DMap k s) -> IO (DMap k s)
forall a b. (a -> b) -> a -> b
$ Merge x k v s -> IORef (DMap k s)
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef (DMap k s)
_merge_parentsRef Merge x k v s
m
          (subscriptionsToKill :: [EventSubscription x]
subscriptionsToKill, newParents :: DMap k s
newParents) <- MergeUpdateFunc k v x p s
updateFunc (EventSubscribed x
-> Merge x k v s -> EventM x (k a) -> Subscriber x (v a)
forall k x (k :: k -> *) (v :: k -> *) (s :: k -> *) (a :: k).
(HasSpiderTimeline x, GCompare k) =>
EventSubscribed x
-> Merge x k v s -> EventM x (k a) -> Subscriber x (v a)
mergeSubscriber EventSubscribed x
subscribed Merge x k v s
m) (Merge x k v s -> IORef HeightBag
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef HeightBag
_merge_heightBagRef Merge x k v s
m) DMap k s
oldParents p
p
          IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (DMap k s) -> DMap k s -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Merge x k v s -> IORef (DMap k s)
forall k (x :: k) k (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef (DMap k s)
_merge_parentsRef Merge x k v s
m) (DMap k s -> IO ()) -> DMap k s -> IO ()
forall a b. (a -> b) -> a -> b
$! DMap k s
newParents
          [EventSubscription x] -> EventM x [EventSubscription x]
forall (m :: * -> *) a. Monad m => a -> m a
return [EventSubscription x]
subscriptionsToKill

{-# INLINE mergeGCheap' #-}
mergeGCheap' :: forall k v x p s q. (HasSpiderTimeline x, GCompare k, PatchTarget p ~ DMap k q)
  => MergeGetSubscription x s -> MergeInitFunc k v q x s -> MergeUpdateFunc k v x p s -> MergeDestroyFunc k s -> DynamicS x p -> Event x (DMap k v)
mergeGCheap' :: MergeGetSubscription x s
-> MergeInitFunc k v q x s
-> MergeUpdateFunc k v x p s
-> MergeDestroyFunc k s
-> DynamicS x p
-> Event x (DMap k v)
mergeGCheap' getParent :: MergeGetSubscription x s
getParent getInitialSubscribers :: MergeInitFunc k v q x s
getInitialSubscribers updateFunc :: MergeUpdateFunc k v x p s
updateFunc destroy :: MergeDestroyFunc k s
destroy d :: DynamicS x p
d = (Subscriber x (DMap k v)
 -> EventM x (EventSubscription x, Maybe (DMap k v)))
-> Event x (DMap k v)
forall k (x :: k) a.
(Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
Event ((Subscriber x (DMap k v)
  -> EventM x (EventSubscription x, Maybe (DMap k v)))
 -> Event x (DMap k v))
-> (Subscriber x (DMap k v)
    -> EventM x (EventSubscription x, Maybe (DMap k v)))
-> Event x (DMap k v)
forall a b. (a -> b) -> a -> b
$ \sub :: Subscriber x (DMap k v)
sub -> do
  DMap k q
initialParents <- Behavior x (DMap k q) -> EventM x (DMap k q)
forall k (x :: k) (m :: * -> *) a.
Defer (SomeHoldInit x) m =>
Behavior x a -> m a
readBehaviorUntracked (Behavior x (DMap k q) -> EventM x (DMap k q))
-> Behavior x (DMap k q) -> EventM x (DMap k q)
forall a b. (a -> b) -> a -> b
$ Dynamic x (DMap k q) p -> Behavior x (DMap k q)
forall k (x :: k) target p. Dynamic x target p -> Behavior x target
dynamicCurrent Dynamic x (DMap k q) p
DynamicS x p
d
  IORef (DMap k v)
accumRef <- IO (IORef (DMap k v)) -> EventM x (IORef (DMap k v))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (DMap k v)) -> EventM x (IORef (DMap k v)))
-> IO (IORef (DMap k v)) -> EventM x (IORef (DMap k v))
forall a b. (a -> b) -> a -> b
$ DMap k v -> IO (IORef (DMap k v))
forall a. a -> IO (IORef a)
newIORef (DMap k v -> IO (IORef (DMap k v)))
-> DMap k v -> IO (IORef (DMap k v))
forall a b. (a -> b) -> a -> b
$ String -> DMap k v
forall a. HasCallStack => String -> a
error "merge: accumRef not yet initialized"
  IORef Height
heightRef <- IO (IORef Height) -> EventM x (IORef Height)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Height) -> EventM x (IORef Height))
-> IO (IORef Height) -> EventM x (IORef Height)
forall a b. (a -> b) -> a -> b
$ Height -> IO (IORef Height)
forall a. a -> IO (IORef a)
newIORef (Height -> IO (IORef Height)) -> Height -> IO (IORef Height)
forall a b. (a -> b) -> a -> b
$ String -> Height
forall a. HasCallStack => String -> a
error "merge: heightRef not yet initialized"
  IORef HeightBag
heightBagRef <- IO (IORef HeightBag) -> EventM x (IORef HeightBag)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef HeightBag) -> EventM x (IORef HeightBag))
-> IO (IORef HeightBag) -> EventM x (IORef HeightBag)
forall a b. (a -> b) -> a -> b
$ HeightBag -> IO (IORef HeightBag)
forall a. a -> IO (IORef a)
newIORef (HeightBag -> IO (IORef HeightBag))
-> HeightBag -> IO (IORef HeightBag)
forall a b. (a -> b) -> a -> b
$ String -> HeightBag
forall a. HasCallStack => String -> a
error "merge: heightBagRef not yet initialized"
  IORef (DMap k s)
parentsRef :: IORef (DMap k s) <- IO (IORef (DMap k s)) -> EventM x (IORef (DMap k s))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (DMap k s)) -> EventM x (IORef (DMap k s)))
-> IO (IORef (DMap k s)) -> EventM x (IORef (DMap k s))
forall a b. (a -> b) -> a -> b
$ DMap k s -> IO (IORef (DMap k s))
forall a. a -> IO (IORef a)
newIORef (DMap k s -> IO (IORef (DMap k s)))
-> DMap k s -> IO (IORef (DMap k s))
forall a b. (a -> b) -> a -> b
$ String -> DMap k s
forall a. HasCallStack => String -> a
error "merge: parentsRef not yet initialized"
  IORef (Subscriber x p, EventSubscription x)
changeSubdRef <- IO (IORef (Subscriber x p, EventSubscription x))
-> EventM x (IORef (Subscriber x p, EventSubscription x))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Subscriber x p, EventSubscription x))
 -> EventM x (IORef (Subscriber x p, EventSubscription x)))
-> IO (IORef (Subscriber x p, EventSubscription x))
-> EventM x (IORef (Subscriber x p, EventSubscription x))
forall a b. (a -> b) -> a -> b
$ (Subscriber x p, EventSubscription x)
-> IO (IORef (Subscriber x p, EventSubscription x))
forall a. a -> IO (IORef a)
newIORef ((Subscriber x p, EventSubscription x)
 -> IO (IORef (Subscriber x p, EventSubscription x)))
-> (Subscriber x p, EventSubscription x)
-> IO (IORef (Subscriber x p, EventSubscription x))
forall a b. (a -> b) -> a -> b
$ String -> (Subscriber x p, EventSubscription x)
forall a. HasCallStack => String -> a
error "getMergeSubscribed: changeSubdRef not yet initialized"

  let subscribed :: EventSubscribed x
subscribed = $WEventSubscribed :: forall k (x :: k). IORef Height -> Any -> EventSubscribed x
EventSubscribed
        { eventSubscribedHeightRef :: IORef Height
eventSubscribedHeightRef = IORef Height
heightRef
        , eventSubscribedRetained :: Any
eventSubscribedRetained = (IORef (DMap k s), IORef (Subscriber x p, EventSubscription x))
-> Any
forall a. a -> Any
toAny (IORef (DMap k s)
parentsRef, IORef (Subscriber x p, EventSubscription x)
changeSubdRef)
#ifdef DEBUG_CYCLES
      , eventSubscribedGetParents = do
          let getParent' (_ :=> v) = _eventSubscription_subscribed (getParent v)
          fmap getParent' . DMap.toList  <$> readIORef parentsRef
      , eventSubscribedHasOwnHeightRef = False
      , eventSubscribedWhoCreated = whoCreatedIORef heightRef
#endif
      }

      m :: Merge x k v s
m = $WMerge :: forall k k (x :: k) (k :: k -> *) (v :: k -> *) (s :: k -> *).
IORef (DMap k s)
-> IORef HeightBag
-> IORef Height
-> Subscriber x (DMap k v)
-> IORef (DMap k v)
-> Merge x k v s
Merge
        { _merge_parentsRef :: IORef (DMap k s)
_merge_parentsRef = IORef (DMap k s)
parentsRef
        , _merge_heightBagRef :: IORef HeightBag
_merge_heightBagRef = IORef HeightBag
heightBagRef
        , _merge_heightRef :: IORef Height
_merge_heightRef = IORef Height
heightRef
        , _merge_sub :: Subscriber x (DMap k v)
_merge_sub = Subscriber x (DMap k v)
sub
        , _merge_accumRef :: IORef (DMap k v)
_merge_accumRef = IORef (DMap k v)
accumRef
        }
  (dm :: DMap k v
dm, heights :: [Height]
heights, initialParentState :: DMap k s
initialParentState) <- MergeInitFunc k v q x s
getInitialSubscribers DMap k q
initialParents ((forall (a :: k). EventM x (k a) -> Subscriber x (v a))
 -> EventM x (DMap k v, [Height], DMap k s))
-> (forall (a :: k). EventM x (k a) -> Subscriber x (v a))
-> EventM x (DMap k v, [Height], DMap k s)
forall a b. (a -> b) -> a -> b
$ EventSubscribed x
-> Merge x k v s -> EventM x (k a) -> Subscriber x (v a)
forall k x (k :: k -> *) (v :: k -> *) (s :: k -> *) (a :: k).
(HasSpiderTimeline x, GCompare k) =>
EventSubscribed x
-> Merge x k v s -> EventM x (k a) -> Subscriber x (v a)
mergeSubscriber EventSubscribed x
subscribed Merge x k v s
m
  let myHeightBag :: HeightBag
myHeightBag = [Height] -> HeightBag
heightBagFromList ([Height] -> HeightBag) -> [Height] -> HeightBag
forall a b. (a -> b) -> a -> b
$ (Height -> Bool) -> [Height] -> [Height]
forall a. (a -> Bool) -> [a] -> [a]
filter (Height -> Height -> Bool
forall a. Eq a => a -> a -> Bool
/= Height
invalidHeight) [Height]
heights
      myHeight :: Height
myHeight = if Height
invalidHeight Height -> [Height] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Height]
heights
                 then Height
invalidHeight
                 else Height -> Height
succHeight (Height -> Height) -> Height -> Height
forall a b. (a -> b) -> a -> b
$ HeightBag -> Height
heightBagMax HeightBag
myHeightBag
  Height
currentHeight <- EventM x Height
forall x (m :: * -> *). HasCurrentHeight x m => m Height
getCurrentHeight
  let (occ :: Maybe (DMap k v)
occ, accum :: DMap k v
accum) = if Height
currentHeight Height -> Height -> Bool
forall a. Ord a => a -> a -> Bool
>= Height
myHeight -- If we should have fired by now
                     then (if DMap k v -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap.null DMap k v
dm then Maybe (DMap k v)
forall a. Maybe a
Nothing else DMap k v -> Maybe (DMap k v)
forall a. a -> Maybe a
Just DMap k v
dm, DMap k v
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f
DMap.empty)
                     else (Maybe (DMap k v)
forall a. Maybe a
Nothing, DMap k v
dm)
  Bool -> EventM x () -> EventM x ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (DMap k v -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap.null DMap k v
accum) (EventM x () -> EventM x ()) -> EventM x () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ Merge x k v s -> Height -> EventM x ()
forall k x (k :: k -> *) (v :: k -> *) (s :: k -> *).
HasSpiderTimeline x =>
Merge x k v s -> Height -> EventM x ()
scheduleMergeSelf Merge x k v s
m Height
myHeight
  IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (DMap k v) -> DMap k v -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (DMap k v)
accumRef (DMap k v -> IO ()) -> DMap k v -> IO ()
forall a b. (a -> b) -> a -> b
$! DMap k v
accum
  IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef Height -> Height -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Height
heightRef (Height -> IO ()) -> Height -> IO ()
forall a b. (a -> b) -> a -> b
$! Height
myHeight
  IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef HeightBag -> HeightBag -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef HeightBag
heightBagRef (HeightBag -> IO ()) -> HeightBag -> IO ()
forall a b. (a -> b) -> a -> b
$! HeightBag
myHeightBag
  IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (DMap k s) -> MergeDestroyFunc k s
forall a. IORef a -> a -> IO ()
writeIORef IORef (DMap k s)
parentsRef MergeDestroyFunc k s -> MergeDestroyFunc k s
forall a b. (a -> b) -> a -> b
$! DMap k s
initialParentState
  SomeMergeInit x -> EventM x ()
forall a (m :: * -> *). Defer a m => a -> m ()
defer (SomeMergeInit x -> EventM x ()) -> SomeMergeInit x -> EventM x ()
forall a b. (a -> b) -> a -> b
$ EventM x () -> SomeMergeInit x
forall k (x :: k). EventM x () -> SomeMergeInit x
SomeMergeInit (EventM x () -> SomeMergeInit x) -> EventM x () -> SomeMergeInit x
forall a b. (a -> b) -> a -> b
$ do
    let changeSubscriber :: Subscriber x p
changeSubscriber = $WSubscriber :: forall k (x :: k) a.
(a -> EventM x ())
-> (Height -> IO ()) -> (Height -> IO ()) -> Subscriber x a
Subscriber
          { subscriberPropagate :: p -> EventM x ()
subscriberPropagate = \a :: p
a -> {-# SCC "traverseMergeChange" #-} do
              Proxy x -> String -> EventM x ()
forall x (m :: * -> *) (proxy :: * -> *).
CanTrace x m =>
proxy x -> String -> m ()
tracePropagate (Proxy x
forall k (t :: k). Proxy t
Proxy :: Proxy x) "SubscriberMerge/Change"
              SomeMergeUpdate x -> EventM x ()
forall a (m :: * -> *). Defer a m => a -> m ()
defer (SomeMergeUpdate x -> EventM x ())
-> SomeMergeUpdate x -> EventM x ()
forall a b. (a -> b) -> a -> b
$ EventSubscribed x
-> Merge x k v s
-> MergeUpdateFunc k v x p s
-> p
-> SomeMergeUpdate x
forall k x (k :: k -> *) (v :: k -> *) (s :: k -> *) p.
(HasSpiderTimeline x, GCompare k) =>
EventSubscribed x
-> Merge x k v s
-> MergeUpdateFunc k v x p s
-> p
-> SomeMergeUpdate x
updateMerge EventSubscribed x
subscribed Merge x k v s
m MergeUpdateFunc k v x p s
updateFunc p
a
          , subscriberInvalidateHeight :: Height -> IO ()
subscriberInvalidateHeight = \_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = \_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          }
    (changeSubscription :: EventSubscription x
changeSubscription, change :: Maybe p
change) <- Event x p
-> Subscriber x p -> EventM x (EventSubscription x, Maybe p)
forall k (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead (Dynamic x (DMap k q) p -> Event x p
forall k (x :: k) target p. Dynamic x target p -> Event x p
dynamicUpdated Dynamic x (DMap k q) p
DynamicS x p
d) Subscriber x p
changeSubscriber
    Maybe p -> (p -> EventM x ()) -> EventM x ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe p
change ((p -> EventM x ()) -> EventM x ())
-> (p -> EventM x ()) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ \c :: p
c -> SomeMergeUpdate x -> EventM x ()
forall a (m :: * -> *). Defer a m => a -> m ()
defer (SomeMergeUpdate x -> EventM x ())
-> SomeMergeUpdate x -> EventM x ()
forall a b. (a -> b) -> a -> b
$ EventSubscribed x
-> Merge x k v s
-> MergeUpdateFunc k v x p s
-> p
-> SomeMergeUpdate x
forall k x (k :: k -> *) (v :: k -> *) (s :: k -> *) p.
(HasSpiderTimeline x, GCompare k) =>
EventSubscribed x
-> Merge x k v s
-> MergeUpdateFunc k v x p s
-> p
-> SomeMergeUpdate x
updateMerge EventSubscribed x
subscribed Merge x k v s
m MergeUpdateFunc k v x p s
updateFunc p
c
    -- We explicitly hold on to the unsubscribe function from subscribing to the update event.
    -- If we don't do this, there are certain cases where mergeCheap will fail to properly retain
    -- its subscription.
    IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Subscriber x p, EventSubscription x)
-> (Subscriber x p, EventSubscription x) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Subscriber x p, EventSubscription x)
changeSubdRef (Subscriber x p
changeSubscriber, EventSubscription x
changeSubscription)
  let unsubscribeAll :: IO ()
unsubscribeAll = MergeDestroyFunc k s
destroy MergeDestroyFunc k s -> IO (DMap k s) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (DMap k s) -> IO (DMap k s)
forall a. IORef a -> IO a
readIORef IORef (DMap k s)
parentsRef

  (EventSubscription x, Maybe (DMap k v))
-> EventM x (EventSubscription x, Maybe (DMap k v))
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> EventSubscribed x -> EventSubscription x
forall k (x :: k).
IO () -> EventSubscribed x -> EventSubscription x
EventSubscription IO ()
unsubscribeAll EventSubscribed x
subscribed, Maybe (DMap k v)
occ)


mergeInt :: forall x a. (HasSpiderTimeline x) => DynamicS x (PatchIntMap (Event x a)) -> Event x (IntMap a)
mergeInt :: DynamicS x (PatchIntMap (Event x a)) -> Event x (IntMap a)
mergeInt = Event x (IntMap a) -> Event x (IntMap a)
forall x a. HasSpiderTimeline x => Event x a -> Event x a
cacheEvent (Event x (IntMap a) -> Event x (IntMap a))
-> (Dynamic x (IntMap (Event x a)) (PatchIntMap (Event x a))
    -> Event x (IntMap a))
-> Dynamic x (IntMap (Event x a)) (PatchIntMap (Event x a))
-> Event x (IntMap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic x (IntMap (Event x a)) (PatchIntMap (Event x a))
-> Event x (IntMap a)
forall x a.
HasSpiderTimeline x =>
DynamicS x (PatchIntMap (Event x a)) -> Event x (IntMap a)
mergeIntCheap

{-# INLINABLE mergeIntCheap #-}
mergeIntCheap :: forall x a. (HasSpiderTimeline x) => DynamicS x (PatchIntMap (Event x a)) -> Event x (IntMap a)
mergeIntCheap :: DynamicS x (PatchIntMap (Event x a)) -> Event x (IntMap a)
mergeIntCheap d :: DynamicS x (PatchIntMap (Event x a))
d = (Subscriber x (IntMap a)
 -> EventM x (EventSubscription x, Maybe (IntMap a)))
-> Event x (IntMap a)
forall k (x :: k) a.
(Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Event x a
Event ((Subscriber x (IntMap a)
  -> EventM x (EventSubscription x, Maybe (IntMap a)))
 -> Event x (IntMap a))
-> (Subscriber x (IntMap a)
    -> EventM x (EventSubscription x, Maybe (IntMap a)))
-> Event x (IntMap a)
forall a b. (a -> b) -> a -> b
$ \sub :: Subscriber x (IntMap a)
sub -> do
  IntMap (Event x a)
initialParents <- Behavior x (IntMap (Event x a)) -> EventM x (IntMap (Event x a))
forall k (x :: k) (m :: * -> *) a.
Defer (SomeHoldInit x) m =>
Behavior x a -> m a
readBehaviorUntracked (Behavior x (IntMap (Event x a)) -> EventM x (IntMap (Event x a)))
-> Behavior x (IntMap (Event x a)) -> EventM x (IntMap (Event x a))
forall a b. (a -> b) -> a -> b
$ Dynamic x (IntMap (Event x a)) (PatchIntMap (Event x a))
-> Behavior x (IntMap (Event x a))
forall k (x :: k) target p. Dynamic x target p -> Behavior x target
dynamicCurrent Dynamic x (IntMap (Event x a)) (PatchIntMap (Event x a))
DynamicS x (PatchIntMap (Event x a))
d
  FastMutableIntMap a
accum <- IO (FastMutableIntMap a) -> EventM x (FastMutableIntMap a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FastMutableIntMap a) -> EventM x (FastMutableIntMap a))
-> IO (FastMutableIntMap a) -> EventM x (FastMutableIntMap a)
forall a b. (a -> b) -> a -> b
$ IO (FastMutableIntMap a)
forall a. IO (FastMutableIntMap a)
FastMutableIntMap.newEmpty
  IORef Height
heightRef <- IO (IORef Height) -> EventM x (IORef Height)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Height) -> EventM x (IORef Height))
-> IO (IORef Height) -> EventM x (IORef Height)
forall a b. (a -> b) -> a -> b
$ Height -> IO (IORef Height)
forall a. a -> IO (IORef a)
newIORef Height
zeroHeight
  IORef HeightBag
heightBagRef <- IO (IORef HeightBag) -> EventM x (IORef HeightBag)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef HeightBag) -> EventM x (IORef HeightBag))
-> IO (IORef HeightBag) -> EventM x (IORef HeightBag)
forall a b. (a -> b) -> a -> b
$ HeightBag -> IO (IORef HeightBag)
forall a. a -> IO (IORef a)
newIORef HeightBag
heightBagEmpty
  FastMutableIntMap (EventSubscription x)
parents <- IO (FastMutableIntMap (EventSubscription x))
-> EventM x (FastMutableIntMap (EventSubscription x))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FastMutableIntMap (EventSubscription x))
 -> EventM x (FastMutableIntMap (EventSubscription x)))
-> IO (FastMutableIntMap (EventSubscription x))
-> EventM x (FastMutableIntMap (EventSubscription x))
forall a b. (a -> b) -> a -> b
$ IO (FastMutableIntMap (EventSubscription x))
forall a. IO (FastMutableIntMap a)
FastMutableIntMap.newEmpty
  IORef (Subscriber x (PatchIntMap (Event x a)), EventSubscription x)
changeSubdRef <- IO
  (IORef
     (Subscriber x (PatchIntMap (Event x a)), EventSubscription x))
-> EventM
     x
     (IORef
        (Subscriber x (PatchIntMap (Event x a)), EventSubscription x))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (IORef
      (Subscriber x (PatchIntMap (Event x a)), EventSubscription x))
 -> EventM
      x
      (IORef
         (Subscriber x (PatchIntMap (Event x a)), EventSubscription x)))
-> IO
     (IORef
        (Subscriber x (PatchIntMap (Event x a)), EventSubscription x))
-> EventM
     x
     (IORef
        (Subscriber x (PatchIntMap (Event x a)), EventSubscription x))
forall a b. (a -> b) -> a -> b
$ (Subscriber x (PatchIntMap (Event x a)), EventSubscription x)
-> IO
     (IORef
        (Subscriber x (PatchIntMap (Event x a)), EventSubscription x))
forall a. a -> IO (IORef a)
newIORef ((Subscriber x (PatchIntMap (Event x a)), EventSubscription x)
 -> IO
      (IORef
         (Subscriber x (PatchIntMap (Event x a)), EventSubscription x)))
-> (Subscriber x (PatchIntMap (Event x a)), EventSubscription x)
-> IO
     (IORef
        (Subscriber x (PatchIntMap (Event x a)), EventSubscription x))
forall a b. (a -> b) -> a -> b
$ String
-> (Subscriber x (PatchIntMap (Event x a)), EventSubscription x)
forall a. HasCallStack => String -> a
error "getMergeSubscribed: changeSubdRef not yet initialized"
  let subscribed :: EventSubscribed x
subscribed = $WEventSubscribed :: forall k (x :: k). IORef Height -> Any -> EventSubscribed x
EventSubscribed
        { eventSubscribedHeightRef :: IORef Height
eventSubscribedHeightRef = IORef Height
heightRef
        , eventSubscribedRetained :: Any
eventSubscribedRetained = (FastMutableIntMap (EventSubscription x),
 IORef
   (Subscriber x (PatchIntMap (Event x a)), EventSubscription x))
-> Any
forall a. a -> Any
toAny (FastMutableIntMap (EventSubscription x)
parents, IORef (Subscriber x (PatchIntMap (Event x a)), EventSubscription x)
changeSubdRef)
#ifdef DEBUG_CYCLES
        , eventSubscribedGetParents = fmap (_eventSubscription_subscribed . snd) <$> FastMutableIntMap.toList parents
        , eventSubscribedHasOwnHeightRef = False
        , eventSubscribedWhoCreated = whoCreatedIORef heightRef
#endif
        }
  let scheduleSelf :: EventM x ()
scheduleSelf = do
        Height
height <- IO Height -> EventM x Height
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Height -> EventM x Height) -> IO Height -> EventM x Height
forall a b. (a -> b) -> a -> b
$ IORef Height -> IO Height
forall a. IORef a -> IO a
readIORef (IORef Height -> IO Height) -> IORef Height -> IO Height
forall a b. (a -> b) -> a -> b
$ IORef Height
heightRef
        Height -> IORef Height -> EventM x () -> EventM x ()
forall x.
HasSpiderTimeline x =>
Height -> IORef Height -> EventM x () -> EventM x ()
scheduleMerge' Height
height IORef Height
heightRef (EventM x () -> EventM x ()) -> EventM x () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ do
          IntMap a
vals <- IO (IntMap a) -> EventM x (IntMap a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IntMap a) -> EventM x (IntMap a))
-> IO (IntMap a) -> EventM x (IntMap a)
forall a b. (a -> b) -> a -> b
$ FastMutableIntMap a -> IO (IntMap a)
forall a. FastMutableIntMap a -> IO (IntMap a)
FastMutableIntMap.getFrozenAndClear FastMutableIntMap a
accum
          Subscriber x (IntMap a) -> IntMap a -> EventM x ()
forall k (x :: k) a. Subscriber x a -> a -> EventM x ()
subscriberPropagate Subscriber x (IntMap a)
sub IntMap a
vals
      invalidateMyHeight :: IO ()
invalidateMyHeight = IORef Height -> Subscriber x (IntMap a) -> IO ()
forall k (x :: k) a. IORef Height -> Subscriber x a -> IO ()
invalidateMergeHeight' IORef Height
heightRef Subscriber x (IntMap a)
sub
      recalculateMyHeight :: IO ()
recalculateMyHeight = do
        Height
currentHeight <- IORef Height -> IO Height
forall a. IORef a -> IO a
readIORef IORef Height
heightRef
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Height
currentHeight Height -> Height -> Bool
forall a. Eq a => a -> a -> Bool
== Height
invalidHeight) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do --TODO: This will almost always be true; can we get rid of this check and just proceed to the next one always?
          HeightBag
heights <- IORef HeightBag -> IO HeightBag
forall a. IORef a -> IO a
readIORef IORef HeightBag
heightBagRef
          Int
numParents <- FastMutableIntMap (EventSubscription x) -> IO Int
forall a. FastMutableIntMap a -> IO Int
FastMutableIntMap.size FastMutableIntMap (EventSubscription x)
parents
          case HeightBag -> Int
heightBagSize HeightBag
heights Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
numParents of
            LT -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            EQ -> do
              let height :: Height
height = Height -> Height
succHeight (Height -> Height) -> Height -> Height
forall a b. (a -> b) -> a -> b
$ HeightBag -> Height
heightBagMax HeightBag
heights
              String -> IO ()
traceInvalidateHeight (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "recalculateSubscriberHeight: height: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Height -> String
forall a. Show a => a -> String
show Height
height
              IORef Height -> Height -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Height
heightRef (Height -> IO ()) -> Height -> IO ()
forall a b. (a -> b) -> a -> b
$! Height
height
              Subscriber x (IntMap a) -> Height -> IO ()
forall k (x :: k) a. Subscriber x a -> Height -> IO ()
subscriberRecalculateHeight Subscriber x (IntMap a)
sub Height
height
            GT -> String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "revalidateMergeHeight: more heights (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (HeightBag -> Int
heightBagSize HeightBag
heights) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ") than parents (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
numParents String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ") for Merge"
      mySubscriber :: Int -> Subscriber x a
mySubscriber k :: Int
k = $WSubscriber :: forall k (x :: k) a.
(a -> EventM x ())
-> (Height -> IO ()) -> (Height -> IO ()) -> Subscriber x a
Subscriber
        { subscriberPropagate :: a -> EventM x ()
subscriberPropagate = \a :: a
a -> do
            EventSubscribed x -> EventM x ()
forall x. HasSpiderTimeline x => EventSubscribed x -> EventM x ()
checkCycle EventSubscribed x
subscribed

            Bool
wasEmpty <- IO Bool -> EventM x Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> EventM x Bool) -> IO Bool -> EventM x Bool
forall a b. (a -> b) -> a -> b
$ FastMutableIntMap a -> IO Bool
forall a. FastMutableIntMap a -> IO Bool
FastMutableIntMap.isEmpty FastMutableIntMap a
accum
            IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ FastMutableIntMap a -> Int -> a -> IO ()
forall a. FastMutableIntMap a -> Int -> a -> IO ()
FastMutableIntMap.insert FastMutableIntMap a
accum Int
k a
a
            Bool -> EventM x () -> EventM x ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
wasEmpty EventM x ()
scheduleSelf
        , subscriberInvalidateHeight :: Height -> IO ()
subscriberInvalidateHeight = \old :: Height
old -> do
            IORef HeightBag -> (HeightBag -> HeightBag) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef HeightBag
heightBagRef ((HeightBag -> HeightBag) -> IO ())
-> (HeightBag -> HeightBag) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> HeightBag -> HeightBag
heightBagRemove Height
old
            IO ()
invalidateMyHeight
        , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = \new :: Height
new -> do
            IORef HeightBag -> (HeightBag -> HeightBag) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef HeightBag
heightBagRef ((HeightBag -> HeightBag) -> IO ())
-> (HeightBag -> HeightBag) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> HeightBag -> HeightBag
heightBagAdd Height
new
            IO ()
recalculateMyHeight
        }
  [(Int, Event x a)]
-> ((Int, Event x a) -> EventM x ()) -> EventM x ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (IntMap (Event x a) -> [(Int, Event x a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap (Event x a)
initialParents) (((Int, Event x a) -> EventM x ()) -> EventM x ())
-> ((Int, Event x a) -> EventM x ()) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ \(k :: Int
k, p :: Event x a
p) -> do
    (subscription :: EventSubscription x
subscription@(EventSubscription _ parentSubd :: EventSubscribed x
parentSubd), parentOcc :: Maybe a
parentOcc) <- Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
forall k (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead Event x a
p (Subscriber x a -> EventM x (EventSubscription x, Maybe a))
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
forall a b. (a -> b) -> a -> b
$ Int -> Subscriber x a
mySubscriber Int
k
    IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe a -> (a -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe a
parentOcc ((a -> IO ()) -> IO ()) -> (a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ FastMutableIntMap a -> Int -> a -> IO ()
forall a. FastMutableIntMap a -> Int -> a -> IO ()
FastMutableIntMap.insert FastMutableIntMap a
accum Int
k
      FastMutableIntMap (EventSubscription x)
-> Int -> EventSubscription x -> IO ()
forall a. FastMutableIntMap a -> Int -> a -> IO ()
FastMutableIntMap.insert FastMutableIntMap (EventSubscription x)
parents Int
k EventSubscription x
subscription
      Height
height <- EventSubscribed x -> IO Height
forall k (x :: k). EventSubscribed x -> IO Height
getEventSubscribedHeight EventSubscribed x
parentSubd
      if Height
height Height -> Height -> Bool
forall a. Eq a => a -> a -> Bool
== Height
invalidHeight
        then IORef Height -> Height -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Height
heightRef Height
invalidHeight
        else do
          IORef HeightBag -> (HeightBag -> HeightBag) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef HeightBag
heightBagRef ((HeightBag -> HeightBag) -> IO ())
-> (HeightBag -> HeightBag) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> HeightBag -> HeightBag
heightBagAdd Height
height
          IORef Height -> (Height -> Height) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Height
heightRef ((Height -> Height) -> IO ()) -> (Height -> Height) -> IO ()
forall a b. (a -> b) -> a -> b
$ \oldHeight :: Height
oldHeight ->
            if Height
oldHeight Height -> Height -> Bool
forall a. Eq a => a -> a -> Bool
== Height
invalidHeight
            then Height
invalidHeight
            else Height -> Height -> Height
forall a. Ord a => a -> a -> a
max (Height -> Height
succHeight Height
height) Height
oldHeight
  Height
myHeight <- IO Height -> EventM x Height
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Height -> EventM x Height) -> IO Height -> EventM x Height
forall a b. (a -> b) -> a -> b
$ IORef Height -> IO Height
forall a. IORef a -> IO a
readIORef IORef Height
heightRef
  Height
currentHeight <- EventM x Height
forall x (m :: * -> *). HasCurrentHeight x m => m Height
getCurrentHeight
  Bool
isEmpty <- IO Bool -> EventM x Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> EventM x Bool) -> IO Bool -> EventM x Bool
forall a b. (a -> b) -> a -> b
$ FastMutableIntMap a -> IO Bool
forall a. FastMutableIntMap a -> IO Bool
FastMutableIntMap.isEmpty FastMutableIntMap a
accum
  Maybe (IntMap a)
occ <- if Height
currentHeight Height -> Height -> Bool
forall a. Ord a => a -> a -> Bool
>= Height
myHeight -- If we should have fired by now
    then if Bool
isEmpty
         then Maybe (IntMap a) -> EventM x (Maybe (IntMap a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IntMap a)
forall a. Maybe a
Nothing
         else IO (Maybe (IntMap a)) -> EventM x (Maybe (IntMap a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (IntMap a)) -> EventM x (Maybe (IntMap a)))
-> IO (Maybe (IntMap a)) -> EventM x (Maybe (IntMap a))
forall a b. (a -> b) -> a -> b
$ IntMap a -> Maybe (IntMap a)
forall a. a -> Maybe a
Just (IntMap a -> Maybe (IntMap a))
-> IO (IntMap a) -> IO (Maybe (IntMap a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastMutableIntMap a -> IO (IntMap a)
forall a. FastMutableIntMap a -> IO (IntMap a)
FastMutableIntMap.getFrozenAndClear FastMutableIntMap a
accum
    else do Bool -> EventM x () -> EventM x ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isEmpty) EventM x ()
scheduleSelf -- We have things accumulated, but we shouldn't have fired them yet
            Maybe (IntMap a) -> EventM x (Maybe (IntMap a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IntMap a)
forall a. Maybe a
Nothing
  SomeMergeInit x -> EventM x ()
forall a (m :: * -> *). Defer a m => a -> m ()
defer (SomeMergeInit x -> EventM x ()) -> SomeMergeInit x -> EventM x ()
forall a b. (a -> b) -> a -> b
$ EventM x () -> SomeMergeInit x
forall k (x :: k). EventM x () -> SomeMergeInit x
SomeMergeInit (EventM x () -> SomeMergeInit x) -> EventM x () -> SomeMergeInit x
forall a b. (a -> b) -> a -> b
$ do
    let updateMe :: PatchIntMap (Event x a) -> SomeMergeUpdate x
updateMe a :: PatchIntMap (Event x a)
a = EventM x [EventSubscription x]
-> IO () -> IO () -> SomeMergeUpdate x
forall k (x :: k).
EventM x [EventSubscription x]
-> IO () -> IO () -> SomeMergeUpdate x
SomeMergeUpdate EventM x [EventSubscription x]
u IO ()
invalidateMyHeight IO ()
recalculateMyHeight
          where
            u :: EventM x [EventSubscription x]
u = do
              let f :: Int -> Event x a -> EventM x (EventSubscription x)
f k :: Int
k newParent :: Event x a
newParent = do
                    subscription :: EventSubscription x
subscription@(EventSubscription _ subd :: EventSubscribed x
subd) <- Event x a -> Subscriber x a -> EventM x (EventSubscription x)
forall k (x :: k) a.
Event x a -> Subscriber x a -> EventM x (EventSubscription x)
subscribe Event x a
newParent (Subscriber x a -> EventM x (EventSubscription x))
-> Subscriber x a -> EventM x (EventSubscription x)
forall a b. (a -> b) -> a -> b
$ Int -> Subscriber x a
mySubscriber Int
k
                    Height
newParentHeight <- IO Height -> EventM x Height
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Height -> EventM x Height) -> IO Height -> EventM x Height
forall a b. (a -> b) -> a -> b
$ EventSubscribed x -> IO Height
forall k (x :: k). EventSubscribed x -> IO Height
getEventSubscribedHeight EventSubscribed x
subd
                    IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef HeightBag -> (HeightBag -> HeightBag) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef HeightBag
heightBagRef ((HeightBag -> HeightBag) -> IO ())
-> (HeightBag -> HeightBag) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> HeightBag -> HeightBag
heightBagAdd Height
newParentHeight
                    EventSubscription x -> EventM x (EventSubscription x)
forall (m :: * -> *) a. Monad m => a -> m a
return EventSubscription x
subscription
              PatchIntMap (EventSubscription x)
newSubscriptions <- (Int -> Event x a -> EventM x (EventSubscription x))
-> PatchIntMap (Event x a)
-> EventM x (PatchIntMap (EventSubscription x))
forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> PatchIntMap a -> f (PatchIntMap b)
FastMutableIntMap.traverseIntMapPatchWithKey Int -> Event x a -> EventM x (EventSubscription x)
f PatchIntMap (Event x a)
a
              IntMap (EventSubscription x)
oldParents <- IO (IntMap (EventSubscription x))
-> EventM x (IntMap (EventSubscription x))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IntMap (EventSubscription x))
 -> EventM x (IntMap (EventSubscription x)))
-> IO (IntMap (EventSubscription x))
-> EventM x (IntMap (EventSubscription x))
forall a b. (a -> b) -> a -> b
$ FastMutableIntMap (EventSubscription x)
-> PatchIntMap (EventSubscription x)
-> IO (IntMap (EventSubscription x))
forall a. FastMutableIntMap a -> PatchIntMap a -> IO (IntMap a)
FastMutableIntMap.applyPatch FastMutableIntMap (EventSubscription x)
parents PatchIntMap (EventSubscription x)
newSubscriptions
              IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IntMap (EventSubscription x)
-> (EventSubscription x -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ IntMap (EventSubscription x)
oldParents ((EventSubscription x -> IO ()) -> IO ())
-> (EventSubscription x -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \oldParent :: EventSubscription x
oldParent -> do
                Height
oldParentHeight <- EventSubscribed x -> IO Height
forall k (x :: k). EventSubscribed x -> IO Height
getEventSubscribedHeight (EventSubscribed x -> IO Height) -> EventSubscribed x -> IO Height
forall a b. (a -> b) -> a -> b
$ EventSubscription x -> EventSubscribed x
forall k (x :: k). EventSubscription x -> EventSubscribed x
_eventSubscription_subscribed EventSubscription x
oldParent

                (String, Height) -> IO ()
forall a. Show a => a -> IO ()
print ("updateMe", Height
oldParentHeight)
                IORef HeightBag -> (HeightBag -> HeightBag) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef HeightBag
heightBagRef ((HeightBag -> HeightBag) -> IO ())
-> (HeightBag -> HeightBag) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> HeightBag -> HeightBag
heightBagRemove Height
oldParentHeight
              [EventSubscription x] -> EventM x [EventSubscription x]
forall (m :: * -> *) a. Monad m => a -> m a
return ([EventSubscription x] -> EventM x [EventSubscription x])
-> [EventSubscription x] -> EventM x [EventSubscription x]
forall a b. (a -> b) -> a -> b
$ IntMap (EventSubscription x) -> [EventSubscription x]
forall a. IntMap a -> [a]
IntMap.elems IntMap (EventSubscription x)
oldParents
    let changeSubscriber :: Subscriber x (PatchIntMap (Event x a))
changeSubscriber = $WSubscriber :: forall k (x :: k) a.
(a -> EventM x ())
-> (Height -> IO ()) -> (Height -> IO ()) -> Subscriber x a
Subscriber
          { subscriberPropagate :: PatchIntMap (Event x a) -> EventM x ()
subscriberPropagate = \a :: PatchIntMap (Event x a)
a -> {-# SCC "traverseMergeChange" #-} do
              Proxy x -> String -> EventM x ()
forall x (m :: * -> *) (proxy :: * -> *).
CanTrace x m =>
proxy x -> String -> m ()
tracePropagate (Proxy x
forall k (t :: k). Proxy t
Proxy :: Proxy x) (String -> EventM x ()) -> String -> EventM x ()
forall a b. (a -> b) -> a -> b
$ "SubscriberMergeInt/Change"
              SomeMergeUpdate x -> EventM x ()
forall a (m :: * -> *). Defer a m => a -> m ()
defer (SomeMergeUpdate x -> EventM x ())
-> SomeMergeUpdate x -> EventM x ()
forall a b. (a -> b) -> a -> b
$ PatchIntMap (Event x a) -> SomeMergeUpdate x
updateMe PatchIntMap (Event x a)
a
          , subscriberInvalidateHeight :: Height -> IO ()
subscriberInvalidateHeight = \_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = \_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          }
    (changeSubscription :: EventSubscription x
changeSubscription, change :: Maybe (PatchIntMap (Event x a))
change) <- Event x (PatchIntMap (Event x a))
-> Subscriber x (PatchIntMap (Event x a))
-> EventM x (EventSubscription x, Maybe (PatchIntMap (Event x a)))
forall k (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndRead (Dynamic x (IntMap (Event x a)) (PatchIntMap (Event x a))
-> Event x (PatchIntMap (Event x a))
forall k (x :: k) target p. Dynamic x target p -> Event x p
dynamicUpdated Dynamic x (IntMap (Event x a)) (PatchIntMap (Event x a))
DynamicS x (PatchIntMap (Event x a))
d) Subscriber x (PatchIntMap (Event x a))
changeSubscriber
    Maybe (PatchIntMap (Event x a))
-> (PatchIntMap (Event x a) -> EventM x ()) -> EventM x ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (PatchIntMap (Event x a))
change ((PatchIntMap (Event x a) -> EventM x ()) -> EventM x ())
-> (PatchIntMap (Event x a) -> EventM x ()) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ \c :: PatchIntMap (Event x a)
c -> SomeMergeUpdate x -> EventM x ()
forall a (m :: * -> *). Defer a m => a -> m ()
defer (SomeMergeUpdate x -> EventM x ())
-> SomeMergeUpdate x -> EventM x ()
forall a b. (a -> b) -> a -> b
$ PatchIntMap (Event x a) -> SomeMergeUpdate x
updateMe PatchIntMap (Event x a)
c
    -- We explicitly hold on to the unsubscribe function from subscribing to the update event.
    -- If we don't do this, there are certain cases where mergeCheap will fail to properly retain
    -- its subscription.
    IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Subscriber x (PatchIntMap (Event x a)), EventSubscription x)
-> (Subscriber x (PatchIntMap (Event x a)), EventSubscription x)
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Subscriber x (PatchIntMap (Event x a)), EventSubscription x)
changeSubdRef (Subscriber x (PatchIntMap (Event x a))
changeSubscriber, EventSubscription x
changeSubscription)
  let unsubscribeAll :: IO ()
unsubscribeAll = (EventSubscription x -> IO ())
-> IntMap (EventSubscription x) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ EventSubscription x -> IO ()
forall k (x :: k). EventSubscription x -> IO ()
unsubscribe (IntMap (EventSubscription x) -> IO ())
-> IO (IntMap (EventSubscription x)) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FastMutableIntMap (EventSubscription x)
-> IO (IntMap (EventSubscription x))
forall a. FastMutableIntMap a -> IO (IntMap a)
FastMutableIntMap.getFrozenAndClear FastMutableIntMap (EventSubscription x)
parents


  (EventSubscription x, Maybe (IntMap a))
-> EventM x (EventSubscription x, Maybe (IntMap a))
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> EventSubscribed x -> EventSubscription x
forall k (x :: k).
IO () -> EventSubscribed x -> EventSubscription x
EventSubscription IO ()
unsubscribeAll EventSubscribed x
subscribed, Maybe (IntMap a)
occ)

newtype EventSelector x k = EventSelector { EventSelector x k -> forall a. k a -> Event x a
select :: forall a. k a -> Event x a }
newtype EventSelectorG x k v = EventSelectorG { EventSelectorG x k v -> forall (a :: k). k a -> Event x (v a)
selectG :: forall a. k a -> Event x (v a) }

fanG :: (HasSpiderTimeline x, GCompare k) => Event x (DMap k v) -> EventSelectorG x k v
fanG :: Event x (DMap k v) -> EventSelectorG x k v
fanG e :: Event x (DMap k v)
e = IO (EventSelectorG x k v) -> EventSelectorG x k v
forall a. IO a -> a
unsafePerformIO (IO (EventSelectorG x k v) -> EventSelectorG x k v)
-> IO (EventSelectorG x k v) -> EventSelectorG x k v
forall a b. (a -> b) -> a -> b
$ do
  IORef (Maybe (FanSubscribed x k v))
ref <- Maybe (FanSubscribed x k v)
-> IO (IORef (Maybe (FanSubscribed x k v)))
forall a. a -> IO (IORef a)
newIORef Maybe (FanSubscribed x k v)
forall a. Maybe a
Nothing
  let f :: Fan x k v
f = $WFan :: forall k k (x :: k) (k :: k -> *) (v :: k -> *).
Event x (DMap k v)
-> IORef (Maybe (FanSubscribed x k v)) -> Fan x k v
Fan
        { fanParent :: Event x (DMap k v)
fanParent = Event x (DMap k v)
e
        , fanSubscribed :: IORef (Maybe (FanSubscribed x k v))
fanSubscribed = IORef (Maybe (FanSubscribed x k v))
ref
        }
  EventSelectorG x k v -> IO (EventSelectorG x k v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EventSelectorG x k v -> IO (EventSelectorG x k v))
-> EventSelectorG x k v -> IO (EventSelectorG x k v)
forall a b. (a -> b) -> a -> b
$ (forall (a :: k). k a -> Event x (v a)) -> EventSelectorG x k v
forall k k (x :: k) (k :: k -> *) (v :: k -> *).
(forall (a :: k). k a -> Event x (v a)) -> EventSelectorG x k v
EventSelectorG ((forall (a :: k). k a -> Event x (v a)) -> EventSelectorG x k v)
-> (forall (a :: k). k a -> Event x (v a)) -> EventSelectorG x k v
forall a b. (a -> b) -> a -> b
$ \k :: k a
k -> k a -> Fan x k v -> Event x (v a)
forall k (k :: k -> *) x (a :: k) (v :: k -> *).
(GCompare k, HasSpiderTimeline x) =>
k a -> Fan x k v -> Event x (v a)
eventFan k a
k Fan x k v
f

runHoldInits :: HasSpiderTimeline x => IORef [SomeHoldInit x] -> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()
runHoldInits :: IORef [SomeHoldInit x]
-> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()
runHoldInits holdInitRef :: IORef [SomeHoldInit x]
holdInitRef dynInitRef :: IORef [SomeDynInit x]
dynInitRef mergeInitRef :: IORef [SomeMergeInit x]
mergeInitRef = do
  [SomeHoldInit x]
holdInits <- IO [SomeHoldInit x] -> EventM x [SomeHoldInit x]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SomeHoldInit x] -> EventM x [SomeHoldInit x])
-> IO [SomeHoldInit x] -> EventM x [SomeHoldInit x]
forall a b. (a -> b) -> a -> b
$ IORef [SomeHoldInit x] -> IO [SomeHoldInit x]
forall a. IORef a -> IO a
readIORef IORef [SomeHoldInit x]
holdInitRef
  [SomeDynInit x]
dynInits <- IO [SomeDynInit x] -> EventM x [SomeDynInit x]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SomeDynInit x] -> EventM x [SomeDynInit x])
-> IO [SomeDynInit x] -> EventM x [SomeDynInit x]
forall a b. (a -> b) -> a -> b
$ IORef [SomeDynInit x] -> IO [SomeDynInit x]
forall a. IORef a -> IO a
readIORef IORef [SomeDynInit x]
dynInitRef
  [SomeMergeInit x]
mergeInits <- IO [SomeMergeInit x] -> EventM x [SomeMergeInit x]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SomeMergeInit x] -> EventM x [SomeMergeInit x])
-> IO [SomeMergeInit x] -> EventM x [SomeMergeInit x]
forall a b. (a -> b) -> a -> b
$ IORef [SomeMergeInit x] -> IO [SomeMergeInit x]
forall a. IORef a -> IO a
readIORef IORef [SomeMergeInit x]
mergeInitRef
  Bool -> EventM x () -> EventM x ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SomeHoldInit x] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SomeHoldInit x]
holdInits Bool -> Bool -> Bool
&& [SomeDynInit x] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SomeDynInit x]
dynInits Bool -> Bool -> Bool
&& [SomeMergeInit x] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SomeMergeInit x]
mergeInits) (EventM x () -> EventM x ()) -> EventM x () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ do
    IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef [SomeHoldInit x] -> [SomeHoldInit x] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [SomeHoldInit x]
holdInitRef []
    IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef [SomeDynInit x] -> [SomeDynInit x] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [SomeDynInit x]
dynInitRef []
    IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef [SomeMergeInit x] -> [SomeMergeInit x] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [SomeMergeInit x]
mergeInitRef []
    (SomeHoldInit x -> EventM x ()) -> [SomeHoldInit x] -> EventM x ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SomeHoldInit x -> EventM x ()
forall x. HasSpiderTimeline x => SomeHoldInit x -> EventM x ()
initHold [SomeHoldInit x]
holdInits
    (SomeDynInit x -> EventM x ()) -> [SomeDynInit x] -> EventM x ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SomeDynInit x -> EventM x ()
forall x. HasSpiderTimeline x => SomeDynInit x -> EventM x ()
initDyn [SomeDynInit x]
dynInits
    (SomeMergeInit x -> EventM x ())
-> [SomeMergeInit x] -> EventM x ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SomeMergeInit x -> EventM x ()
forall k (x :: k). SomeMergeInit x -> EventM x ()
unSomeMergeInit [SomeMergeInit x]
mergeInits
    IORef [SomeHoldInit x]
-> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()
forall x.
HasSpiderTimeline x =>
IORef [SomeHoldInit x]
-> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()
runHoldInits IORef [SomeHoldInit x]
holdInitRef IORef [SomeDynInit x]
dynInitRef IORef [SomeMergeInit x]
mergeInitRef

initHold :: HasSpiderTimeline x => SomeHoldInit x -> EventM x ()
initHold :: SomeHoldInit x -> EventM x ()
initHold (SomeHoldInit h :: Hold x p
h) = EventM x (EventSubscription x) -> EventM x ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EventM x (EventSubscription x) -> EventM x ())
-> EventM x (EventSubscription x) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ Hold x p -> EventM x (EventSubscription x)
forall p x.
(HasSpiderTimeline x, Patch p) =>
Hold x p -> EventM x (EventSubscription x)
getHoldEventSubscription Hold x p
h

initDyn :: HasSpiderTimeline x => SomeDynInit x -> EventM x ()
initDyn :: SomeDynInit x -> EventM x ()
initDyn (SomeDynInit d :: Dyn x p
d) = EventM x (Hold x p) -> EventM x ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EventM x (Hold x p) -> EventM x ())
-> EventM x (Hold x p) -> EventM x ()
forall a b. (a -> b) -> a -> b
$ Dyn x p -> EventM x (Hold x p)
forall x (m :: * -> *) p.
(Defer (SomeHoldInit x) m, Patch p) =>
Dyn x p -> m (Hold x p)
getDynHold Dyn x p
d

newEventEnv :: IO (EventEnv x)
newEventEnv :: IO (EventEnv x)
newEventEnv = do
  IORef [SomeAssignment x]
toAssignRef <- [SomeAssignment x] -> IO (IORef [SomeAssignment x])
forall a. a -> IO (IORef a)
newIORef [] -- This should only actually get used when events are firing
  IORef [SomeHoldInit x]
holdInitRef <- [SomeHoldInit x] -> IO (IORef [SomeHoldInit x])
forall a. a -> IO (IORef a)
newIORef []
  IORef [SomeDynInit x]
dynInitRef <- [SomeDynInit x] -> IO (IORef [SomeDynInit x])
forall a. a -> IO (IORef a)
newIORef []
  IORef [SomeMergeUpdate x]
mergeUpdateRef <- [SomeMergeUpdate x] -> IO (IORef [SomeMergeUpdate x])
forall a. a -> IO (IORef a)
newIORef []
  IORef [SomeMergeInit x]
mergeInitRef <- [SomeMergeInit x] -> IO (IORef [SomeMergeInit x])
forall a. a -> IO (IORef a)
newIORef []
  IORef Height
heightRef <- Height -> IO (IORef Height)
forall a. a -> IO (IORef a)
newIORef Height
zeroHeight
  IORef [Some Clear]
toClearRef <- [Some Clear] -> IO (IORef [Some Clear])
forall a. a -> IO (IORef a)
newIORef []
  IORef [Some IntClear]
toClearIntRef <- [Some IntClear] -> IO (IORef [Some IntClear])
forall a. a -> IO (IORef a)
newIORef []
  IORef [Some RootClear]
toClearRootRef <- [Some RootClear] -> IO (IORef [Some RootClear])
forall a. a -> IO (IORef a)
newIORef []
  IORef [SomeResetCoincidence x]
coincidenceInfosRef <- [SomeResetCoincidence x] -> IO (IORef [SomeResetCoincidence x])
forall a. a -> IO (IORef a)
newIORef []
  IORef (IntMap [EventM x ()])
delayedRef <- IntMap [EventM x ()] -> IO (IORef (IntMap [EventM x ()]))
forall a. a -> IO (IORef a)
newIORef IntMap [EventM x ()]
forall a. IntMap a
IntMap.empty
  EventEnv x -> IO (EventEnv x)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventEnv x -> IO (EventEnv x)) -> EventEnv x -> IO (EventEnv x)
forall a b. (a -> b) -> a -> b
$ IORef [SomeAssignment x]
-> IORef [SomeHoldInit x]
-> IORef [SomeDynInit x]
-> IORef [SomeMergeUpdate x]
-> IORef [SomeMergeInit x]
-> IORef [Some Clear]
-> IORef [Some IntClear]
-> IORef [Some RootClear]
-> IORef Height
-> IORef [SomeResetCoincidence x]
-> IORef (IntMap [EventM x ()])
-> EventEnv x
forall x.
IORef [SomeAssignment x]
-> IORef [SomeHoldInit x]
-> IORef [SomeDynInit x]
-> IORef [SomeMergeUpdate x]
-> IORef [SomeMergeInit x]
-> IORef [Some Clear]
-> IORef [Some IntClear]
-> IORef [Some RootClear]
-> IORef Height
-> IORef [SomeResetCoincidence x]
-> IORef (IntMap [EventM x ()])
-> EventEnv x
EventEnv IORef [SomeAssignment x]
toAssignRef IORef [SomeHoldInit x]
holdInitRef IORef [SomeDynInit x]
dynInitRef IORef [SomeMergeUpdate x]
mergeUpdateRef IORef [SomeMergeInit x]
mergeInitRef IORef [Some Clear]
toClearRef IORef [Some IntClear]
toClearIntRef IORef [Some RootClear]
toClearRootRef IORef Height
heightRef IORef [SomeResetCoincidence x]
coincidenceInfosRef IORef (IntMap [EventM x ()])
delayedRef

clearEventEnv :: EventEnv x -> IO ()
clearEventEnv :: EventEnv x -> IO ()
clearEventEnv (EventEnv toAssignRef :: IORef [SomeAssignment x]
toAssignRef holdInitRef :: IORef [SomeHoldInit x]
holdInitRef dynInitRef :: IORef [SomeDynInit x]
dynInitRef mergeUpdateRef :: IORef [SomeMergeUpdate x]
mergeUpdateRef mergeInitRef :: IORef [SomeMergeInit x]
mergeInitRef toClearRef :: IORef [Some Clear]
toClearRef toClearIntRef :: IORef [Some IntClear]
toClearIntRef toClearRootRef :: IORef [Some RootClear]
toClearRootRef heightRef :: IORef Height
heightRef coincidenceInfosRef :: IORef [SomeResetCoincidence x]
coincidenceInfosRef delayedRef :: IORef (IntMap [EventM x ()])
delayedRef) = do
  IORef [SomeAssignment x] -> [SomeAssignment x] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [SomeAssignment x]
toAssignRef []
  IORef [SomeHoldInit x] -> [SomeHoldInit x] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [SomeHoldInit x]
holdInitRef []
  IORef [SomeDynInit x] -> [SomeDynInit x] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [SomeDynInit x]
dynInitRef []
  IORef [SomeMergeUpdate x] -> [SomeMergeUpdate x] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [SomeMergeUpdate x]
mergeUpdateRef []
  IORef [SomeMergeInit x] -> [SomeMergeInit x] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [SomeMergeInit x]
mergeInitRef []
  IORef Height -> Height -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Height
heightRef Height
zeroHeight
  IORef [Some Clear] -> [Some Clear] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [Some Clear]
toClearRef []
  IORef [Some IntClear] -> [Some IntClear] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [Some IntClear]
toClearIntRef []
  IORef [Some RootClear] -> [Some RootClear] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [Some RootClear]
toClearRootRef []
  IORef [SomeResetCoincidence x] -> [SomeResetCoincidence x] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [SomeResetCoincidence x]
coincidenceInfosRef []
  IORef (IntMap [EventM x ()]) -> IntMap [EventM x ()] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (IntMap [EventM x ()])
delayedRef IntMap [EventM x ()]
forall a. IntMap a
IntMap.empty

-- | Run an event action outside of a frame
runFrame :: forall x a. HasSpiderTimeline x => EventM x a -> SpiderHost x a --TODO: This function also needs to hold the mutex
runFrame :: EventM x a -> SpiderHost x a
runFrame a :: EventM x a
a = IO a -> SpiderHost x a
forall x a. IO a -> SpiderHost x a
SpiderHost (IO a -> SpiderHost x a) -> IO a -> SpiderHost x a
forall a b. (a -> b) -> a -> b
$ do
  let env :: EventEnv x
env = SpiderTimelineEnv' x -> EventEnv x
forall x. SpiderTimelineEnv' x -> EventEnv x
_spiderTimeline_eventEnv (SpiderTimelineEnv' x -> EventEnv x)
-> SpiderTimelineEnv' x -> EventEnv x
forall a b. (a -> b) -> a -> b
$ SpiderTimelineEnv x -> SpiderTimelineEnv' x
forall x. SpiderTimelineEnv x -> SpiderTimelineEnv' x
unSTE (SpiderTimelineEnv x
forall x. HasSpiderTimeline x => SpiderTimelineEnv x
spiderTimeline :: SpiderTimelineEnv x)
  let go :: EventM x a
go = do
        a
result <- EventM x a
a
        IORef [SomeHoldInit x]
-> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()
forall x.
HasSpiderTimeline x =>
IORef [SomeHoldInit x]
-> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()
runHoldInits (EventEnv x -> IORef [SomeHoldInit x]
forall x. EventEnv x -> IORef [SomeHoldInit x]
eventEnvHoldInits EventEnv x
env) (EventEnv x -> IORef [SomeDynInit x]
forall x. EventEnv x -> IORef [SomeDynInit x]
eventEnvDynInits EventEnv x
env) (EventEnv x -> IORef [SomeMergeInit x]
forall x. EventEnv x -> IORef [SomeMergeInit x]
eventEnvMergeInits EventEnv x
env) -- This must happen before doing the assignments, in case subscribing a Hold causes existing Holds to be read by the newly-propagated events
        a -> EventM x a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
  a
result <- EventM x a -> IO a
forall k (x :: k) a. EventM x a -> IO a
runEventM EventM x a
go
  [Some Clear]
toClear <- IORef [Some Clear] -> IO [Some Clear]
forall a. IORef a -> IO a
readIORef (IORef [Some Clear] -> IO [Some Clear])
-> IORef [Some Clear] -> IO [Some Clear]
forall a b. (a -> b) -> a -> b
$ EventEnv x -> IORef [Some Clear]
forall x. EventEnv x -> IORef [Some Clear]
eventEnvClears EventEnv x
env
  [Some Clear] -> (Some Clear -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Some Clear]
toClear ((Some Clear -> IO ()) -> IO ()) -> (Some Clear -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Some (Clear ref :: IORef (Maybe a)
ref)) -> {-# SCC "clear" #-} IORef (Maybe a) -> Maybe a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe a)
ref Maybe a
forall a. Maybe a
Nothing
  [Some IntClear]
toClearInt <- IORef [Some IntClear] -> IO [Some IntClear]
forall a. IORef a -> IO a
readIORef (IORef [Some IntClear] -> IO [Some IntClear])
-> IORef [Some IntClear] -> IO [Some IntClear]
forall a b. (a -> b) -> a -> b
$ EventEnv x -> IORef [Some IntClear]
forall x. EventEnv x -> IORef [Some IntClear]
eventEnvIntClears EventEnv x
env
  [Some IntClear] -> (Some IntClear -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Some IntClear]
toClearInt ((Some IntClear -> IO ()) -> IO ())
-> (Some IntClear -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Some (IntClear ref :: IORef (IntMap a)
ref)) -> {-# SCC "intClear" #-} IORef (IntMap a) -> IntMap a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (IntMap a)
ref (IntMap a -> IO ()) -> IntMap a -> IO ()
forall a b. (a -> b) -> a -> b
$! IntMap a
forall a. IntMap a
IntMap.empty
  [Some RootClear]
toClearRoot <- IORef [Some RootClear] -> IO [Some RootClear]
forall a. IORef a -> IO a
readIORef (IORef [Some RootClear] -> IO [Some RootClear])
-> IORef [Some RootClear] -> IO [Some RootClear]
forall a b. (a -> b) -> a -> b
$ EventEnv x -> IORef [Some RootClear]
forall x. EventEnv x -> IORef [Some RootClear]
eventEnvRootClears EventEnv x
env
  [Some RootClear] -> (Some RootClear -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Some RootClear]
toClearRoot ((Some RootClear -> IO ()) -> IO ())
-> (Some RootClear -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Some (RootClear ref :: IORef (DMap a Identity)
ref)) -> {-# SCC "rootClear" #-} IORef (DMap a Identity) -> DMap a Identity -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (DMap a Identity)
ref (DMap a Identity -> IO ()) -> DMap a Identity -> IO ()
forall a b. (a -> b) -> a -> b
$! DMap a Identity
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f
DMap.empty
  [SomeAssignment x]
toAssign <- IORef [SomeAssignment x] -> IO [SomeAssignment x]
forall a. IORef a -> IO a
readIORef (IORef [SomeAssignment x] -> IO [SomeAssignment x])
-> IORef [SomeAssignment x] -> IO [SomeAssignment x]
forall a b. (a -> b) -> a -> b
$ EventEnv x -> IORef [SomeAssignment x]
forall x. EventEnv x -> IORef [SomeAssignment x]
eventEnvAssignments EventEnv x
env
  IORef [SomeSwitchSubscribed x]
toReconnectRef <- [SomeSwitchSubscribed x] -> IO (IORef [SomeSwitchSubscribed x])
forall a. a -> IO (IORef a)
newIORef []
  [SomeResetCoincidence x]
coincidenceInfos <- IORef [SomeResetCoincidence x] -> IO [SomeResetCoincidence x]
forall a. IORef a -> IO a
readIORef (IORef [SomeResetCoincidence x] -> IO [SomeResetCoincidence x])
-> IORef [SomeResetCoincidence x] -> IO [SomeResetCoincidence x]
forall a b. (a -> b) -> a -> b
$ EventEnv x -> IORef [SomeResetCoincidence x]
forall x. EventEnv x -> IORef [SomeResetCoincidence x]
eventEnvResetCoincidences EventEnv x
env
  [SomeAssignment x] -> (SomeAssignment x -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SomeAssignment x]
toAssign ((SomeAssignment x -> IO ()) -> IO ())
-> (SomeAssignment x -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(SomeAssignment vRef :: IORef a
vRef iRef :: IORef [Weak (Invalidator x)]
iRef v :: a
v) -> {-# SCC "assignment" #-} do
    IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
vRef a
v
    String -> IO ()
traceInvalidate (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Invalidating Hold"
    IORef [Weak (Invalidator x)] -> [Weak (Invalidator x)] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [Weak (Invalidator x)]
iRef ([Weak (Invalidator x)] -> IO ())
-> IO [Weak (Invalidator x)] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Weak (Invalidator x)] -> IO [Weak (Invalidator x)]
forall a. a -> IO a
evaluate ([Weak (Invalidator x)] -> IO [Weak (Invalidator x)])
-> IO [Weak (Invalidator x)] -> IO [Weak (Invalidator x)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef [SomeSwitchSubscribed x]
-> [Weak (Invalidator x)] -> IO [Weak (Invalidator x)]
forall k (x :: k).
IORef [SomeSwitchSubscribed x]
-> WeakList (Invalidator x) -> IO (WeakList (Invalidator x))
invalidate IORef [SomeSwitchSubscribed x]
toReconnectRef ([Weak (Invalidator x)] -> IO [Weak (Invalidator x)])
-> IO [Weak (Invalidator x)] -> IO [Weak (Invalidator x)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef [Weak (Invalidator x)] -> IO [Weak (Invalidator x)]
forall a. IORef a -> IO a
readIORef IORef [Weak (Invalidator x)]
iRef
  [SomeMergeUpdate x]
mergeUpdates <- IORef [SomeMergeUpdate x] -> IO [SomeMergeUpdate x]
forall a. IORef a -> IO a
readIORef (IORef [SomeMergeUpdate x] -> IO [SomeMergeUpdate x])
-> IORef [SomeMergeUpdate x] -> IO [SomeMergeUpdate x]
forall a b. (a -> b) -> a -> b
$ EventEnv x -> IORef [SomeMergeUpdate x]
forall x. EventEnv x -> IORef [SomeMergeUpdate x]
eventEnvMergeUpdates EventEnv x
env
  IORef [SomeMergeUpdate x] -> [SomeMergeUpdate x] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (EventEnv x -> IORef [SomeMergeUpdate x]
forall x. EventEnv x -> IORef [SomeMergeUpdate x]
eventEnvMergeUpdates EventEnv x
env) []
  Proxy x -> String -> IO ()
forall x (m :: * -> *) (proxy :: * -> *).
CanTrace x m =>
proxy x -> String -> m ()
tracePropagate (Proxy x
forall k (t :: k). Proxy t
Proxy::Proxy x) (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Updating merges"
  [EventSubscription x]
mergeSubscriptionsToKill <- EventM x [EventSubscription x] -> IO [EventSubscription x]
forall k (x :: k) a. EventM x a -> IO a
runEventM (EventM x [EventSubscription x] -> IO [EventSubscription x])
-> EventM x [EventSubscription x] -> IO [EventSubscription x]
forall a b. (a -> b) -> a -> b
$ [[EventSubscription x]] -> [EventSubscription x]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[EventSubscription x]] -> [EventSubscription x])
-> EventM x [[EventSubscription x]]
-> EventM x [EventSubscription x]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SomeMergeUpdate x -> EventM x [EventSubscription x])
-> [SomeMergeUpdate x] -> EventM x [[EventSubscription x]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SomeMergeUpdate x -> EventM x [EventSubscription x]
forall k (x :: k).
SomeMergeUpdate x -> EventM x [EventSubscription x]
_someMergeUpdate_update [SomeMergeUpdate x]
mergeUpdates
  Proxy x -> String -> IO ()
forall x (m :: * -> *) (proxy :: * -> *).
CanTrace x m =>
proxy x -> String -> m ()
tracePropagate (Proxy x
forall k (t :: k). Proxy t
Proxy::Proxy x) (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Updating merges done"
  [SomeSwitchSubscribed x]
toReconnect <- IORef [SomeSwitchSubscribed x] -> IO [SomeSwitchSubscribed x]
forall a. IORef a -> IO a
readIORef IORef [SomeSwitchSubscribed x]
toReconnectRef
  EventEnv x -> IO ()
forall x. EventEnv x -> IO ()
clearEventEnv EventEnv x
env
  [EventSubscription x]
switchSubscriptionsToKill <- [SomeSwitchSubscribed x]
-> (SomeSwitchSubscribed x -> IO (EventSubscription x))
-> IO [EventSubscription x]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SomeSwitchSubscribed x]
toReconnect ((SomeSwitchSubscribed x -> IO (EventSubscription x))
 -> IO [EventSubscription x])
-> (SomeSwitchSubscribed x -> IO (EventSubscription x))
-> IO [EventSubscription x]
forall a b. (a -> b) -> a -> b
$ \(SomeSwitchSubscribed subscribed :: SwitchSubscribed x a
subscribed) -> {-# SCC "switchSubscribed" #-} do
    EventSubscription x
oldSubscription <- IORef (EventSubscription x) -> IO (EventSubscription x)
forall a. IORef a -> IO a
readIORef (IORef (EventSubscription x) -> IO (EventSubscription x))
-> IORef (EventSubscription x) -> IO (EventSubscription x)
forall a b. (a -> b) -> a -> b
$ SwitchSubscribed x a -> IORef (EventSubscription x)
forall k (x :: k) a.
SwitchSubscribed x a -> IORef (EventSubscription x)
switchSubscribedCurrentParent SwitchSubscribed x a
subscribed
    Weak (Invalidator x)
wi <- IORef (Weak (Invalidator x)) -> IO (Weak (Invalidator x))
forall a. IORef a -> IO a
readIORef (IORef (Weak (Invalidator x)) -> IO (Weak (Invalidator x)))
-> IORef (Weak (Invalidator x)) -> IO (Weak (Invalidator x))
forall a b. (a -> b) -> a -> b
$ SwitchSubscribed x a -> IORef (Weak (Invalidator x))
forall k (x :: k) a.
SwitchSubscribed x a -> IORef (Weak (Invalidator x))
switchSubscribedOwnWeakInvalidator SwitchSubscribed x a
subscribed
    String -> IO ()
traceInvalidate (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Finalizing invalidator for Switch" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SwitchSubscribed x a -> String
forall a. a -> String
showNodeId SwitchSubscribed x a
subscribed
    Weak (Invalidator x) -> IO ()
forall v. Weak v -> IO ()
finalize Weak (Invalidator x)
wi
    Invalidator x
i <- Invalidator x -> IO (Invalidator x)
forall a. a -> IO a
evaluate (Invalidator x -> IO (Invalidator x))
-> Invalidator x -> IO (Invalidator x)
forall a b. (a -> b) -> a -> b
$ SwitchSubscribed x a -> Invalidator x
forall k (x :: k) a. SwitchSubscribed x a -> Invalidator x
switchSubscribedOwnInvalidator SwitchSubscribed x a
subscribed
    Weak (Invalidator x)
wi' <- Invalidator x -> String -> IO (Weak (Invalidator x))
forall a. a -> String -> IO (Weak a)
mkWeakPtrWithDebug Invalidator x
i "wi'"
    IORef (Weak (Invalidator x)) -> Weak (Invalidator x) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (SwitchSubscribed x a -> IORef (Weak (Invalidator x))
forall k (x :: k) a.
SwitchSubscribed x a -> IORef (Weak (Invalidator x))
switchSubscribedOwnWeakInvalidator SwitchSubscribed x a
subscribed) (Weak (Invalidator x) -> IO ()) -> Weak (Invalidator x) -> IO ()
forall a b. (a -> b) -> a -> b
$! Weak (Invalidator x)
wi'
    IORef [SomeBehaviorSubscribed x]
-> [SomeBehaviorSubscribed x] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (SwitchSubscribed x a -> IORef [SomeBehaviorSubscribed x]
forall k (x :: k) a.
SwitchSubscribed x a -> IORef [SomeBehaviorSubscribed x]
switchSubscribedBehaviorParents SwitchSubscribed x a
subscribed) []
    IORef [SomeHoldInit x] -> [SomeHoldInit x] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (EventEnv x -> IORef [SomeHoldInit x]
forall x. EventEnv x -> IORef [SomeHoldInit x]
eventEnvHoldInits EventEnv x
env) [] --TODO: Should we reuse this?
    Event x a
e <- BehaviorM x (Event x a)
-> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
-> IORef [SomeHoldInit x]
-> IO (Event x a)
forall k (x :: k) a.
BehaviorM x a
-> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
-> IORef [SomeHoldInit x]
-> IO a
runBehaviorM (Behavior x (Event x a) -> BehaviorM x (Event x a)
forall k (x :: k) a. Behavior x a -> BehaviorM x a
readBehaviorTracked (SwitchSubscribed x a -> Behavior x (Event x a)
forall k (x :: k) a. SwitchSubscribed x a -> Behavior x (Event x a)
switchSubscribedParent SwitchSubscribed x a
subscribed)) ((Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
-> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
forall a. a -> Maybe a
Just (Weak (Invalidator x)
wi', SwitchSubscribed x a -> IORef [SomeBehaviorSubscribed x]
forall k (x :: k) a.
SwitchSubscribed x a -> IORef [SomeBehaviorSubscribed x]
switchSubscribedBehaviorParents SwitchSubscribed x a
subscribed)) (IORef [SomeHoldInit x] -> IO (Event x a))
-> IORef [SomeHoldInit x] -> IO (Event x a)
forall a b. (a -> b) -> a -> b
$ EventEnv x -> IORef [SomeHoldInit x]
forall x. EventEnv x -> IORef [SomeHoldInit x]
eventEnvHoldInits EventEnv x
env
    EventM x () -> IO ()
forall k (x :: k) a. EventM x a -> IO a
runEventM (EventM x () -> IO ()) -> EventM x () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef [SomeHoldInit x]
-> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()
forall x.
HasSpiderTimeline x =>
IORef [SomeHoldInit x]
-> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()
runHoldInits (EventEnv x -> IORef [SomeHoldInit x]
forall x. EventEnv x -> IORef [SomeHoldInit x]
eventEnvHoldInits EventEnv x
env) (EventEnv x -> IORef [SomeDynInit x]
forall x. EventEnv x -> IORef [SomeDynInit x]
eventEnvDynInits EventEnv x
env) (EventEnv x -> IORef [SomeMergeInit x]
forall x. EventEnv x -> IORef [SomeMergeInit x]
eventEnvMergeInits EventEnv x
env) --TODO: Is this actually OK? It seems like it should be, since we know that no events are firing at this point, but it still seems inelegant
    --TODO: Make sure we touch the pieces of the SwitchSubscribed at the appropriate times
    Subscriber x a
sub <- SwitchSubscribed x a -> IO (Subscriber x a)
forall x a.
HasSpiderTimeline x =>
SwitchSubscribed x a -> IO (Subscriber x a)
newSubscriberSwitch SwitchSubscribed x a
subscribed
    EventSubscription x
subscription <- SpiderHost x (EventSubscription x) -> IO (EventSubscription x)
forall x a. SpiderHost x a -> IO a
unSpiderHost (SpiderHost x (EventSubscription x) -> IO (EventSubscription x))
-> SpiderHost x (EventSubscription x) -> IO (EventSubscription x)
forall a b. (a -> b) -> a -> b
$ EventM x (EventSubscription x)
-> SpiderHost x (EventSubscription x)
forall x a. HasSpiderTimeline x => EventM x a -> SpiderHost x a
runFrame (EventM x (EventSubscription x)
 -> SpiderHost x (EventSubscription x))
-> EventM x (EventSubscription x)
-> SpiderHost x (EventSubscription x)
forall a b. (a -> b) -> a -> b
$ {-# SCC "subscribeSwitch" #-} Event x a -> Subscriber x a -> EventM x (EventSubscription x)
forall k (x :: k) a.
Event x a -> Subscriber x a -> EventM x (EventSubscription x)
subscribe Event x a
e Subscriber x a
sub --TODO: Assert that the event isn't firing --TODO: This should not loop because none of the events should be firing, but still, it is inefficient
    {-
    stackTrace <- liftIO $ fmap renderStack $ ccsToStrings =<< (getCCSOf $! switchSubscribedParent subscribed)
    liftIO $ debugStrLn $ (++stackTrace) $ "subd' subscribed to " ++ case e of
      EventRoot _ -> "EventRoot"
      EventNever -> "EventNever"
      _ -> "something else"
    -}
    IORef (EventSubscription x) -> EventSubscription x -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (SwitchSubscribed x a -> IORef (EventSubscription x)
forall k (x :: k) a.
SwitchSubscribed x a -> IORef (EventSubscription x)
switchSubscribedCurrentParent SwitchSubscribed x a
subscribed) (EventSubscription x -> IO ()) -> EventSubscription x -> IO ()
forall a b. (a -> b) -> a -> b
$! EventSubscription x
subscription
    EventSubscription x -> IO (EventSubscription x)
forall (m :: * -> *) a. Monad m => a -> m a
return EventSubscription x
oldSubscription
  IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (EventSubscription x -> IO ()) -> [EventSubscription x] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ EventSubscription x -> IO ()
forall k (x :: k). EventSubscription x -> IO ()
unsubscribe [EventSubscription x]
mergeSubscriptionsToKill
  IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (EventSubscription x -> IO ()) -> [EventSubscription x] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ EventSubscription x -> IO ()
forall k (x :: k). EventSubscription x -> IO ()
unsubscribe [EventSubscription x]
switchSubscriptionsToKill
  [SomeSwitchSubscribed x]
-> (SomeSwitchSubscribed x -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SomeSwitchSubscribed x]
toReconnect ((SomeSwitchSubscribed x -> IO ()) -> IO ())
-> (SomeSwitchSubscribed x -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(SomeSwitchSubscribed subscribed :: SwitchSubscribed x a
subscribed) -> {-# SCC "switchSubscribed" #-} do
    EventSubscription _ subd' :: EventSubscribed x
subd' <- IORef (EventSubscription x) -> IO (EventSubscription x)
forall a. IORef a -> IO a
readIORef (IORef (EventSubscription x) -> IO (EventSubscription x))
-> IORef (EventSubscription x) -> IO (EventSubscription x)
forall a b. (a -> b) -> a -> b
$ SwitchSubscribed x a -> IORef (EventSubscription x)
forall k (x :: k) a.
SwitchSubscribed x a -> IORef (EventSubscription x)
switchSubscribedCurrentParent SwitchSubscribed x a
subscribed
    Height
parentHeight <- EventSubscribed x -> IO Height
forall k (x :: k). EventSubscribed x -> IO Height
getEventSubscribedHeight EventSubscribed x
subd'
    Height
myHeight <- IORef Height -> IO Height
forall a. IORef a -> IO a
readIORef (IORef Height -> IO Height) -> IORef Height -> IO Height
forall a b. (a -> b) -> a -> b
$ SwitchSubscribed x a -> IORef Height
forall k (x :: k) a. SwitchSubscribed x a -> IORef Height
switchSubscribedHeight SwitchSubscribed x a
subscribed
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Height
parentHeight Height -> Height -> Bool
forall a. Eq a => a -> a -> Bool
/= Height
myHeight) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      IORef Height -> Height -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (SwitchSubscribed x a -> IORef Height
forall k (x :: k) a. SwitchSubscribed x a -> IORef Height
switchSubscribedHeight SwitchSubscribed x a
subscribed) (Height -> IO ()) -> Height -> IO ()
forall a b. (a -> b) -> a -> b
$! Height
invalidHeight
      WeakBag (Subscriber x a) -> (Subscriber x a -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
WeakBag a -> (a -> m ()) -> m ()
WeakBag.traverse_ (SwitchSubscribed x a -> WeakBag (Subscriber x a)
forall k (x :: k) a.
SwitchSubscribed x a -> WeakBag (Subscriber x a)
switchSubscribedSubscribers SwitchSubscribed x a
subscribed) ((Subscriber x a -> IO ()) -> IO ())
-> (Subscriber x a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> Subscriber x a -> IO ()
forall k (x :: k) a. Height -> Subscriber x a -> IO ()
invalidateSubscriberHeight Height
myHeight
  (SomeMergeUpdate x -> IO ()) -> [SomeMergeUpdate x] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SomeMergeUpdate x -> IO ()
forall k (x :: k). SomeMergeUpdate x -> IO ()
_someMergeUpdate_invalidateHeight [SomeMergeUpdate x]
mergeUpdates --TODO: In addition to when the patch is completely empty, we should also not run this if it has some Nothing values, but none of them have actually had any effect; potentially, we could even check for Just values with no effect (e.g. by comparing their IORefs and ignoring them if they are unchanged); actually, we could just check if the new height is different
  [SomeResetCoincidence x]
-> (SomeResetCoincidence x -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SomeResetCoincidence x]
coincidenceInfos ((SomeResetCoincidence x -> IO ()) -> IO ())
-> (SomeResetCoincidence x -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(SomeResetCoincidence subscription :: EventSubscription x
subscription mcs :: Maybe (CoincidenceSubscribed x a)
mcs) -> do
    EventSubscription x -> IO ()
forall k (x :: k). EventSubscription x -> IO ()
unsubscribe EventSubscription x
subscription
    (CoincidenceSubscribed x a -> IO ())
-> Maybe (CoincidenceSubscribed x a) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CoincidenceSubscribed x a -> IO ()
forall k (x :: k) a. CoincidenceSubscribed x a -> IO ()
invalidateCoincidenceHeight Maybe (CoincidenceSubscribed x a)
mcs
  [SomeResetCoincidence x]
-> (SomeResetCoincidence x -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SomeResetCoincidence x]
coincidenceInfos ((SomeResetCoincidence x -> IO ()) -> IO ())
-> (SomeResetCoincidence x -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(SomeResetCoincidence _ mcs :: Maybe (CoincidenceSubscribed x a)
mcs) -> (CoincidenceSubscribed x a -> IO ())
-> Maybe (CoincidenceSubscribed x a) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CoincidenceSubscribed x a -> IO ()
forall k (x :: k) a. CoincidenceSubscribed x a -> IO ()
recalculateCoincidenceHeight Maybe (CoincidenceSubscribed x a)
mcs
  (SomeMergeUpdate x -> IO ()) -> [SomeMergeUpdate x] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SomeMergeUpdate x -> IO ()
forall k (x :: k). SomeMergeUpdate x -> IO ()
_someMergeUpdate_recalculateHeight [SomeMergeUpdate x]
mergeUpdates
  [SomeSwitchSubscribed x]
-> (SomeSwitchSubscribed x -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SomeSwitchSubscribed x]
toReconnect ((SomeSwitchSubscribed x -> IO ()) -> IO ())
-> (SomeSwitchSubscribed x -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(SomeSwitchSubscribed subscribed :: SwitchSubscribed x a
subscribed) -> do
    Height
height <- SwitchSubscribed x a -> IO Height
forall k (x :: k) a. SwitchSubscribed x a -> IO Height
calculateSwitchHeight SwitchSubscribed x a
subscribed
    Height -> SwitchSubscribed x a -> IO ()
forall k (x :: k) a. Height -> SwitchSubscribed x a -> IO ()
updateSwitchHeight Height
height SwitchSubscribed x a
subscribed
  a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

newtype Height = Height { Height -> Int
unHeight :: Int } deriving (Int -> Height -> String -> String
[Height] -> String -> String
Height -> String
(Int -> Height -> String -> String)
-> (Height -> String)
-> ([Height] -> String -> String)
-> Show Height
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Height] -> String -> String
$cshowList :: [Height] -> String -> String
show :: Height -> String
$cshow :: Height -> String
showsPrec :: Int -> Height -> String -> String
$cshowsPrec :: Int -> Height -> String -> String
Show, ReadPrec [Height]
ReadPrec Height
Int -> ReadS Height
ReadS [Height]
(Int -> ReadS Height)
-> ReadS [Height]
-> ReadPrec Height
-> ReadPrec [Height]
-> Read Height
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Height]
$creadListPrec :: ReadPrec [Height]
readPrec :: ReadPrec Height
$creadPrec :: ReadPrec Height
readList :: ReadS [Height]
$creadList :: ReadS [Height]
readsPrec :: Int -> ReadS Height
$creadsPrec :: Int -> ReadS Height
Read, Height -> Height -> Bool
(Height -> Height -> Bool)
-> (Height -> Height -> Bool) -> Eq Height
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Height -> Height -> Bool
$c/= :: Height -> Height -> Bool
== :: Height -> Height -> Bool
$c== :: Height -> Height -> Bool
Eq, Eq Height
Eq Height =>
(Height -> Height -> Ordering)
-> (Height -> Height -> Bool)
-> (Height -> Height -> Bool)
-> (Height -> Height -> Bool)
-> (Height -> Height -> Bool)
-> (Height -> Height -> Height)
-> (Height -> Height -> Height)
-> Ord Height
Height -> Height -> Bool
Height -> Height -> Ordering
Height -> Height -> Height
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Height -> Height -> Height
$cmin :: Height -> Height -> Height
max :: Height -> Height -> Height
$cmax :: Height -> Height -> Height
>= :: Height -> Height -> Bool
$c>= :: Height -> Height -> Bool
> :: Height -> Height -> Bool
$c> :: Height -> Height -> Bool
<= :: Height -> Height -> Bool
$c<= :: Height -> Height -> Bool
< :: Height -> Height -> Bool
$c< :: Height -> Height -> Bool
compare :: Height -> Height -> Ordering
$ccompare :: Height -> Height -> Ordering
$cp1Ord :: Eq Height
Ord, Height
Height -> Height -> Bounded Height
forall a. a -> a -> Bounded a
maxBound :: Height
$cmaxBound :: Height
minBound :: Height
$cminBound :: Height
Bounded)

{-# INLINE zeroHeight #-}
zeroHeight :: Height
zeroHeight :: Height
zeroHeight = Int -> Height
Height 0

{-# INLINE invalidHeight #-}
invalidHeight :: Height
invalidHeight :: Height
invalidHeight = Int -> Height
Height (-1000)

#ifdef DEBUG_CYCLES
-- | An invalid height that is currently being traversed, e.g. by walkInvalidHeightParents
{-# INLINE invalidHeightBeingTraversed #-}
invalidHeightBeingTraversed :: Height
invalidHeightBeingTraversed = Height (-1001)
#endif

{-# INLINE succHeight #-}
succHeight :: Height -> Height
succHeight :: Height -> Height
succHeight h :: Height
h@(Height a :: Int
a) =
  if Height
h Height -> Height -> Bool
forall a. Eq a => a -> a -> Bool
== Height
invalidHeight
  then Height
invalidHeight
  else Int -> Height
Height (Int -> Height) -> Int -> Height
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> a
succ Int
a

invalidateCoincidenceHeight :: CoincidenceSubscribed x a -> IO ()
invalidateCoincidenceHeight :: CoincidenceSubscribed x a -> IO ()
invalidateCoincidenceHeight subscribed :: CoincidenceSubscribed x a
subscribed = do
  Height
oldHeight <- IORef Height -> IO Height
forall a. IORef a -> IO a
readIORef (IORef Height -> IO Height) -> IORef Height -> IO Height
forall a b. (a -> b) -> a -> b
$ CoincidenceSubscribed x a -> IORef Height
forall k (x :: k) a. CoincidenceSubscribed x a -> IORef Height
coincidenceSubscribedHeight CoincidenceSubscribed x a
subscribed
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Height
oldHeight Height -> Height -> Bool
forall a. Eq a => a -> a -> Bool
/= Height
invalidHeight) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    IORef Height -> Height -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (CoincidenceSubscribed x a -> IORef Height
forall k (x :: k) a. CoincidenceSubscribed x a -> IORef Height
coincidenceSubscribedHeight CoincidenceSubscribed x a
subscribed) (Height -> IO ()) -> Height -> IO ()
forall a b. (a -> b) -> a -> b
$! Height
invalidHeight
    WeakBag (Subscriber x a) -> (Subscriber x a -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
WeakBag a -> (a -> m ()) -> m ()
WeakBag.traverse_ (CoincidenceSubscribed x a -> WeakBag (Subscriber x a)
forall k (x :: k) a.
CoincidenceSubscribed x a -> WeakBag (Subscriber x a)
coincidenceSubscribedSubscribers CoincidenceSubscribed x a
subscribed) ((Subscriber x a -> IO ()) -> IO ())
-> (Subscriber x a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> Subscriber x a -> IO ()
forall k (x :: k) a. Height -> Subscriber x a -> IO ()
invalidateSubscriberHeight Height
oldHeight

updateSwitchHeight :: Height -> SwitchSubscribed x a -> IO ()
updateSwitchHeight :: Height -> SwitchSubscribed x a -> IO ()
updateSwitchHeight new :: Height
new subscribed :: SwitchSubscribed x a
subscribed = do
  Height
oldHeight <- IORef Height -> IO Height
forall a. IORef a -> IO a
readIORef (IORef Height -> IO Height) -> IORef Height -> IO Height
forall a b. (a -> b) -> a -> b
$ SwitchSubscribed x a -> IORef Height
forall k (x :: k) a. SwitchSubscribed x a -> IORef Height
switchSubscribedHeight SwitchSubscribed x a
subscribed
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Height
oldHeight Height -> Height -> Bool
forall a. Eq a => a -> a -> Bool
== Height
invalidHeight) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do --TODO: This 'when' should probably be an assertion
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Height
new Height -> Height -> Bool
forall a. Eq a => a -> a -> Bool
/= Height
invalidHeight) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do --TODO: This 'when' should probably be an assertion
      IORef Height -> Height -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (SwitchSubscribed x a -> IORef Height
forall k (x :: k) a. SwitchSubscribed x a -> IORef Height
switchSubscribedHeight SwitchSubscribed x a
subscribed) (Height -> IO ()) -> Height -> IO ()
forall a b. (a -> b) -> a -> b
$! Height
new
      WeakBag (Subscriber x a) -> (Subscriber x a -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
WeakBag a -> (a -> m ()) -> m ()
WeakBag.traverse_ (SwitchSubscribed x a -> WeakBag (Subscriber x a)
forall k (x :: k) a.
SwitchSubscribed x a -> WeakBag (Subscriber x a)
switchSubscribedSubscribers SwitchSubscribed x a
subscribed) ((Subscriber x a -> IO ()) -> IO ())
-> (Subscriber x a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> Subscriber x a -> IO ()
forall k (x :: k) a. Height -> Subscriber x a -> IO ()
recalculateSubscriberHeight Height
new

recalculateCoincidenceHeight :: CoincidenceSubscribed x a -> IO ()
recalculateCoincidenceHeight :: CoincidenceSubscribed x a -> IO ()
recalculateCoincidenceHeight subscribed :: CoincidenceSubscribed x a
subscribed = do
  Height
oldHeight <- IORef Height -> IO Height
forall a. IORef a -> IO a
readIORef (IORef Height -> IO Height) -> IORef Height -> IO Height
forall a b. (a -> b) -> a -> b
$ CoincidenceSubscribed x a -> IORef Height
forall k (x :: k) a. CoincidenceSubscribed x a -> IORef Height
coincidenceSubscribedHeight CoincidenceSubscribed x a
subscribed
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Height
oldHeight Height -> Height -> Bool
forall a. Eq a => a -> a -> Bool
== Height
invalidHeight) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do --TODO: This 'when' should probably be an assertion
    Height
height <- CoincidenceSubscribed x a -> IO Height
forall k (x :: k) a. CoincidenceSubscribed x a -> IO Height
calculateCoincidenceHeight CoincidenceSubscribed x a
subscribed
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Height
height Height -> Height -> Bool
forall a. Eq a => a -> a -> Bool
/= Height
invalidHeight) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      IORef Height -> Height -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (CoincidenceSubscribed x a -> IORef Height
forall k (x :: k) a. CoincidenceSubscribed x a -> IORef Height
coincidenceSubscribedHeight CoincidenceSubscribed x a
subscribed) (Height -> IO ()) -> Height -> IO ()
forall a b. (a -> b) -> a -> b
$! Height
height
      WeakBag (Subscriber x a) -> (Subscriber x a -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
WeakBag a -> (a -> m ()) -> m ()
WeakBag.traverse_ (CoincidenceSubscribed x a -> WeakBag (Subscriber x a)
forall k (x :: k) a.
CoincidenceSubscribed x a -> WeakBag (Subscriber x a)
coincidenceSubscribedSubscribers CoincidenceSubscribed x a
subscribed) ((Subscriber x a -> IO ()) -> IO ())
-> (Subscriber x a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Height -> Subscriber x a -> IO ()
forall k (x :: k) a. Height -> Subscriber x a -> IO ()
recalculateSubscriberHeight Height
height

calculateSwitchHeight :: SwitchSubscribed x a -> IO Height
calculateSwitchHeight :: SwitchSubscribed x a -> IO Height
calculateSwitchHeight subscribed :: SwitchSubscribed x a
subscribed = EventSubscribed x -> IO Height
forall k (x :: k). EventSubscribed x -> IO Height
getEventSubscribedHeight (EventSubscribed x -> IO Height)
-> (EventSubscription x -> EventSubscribed x)
-> EventSubscription x
-> IO Height
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventSubscription x -> EventSubscribed x
forall k (x :: k). EventSubscription x -> EventSubscribed x
_eventSubscription_subscribed (EventSubscription x -> IO Height)
-> IO (EventSubscription x) -> IO Height
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (EventSubscription x) -> IO (EventSubscription x)
forall a. IORef a -> IO a
readIORef (SwitchSubscribed x a -> IORef (EventSubscription x)
forall k (x :: k) a.
SwitchSubscribed x a -> IORef (EventSubscription x)
switchSubscribedCurrentParent SwitchSubscribed x a
subscribed)

calculateCoincidenceHeight :: CoincidenceSubscribed x a -> IO Height
calculateCoincidenceHeight :: CoincidenceSubscribed x a -> IO Height
calculateCoincidenceHeight subscribed :: CoincidenceSubscribed x a
subscribed = do
  Height
outerHeight <- EventSubscribed x -> IO Height
forall k (x :: k). EventSubscribed x -> IO Height
getEventSubscribedHeight (EventSubscribed x -> IO Height) -> EventSubscribed x -> IO Height
forall a b. (a -> b) -> a -> b
$ EventSubscription x -> EventSubscribed x
forall k (x :: k). EventSubscription x -> EventSubscribed x
_eventSubscription_subscribed (EventSubscription x -> EventSubscribed x)
-> EventSubscription x -> EventSubscribed x
forall a b. (a -> b) -> a -> b
$ CoincidenceSubscribed x a -> EventSubscription x
forall k (x :: k) a.
CoincidenceSubscribed x a -> EventSubscription x
coincidenceSubscribedOuterParent CoincidenceSubscribed x a
subscribed
  Height
innerHeight <- IO Height
-> (EventSubscribed x -> IO Height)
-> Maybe (EventSubscribed x)
-> IO Height
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Height -> IO Height
forall (m :: * -> *) a. Monad m => a -> m a
return Height
zeroHeight) EventSubscribed x -> IO Height
forall k (x :: k). EventSubscribed x -> IO Height
getEventSubscribedHeight (Maybe (EventSubscribed x) -> IO Height)
-> IO (Maybe (EventSubscribed x)) -> IO Height
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (Maybe (EventSubscribed x)) -> IO (Maybe (EventSubscribed x))
forall a. IORef a -> IO a
readIORef (CoincidenceSubscribed x a -> IORef (Maybe (EventSubscribed x))
forall k (x :: k) a.
CoincidenceSubscribed x a -> IORef (Maybe (EventSubscribed x))
coincidenceSubscribedInnerParent CoincidenceSubscribed x a
subscribed)
  Height -> IO Height
forall (m :: * -> *) a. Monad m => a -> m a
return (Height -> IO Height) -> Height -> IO Height
forall a b. (a -> b) -> a -> b
$ if Height
outerHeight Height -> Height -> Bool
forall a. Eq a => a -> a -> Bool
== Height
invalidHeight Bool -> Bool -> Bool
|| Height
innerHeight Height -> Height -> Bool
forall a. Eq a => a -> a -> Bool
== Height
invalidHeight then Height
invalidHeight else Height -> Height -> Height
forall a. Ord a => a -> a -> a
max Height
outerHeight Height
innerHeight

data SomeSwitchSubscribed x = forall a. SomeSwitchSubscribed {-# NOUNPACK #-} (SwitchSubscribed x a)

invalidate :: IORef [SomeSwitchSubscribed x] -> WeakList (Invalidator x) -> IO (WeakList (Invalidator x))
invalidate :: IORef [SomeSwitchSubscribed x]
-> WeakList (Invalidator x) -> IO (WeakList (Invalidator x))
invalidate toReconnectRef :: IORef [SomeSwitchSubscribed x]
toReconnectRef wis :: WeakList (Invalidator x)
wis = do
  WeakList (Invalidator x)
-> (Weak (Invalidator x) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ WeakList (Invalidator x)
wis ((Weak (Invalidator x) -> IO ()) -> IO ())
-> (Weak (Invalidator x) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \wi :: Weak (Invalidator x)
wi -> do
    Maybe (Invalidator x)
mi <- Weak (Invalidator x) -> IO (Maybe (Invalidator x))
forall v. Weak v -> IO (Maybe v)
deRefWeak Weak (Invalidator x)
wi
    case Maybe (Invalidator x)
mi of
      Nothing -> do
        String -> IO ()
traceInvalidate "invalidate Dead"
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO: Should we clean this up here?
      Just i :: Invalidator x
i -> do
        Weak (Invalidator x) -> IO ()
forall v. Weak v -> IO ()
finalize Weak (Invalidator x)
wi -- Once something's invalidated, it doesn't need to hang around; this will change when some things are strict
        case Invalidator x
i of
          InvalidatorPull p :: Pull x a
p -> do
            String -> IO ()
traceInvalidate (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "invalidate: Pull" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Pull x a -> String
forall a. a -> String
showNodeId Pull x a
p
            Maybe (PullSubscribed x a)
mVal <- IORef (Maybe (PullSubscribed x a))
-> IO (Maybe (PullSubscribed x a))
forall a. IORef a -> IO a
readIORef (IORef (Maybe (PullSubscribed x a))
 -> IO (Maybe (PullSubscribed x a)))
-> IORef (Maybe (PullSubscribed x a))
-> IO (Maybe (PullSubscribed x a))
forall a b. (a -> b) -> a -> b
$ Pull x a -> IORef (Maybe (PullSubscribed x a))
forall k (x :: k) a. Pull x a -> IORef (Maybe (PullSubscribed x a))
pullValue Pull x a
p
            Maybe (PullSubscribed x a)
-> (PullSubscribed x a -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (PullSubscribed x a)
mVal ((PullSubscribed x a -> IO ()) -> IO ())
-> (PullSubscribed x a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \val :: PullSubscribed x a
val -> do
              IORef (Maybe (PullSubscribed x a))
-> Maybe (PullSubscribed x a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Pull x a -> IORef (Maybe (PullSubscribed x a))
forall k (x :: k) a. Pull x a -> IORef (Maybe (PullSubscribed x a))
pullValue Pull x a
p) Maybe (PullSubscribed x a)
forall a. Maybe a
Nothing
              IORef (WeakList (Invalidator x))
-> WeakList (Invalidator x) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (PullSubscribed x a -> IORef (WeakList (Invalidator x))
forall k (x :: k) a.
PullSubscribed x a -> IORef [Weak (Invalidator x)]
pullSubscribedInvalidators PullSubscribed x a
val) (WeakList (Invalidator x) -> IO ())
-> IO (WeakList (Invalidator x)) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< WeakList (Invalidator x) -> IO (WeakList (Invalidator x))
forall a. a -> IO a
evaluate (WeakList (Invalidator x) -> IO (WeakList (Invalidator x)))
-> IO (WeakList (Invalidator x)) -> IO (WeakList (Invalidator x))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef [SomeSwitchSubscribed x]
-> WeakList (Invalidator x) -> IO (WeakList (Invalidator x))
forall k (x :: k).
IORef [SomeSwitchSubscribed x]
-> WeakList (Invalidator x) -> IO (WeakList (Invalidator x))
invalidate IORef [SomeSwitchSubscribed x]
toReconnectRef (WeakList (Invalidator x) -> IO (WeakList (Invalidator x)))
-> IO (WeakList (Invalidator x)) -> IO (WeakList (Invalidator x))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (WeakList (Invalidator x)) -> IO (WeakList (Invalidator x))
forall a. IORef a -> IO a
readIORef (PullSubscribed x a -> IORef (WeakList (Invalidator x))
forall k (x :: k) a.
PullSubscribed x a -> IORef [Weak (Invalidator x)]
pullSubscribedInvalidators PullSubscribed x a
val)
          InvalidatorSwitch subscribed :: SwitchSubscribed x a
subscribed -> do
            String -> IO ()
traceInvalidate (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "invalidate: Switch" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SwitchSubscribed x a -> String
forall a. a -> String
showNodeId SwitchSubscribed x a
subscribed
            IORef [SomeSwitchSubscribed x]
-> ([SomeSwitchSubscribed x] -> [SomeSwitchSubscribed x]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [SomeSwitchSubscribed x]
toReconnectRef (SwitchSubscribed x a -> SomeSwitchSubscribed x
forall k (x :: k) a. SwitchSubscribed x a -> SomeSwitchSubscribed x
SomeSwitchSubscribed SwitchSubscribed x a
subscribed SomeSwitchSubscribed x
-> [SomeSwitchSubscribed x] -> [SomeSwitchSubscribed x]
forall a. a -> [a] -> [a]
:)
  WeakList (Invalidator x) -> IO (WeakList (Invalidator x))
forall (m :: * -> *) a. Monad m => a -> m a
return [] -- Since we always finalize everything, always return an empty list --TODO: There are some things that will need to be re-subscribed every time; we should try to avoid finalizing them

--------------------------------------------------------------------------------
-- Reflex integration
--------------------------------------------------------------------------------

-- | Designates the default, global Spider timeline
data SpiderTimeline x
type role SpiderTimeline nominal

-- | The default, global Spider environment
type Spider = SpiderTimeline Global

instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (EventM x) where
  {-# INLINABLE sample #-}
  sample :: Behavior (SpiderTimeline x) a -> EventM x a
sample (SpiderBehavior b) = Behavior x a -> EventM x a
forall k (x :: k) (m :: * -> *) a.
Defer (SomeHoldInit x) m =>
Behavior x a -> m a
readBehaviorUntracked Behavior x a
b

instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (EventM x) where
  {-# INLINABLE hold #-}
  hold :: a
-> Event (SpiderTimeline x) a
-> EventM x (Behavior (SpiderTimeline x) a)
hold = a
-> Event (SpiderTimeline x) a
-> EventM x (Behavior (SpiderTimeline x) a)
forall x a.
HasSpiderTimeline x =>
a
-> Event (SpiderTimeline x) a
-> EventM x (Behavior (SpiderTimeline x) a)
holdSpiderEventM
  {-# INLINABLE holdDyn #-}
  holdDyn :: a
-> Event (SpiderTimeline x) a
-> EventM x (Dynamic (SpiderTimeline x) a)
holdDyn = a
-> Event (SpiderTimeline x) a
-> EventM x (Dynamic (SpiderTimeline x) a)
forall x a.
HasSpiderTimeline x =>
a
-> Event (SpiderTimeline x) a
-> EventM x (Dynamic (SpiderTimeline x) a)
holdDynSpiderEventM
  {-# INLINABLE holdIncremental #-}
  holdIncremental :: PatchTarget p
-> Event (SpiderTimeline x) p
-> EventM x (Incremental (SpiderTimeline x) p)
holdIncremental = PatchTarget p
-> Event (SpiderTimeline x) p
-> EventM x (Incremental (SpiderTimeline x) p)
forall x p.
(HasSpiderTimeline x, Patch p) =>
PatchTarget p
-> Event (SpiderTimeline x) p
-> EventM x (Incremental (SpiderTimeline x) p)
holdIncrementalSpiderEventM
  {-# INLINABLE buildDynamic #-}
  buildDynamic :: PushM (SpiderTimeline x) a
-> Event (SpiderTimeline x) a
-> EventM x (Dynamic (SpiderTimeline x) a)
buildDynamic = PushM (SpiderTimeline x) a
-> Event (SpiderTimeline x) a
-> EventM x (Dynamic (SpiderTimeline x) a)
forall x a.
HasSpiderTimeline x =>
SpiderPushM x a
-> Event (SpiderTimeline x) a
-> EventM x (Dynamic (SpiderTimeline x) a)
buildDynamicSpiderEventM
  {-# INLINABLE headE #-}
  headE :: Event (SpiderTimeline x) a -> EventM x (Event (SpiderTimeline x) a)
headE = Event (SpiderTimeline x) a -> EventM x (Event (SpiderTimeline x) a)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m) =>
Event t a -> m (Event t a)
R.slowHeadE
--  headE (SpiderEvent e) = SpiderEvent <$> Reflex.Spider.Internal.headE e

instance Reflex.Class.MonadSample (SpiderTimeline x) (SpiderPullM x) where
  {-# INLINABLE sample #-}
  sample :: Behavior (SpiderTimeline x) a -> SpiderPullM x a
sample = BehaviorM x a -> SpiderPullM x a
forall a b. Coercible a b => a -> b
coerce (BehaviorM x a -> SpiderPullM x a)
-> (Behavior (SpiderTimeline x) a -> BehaviorM x a)
-> Behavior (SpiderTimeline x) a
-> SpiderPullM x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior x a -> BehaviorM x a
forall k (x :: k) a. Behavior x a -> BehaviorM x a
readBehaviorTracked (Behavior x a -> BehaviorM x a)
-> (Behavior (SpiderTimeline x) a -> Behavior x a)
-> Behavior (SpiderTimeline x) a
-> BehaviorM x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior (SpiderTimeline x) a -> Behavior x a
forall x a. Behavior (SpiderTimeline x) a -> Behavior x a
unSpiderBehavior

instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderPushM x) where
  {-# INLINABLE sample #-}
  sample :: Behavior (SpiderTimeline x) a -> SpiderPushM x a
sample (SpiderBehavior b) = ComputeM x a -> SpiderPushM x a
forall x a. ComputeM x a -> SpiderPushM x a
SpiderPushM (ComputeM x a -> SpiderPushM x a)
-> ComputeM x a -> SpiderPushM x a
forall a b. (a -> b) -> a -> b
$ Behavior x a -> ComputeM x a
forall k (x :: k) (m :: * -> *) a.
Defer (SomeHoldInit x) m =>
Behavior x a -> m a
readBehaviorUntracked Behavior x a
b

instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (SpiderPushM x) where
  {-# INLINABLE hold #-}
  hold :: a
-> Event (SpiderTimeline x) a
-> SpiderPushM x (Behavior (SpiderTimeline x) a)
hold v0 :: a
v0 e :: Event (SpiderTimeline x) a
e = Dynamic (SpiderTimeline x) a -> Behavior (SpiderTimeline x) a
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
Reflex.Class.current (Dynamic (SpiderTimeline x) a -> Behavior (SpiderTimeline x) a)
-> SpiderPushM x (Dynamic (SpiderTimeline x) a)
-> SpiderPushM x (Behavior (SpiderTimeline x) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a
-> Event (SpiderTimeline x) a
-> SpiderPushM x (Dynamic (SpiderTimeline x) a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
Reflex.Class.holdDyn a
v0 Event (SpiderTimeline x) a
e
  {-# INLINABLE holdDyn #-}
  holdDyn :: a
-> Event (SpiderTimeline x) a
-> SpiderPushM x (Dynamic (SpiderTimeline x) a)
holdDyn v0 :: a
v0 (SpiderEvent e) = ComputeM x (Dynamic (SpiderTimeline x) a)
-> SpiderPushM x (Dynamic (SpiderTimeline x) a)
forall x a. ComputeM x a -> SpiderPushM x a
SpiderPushM (ComputeM x (Dynamic (SpiderTimeline x) a)
 -> SpiderPushM x (Dynamic (SpiderTimeline x) a))
-> ComputeM x (Dynamic (SpiderTimeline x) a)
-> SpiderPushM x (Dynamic (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ (Hold x (Identity a) -> Dynamic (SpiderTimeline x) a)
-> EventM x (Hold x (Identity a))
-> ComputeM x (Dynamic (SpiderTimeline x) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a
forall x a. DynamicS x (Identity a) -> Dynamic (SpiderTimeline x) a
SpiderDynamic (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a)
-> (Hold x (Identity a) -> Dynamic x a (Identity a))
-> Hold x (Identity a)
-> Dynamic (SpiderTimeline x) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hold x (Identity a) -> Dynamic x a (Identity a)
forall k (x :: k) a. Hold x (Identity a) -> DynamicS x (Identity a)
dynamicHoldIdentity) (EventM x (Hold x (Identity a))
 -> ComputeM x (Dynamic (SpiderTimeline x) a))
-> EventM x (Hold x (Identity a))
-> ComputeM x (Dynamic (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ PatchTarget (Identity a)
-> Event x (Identity a) -> EventM x (Hold x (Identity a))
forall k p (x :: k) (m :: * -> *).
(Patch p, Defer (SomeHoldInit x) m) =>
PatchTarget p -> Event x p -> m (Hold x p)
Reflex.Spider.Internal.hold a
PatchTarget (Identity a)
v0 (Event x (Identity a) -> EventM x (Hold x (Identity a)))
-> Event x (Identity a) -> EventM x (Hold x (Identity a))
forall a b. (a -> b) -> a -> b
$ Event x a -> Event x (Identity a)
forall a b. Coercible a b => a -> b
coerce Event x a
e
  {-# INLINABLE holdIncremental #-}
  holdIncremental :: PatchTarget p
-> Event (SpiderTimeline x) p
-> SpiderPushM x (Incremental (SpiderTimeline x) p)
holdIncremental v0 :: PatchTarget p
v0 (SpiderEvent e) = ComputeM x (Incremental (SpiderTimeline x) p)
-> SpiderPushM x (Incremental (SpiderTimeline x) p)
forall x a. ComputeM x a -> SpiderPushM x a
SpiderPushM (ComputeM x (Incremental (SpiderTimeline x) p)
 -> SpiderPushM x (Incremental (SpiderTimeline x) p))
-> ComputeM x (Incremental (SpiderTimeline x) p)
-> SpiderPushM x (Incremental (SpiderTimeline x) p)
forall a b. (a -> b) -> a -> b
$ DynamicS x p -> Incremental (SpiderTimeline x) p
forall x p. DynamicS x p -> Incremental (SpiderTimeline x) p
SpiderIncremental (DynamicS x p -> Incremental (SpiderTimeline x) p)
-> (Hold x p -> DynamicS x p)
-> Hold x p
-> Incremental (SpiderTimeline x) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hold x p -> DynamicS x p
forall k (x :: k) p. Hold x p -> DynamicS x p
dynamicHold (Hold x p -> Incremental (SpiderTimeline x) p)
-> EventM x (Hold x p)
-> ComputeM x (Incremental (SpiderTimeline x) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PatchTarget p -> Event x p -> EventM x (Hold x p)
forall k p (x :: k) (m :: * -> *).
(Patch p, Defer (SomeHoldInit x) m) =>
PatchTarget p -> Event x p -> m (Hold x p)
Reflex.Spider.Internal.hold PatchTarget p
v0 Event x p
e
  {-# INLINABLE buildDynamic #-}
  buildDynamic :: PushM (SpiderTimeline x) a
-> Event (SpiderTimeline x) a
-> SpiderPushM x (Dynamic (SpiderTimeline x) a)
buildDynamic getV0 :: PushM (SpiderTimeline x) a
getV0 (SpiderEvent e) = ComputeM x (Dynamic (SpiderTimeline x) a)
-> SpiderPushM x (Dynamic (SpiderTimeline x) a)
forall x a. ComputeM x a -> SpiderPushM x a
SpiderPushM (ComputeM x (Dynamic (SpiderTimeline x) a)
 -> SpiderPushM x (Dynamic (SpiderTimeline x) a))
-> ComputeM x (Dynamic (SpiderTimeline x) a)
-> SpiderPushM x (Dynamic (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ (Dyn x (Identity a) -> Dynamic (SpiderTimeline x) a)
-> EventM x (Dyn x (Identity a))
-> ComputeM x (Dynamic (SpiderTimeline x) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a
forall x a. DynamicS x (Identity a) -> Dynamic (SpiderTimeline x) a
SpiderDynamic (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a)
-> (Dyn x (Identity a) -> Dynamic x a (Identity a))
-> Dyn x (Identity a)
-> Dynamic (SpiderTimeline x) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dyn x (Identity a) -> Dynamic x a (Identity a)
forall x a.
HasSpiderTimeline x =>
Dyn x (Identity a) -> DynamicS x (Identity a)
dynamicDynIdentity) (EventM x (Dyn x (Identity a))
 -> ComputeM x (Dynamic (SpiderTimeline x) a))
-> EventM x (Dyn x (Identity a))
-> ComputeM x (Dynamic (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ EventM x (PatchTarget (Identity a))
-> Event x (Identity a) -> EventM x (Dyn x (Identity a))
forall x (m :: * -> *) p.
(Defer (SomeDynInit x) m, Patch p) =>
EventM x (PatchTarget p) -> Event x p -> m (Dyn x p)
Reflex.Spider.Internal.buildDynamic (SpiderPushM x a -> EventM x a
forall a b. Coercible a b => a -> b
coerce PushM (SpiderTimeline x) a
SpiderPushM x a
getV0) (Event x (Identity a) -> EventM x (Dyn x (Identity a)))
-> Event x (Identity a) -> EventM x (Dyn x (Identity a))
forall a b. (a -> b) -> a -> b
$ Event x a -> Event x (Identity a)
forall a b. Coercible a b => a -> b
coerce Event x a
e
  {-# INLINABLE headE #-}
  headE :: Event (SpiderTimeline x) a
-> SpiderPushM x (Event (SpiderTimeline x) a)
headE = Event (SpiderTimeline x) a
-> SpiderPushM x (Event (SpiderTimeline x) a)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m) =>
Event t a -> m (Event t a)
R.slowHeadE
--  headE (SpiderEvent e) = SpiderPushM $ SpiderEvent <$> Reflex.Spider.Internal.headE e

instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x)) where
  {-# INLINE return #-}
  return :: a -> Dynamic (SpiderTimeline x) a
return = a -> Dynamic (SpiderTimeline x) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE (>>=) #-}
  x :: Dynamic (SpiderTimeline x) a
x >>= :: Dynamic (SpiderTimeline x) a
-> (a -> Dynamic (SpiderTimeline x) b)
-> Dynamic (SpiderTimeline x) b
>>= f :: a -> Dynamic (SpiderTimeline x) b
f = DynamicS x (Identity b) -> Dynamic (SpiderTimeline x) b
forall x a. DynamicS x (Identity a) -> Dynamic (SpiderTimeline x) a
SpiderDynamic (DynamicS x (Identity b) -> Dynamic (SpiderTimeline x) b)
-> DynamicS x (Identity b) -> Dynamic (SpiderTimeline x) b
forall a b. (a -> b) -> a -> b
$ Dyn x (Identity b) -> DynamicS x (Identity b)
forall x a.
HasSpiderTimeline x =>
Dyn x (Identity a) -> DynamicS x (Identity a)
dynamicDynIdentity (Dyn x (Identity b) -> DynamicS x (Identity b))
-> Dyn x (Identity b) -> DynamicS x (Identity b)
forall a b. (a -> b) -> a -> b
$ DynamicS x (Identity (DynamicS x (Identity b)))
-> Dyn x (Identity b)
forall x a.
HasSpiderTimeline x =>
DynamicS x (Identity (DynamicS x (Identity a)))
-> Dyn x (Identity a)
newJoinDyn (DynamicS x (Identity (DynamicS x (Identity b)))
 -> Dyn x (Identity b))
-> DynamicS x (Identity (DynamicS x (Identity b)))
-> Dyn x (Identity b)
forall a b. (a -> b) -> a -> b
$ (a -> Dynamic x b (Identity b))
-> DynamicS x (Identity a)
-> DynamicS x (Identity (Dynamic x b (Identity b)))
forall x a b.
HasSpiderTimeline x =>
(a -> b) -> DynamicS x (Identity a) -> DynamicS x (Identity b)
newMapDyn (Dynamic (SpiderTimeline x) b -> Dynamic x b (Identity b)
forall x a. Dynamic (SpiderTimeline x) a -> DynamicS x (Identity a)
unSpiderDynamic (Dynamic (SpiderTimeline x) b -> Dynamic x b (Identity b))
-> (a -> Dynamic (SpiderTimeline x) b)
-> a
-> Dynamic x b (Identity b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Dynamic (SpiderTimeline x) b
f) (DynamicS x (Identity a)
 -> DynamicS x (Identity (DynamicS x (Identity b))))
-> DynamicS x (Identity a)
-> DynamicS x (Identity (DynamicS x (Identity b)))
forall a b. (a -> b) -> a -> b
$ Dynamic (SpiderTimeline x) a -> DynamicS x (Identity a)
forall x a. Dynamic (SpiderTimeline x) a -> DynamicS x (Identity a)
unSpiderDynamic Dynamic (SpiderTimeline x) a
x
  {-# INLINE (>>) #-}
  >> :: Dynamic (SpiderTimeline x) a
-> Dynamic (SpiderTimeline x) b -> Dynamic (SpiderTimeline x) b
(>>) = Dynamic (SpiderTimeline x) a
-> Dynamic (SpiderTimeline x) b -> Dynamic (SpiderTimeline x) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
#if !MIN_VERSION_base(4,13,0)
  {-# INLINE fail #-}
  fail _ = error "Dynamic does not support 'fail'"
#endif

{-# INLINABLE newJoinDyn #-}
newJoinDyn :: HasSpiderTimeline x => DynamicS x (Identity (DynamicS x (Identity a))) -> Reflex.Spider.Internal.Dyn x (Identity a)
newJoinDyn :: DynamicS x (Identity (DynamicS x (Identity a)))
-> Dyn x (Identity a)
newJoinDyn d :: DynamicS x (Identity (DynamicS x (Identity a)))
d =
  let readV0 :: BehaviorM x a
readV0 = Behavior x a -> BehaviorM x a
forall k (x :: k) a. Behavior x a -> BehaviorM x a
readBehaviorTracked (Behavior x a -> BehaviorM x a)
-> (Dynamic x a (Identity a) -> Behavior x a)
-> Dynamic x a (Identity a)
-> BehaviorM x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic x a (Identity a) -> Behavior x a
forall k (x :: k) target p. Dynamic x target p -> Behavior x target
dynamicCurrent (Dynamic x a (Identity a) -> BehaviorM x a)
-> BehaviorM x (Dynamic x a (Identity a)) -> BehaviorM x a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Behavior x (Dynamic x a (Identity a))
-> BehaviorM x (Dynamic x a (Identity a))
forall k (x :: k) a. Behavior x a -> BehaviorM x a
readBehaviorTracked (Dynamic
  x (Dynamic x a (Identity a)) (Identity (Dynamic x a (Identity a)))
-> Behavior x (Dynamic x a (Identity a))
forall k (x :: k) target p. Dynamic x target p -> Behavior x target
dynamicCurrent DynamicS x (Identity (DynamicS x (Identity a)))
Dynamic
  x (Dynamic x a (Identity a)) (Identity (Dynamic x a (Identity a)))
d)
      eOuter :: Event x (Identity a)
eOuter = (Identity (Dynamic x a (Identity a))
 -> ComputeM x (Maybe (Identity a)))
-> Event x (Identity (Dynamic x a (Identity a)))
-> Event x (Identity a)
forall x a b.
HasSpiderTimeline x =>
(a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
Reflex.Spider.Internal.push ((a -> Maybe (Identity a))
-> EventM x a -> ComputeM x (Maybe (Identity a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Identity a -> Maybe (Identity a)
forall a. a -> Maybe a
Just (Identity a -> Maybe (Identity a))
-> (a -> Identity a) -> a -> Maybe (Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity a
forall a. a -> Identity a
Identity) (EventM x a -> ComputeM x (Maybe (Identity a)))
-> (Identity (Dynamic x a (Identity a)) -> EventM x a)
-> Identity (Dynamic x a (Identity a))
-> ComputeM x (Maybe (Identity a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior x a -> EventM x a
forall k (x :: k) (m :: * -> *) a.
Defer (SomeHoldInit x) m =>
Behavior x a -> m a
readBehaviorUntracked (Behavior x a -> EventM x a)
-> (Identity (Dynamic x a (Identity a)) -> Behavior x a)
-> Identity (Dynamic x a (Identity a))
-> EventM x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic x a (Identity a) -> Behavior x a
forall k (x :: k) target p. Dynamic x target p -> Behavior x target
dynamicCurrent (Dynamic x a (Identity a) -> Behavior x a)
-> (Identity (Dynamic x a (Identity a))
    -> Dynamic x a (Identity a))
-> Identity (Dynamic x a (Identity a))
-> Behavior x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Dynamic x a (Identity a)) -> Dynamic x a (Identity a)
forall a. Identity a -> a
runIdentity) (Event x (Identity (Dynamic x a (Identity a)))
 -> Event x (Identity a))
-> Event x (Identity (Dynamic x a (Identity a)))
-> Event x (Identity a)
forall a b. (a -> b) -> a -> b
$ Dynamic
  x (Dynamic x a (Identity a)) (Identity (Dynamic x a (Identity a)))
-> Event x (Identity (Dynamic x a (Identity a)))
forall k (x :: k) target p. Dynamic x target p -> Event x p
dynamicUpdated DynamicS x (Identity (DynamicS x (Identity a)))
Dynamic
  x (Dynamic x a (Identity a)) (Identity (Dynamic x a (Identity a)))
d
      eInner :: Event x (Identity a)
eInner = Behavior x (Event x (Identity a)) -> Event x (Identity a)
forall x a.
HasSpiderTimeline x =>
Behavior x (Event x a) -> Event x a
Reflex.Spider.Internal.switch (Behavior x (Event x (Identity a)) -> Event x (Identity a))
-> Behavior x (Event x (Identity a)) -> Event x (Identity a)
forall a b. (a -> b) -> a -> b
$ Dynamic x a (Identity a) -> Event x (Identity a)
forall k (x :: k) target p. Dynamic x target p -> Event x p
dynamicUpdated (Dynamic x a (Identity a) -> Event x (Identity a))
-> Behavior x (Dynamic x a (Identity a))
-> Behavior x (Event x (Identity a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic
  x (Dynamic x a (Identity a)) (Identity (Dynamic x a (Identity a)))
-> Behavior x (Dynamic x a (Identity a))
forall k (x :: k) target p. Dynamic x target p -> Behavior x target
dynamicCurrent DynamicS x (Identity (DynamicS x (Identity a)))
Dynamic
  x (Dynamic x a (Identity a)) (Identity (Dynamic x a (Identity a)))
d
      eBoth :: Event x (Identity a)
eBoth = Event x (Event x (Identity a)) -> Event x (Identity a)
forall x a. HasSpiderTimeline x => Event x (Event x a) -> Event x a
Reflex.Spider.Internal.coincidence (Event x (Event x (Identity a)) -> Event x (Identity a))
-> Event x (Event x (Identity a)) -> Event x (Identity a)
forall a b. (a -> b) -> a -> b
$ Dynamic x a (Identity a) -> Event x (Identity a)
forall k (x :: k) target p. Dynamic x target p -> Event x p
dynamicUpdated (Dynamic x a (Identity a) -> Event x (Identity a))
-> (Identity (Dynamic x a (Identity a))
    -> Dynamic x a (Identity a))
-> Identity (Dynamic x a (Identity a))
-> Event x (Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Dynamic x a (Identity a)) -> Dynamic x a (Identity a)
forall a. Identity a -> a
runIdentity (Identity (Dynamic x a (Identity a)) -> Event x (Identity a))
-> Event x (Identity (Dynamic x a (Identity a)))
-> Event x (Event x (Identity a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic
  x (Dynamic x a (Identity a)) (Identity (Dynamic x a (Identity a)))
-> Event x (Identity (Dynamic x a (Identity a)))
forall k (x :: k) target p. Dynamic x target p -> Event x p
dynamicUpdated DynamicS x (Identity (DynamicS x (Identity a)))
Dynamic
  x (Dynamic x a (Identity a)) (Identity (Dynamic x a (Identity a)))
d
      v' :: Event x (Identity a)
v' = Event (SpiderTimeline x) (Identity a) -> Event x (Identity a)
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent (Event (SpiderTimeline x) (Identity a) -> Event x (Identity a))
-> Event (SpiderTimeline x) (Identity a) -> Event x (Identity a)
forall a b. (a -> b) -> a -> b
$ [Event (SpiderTimeline x) (Identity a)]
-> Event (SpiderTimeline x) (Identity a)
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
Reflex.Class.leftmost ([Event (SpiderTimeline x) (Identity a)]
 -> Event (SpiderTimeline x) (Identity a))
-> [Event (SpiderTimeline x) (Identity a)]
-> Event (SpiderTimeline x) (Identity a)
forall a b. (a -> b) -> a -> b
$ (Event x (Identity a) -> Event (SpiderTimeline x) (Identity a))
-> [Event x (Identity a)]
-> [Event (SpiderTimeline x) (Identity a)]
forall a b. (a -> b) -> [a] -> [b]
map Event x (Identity a) -> Event (SpiderTimeline x) (Identity a)
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent [Event x (Identity a)
eBoth, Event x (Identity a)
eOuter, Event x (Identity a)
eInner]
  in BehaviorM x (PatchTarget (Identity a))
-> Event x (Identity a) -> Dyn x (Identity a)
forall x p. BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
Reflex.Spider.Internal.unsafeBuildDynamic BehaviorM x a
BehaviorM x (PatchTarget (Identity a))
readV0 Event x (Identity a)
v'

instance HasSpiderTimeline x => Functor (Reflex.Class.Dynamic (SpiderTimeline x)) where
  fmap :: (a -> b)
-> Dynamic (SpiderTimeline x) a -> Dynamic (SpiderTimeline x) b
fmap = (a -> b)
-> Dynamic (SpiderTimeline x) a -> Dynamic (SpiderTimeline x) b
forall x a b.
HasSpiderTimeline x =>
(a -> b)
-> Dynamic (SpiderTimeline x) a -> Dynamic (SpiderTimeline x) b
mapDynamicSpider
  x :: a
x <$ :: a -> Dynamic (SpiderTimeline x) b -> Dynamic (SpiderTimeline x) a
<$ d :: Dynamic (SpiderTimeline x) b
d = PullM (SpiderTimeline x) a
-> Event (SpiderTimeline x) a -> Dynamic (SpiderTimeline x) a
forall k (t :: k) a.
Reflex t =>
PullM t a -> Event t a -> Dynamic t a
R.unsafeBuildDynamic (a -> SpiderPullM x a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x) (Event (SpiderTimeline x) a -> Dynamic (SpiderTimeline x) a)
-> Event (SpiderTimeline x) a -> Dynamic (SpiderTimeline x) a
forall a b. (a -> b) -> a -> b
$ a
x a -> Event (SpiderTimeline x) b -> Event (SpiderTimeline x) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Dynamic (SpiderTimeline x) b -> Event (SpiderTimeline x) b
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
R.updated Dynamic (SpiderTimeline x) b
d

mapDynamicSpider :: HasSpiderTimeline x => (a -> b) -> Reflex.Class.Dynamic (SpiderTimeline x) a -> Reflex.Class.Dynamic (SpiderTimeline x) b
mapDynamicSpider :: (a -> b)
-> Dynamic (SpiderTimeline x) a -> Dynamic (SpiderTimeline x) b
mapDynamicSpider f :: a -> b
f = Dynamic x b (Identity b) -> Dynamic (SpiderTimeline x) b
forall x a. DynamicS x (Identity a) -> Dynamic (SpiderTimeline x) a
SpiderDynamic (Dynamic x b (Identity b) -> Dynamic (SpiderTimeline x) b)
-> (Dynamic (SpiderTimeline x) a -> Dynamic x b (Identity b))
-> Dynamic (SpiderTimeline x) a
-> Dynamic (SpiderTimeline x) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> DynamicS x (Identity a) -> DynamicS x (Identity b)
forall x a b.
HasSpiderTimeline x =>
(a -> b) -> DynamicS x (Identity a) -> DynamicS x (Identity b)
newMapDyn a -> b
f (Dynamic x a (Identity a) -> Dynamic x b (Identity b))
-> (Dynamic (SpiderTimeline x) a -> Dynamic x a (Identity a))
-> Dynamic (SpiderTimeline x) a
-> Dynamic x b (Identity b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic (SpiderTimeline x) a -> Dynamic x a (Identity a)
forall x a. Dynamic (SpiderTimeline x) a -> DynamicS x (Identity a)
unSpiderDynamic
{-# INLINE [1] mapDynamicSpider #-}

instance HasSpiderTimeline x => Applicative (Reflex.Class.Dynamic (SpiderTimeline x)) where
  pure :: a -> Dynamic (SpiderTimeline x) a
pure = Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a
forall x a. DynamicS x (Identity a) -> Dynamic (SpiderTimeline x) a
SpiderDynamic (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a)
-> (a -> Dynamic x a (Identity a))
-> a
-> Dynamic (SpiderTimeline x) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Dynamic x a (Identity a)
forall k p (x :: k). PatchTarget p -> DynamicS x p
dynamicConst
#if MIN_VERSION_base(4,10,0)
  liftA2 :: (a -> b -> c)
-> Dynamic (SpiderTimeline x) a
-> Dynamic (SpiderTimeline x) b
-> Dynamic (SpiderTimeline x) c
liftA2 f :: a -> b -> c
f a :: Dynamic (SpiderTimeline x) a
a b :: Dynamic (SpiderTimeline x) b
b = DynamicS x (Identity c) -> Dynamic (SpiderTimeline x) c
forall x a. DynamicS x (Identity a) -> Dynamic (SpiderTimeline x) a
SpiderDynamic (DynamicS x (Identity c) -> Dynamic (SpiderTimeline x) c)
-> DynamicS x (Identity c) -> Dynamic (SpiderTimeline x) c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c)
-> DynamicS x (Identity a)
-> DynamicS x (Identity b)
-> DynamicS x (Identity c)
forall x a b c.
HasSpiderTimeline x =>
(a -> b -> c)
-> DynamicS x (Identity a)
-> DynamicS x (Identity b)
-> DynamicS x (Identity c)
Reflex.Spider.Internal.zipDynWith a -> b -> c
f (Dynamic (SpiderTimeline x) a -> DynamicS x (Identity a)
forall x a. Dynamic (SpiderTimeline x) a -> DynamicS x (Identity a)
unSpiderDynamic Dynamic (SpiderTimeline x) a
a) (Dynamic (SpiderTimeline x) b -> DynamicS x (Identity b)
forall x a. Dynamic (SpiderTimeline x) a -> DynamicS x (Identity a)
unSpiderDynamic Dynamic (SpiderTimeline x) b
b)
#endif
  SpiderDynamic a <*> :: Dynamic (SpiderTimeline x) (a -> b)
-> Dynamic (SpiderTimeline x) a -> Dynamic (SpiderTimeline x) b
<*> SpiderDynamic b = DynamicS x (Identity b) -> Dynamic (SpiderTimeline x) b
forall x a. DynamicS x (Identity a) -> Dynamic (SpiderTimeline x) a
SpiderDynamic (DynamicS x (Identity b) -> Dynamic (SpiderTimeline x) b)
-> DynamicS x (Identity b) -> Dynamic (SpiderTimeline x) b
forall a b. (a -> b) -> a -> b
$ ((a -> b) -> a -> b)
-> DynamicS x (Identity (a -> b))
-> DynamicS x (Identity a)
-> DynamicS x (Identity b)
forall x a b c.
HasSpiderTimeline x =>
(a -> b -> c)
-> DynamicS x (Identity a)
-> DynamicS x (Identity b)
-> DynamicS x (Identity c)
Reflex.Spider.Internal.zipDynWith (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($) DynamicS x (Identity (a -> b))
a DynamicS x (Identity a)
b
  a :: Dynamic (SpiderTimeline x) a
a *> :: Dynamic (SpiderTimeline x) a
-> Dynamic (SpiderTimeline x) b -> Dynamic (SpiderTimeline x) b
*> b :: Dynamic (SpiderTimeline x) b
b = PullM (SpiderTimeline x) b
-> Event (SpiderTimeline x) b -> Dynamic (SpiderTimeline x) b
forall k (t :: k) a.
Reflex t =>
PullM t a -> Event t a -> Dynamic t a
R.unsafeBuildDynamic (Behavior (SpiderTimeline x) b -> PullM (SpiderTimeline x) b
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
R.sample (Behavior (SpiderTimeline x) b -> PullM (SpiderTimeline x) b)
-> Behavior (SpiderTimeline x) b -> PullM (SpiderTimeline x) b
forall a b. (a -> b) -> a -> b
$ Dynamic (SpiderTimeline x) b -> Behavior (SpiderTimeline x) b
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
R.current Dynamic (SpiderTimeline x) b
b) (Event (SpiderTimeline x) b -> Dynamic (SpiderTimeline x) b)
-> Event (SpiderTimeline x) b -> Dynamic (SpiderTimeline x) b
forall a b. (a -> b) -> a -> b
$ [Event (SpiderTimeline x) b] -> Event (SpiderTimeline x) b
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
R.leftmost [Dynamic (SpiderTimeline x) b -> Event (SpiderTimeline x) b
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
R.updated Dynamic (SpiderTimeline x) b
b, Behavior (SpiderTimeline x) b
-> Event (SpiderTimeline x) a -> Event (SpiderTimeline x) b
forall k (t :: k) b a.
Reflex t =>
Behavior t b -> Event t a -> Event t b
R.tag (Dynamic (SpiderTimeline x) b -> Behavior (SpiderTimeline x) b
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
R.current Dynamic (SpiderTimeline x) b
b) (Event (SpiderTimeline x) a -> Event (SpiderTimeline x) b)
-> Event (SpiderTimeline x) a -> Event (SpiderTimeline x) b
forall a b. (a -> b) -> a -> b
$ Dynamic (SpiderTimeline x) a -> Event (SpiderTimeline x) a
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
R.updated Dynamic (SpiderTimeline x) a
a]
  <* :: Dynamic (SpiderTimeline x) a
-> Dynamic (SpiderTimeline x) b -> Dynamic (SpiderTimeline x) a
(<*) = (Dynamic (SpiderTimeline x) b
 -> Dynamic (SpiderTimeline x) a -> Dynamic (SpiderTimeline x) a)
-> Dynamic (SpiderTimeline x) a
-> Dynamic (SpiderTimeline x) b
-> Dynamic (SpiderTimeline x) a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Dynamic (SpiderTimeline x) b
-> Dynamic (SpiderTimeline x) a -> Dynamic (SpiderTimeline x) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>) -- There are no effects, so order doesn't matter

holdSpiderEventM :: HasSpiderTimeline x => a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Behavior (SpiderTimeline x) a)
holdSpiderEventM :: a
-> Event (SpiderTimeline x) a
-> EventM x (Behavior (SpiderTimeline x) a)
holdSpiderEventM v0 :: a
v0 e :: Event (SpiderTimeline x) a
e = (Hold x (Identity a) -> Behavior (SpiderTimeline x) a)
-> EventM x (Hold x (Identity a))
-> EventM x (Behavior (SpiderTimeline x) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Behavior x a -> Behavior (SpiderTimeline x) a
forall x a. Behavior x a -> Behavior (SpiderTimeline x) a
SpiderBehavior (Behavior x a -> Behavior (SpiderTimeline x) a)
-> (Hold x (Identity a) -> Behavior x a)
-> Hold x (Identity a)
-> Behavior (SpiderTimeline x) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hold x (Identity a) -> Behavior x a
forall k (x :: k) a. Hold x (Identity a) -> Behavior x a
behaviorHoldIdentity) (EventM x (Hold x (Identity a))
 -> EventM x (Behavior (SpiderTimeline x) a))
-> EventM x (Hold x (Identity a))
-> EventM x (Behavior (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ PatchTarget (Identity a)
-> Event x (Identity a) -> EventM x (Hold x (Identity a))
forall k p (x :: k) (m :: * -> *).
(Patch p, Defer (SomeHoldInit x) m) =>
PatchTarget p -> Event x p -> m (Hold x p)
Reflex.Spider.Internal.hold a
PatchTarget (Identity a)
v0 (Event x (Identity a) -> EventM x (Hold x (Identity a)))
-> Event x (Identity a) -> EventM x (Hold x (Identity a))
forall a b. (a -> b) -> a -> b
$ Event x a -> Event x (Identity a)
forall a b. Coercible a b => a -> b
coerce (Event x a -> Event x (Identity a))
-> Event x a -> Event x (Identity a)
forall a b. (a -> b) -> a -> b
$ Event (SpiderTimeline x) a -> Event x a
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent Event (SpiderTimeline x) a
e

holdDynSpiderEventM :: HasSpiderTimeline x => a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Dynamic (SpiderTimeline x) a)
holdDynSpiderEventM :: a
-> Event (SpiderTimeline x) a
-> EventM x (Dynamic (SpiderTimeline x) a)
holdDynSpiderEventM v0 :: a
v0 e :: Event (SpiderTimeline x) a
e = (Hold x (Identity a) -> Dynamic (SpiderTimeline x) a)
-> EventM x (Hold x (Identity a))
-> EventM x (Dynamic (SpiderTimeline x) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a
forall x a. DynamicS x (Identity a) -> Dynamic (SpiderTimeline x) a
SpiderDynamic (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a)
-> (Hold x (Identity a) -> Dynamic x a (Identity a))
-> Hold x (Identity a)
-> Dynamic (SpiderTimeline x) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hold x (Identity a) -> Dynamic x a (Identity a)
forall k (x :: k) a. Hold x (Identity a) -> DynamicS x (Identity a)
dynamicHoldIdentity) (EventM x (Hold x (Identity a))
 -> EventM x (Dynamic (SpiderTimeline x) a))
-> EventM x (Hold x (Identity a))
-> EventM x (Dynamic (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ PatchTarget (Identity a)
-> Event x (Identity a) -> EventM x (Hold x (Identity a))
forall k p (x :: k) (m :: * -> *).
(Patch p, Defer (SomeHoldInit x) m) =>
PatchTarget p -> Event x p -> m (Hold x p)
Reflex.Spider.Internal.hold a
PatchTarget (Identity a)
v0 (Event x (Identity a) -> EventM x (Hold x (Identity a)))
-> Event x (Identity a) -> EventM x (Hold x (Identity a))
forall a b. (a -> b) -> a -> b
$ Event x a -> Event x (Identity a)
forall a b. Coercible a b => a -> b
coerce (Event x a -> Event x (Identity a))
-> Event x a -> Event x (Identity a)
forall a b. (a -> b) -> a -> b
$ Event (SpiderTimeline x) a -> Event x a
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent Event (SpiderTimeline x) a
e

holdIncrementalSpiderEventM :: (HasSpiderTimeline x, Patch p) => PatchTarget p -> Reflex.Class.Event (SpiderTimeline x) p -> EventM x (Reflex.Class.Incremental (SpiderTimeline x) p)
holdIncrementalSpiderEventM :: PatchTarget p
-> Event (SpiderTimeline x) p
-> EventM x (Incremental (SpiderTimeline x) p)
holdIncrementalSpiderEventM v0 :: PatchTarget p
v0 e :: Event (SpiderTimeline x) p
e = (Hold x p -> Incremental (SpiderTimeline x) p)
-> EventM x (Hold x p)
-> EventM x (Incremental (SpiderTimeline x) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DynamicS x p -> Incremental (SpiderTimeline x) p
forall x p. DynamicS x p -> Incremental (SpiderTimeline x) p
SpiderIncremental (DynamicS x p -> Incremental (SpiderTimeline x) p)
-> (Hold x p -> DynamicS x p)
-> Hold x p
-> Incremental (SpiderTimeline x) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hold x p -> DynamicS x p
forall k (x :: k) p. Hold x p -> DynamicS x p
dynamicHold) (EventM x (Hold x p)
 -> EventM x (Incremental (SpiderTimeline x) p))
-> EventM x (Hold x p)
-> EventM x (Incremental (SpiderTimeline x) p)
forall a b. (a -> b) -> a -> b
$ PatchTarget p -> Event x p -> EventM x (Hold x p)
forall k p (x :: k) (m :: * -> *).
(Patch p, Defer (SomeHoldInit x) m) =>
PatchTarget p -> Event x p -> m (Hold x p)
Reflex.Spider.Internal.hold PatchTarget p
v0 (Event x p -> EventM x (Hold x p))
-> Event x p -> EventM x (Hold x p)
forall a b. (a -> b) -> a -> b
$ Event (SpiderTimeline x) p -> Event x p
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent Event (SpiderTimeline x) p
e

buildDynamicSpiderEventM :: HasSpiderTimeline x => SpiderPushM x a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Dynamic (SpiderTimeline x) a)
buildDynamicSpiderEventM :: SpiderPushM x a
-> Event (SpiderTimeline x) a
-> EventM x (Dynamic (SpiderTimeline x) a)
buildDynamicSpiderEventM getV0 :: SpiderPushM x a
getV0 e :: Event (SpiderTimeline x) a
e = (Dyn x (Identity a) -> Dynamic (SpiderTimeline x) a)
-> EventM x (Dyn x (Identity a))
-> EventM x (Dynamic (SpiderTimeline x) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a
forall x a. DynamicS x (Identity a) -> Dynamic (SpiderTimeline x) a
SpiderDynamic (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a)
-> (Dyn x (Identity a) -> Dynamic x a (Identity a))
-> Dyn x (Identity a)
-> Dynamic (SpiderTimeline x) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dyn x (Identity a) -> Dynamic x a (Identity a)
forall x a.
HasSpiderTimeline x =>
Dyn x (Identity a) -> DynamicS x (Identity a)
dynamicDynIdentity) (EventM x (Dyn x (Identity a))
 -> EventM x (Dynamic (SpiderTimeline x) a))
-> EventM x (Dyn x (Identity a))
-> EventM x (Dynamic (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ EventM x (PatchTarget (Identity a))
-> Event x (Identity a) -> EventM x (Dyn x (Identity a))
forall x (m :: * -> *) p.
(Defer (SomeDynInit x) m, Patch p) =>
EventM x (PatchTarget p) -> Event x p -> m (Dyn x p)
Reflex.Spider.Internal.buildDynamic (SpiderPushM x a -> EventM x a
forall a b. Coercible a b => a -> b
coerce SpiderPushM x a
getV0) (Event x (Identity a) -> EventM x (Dyn x (Identity a)))
-> Event x (Identity a) -> EventM x (Dyn x (Identity a))
forall a b. (a -> b) -> a -> b
$ Event x a -> Event x (Identity a)
forall a b. Coercible a b => a -> b
coerce (Event x a -> Event x (Identity a))
-> Event x a -> Event x (Identity a)
forall a b. (a -> b) -> a -> b
$ Event (SpiderTimeline x) a -> Event x a
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent Event (SpiderTimeline x) a
e

instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (SpiderHost x) where
  {-# INLINABLE hold #-}
  hold :: a
-> Event (SpiderTimeline x) a
-> SpiderHost x (Behavior (SpiderTimeline x) a)
hold v0 :: a
v0 e :: Event (SpiderTimeline x) a
e = EventM x (Behavior (SpiderTimeline x) a)
-> SpiderHost x (Behavior (SpiderTimeline x) a)
forall x a. HasSpiderTimeline x => EventM x a -> SpiderHost x a
runFrame (EventM x (Behavior (SpiderTimeline x) a)
 -> SpiderHost x (Behavior (SpiderTimeline x) a))
-> (SpiderHostFrame x (Behavior (SpiderTimeline x) a)
    -> EventM x (Behavior (SpiderTimeline x) a))
-> SpiderHostFrame x (Behavior (SpiderTimeline x) a)
-> SpiderHost x (Behavior (SpiderTimeline x) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpiderHostFrame x (Behavior (SpiderTimeline x) a)
-> EventM x (Behavior (SpiderTimeline x) a)
forall x a. SpiderHostFrame x a -> EventM x a
runSpiderHostFrame (SpiderHostFrame x (Behavior (SpiderTimeline x) a)
 -> SpiderHost x (Behavior (SpiderTimeline x) a))
-> SpiderHostFrame x (Behavior (SpiderTimeline x) a)
-> SpiderHost x (Behavior (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ a
-> Event (SpiderTimeline x) a
-> SpiderHostFrame x (Behavior (SpiderTimeline x) a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
Reflex.Class.hold a
v0 Event (SpiderTimeline x) a
e
  {-# INLINABLE holdDyn #-}
  holdDyn :: a
-> Event (SpiderTimeline x) a
-> SpiderHost x (Dynamic (SpiderTimeline x) a)
holdDyn v0 :: a
v0 e :: Event (SpiderTimeline x) a
e = EventM x (Dynamic (SpiderTimeline x) a)
-> SpiderHost x (Dynamic (SpiderTimeline x) a)
forall x a. HasSpiderTimeline x => EventM x a -> SpiderHost x a
runFrame (EventM x (Dynamic (SpiderTimeline x) a)
 -> SpiderHost x (Dynamic (SpiderTimeline x) a))
-> (SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
    -> EventM x (Dynamic (SpiderTimeline x) a))
-> SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
-> SpiderHost x (Dynamic (SpiderTimeline x) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
-> EventM x (Dynamic (SpiderTimeline x) a)
forall x a. SpiderHostFrame x a -> EventM x a
runSpiderHostFrame (SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
 -> SpiderHost x (Dynamic (SpiderTimeline x) a))
-> SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
-> SpiderHost x (Dynamic (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ a
-> Event (SpiderTimeline x) a
-> SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
Reflex.Class.holdDyn a
v0 Event (SpiderTimeline x) a
e
  {-# INLINABLE holdIncremental #-}
  holdIncremental :: PatchTarget p
-> Event (SpiderTimeline x) p
-> SpiderHost x (Incremental (SpiderTimeline x) p)
holdIncremental v0 :: PatchTarget p
v0 e :: Event (SpiderTimeline x) p
e = EventM x (Incremental (SpiderTimeline x) p)
-> SpiderHost x (Incremental (SpiderTimeline x) p)
forall x a. HasSpiderTimeline x => EventM x a -> SpiderHost x a
runFrame (EventM x (Incremental (SpiderTimeline x) p)
 -> SpiderHost x (Incremental (SpiderTimeline x) p))
-> (SpiderHostFrame x (Incremental (SpiderTimeline x) p)
    -> EventM x (Incremental (SpiderTimeline x) p))
-> SpiderHostFrame x (Incremental (SpiderTimeline x) p)
-> SpiderHost x (Incremental (SpiderTimeline x) p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpiderHostFrame x (Incremental (SpiderTimeline x) p)
-> EventM x (Incremental (SpiderTimeline x) p)
forall x a. SpiderHostFrame x a -> EventM x a
runSpiderHostFrame (SpiderHostFrame x (Incremental (SpiderTimeline x) p)
 -> SpiderHost x (Incremental (SpiderTimeline x) p))
-> SpiderHostFrame x (Incremental (SpiderTimeline x) p)
-> SpiderHost x (Incremental (SpiderTimeline x) p)
forall a b. (a -> b) -> a -> b
$ PatchTarget p
-> Event (SpiderTimeline x) p
-> SpiderHostFrame x (Incremental (SpiderTimeline x) p)
forall k (t :: k) (m :: * -> *) p.
(MonadHold t m, Patch p) =>
PatchTarget p -> Event t p -> m (Incremental t p)
Reflex.Class.holdIncremental PatchTarget p
v0 Event (SpiderTimeline x) p
e
  {-# INLINABLE buildDynamic #-}
  buildDynamic :: PushM (SpiderTimeline x) a
-> Event (SpiderTimeline x) a
-> SpiderHost x (Dynamic (SpiderTimeline x) a)
buildDynamic getV0 :: PushM (SpiderTimeline x) a
getV0 e :: Event (SpiderTimeline x) a
e = EventM x (Dynamic (SpiderTimeline x) a)
-> SpiderHost x (Dynamic (SpiderTimeline x) a)
forall x a. HasSpiderTimeline x => EventM x a -> SpiderHost x a
runFrame (EventM x (Dynamic (SpiderTimeline x) a)
 -> SpiderHost x (Dynamic (SpiderTimeline x) a))
-> (SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
    -> EventM x (Dynamic (SpiderTimeline x) a))
-> SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
-> SpiderHost x (Dynamic (SpiderTimeline x) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
-> EventM x (Dynamic (SpiderTimeline x) a)
forall x a. SpiderHostFrame x a -> EventM x a
runSpiderHostFrame (SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
 -> SpiderHost x (Dynamic (SpiderTimeline x) a))
-> SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
-> SpiderHost x (Dynamic (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ PushM (SpiderTimeline x) a
-> Event (SpiderTimeline x) a
-> SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
PushM t a -> Event t a -> m (Dynamic t a)
Reflex.Class.buildDynamic PushM (SpiderTimeline x) a
getV0 Event (SpiderTimeline x) a
e
  {-# INLINABLE headE #-}
  headE :: Event (SpiderTimeline x) a
-> SpiderHost x (Event (SpiderTimeline x) a)
headE e :: Event (SpiderTimeline x) a
e = EventM x (Event (SpiderTimeline x) a)
-> SpiderHost x (Event (SpiderTimeline x) a)
forall x a. HasSpiderTimeline x => EventM x a -> SpiderHost x a
runFrame (EventM x (Event (SpiderTimeline x) a)
 -> SpiderHost x (Event (SpiderTimeline x) a))
-> (SpiderHostFrame x (Event (SpiderTimeline x) a)
    -> EventM x (Event (SpiderTimeline x) a))
-> SpiderHostFrame x (Event (SpiderTimeline x) a)
-> SpiderHost x (Event (SpiderTimeline x) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpiderHostFrame x (Event (SpiderTimeline x) a)
-> EventM x (Event (SpiderTimeline x) a)
forall x a. SpiderHostFrame x a -> EventM x a
runSpiderHostFrame (SpiderHostFrame x (Event (SpiderTimeline x) a)
 -> SpiderHost x (Event (SpiderTimeline x) a))
-> SpiderHostFrame x (Event (SpiderTimeline x) a)
-> SpiderHost x (Event (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ Event (SpiderTimeline x) a
-> SpiderHostFrame x (Event (SpiderTimeline x) a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
Event t a -> m (Event t a)
Reflex.Class.headE Event (SpiderTimeline x) a
e

instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where
  sample :: Behavior (SpiderTimeline x) a -> SpiderHostFrame x a
sample = EventM x a -> SpiderHostFrame x a
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame (EventM x a -> SpiderHostFrame x a)
-> (Behavior (SpiderTimeline x) a -> EventM x a)
-> Behavior (SpiderTimeline x) a
-> SpiderHostFrame x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior x a -> EventM x a
forall k (x :: k) (m :: * -> *) a.
Defer (SomeHoldInit x) m =>
Behavior x a -> m a
readBehaviorUntracked (Behavior x a -> EventM x a)
-> (Behavior (SpiderTimeline x) a -> Behavior x a)
-> Behavior (SpiderTimeline x) a
-> EventM x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior (SpiderTimeline x) a -> Behavior x a
forall x a. Behavior (SpiderTimeline x) a -> Behavior x a
unSpiderBehavior --TODO: This can cause problems with laziness, so we should get rid of it if we can

instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (SpiderHostFrame x) where
  {-# INLINABLE hold #-}
  hold :: a
-> Event (SpiderTimeline x) a
-> SpiderHostFrame x (Behavior (SpiderTimeline x) a)
hold v0 :: a
v0 e :: Event (SpiderTimeline x) a
e = EventM x (Behavior (SpiderTimeline x) a)
-> SpiderHostFrame x (Behavior (SpiderTimeline x) a)
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame (EventM x (Behavior (SpiderTimeline x) a)
 -> SpiderHostFrame x (Behavior (SpiderTimeline x) a))
-> EventM x (Behavior (SpiderTimeline x) a)
-> SpiderHostFrame x (Behavior (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ (Hold x (Identity a) -> Behavior (SpiderTimeline x) a)
-> EventM x (Hold x (Identity a))
-> EventM x (Behavior (SpiderTimeline x) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Behavior x a -> Behavior (SpiderTimeline x) a
forall x a. Behavior x a -> Behavior (SpiderTimeline x) a
SpiderBehavior (Behavior x a -> Behavior (SpiderTimeline x) a)
-> (Hold x (Identity a) -> Behavior x a)
-> Hold x (Identity a)
-> Behavior (SpiderTimeline x) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hold x (Identity a) -> Behavior x a
forall k (x :: k) a. Hold x (Identity a) -> Behavior x a
behaviorHoldIdentity) (EventM x (Hold x (Identity a))
 -> EventM x (Behavior (SpiderTimeline x) a))
-> EventM x (Hold x (Identity a))
-> EventM x (Behavior (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ PatchTarget (Identity a)
-> Event x (Identity a) -> EventM x (Hold x (Identity a))
forall k p (x :: k) (m :: * -> *).
(Patch p, Defer (SomeHoldInit x) m) =>
PatchTarget p -> Event x p -> m (Hold x p)
Reflex.Spider.Internal.hold a
PatchTarget (Identity a)
v0 (Event x (Identity a) -> EventM x (Hold x (Identity a)))
-> Event x (Identity a) -> EventM x (Hold x (Identity a))
forall a b. (a -> b) -> a -> b
$ Event x a -> Event x (Identity a)
forall a b. Coercible a b => a -> b
coerce (Event x a -> Event x (Identity a))
-> Event x a -> Event x (Identity a)
forall a b. (a -> b) -> a -> b
$ Event (SpiderTimeline x) a -> Event x a
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent Event (SpiderTimeline x) a
e
  {-# INLINABLE holdDyn #-}
  holdDyn :: a
-> Event (SpiderTimeline x) a
-> SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
holdDyn v0 :: a
v0 e :: Event (SpiderTimeline x) a
e = EventM x (Dynamic (SpiderTimeline x) a)
-> SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame (EventM x (Dynamic (SpiderTimeline x) a)
 -> SpiderHostFrame x (Dynamic (SpiderTimeline x) a))
-> EventM x (Dynamic (SpiderTimeline x) a)
-> SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ (Hold x (Identity a) -> Dynamic (SpiderTimeline x) a)
-> EventM x (Hold x (Identity a))
-> EventM x (Dynamic (SpiderTimeline x) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a
forall x a. DynamicS x (Identity a) -> Dynamic (SpiderTimeline x) a
SpiderDynamic (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a)
-> (Hold x (Identity a) -> Dynamic x a (Identity a))
-> Hold x (Identity a)
-> Dynamic (SpiderTimeline x) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hold x (Identity a) -> Dynamic x a (Identity a)
forall k (x :: k) a. Hold x (Identity a) -> DynamicS x (Identity a)
dynamicHoldIdentity) (EventM x (Hold x (Identity a))
 -> EventM x (Dynamic (SpiderTimeline x) a))
-> EventM x (Hold x (Identity a))
-> EventM x (Dynamic (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ PatchTarget (Identity a)
-> Event x (Identity a) -> EventM x (Hold x (Identity a))
forall k p (x :: k) (m :: * -> *).
(Patch p, Defer (SomeHoldInit x) m) =>
PatchTarget p -> Event x p -> m (Hold x p)
Reflex.Spider.Internal.hold a
PatchTarget (Identity a)
v0 (Event x (Identity a) -> EventM x (Hold x (Identity a)))
-> Event x (Identity a) -> EventM x (Hold x (Identity a))
forall a b. (a -> b) -> a -> b
$ Event x a -> Event x (Identity a)
forall a b. Coercible a b => a -> b
coerce (Event x a -> Event x (Identity a))
-> Event x a -> Event x (Identity a)
forall a b. (a -> b) -> a -> b
$ Event (SpiderTimeline x) a -> Event x a
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent Event (SpiderTimeline x) a
e
  {-# INLINABLE holdIncremental #-}
  holdIncremental :: PatchTarget p
-> Event (SpiderTimeline x) p
-> SpiderHostFrame x (Incremental (SpiderTimeline x) p)
holdIncremental v0 :: PatchTarget p
v0 e :: Event (SpiderTimeline x) p
e = EventM x (Incremental (SpiderTimeline x) p)
-> SpiderHostFrame x (Incremental (SpiderTimeline x) p)
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame (EventM x (Incremental (SpiderTimeline x) p)
 -> SpiderHostFrame x (Incremental (SpiderTimeline x) p))
-> EventM x (Incremental (SpiderTimeline x) p)
-> SpiderHostFrame x (Incremental (SpiderTimeline x) p)
forall a b. (a -> b) -> a -> b
$ (Hold x p -> Incremental (SpiderTimeline x) p)
-> EventM x (Hold x p)
-> EventM x (Incremental (SpiderTimeline x) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DynamicS x p -> Incremental (SpiderTimeline x) p
forall x p. DynamicS x p -> Incremental (SpiderTimeline x) p
SpiderIncremental (DynamicS x p -> Incremental (SpiderTimeline x) p)
-> (Hold x p -> DynamicS x p)
-> Hold x p
-> Incremental (SpiderTimeline x) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hold x p -> DynamicS x p
forall k (x :: k) p. Hold x p -> DynamicS x p
dynamicHold) (EventM x (Hold x p)
 -> EventM x (Incremental (SpiderTimeline x) p))
-> EventM x (Hold x p)
-> EventM x (Incremental (SpiderTimeline x) p)
forall a b. (a -> b) -> a -> b
$ PatchTarget p -> Event x p -> EventM x (Hold x p)
forall k p (x :: k) (m :: * -> *).
(Patch p, Defer (SomeHoldInit x) m) =>
PatchTarget p -> Event x p -> m (Hold x p)
Reflex.Spider.Internal.hold PatchTarget p
v0 (Event x p -> EventM x (Hold x p))
-> Event x p -> EventM x (Hold x p)
forall a b. (a -> b) -> a -> b
$ Event (SpiderTimeline x) p -> Event x p
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent Event (SpiderTimeline x) p
e
  {-# INLINABLE buildDynamic #-}
  buildDynamic :: PushM (SpiderTimeline x) a
-> Event (SpiderTimeline x) a
-> SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
buildDynamic getV0 :: PushM (SpiderTimeline x) a
getV0 e :: Event (SpiderTimeline x) a
e = EventM x (Dynamic (SpiderTimeline x) a)
-> SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame (EventM x (Dynamic (SpiderTimeline x) a)
 -> SpiderHostFrame x (Dynamic (SpiderTimeline x) a))
-> EventM x (Dynamic (SpiderTimeline x) a)
-> SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ (Dyn x (Identity a) -> Dynamic (SpiderTimeline x) a)
-> EventM x (Dyn x (Identity a))
-> EventM x (Dynamic (SpiderTimeline x) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a
forall x a. DynamicS x (Identity a) -> Dynamic (SpiderTimeline x) a
SpiderDynamic (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a)
-> (Dyn x (Identity a) -> Dynamic x a (Identity a))
-> Dyn x (Identity a)
-> Dynamic (SpiderTimeline x) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dyn x (Identity a) -> Dynamic x a (Identity a)
forall x a.
HasSpiderTimeline x =>
Dyn x (Identity a) -> DynamicS x (Identity a)
dynamicDynIdentity) (EventM x (Dyn x (Identity a))
 -> EventM x (Dynamic (SpiderTimeline x) a))
-> EventM x (Dyn x (Identity a))
-> EventM x (Dynamic (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ EventM x (PatchTarget (Identity a))
-> Event x (Identity a) -> EventM x (Dyn x (Identity a))
forall x (m :: * -> *) p.
(Defer (SomeDynInit x) m, Patch p) =>
EventM x (PatchTarget p) -> Event x p -> m (Dyn x p)
Reflex.Spider.Internal.buildDynamic (SpiderPushM x a -> EventM x a
forall a b. Coercible a b => a -> b
coerce PushM (SpiderTimeline x) a
SpiderPushM x a
getV0) (Event x (Identity a) -> EventM x (Dyn x (Identity a)))
-> Event x (Identity a) -> EventM x (Dyn x (Identity a))
forall a b. (a -> b) -> a -> b
$ Event x a -> Event x (Identity a)
forall a b. Coercible a b => a -> b
coerce (Event x a -> Event x (Identity a))
-> Event x a -> Event x (Identity a)
forall a b. (a -> b) -> a -> b
$ Event (SpiderTimeline x) a -> Event x a
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent Event (SpiderTimeline x) a
e
  {-# INLINABLE headE #-}
  headE :: Event (SpiderTimeline x) a
-> SpiderHostFrame x (Event (SpiderTimeline x) a)
headE = Event (SpiderTimeline x) a
-> SpiderHostFrame x (Event (SpiderTimeline x) a)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m) =>
Event t a -> m (Event t a)
R.slowHeadE
--  headE (SpiderEvent e) = SpiderHostFrame $ SpiderEvent <$> Reflex.Spider.Internal.headE e

instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHost x) where
  {-# INLINABLE sample #-}
  sample :: Behavior (SpiderTimeline x) a -> SpiderHost x a
sample = EventM x a -> SpiderHost x a
forall x a. HasSpiderTimeline x => EventM x a -> SpiderHost x a
runFrame (EventM x a -> SpiderHost x a)
-> (Behavior (SpiderTimeline x) a -> EventM x a)
-> Behavior (SpiderTimeline x) a
-> SpiderHost x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior x a -> EventM x a
forall k (x :: k) (m :: * -> *) a.
Defer (SomeHoldInit x) m =>
Behavior x a -> m a
readBehaviorUntracked (Behavior x a -> EventM x a)
-> (Behavior (SpiderTimeline x) a -> Behavior x a)
-> Behavior (SpiderTimeline x) a
-> EventM x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior (SpiderTimeline x) a -> Behavior x a
forall x a. Behavior (SpiderTimeline x) a -> Behavior x a
unSpiderBehavior

instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (Reflex.Spider.Internal.ReadPhase x) where
  {-# INLINABLE sample #-}
  sample :: Behavior (SpiderTimeline x) a -> ReadPhase x a
sample = ResultM x a -> ReadPhase x a
forall k (x :: k) a. ResultM x a -> ReadPhase x a
Reflex.Spider.Internal.ReadPhase (ResultM x a -> ReadPhase x a)
-> (Behavior (SpiderTimeline x) a -> ResultM x a)
-> Behavior (SpiderTimeline x) a
-> ReadPhase x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior (SpiderTimeline x) a -> ResultM x a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
Reflex.Class.sample

instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Reflex.Spider.Internal.ReadPhase x) where
  {-# INLINABLE hold #-}
  hold :: a
-> Event (SpiderTimeline x) a
-> ReadPhase x (Behavior (SpiderTimeline x) a)
hold v0 :: a
v0 e :: Event (SpiderTimeline x) a
e = ResultM x (Behavior (SpiderTimeline x) a)
-> ReadPhase x (Behavior (SpiderTimeline x) a)
forall k (x :: k) a. ResultM x a -> ReadPhase x a
Reflex.Spider.Internal.ReadPhase (ResultM x (Behavior (SpiderTimeline x) a)
 -> ReadPhase x (Behavior (SpiderTimeline x) a))
-> ResultM x (Behavior (SpiderTimeline x) a)
-> ReadPhase x (Behavior (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ a
-> Event (SpiderTimeline x) a
-> ResultM x (Behavior (SpiderTimeline x) a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
Reflex.Class.hold a
v0 Event (SpiderTimeline x) a
e
  {-# INLINABLE holdDyn #-}
  holdDyn :: a
-> Event (SpiderTimeline x) a
-> ReadPhase x (Dynamic (SpiderTimeline x) a)
holdDyn v0 :: a
v0 e :: Event (SpiderTimeline x) a
e = ResultM x (Dynamic (SpiderTimeline x) a)
-> ReadPhase x (Dynamic (SpiderTimeline x) a)
forall k (x :: k) a. ResultM x a -> ReadPhase x a
Reflex.Spider.Internal.ReadPhase (ResultM x (Dynamic (SpiderTimeline x) a)
 -> ReadPhase x (Dynamic (SpiderTimeline x) a))
-> ResultM x (Dynamic (SpiderTimeline x) a)
-> ReadPhase x (Dynamic (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ a
-> Event (SpiderTimeline x) a
-> ResultM x (Dynamic (SpiderTimeline x) a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
Reflex.Class.holdDyn a
v0 Event (SpiderTimeline x) a
e
  {-# INLINABLE holdIncremental #-}
  holdIncremental :: PatchTarget p
-> Event (SpiderTimeline x) p
-> ReadPhase x (Incremental (SpiderTimeline x) p)
holdIncremental v0 :: PatchTarget p
v0 e :: Event (SpiderTimeline x) p
e = ResultM x (Incremental (SpiderTimeline x) p)
-> ReadPhase x (Incremental (SpiderTimeline x) p)
forall k (x :: k) a. ResultM x a -> ReadPhase x a
Reflex.Spider.Internal.ReadPhase (ResultM x (Incremental (SpiderTimeline x) p)
 -> ReadPhase x (Incremental (SpiderTimeline x) p))
-> ResultM x (Incremental (SpiderTimeline x) p)
-> ReadPhase x (Incremental (SpiderTimeline x) p)
forall a b. (a -> b) -> a -> b
$ PatchTarget p
-> Event (SpiderTimeline x) p
-> ResultM x (Incremental (SpiderTimeline x) p)
forall k (t :: k) (m :: * -> *) p.
(MonadHold t m, Patch p) =>
PatchTarget p -> Event t p -> m (Incremental t p)
Reflex.Class.holdIncremental PatchTarget p
v0 Event (SpiderTimeline x) p
e
  {-# INLINABLE buildDynamic #-}
  buildDynamic :: PushM (SpiderTimeline x) a
-> Event (SpiderTimeline x) a
-> ReadPhase x (Dynamic (SpiderTimeline x) a)
buildDynamic getV0 :: PushM (SpiderTimeline x) a
getV0 e :: Event (SpiderTimeline x) a
e = ResultM x (Dynamic (SpiderTimeline x) a)
-> ReadPhase x (Dynamic (SpiderTimeline x) a)
forall k (x :: k) a. ResultM x a -> ReadPhase x a
Reflex.Spider.Internal.ReadPhase (ResultM x (Dynamic (SpiderTimeline x) a)
 -> ReadPhase x (Dynamic (SpiderTimeline x) a))
-> ResultM x (Dynamic (SpiderTimeline x) a)
-> ReadPhase x (Dynamic (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ PushM (SpiderTimeline x) a
-> Event (SpiderTimeline x) a
-> ResultM x (Dynamic (SpiderTimeline x) a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
PushM t a -> Event t a -> m (Dynamic t a)
Reflex.Class.buildDynamic PushM (SpiderTimeline x) a
getV0 Event (SpiderTimeline x) a
e
  {-# INLINABLE headE #-}
  headE :: Event (SpiderTimeline x) a
-> ReadPhase x (Event (SpiderTimeline x) a)
headE e :: Event (SpiderTimeline x) a
e = ResultM x (Event (SpiderTimeline x) a)
-> ReadPhase x (Event (SpiderTimeline x) a)
forall k (x :: k) a. ResultM x a -> ReadPhase x a
Reflex.Spider.Internal.ReadPhase (ResultM x (Event (SpiderTimeline x) a)
 -> ReadPhase x (Event (SpiderTimeline x) a))
-> ResultM x (Event (SpiderTimeline x) a)
-> ReadPhase x (Event (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ Event (SpiderTimeline x) a
-> ResultM x (Event (SpiderTimeline x) a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
Event t a -> m (Event t a)
Reflex.Class.headE Event (SpiderTimeline x) a
e

--------------------------------------------------------------------------------
-- Deprecated items
--------------------------------------------------------------------------------

-- | 'SpiderEnv' is the old name for 'SpiderTimeline'
{-# DEPRECATED SpiderEnv "Use 'SpiderTimelineEnv' instead" #-}
type SpiderEnv = SpiderTimeline
instance HasSpiderTimeline x => Reflex.Host.Class.MonadSubscribeEvent (SpiderTimeline x) (SpiderHostFrame x) where
  {-# INLINABLE subscribeEvent #-}
  subscribeEvent :: Event (SpiderTimeline x) a
-> SpiderHostFrame x (EventHandle (SpiderTimeline x) a)
subscribeEvent e :: Event (SpiderTimeline x) a
e = EventM x (SpiderEventHandle x a)
-> SpiderHostFrame x (EventHandle (SpiderTimeline x) a)
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame (EventM x (SpiderEventHandle x a)
 -> SpiderHostFrame x (EventHandle (SpiderTimeline x) a))
-> EventM x (SpiderEventHandle x a)
-> SpiderHostFrame x (EventHandle (SpiderTimeline x) a)
forall a b. (a -> b) -> a -> b
$ do
    --TODO: Unsubscribe eventually (manually and/or with weak ref)
    IORef (Maybe a)
val <- IO (IORef (Maybe a)) -> EventM x (IORef (Maybe a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe a)) -> EventM x (IORef (Maybe a)))
-> IO (IORef (Maybe a)) -> EventM x (IORef (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> IO (IORef (Maybe a))
forall a. a -> IO (IORef a)
newIORef Maybe a
forall a. Maybe a
Nothing
    EventSubscription x
subscription <- Event x a -> Subscriber x a -> EventM x (EventSubscription x)
forall k (x :: k) a.
Event x a -> Subscriber x a -> EventM x (EventSubscription x)
subscribe (Event (SpiderTimeline x) a -> Event x a
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent Event (SpiderTimeline x) a
e) (Subscriber x a -> EventM x (EventSubscription x))
-> Subscriber x a -> EventM x (EventSubscription x)
forall a b. (a -> b) -> a -> b
$ $WSubscriber :: forall k (x :: k) a.
(a -> EventM x ())
-> (Height -> IO ()) -> (Height -> IO ()) -> Subscriber x a
Subscriber
      { subscriberPropagate :: a -> EventM x ()
subscriberPropagate = \a :: a
a -> do
          IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe a) -> Maybe a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe a)
val (Maybe a -> IO ()) -> Maybe a -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
a
          IORef (Maybe a) -> EventM x ()
forall (m :: * -> *) a.
Defer (Some Clear) m =>
IORef (Maybe a) -> m ()
scheduleClear IORef (Maybe a)
val
      , subscriberInvalidateHeight :: Height -> IO ()
subscriberInvalidateHeight = \_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = \_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      }
    SpiderEventHandle x a -> EventM x (SpiderEventHandle x a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SpiderEventHandle x a -> EventM x (SpiderEventHandle x a))
-> SpiderEventHandle x a -> EventM x (SpiderEventHandle x a)
forall a b. (a -> b) -> a -> b
$ SpiderEventHandle :: forall k (x :: k) a.
EventSubscription x -> IORef (Maybe a) -> SpiderEventHandle x a
SpiderEventHandle
      { spiderEventHandleSubscription :: EventSubscription x
spiderEventHandleSubscription = EventSubscription x
subscription
      , spiderEventHandleValue :: IORef (Maybe a)
spiderEventHandleValue = IORef (Maybe a)
val
      }

instance HasSpiderTimeline x => Reflex.Host.Class.ReflexHost (SpiderTimeline x) where
  type EventTrigger (SpiderTimeline x) = RootTrigger x
  type EventHandle (SpiderTimeline x) = SpiderEventHandle x
  type HostFrame (SpiderTimeline x) = SpiderHostFrame x

instance HasSpiderTimeline x => Reflex.Host.Class.MonadReadEvent (SpiderTimeline x) (Reflex.Spider.Internal.ReadPhase x) where
  {-# NOINLINE readEvent #-}
  readEvent :: EventHandle (SpiderTimeline x) a
-> ReadPhase x (Maybe (ReadPhase x a))
readEvent h :: EventHandle (SpiderTimeline x) a
h = ResultM x (Maybe (ReadPhase x a))
-> ReadPhase x (Maybe (ReadPhase x a))
forall k (x :: k) a. ResultM x a -> ReadPhase x a
Reflex.Spider.Internal.ReadPhase (ResultM x (Maybe (ReadPhase x a))
 -> ReadPhase x (Maybe (ReadPhase x a)))
-> ResultM x (Maybe (ReadPhase x a))
-> ReadPhase x (Maybe (ReadPhase x a))
forall a b. (a -> b) -> a -> b
$ (Maybe a -> Maybe (ReadPhase x a))
-> EventM x (Maybe a) -> ResultM x (Maybe (ReadPhase x a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> ReadPhase x a) -> Maybe a -> Maybe (ReadPhase x a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ReadPhase x a
forall (m :: * -> *) a. Monad m => a -> m a
return) (EventM x (Maybe a) -> ResultM x (Maybe (ReadPhase x a)))
-> EventM x (Maybe a) -> ResultM x (Maybe (ReadPhase x a))
forall a b. (a -> b) -> a -> b
$ IO (Maybe a) -> EventM x (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> EventM x (Maybe a))
-> IO (Maybe a) -> EventM x (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
    Maybe a
result <- IORef (Maybe a) -> IO (Maybe a)
forall a. IORef a -> IO a
readIORef (IORef (Maybe a) -> IO (Maybe a))
-> IORef (Maybe a) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ SpiderEventHandle x a -> IORef (Maybe a)
forall k (x :: k) a. SpiderEventHandle x a -> IORef (Maybe a)
spiderEventHandleValue EventHandle (SpiderTimeline x) a
SpiderEventHandle x a
h
    SpiderEventHandle x a -> IO ()
forall (m :: * -> *) a. PrimMonad m => a -> m ()
touch EventHandle (SpiderTimeline x) a
SpiderEventHandle x a
h
    Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
result

instance HasSpiderTimeline x => Reflex.Host.Class.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHost x) where
  newEventWithTrigger :: (EventTrigger (SpiderTimeline x) a -> IO (IO ()))
-> SpiderHost x (Event (SpiderTimeline x) a)
newEventWithTrigger = IO (Event (SpiderTimeline x) a)
-> SpiderHost x (Event (SpiderTimeline x) a)
forall x a. IO a -> SpiderHost x a
SpiderHost (IO (Event (SpiderTimeline x) a)
 -> SpiderHost x (Event (SpiderTimeline x) a))
-> ((RootTrigger x a -> IO (IO ()))
    -> IO (Event (SpiderTimeline x) a))
-> (RootTrigger x a -> IO (IO ()))
-> SpiderHost x (Event (SpiderTimeline x) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event x a -> Event (SpiderTimeline x) a)
-> IO (Event x a) -> IO (Event (SpiderTimeline x) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Event x a -> Event (SpiderTimeline x) a
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (IO (Event x a) -> IO (Event (SpiderTimeline x) a))
-> ((RootTrigger x a -> IO (IO ())) -> IO (Event x a))
-> (RootTrigger x a -> IO (IO ()))
-> IO (Event (SpiderTimeline x) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RootTrigger x a -> IO (IO ())) -> IO (Event x a)
forall x a.
HasSpiderTimeline x =>
(RootTrigger x a -> IO (IO ())) -> IO (Event x a)
newEventWithTriggerIO
  newFanEventWithTrigger :: (forall a. k a -> EventTrigger (SpiderTimeline x) a -> IO (IO ()))
-> SpiderHost x (EventSelector (SpiderTimeline x) k)
newFanEventWithTrigger f :: forall a. k a -> EventTrigger (SpiderTimeline x) a -> IO (IO ())
f = IO (EventSelector (SpiderTimeline x) k)
-> SpiderHost x (EventSelector (SpiderTimeline x) k)
forall x a. IO a -> SpiderHost x a
SpiderHost (IO (EventSelector (SpiderTimeline x) k)
 -> SpiderHost x (EventSelector (SpiderTimeline x) k))
-> IO (EventSelector (SpiderTimeline x) k)
-> SpiderHost x (EventSelector (SpiderTimeline x) k)
forall a b. (a -> b) -> a -> b
$ do
    EventSelector x k
es <- (forall a. k a -> RootTrigger x a -> IO (IO ()))
-> IO (EventSelector x k)
forall x (k :: * -> *).
(HasSpiderTimeline x, GCompare k) =>
(forall a. k a -> RootTrigger x a -> IO (IO ()))
-> IO (EventSelector x k)
newFanEventWithTriggerIO forall a. k a -> EventTrigger (SpiderTimeline x) a -> IO (IO ())
forall a. k a -> RootTrigger x a -> IO (IO ())
f
    EventSelector (SpiderTimeline x) k
-> IO (EventSelector (SpiderTimeline x) k)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventSelector (SpiderTimeline x) k
 -> IO (EventSelector (SpiderTimeline x) k))
-> EventSelector (SpiderTimeline x) k
-> IO (EventSelector (SpiderTimeline x) k)
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> Event (SpiderTimeline x) a)
-> EventSelector (SpiderTimeline x) k
forall k (t :: k) (k :: * -> *).
(forall a. k a -> Event t a) -> EventSelector t k
Reflex.Class.EventSelector ((forall a. k a -> Event (SpiderTimeline x) a)
 -> EventSelector (SpiderTimeline x) k)
-> (forall a. k a -> Event (SpiderTimeline x) a)
-> EventSelector (SpiderTimeline x) k
forall a b. (a -> b) -> a -> b
$ Event x a -> Event (SpiderTimeline x) a
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (Event x a -> Event (SpiderTimeline x) a)
-> (k a -> Event x a) -> k a -> Event (SpiderTimeline x) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventSelector x k -> forall a. k a -> Event x a
forall k (x :: k) (k :: * -> *).
EventSelector x k -> forall a. k a -> Event x a
Reflex.Spider.Internal.select EventSelector x k
es

instance HasSpiderTimeline x => Reflex.Host.Class.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHostFrame x) where
  newEventWithTrigger :: (EventTrigger (SpiderTimeline x) a -> IO (IO ()))
-> SpiderHostFrame x (Event (SpiderTimeline x) a)
newEventWithTrigger = EventM x (Event (SpiderTimeline x) a)
-> SpiderHostFrame x (Event (SpiderTimeline x) a)
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame (EventM x (Event (SpiderTimeline x) a)
 -> SpiderHostFrame x (Event (SpiderTimeline x) a))
-> ((RootTrigger x a -> IO (IO ()))
    -> EventM x (Event (SpiderTimeline x) a))
-> (RootTrigger x a -> IO (IO ()))
-> SpiderHostFrame x (Event (SpiderTimeline x) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Event (SpiderTimeline x) a)
-> EventM x (Event (SpiderTimeline x) a)
forall k (x :: k) a. IO a -> EventM x a
EventM (IO (Event (SpiderTimeline x) a)
 -> EventM x (Event (SpiderTimeline x) a))
-> ((RootTrigger x a -> IO (IO ()))
    -> IO (Event (SpiderTimeline x) a))
-> (RootTrigger x a -> IO (IO ()))
-> EventM x (Event (SpiderTimeline x) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Event (SpiderTimeline x) a) -> IO (Event (SpiderTimeline x) a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Event (SpiderTimeline x) a)
 -> IO (Event (SpiderTimeline x) a))
-> ((RootTrigger x a -> IO (IO ()))
    -> IO (Event (SpiderTimeline x) a))
-> (RootTrigger x a -> IO (IO ()))
-> IO (Event (SpiderTimeline x) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event x a -> Event (SpiderTimeline x) a)
-> IO (Event x a) -> IO (Event (SpiderTimeline x) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Event x a -> Event (SpiderTimeline x) a
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (IO (Event x a) -> IO (Event (SpiderTimeline x) a))
-> ((RootTrigger x a -> IO (IO ())) -> IO (Event x a))
-> (RootTrigger x a -> IO (IO ()))
-> IO (Event (SpiderTimeline x) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RootTrigger x a -> IO (IO ())) -> IO (Event x a)
forall x a.
HasSpiderTimeline x =>
(RootTrigger x a -> IO (IO ())) -> IO (Event x a)
newEventWithTriggerIO
  newFanEventWithTrigger :: (forall a. k a -> EventTrigger (SpiderTimeline x) a -> IO (IO ()))
-> SpiderHostFrame x (EventSelector (SpiderTimeline x) k)
newFanEventWithTrigger f :: forall a. k a -> EventTrigger (SpiderTimeline x) a -> IO (IO ())
f = EventM x (EventSelector (SpiderTimeline x) k)
-> SpiderHostFrame x (EventSelector (SpiderTimeline x) k)
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame (EventM x (EventSelector (SpiderTimeline x) k)
 -> SpiderHostFrame x (EventSelector (SpiderTimeline x) k))
-> EventM x (EventSelector (SpiderTimeline x) k)
-> SpiderHostFrame x (EventSelector (SpiderTimeline x) k)
forall a b. (a -> b) -> a -> b
$ IO (EventSelector (SpiderTimeline x) k)
-> EventM x (EventSelector (SpiderTimeline x) k)
forall k (x :: k) a. IO a -> EventM x a
EventM (IO (EventSelector (SpiderTimeline x) k)
 -> EventM x (EventSelector (SpiderTimeline x) k))
-> IO (EventSelector (SpiderTimeline x) k)
-> EventM x (EventSelector (SpiderTimeline x) k)
forall a b. (a -> b) -> a -> b
$ IO (EventSelector (SpiderTimeline x) k)
-> IO (EventSelector (SpiderTimeline x) k)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (EventSelector (SpiderTimeline x) k)
 -> IO (EventSelector (SpiderTimeline x) k))
-> IO (EventSelector (SpiderTimeline x) k)
-> IO (EventSelector (SpiderTimeline x) k)
forall a b. (a -> b) -> a -> b
$ do
    EventSelector x k
es <- (forall a. k a -> RootTrigger x a -> IO (IO ()))
-> IO (EventSelector x k)
forall x (k :: * -> *).
(HasSpiderTimeline x, GCompare k) =>
(forall a. k a -> RootTrigger x a -> IO (IO ()))
-> IO (EventSelector x k)
newFanEventWithTriggerIO forall a. k a -> EventTrigger (SpiderTimeline x) a -> IO (IO ())
forall a. k a -> RootTrigger x a -> IO (IO ())
f
    EventSelector (SpiderTimeline x) k
-> IO (EventSelector (SpiderTimeline x) k)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventSelector (SpiderTimeline x) k
 -> IO (EventSelector (SpiderTimeline x) k))
-> EventSelector (SpiderTimeline x) k
-> IO (EventSelector (SpiderTimeline x) k)
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> Event (SpiderTimeline x) a)
-> EventSelector (SpiderTimeline x) k
forall k (t :: k) (k :: * -> *).
(forall a. k a -> Event t a) -> EventSelector t k
Reflex.Class.EventSelector ((forall a. k a -> Event (SpiderTimeline x) a)
 -> EventSelector (SpiderTimeline x) k)
-> (forall a. k a -> Event (SpiderTimeline x) a)
-> EventSelector (SpiderTimeline x) k
forall a b. (a -> b) -> a -> b
$ Event x a -> Event (SpiderTimeline x) a
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (Event x a -> Event (SpiderTimeline x) a)
-> (k a -> Event x a) -> k a -> Event (SpiderTimeline x) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventSelector x k -> forall a. k a -> Event x a
forall k (x :: k) (k :: * -> *).
EventSelector x k -> forall a. k a -> Event x a
Reflex.Spider.Internal.select EventSelector x k
es

instance HasSpiderTimeline x => Reflex.Host.Class.MonadSubscribeEvent (SpiderTimeline x) (SpiderHost x) where
  {-# INLINABLE subscribeEvent #-}
  subscribeEvent :: Event (SpiderTimeline x) a
-> SpiderHost x (EventHandle (SpiderTimeline x) a)
subscribeEvent = EventM x (SpiderEventHandle x a)
-> SpiderHost x (SpiderEventHandle x a)
forall x a. HasSpiderTimeline x => EventM x a -> SpiderHost x a
runFrame (EventM x (SpiderEventHandle x a)
 -> SpiderHost x (SpiderEventHandle x a))
-> (Event (SpiderTimeline x) a -> EventM x (SpiderEventHandle x a))
-> Event (SpiderTimeline x) a
-> SpiderHost x (SpiderEventHandle x a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpiderHostFrame x (SpiderEventHandle x a)
-> EventM x (SpiderEventHandle x a)
forall x a. SpiderHostFrame x a -> EventM x a
runSpiderHostFrame (SpiderHostFrame x (SpiderEventHandle x a)
 -> EventM x (SpiderEventHandle x a))
-> (Event (SpiderTimeline x) a
    -> SpiderHostFrame x (SpiderEventHandle x a))
-> Event (SpiderTimeline x) a
-> EventM x (SpiderEventHandle x a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event (SpiderTimeline x) a
-> SpiderHostFrame x (SpiderEventHandle x a)
forall t (m :: * -> *) a.
MonadSubscribeEvent t m =>
Event t a -> m (EventHandle t a)
Reflex.Host.Class.subscribeEvent

instance HasSpiderTimeline x => Reflex.Host.Class.MonadReflexHost (SpiderTimeline x) (SpiderHost x) where
  type ReadPhase (SpiderHost x) = Reflex.Spider.Internal.ReadPhase x
  fireEventsAndRead :: [DSum (EventTrigger (SpiderTimeline x)) Identity]
-> ReadPhase (SpiderHost x) a -> SpiderHost x a
fireEventsAndRead es :: [DSum (EventTrigger (SpiderTimeline x)) Identity]
es (Reflex.Spider.Internal.ReadPhase a) = [DSum (RootTrigger x) Identity] -> ResultM x a -> SpiderHost x a
forall x b.
HasSpiderTimeline x =>
[DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b
run [DSum (EventTrigger (SpiderTimeline x)) Identity]
[DSum (RootTrigger x) Identity]
es ResultM x a
a
  runHostFrame :: HostFrame (SpiderTimeline x) a -> SpiderHost x a
runHostFrame = EventM x a -> SpiderHost x a
forall x a. HasSpiderTimeline x => EventM x a -> SpiderHost x a
runFrame (EventM x a -> SpiderHost x a)
-> (SpiderHostFrame x a -> EventM x a)
-> SpiderHostFrame x a
-> SpiderHost x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpiderHostFrame x a -> EventM x a
forall x a. SpiderHostFrame x a -> EventM x a
runSpiderHostFrame

unsafeNewSpiderTimelineEnv :: forall x. IO (SpiderTimelineEnv x)
unsafeNewSpiderTimelineEnv :: IO (SpiderTimelineEnv x)
unsafeNewSpiderTimelineEnv = do
  MVar ()
lock <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
  EventEnv x
env <- IO (EventEnv x)
forall x. IO (EventEnv x)
newEventEnv
#ifdef DEBUG
  depthRef <- newIORef 0
#endif
  SpiderTimelineEnv x -> IO (SpiderTimelineEnv x)
forall (m :: * -> *) a. Monad m => a -> m a
return (SpiderTimelineEnv x -> IO (SpiderTimelineEnv x))
-> SpiderTimelineEnv x -> IO (SpiderTimelineEnv x)
forall a b. (a -> b) -> a -> b
$ SpiderTimelineEnv' x -> SpiderTimelineEnv x
forall x. SpiderTimelineEnv' x -> SpiderTimelineEnv x
STE (SpiderTimelineEnv' x -> SpiderTimelineEnv x)
-> SpiderTimelineEnv' x -> SpiderTimelineEnv x
forall a b. (a -> b) -> a -> b
$ $WSpiderTimelineEnv :: forall x. MVar () -> EventEnv x -> SpiderTimelineEnv' x
SpiderTimelineEnv
    { _spiderTimeline_lock :: MVar ()
_spiderTimeline_lock = MVar ()
lock
    , _spiderTimeline_eventEnv :: EventEnv x
_spiderTimeline_eventEnv = EventEnv x
env
#ifdef DEBUG
    , _spiderTimeline_depth = depthRef
#endif
    }

-- | Create a new SpiderTimelineEnv
newSpiderTimeline :: IO (Some SpiderTimelineEnv)
newSpiderTimeline :: IO (Some SpiderTimelineEnv)
newSpiderTimeline = (forall x.
 HasSpiderTimeline x =>
 SpiderTimelineEnv x -> IO (Some SpiderTimelineEnv))
-> IO (Some SpiderTimelineEnv)
forall r.
(forall x. HasSpiderTimeline x => SpiderTimelineEnv x -> IO r)
-> IO r
withSpiderTimeline (Some SpiderTimelineEnv -> IO (Some SpiderTimelineEnv)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Some SpiderTimelineEnv -> IO (Some SpiderTimelineEnv))
-> (SpiderTimelineEnv x -> Some SpiderTimelineEnv)
-> SpiderTimelineEnv x
-> IO (Some SpiderTimelineEnv)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpiderTimelineEnv x -> Some SpiderTimelineEnv
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some)

data LocalSpiderTimeline (x :: Type) s

instance Reifies s (SpiderTimelineEnv x) =>
         HasSpiderTimeline (LocalSpiderTimeline x s) where
  spiderTimeline :: SpiderTimelineEnv (LocalSpiderTimeline x s)
spiderTimeline = Proxy s
-> SpiderTimelineEnv x
-> SpiderTimelineEnv (LocalSpiderTimeline x s)
forall k (proxy :: k -> *) (s :: k) x.
proxy s
-> SpiderTimelineEnv x
-> SpiderTimelineEnv (LocalSpiderTimeline x s)
localSpiderTimeline Proxy s
forall k (t :: k). Proxy t
Proxy (SpiderTimelineEnv x
 -> SpiderTimelineEnv (LocalSpiderTimeline x s))
-> SpiderTimelineEnv x
-> SpiderTimelineEnv (LocalSpiderTimeline x s)
forall a b. (a -> b) -> a -> b
$ Proxy s -> SpiderTimelineEnv x
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
reflect (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s)

localSpiderTimeline
  :: proxy s
  -> SpiderTimelineEnv x
  -> SpiderTimelineEnv (LocalSpiderTimeline x s)
localSpiderTimeline :: proxy s
-> SpiderTimelineEnv x
-> SpiderTimelineEnv (LocalSpiderTimeline x s)
localSpiderTimeline _ = SpiderTimelineEnv x -> SpiderTimelineEnv (LocalSpiderTimeline x s)
forall a b. Coercible a b => a -> b
coerce

-- | Pass a new timeline to the given function.
withSpiderTimeline :: (forall x. HasSpiderTimeline x => SpiderTimelineEnv x -> IO r) -> IO r
withSpiderTimeline :: (forall x. HasSpiderTimeline x => SpiderTimelineEnv x -> IO r)
-> IO r
withSpiderTimeline k :: forall x. HasSpiderTimeline x => SpiderTimelineEnv x -> IO r
k = do
  SpiderTimelineEnv Any
env <- IO (SpiderTimelineEnv Any)
forall x. IO (SpiderTimelineEnv x)
unsafeNewSpiderTimelineEnv
  SpiderTimelineEnv Any
-> (forall s. Reifies s (SpiderTimelineEnv Any) => Proxy s -> IO r)
-> IO r
forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r
reify SpiderTimelineEnv Any
env ((forall s. Reifies s (SpiderTimelineEnv Any) => Proxy s -> IO r)
 -> IO r)
-> (forall s. Reifies s (SpiderTimelineEnv Any) => Proxy s -> IO r)
-> IO r
forall a b. (a -> b) -> a -> b
$ \s :: Proxy s
s -> SpiderTimelineEnv (LocalSpiderTimeline Any s) -> IO r
forall x. HasSpiderTimeline x => SpiderTimelineEnv x -> IO r
k (SpiderTimelineEnv (LocalSpiderTimeline Any s) -> IO r)
-> SpiderTimelineEnv (LocalSpiderTimeline Any s) -> IO r
forall a b. (a -> b) -> a -> b
$ Proxy s
-> SpiderTimelineEnv Any
-> SpiderTimelineEnv (LocalSpiderTimeline Any s)
forall k (proxy :: k -> *) (s :: k) x.
proxy s
-> SpiderTimelineEnv x
-> SpiderTimelineEnv (LocalSpiderTimeline x s)
localSpiderTimeline Proxy s
s SpiderTimelineEnv Any
env

newtype SpiderPullM (x :: Type) a = SpiderPullM (BehaviorM x a) deriving (a -> SpiderPullM x b -> SpiderPullM x a
(a -> b) -> SpiderPullM x a -> SpiderPullM x b
(forall a b. (a -> b) -> SpiderPullM x a -> SpiderPullM x b)
-> (forall a b. a -> SpiderPullM x b -> SpiderPullM x a)
-> Functor (SpiderPullM x)
forall a b. a -> SpiderPullM x b -> SpiderPullM x a
forall a b. (a -> b) -> SpiderPullM x a -> SpiderPullM x b
forall x a b. a -> SpiderPullM x b -> SpiderPullM x a
forall x a b. (a -> b) -> SpiderPullM x a -> SpiderPullM x b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SpiderPullM x b -> SpiderPullM x a
$c<$ :: forall x a b. a -> SpiderPullM x b -> SpiderPullM x a
fmap :: (a -> b) -> SpiderPullM x a -> SpiderPullM x b
$cfmap :: forall x a b. (a -> b) -> SpiderPullM x a -> SpiderPullM x b
Functor, Functor (SpiderPullM x)
a -> SpiderPullM x a
Functor (SpiderPullM x) =>
(forall a. a -> SpiderPullM x a)
-> (forall a b.
    SpiderPullM x (a -> b) -> SpiderPullM x a -> SpiderPullM x b)
-> (forall a b c.
    (a -> b -> c)
    -> SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x c)
-> (forall a b.
    SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x b)
-> (forall a b.
    SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x a)
-> Applicative (SpiderPullM x)
SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x b
SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x a
SpiderPullM x (a -> b) -> SpiderPullM x a -> SpiderPullM x b
(a -> b -> c)
-> SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x c
forall x. Functor (SpiderPullM x)
forall a. a -> SpiderPullM x a
forall x a. a -> SpiderPullM x a
forall a b. SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x a
forall a b. SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x b
forall a b.
SpiderPullM x (a -> b) -> SpiderPullM x a -> SpiderPullM x b
forall x a b. SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x a
forall x a b. SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x b
forall x a b.
SpiderPullM x (a -> b) -> SpiderPullM x a -> SpiderPullM x b
forall a b c.
(a -> b -> c)
-> SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x c
forall x a b c.
(a -> b -> c)
-> SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x a
$c<* :: forall x a b. SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x a
*> :: SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x b
$c*> :: forall x a b. SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x b
liftA2 :: (a -> b -> c)
-> SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x c
$cliftA2 :: forall x a b c.
(a -> b -> c)
-> SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x c
<*> :: SpiderPullM x (a -> b) -> SpiderPullM x a -> SpiderPullM x b
$c<*> :: forall x a b.
SpiderPullM x (a -> b) -> SpiderPullM x a -> SpiderPullM x b
pure :: a -> SpiderPullM x a
$cpure :: forall x a. a -> SpiderPullM x a
$cp1Applicative :: forall x. Functor (SpiderPullM x)
Applicative, Applicative (SpiderPullM x)
a -> SpiderPullM x a
Applicative (SpiderPullM x) =>
(forall a b.
 SpiderPullM x a -> (a -> SpiderPullM x b) -> SpiderPullM x b)
-> (forall a b.
    SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x b)
-> (forall a. a -> SpiderPullM x a)
-> Monad (SpiderPullM x)
SpiderPullM x a -> (a -> SpiderPullM x b) -> SpiderPullM x b
SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x b
forall x. Applicative (SpiderPullM x)
forall a. a -> SpiderPullM x a
forall x a. a -> SpiderPullM x a
forall a b. SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x b
forall a b.
SpiderPullM x a -> (a -> SpiderPullM x b) -> SpiderPullM x b
forall x a b. SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x b
forall x a b.
SpiderPullM x a -> (a -> SpiderPullM x b) -> SpiderPullM x b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> SpiderPullM x a
$creturn :: forall x a. a -> SpiderPullM x a
>> :: SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x b
$c>> :: forall x a b. SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x b
>>= :: SpiderPullM x a -> (a -> SpiderPullM x b) -> SpiderPullM x b
$c>>= :: forall x a b.
SpiderPullM x a -> (a -> SpiderPullM x b) -> SpiderPullM x b
$cp1Monad :: forall x. Applicative (SpiderPullM x)
Monad, Monad (SpiderPullM x)
Monad (SpiderPullM x) =>
(forall a. IO a -> SpiderPullM x a) -> MonadIO (SpiderPullM x)
IO a -> SpiderPullM x a
forall x. Monad (SpiderPullM x)
forall a. IO a -> SpiderPullM x a
forall x a. IO a -> SpiderPullM x a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> SpiderPullM x a
$cliftIO :: forall x a. IO a -> SpiderPullM x a
$cp1MonadIO :: forall x. Monad (SpiderPullM x)
MonadIO, Monad (SpiderPullM x)
Monad (SpiderPullM x) =>
(forall a. (a -> SpiderPullM x a) -> SpiderPullM x a)
-> MonadFix (SpiderPullM x)
(a -> SpiderPullM x a) -> SpiderPullM x a
forall x. Monad (SpiderPullM x)
forall a. (a -> SpiderPullM x a) -> SpiderPullM x a
forall x a. (a -> SpiderPullM x a) -> SpiderPullM x a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> SpiderPullM x a) -> SpiderPullM x a
$cmfix :: forall x a. (a -> SpiderPullM x a) -> SpiderPullM x a
$cp1MonadFix :: forall x. Monad (SpiderPullM x)
MonadFix)

type ComputeM = EventM

newtype SpiderPushM (x :: Type) a = SpiderPushM (ComputeM x a) deriving (a -> SpiderPushM x b -> SpiderPushM x a
(a -> b) -> SpiderPushM x a -> SpiderPushM x b
(forall a b. (a -> b) -> SpiderPushM x a -> SpiderPushM x b)
-> (forall a b. a -> SpiderPushM x b -> SpiderPushM x a)
-> Functor (SpiderPushM x)
forall a b. a -> SpiderPushM x b -> SpiderPushM x a
forall a b. (a -> b) -> SpiderPushM x a -> SpiderPushM x b
forall x a b. a -> SpiderPushM x b -> SpiderPushM x a
forall x a b. (a -> b) -> SpiderPushM x a -> SpiderPushM x b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SpiderPushM x b -> SpiderPushM x a
$c<$ :: forall x a b. a -> SpiderPushM x b -> SpiderPushM x a
fmap :: (a -> b) -> SpiderPushM x a -> SpiderPushM x b
$cfmap :: forall x a b. (a -> b) -> SpiderPushM x a -> SpiderPushM x b
Functor, Functor (SpiderPushM x)
a -> SpiderPushM x a
Functor (SpiderPushM x) =>
(forall a. a -> SpiderPushM x a)
-> (forall a b.
    SpiderPushM x (a -> b) -> SpiderPushM x a -> SpiderPushM x b)
-> (forall a b c.
    (a -> b -> c)
    -> SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x c)
-> (forall a b.
    SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x b)
-> (forall a b.
    SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x a)
-> Applicative (SpiderPushM x)
SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x b
SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x a
SpiderPushM x (a -> b) -> SpiderPushM x a -> SpiderPushM x b
(a -> b -> c)
-> SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x c
forall x. Functor (SpiderPushM x)
forall a. a -> SpiderPushM x a
forall x a. a -> SpiderPushM x a
forall a b. SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x a
forall a b. SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x b
forall a b.
SpiderPushM x (a -> b) -> SpiderPushM x a -> SpiderPushM x b
forall x a b. SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x a
forall x a b. SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x b
forall x a b.
SpiderPushM x (a -> b) -> SpiderPushM x a -> SpiderPushM x b
forall a b c.
(a -> b -> c)
-> SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x c
forall x a b c.
(a -> b -> c)
-> SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x a
$c<* :: forall x a b. SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x a
*> :: SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x b
$c*> :: forall x a b. SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x b
liftA2 :: (a -> b -> c)
-> SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x c
$cliftA2 :: forall x a b c.
(a -> b -> c)
-> SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x c
<*> :: SpiderPushM x (a -> b) -> SpiderPushM x a -> SpiderPushM x b
$c<*> :: forall x a b.
SpiderPushM x (a -> b) -> SpiderPushM x a -> SpiderPushM x b
pure :: a -> SpiderPushM x a
$cpure :: forall x a. a -> SpiderPushM x a
$cp1Applicative :: forall x. Functor (SpiderPushM x)
Applicative, Applicative (SpiderPushM x)
a -> SpiderPushM x a
Applicative (SpiderPushM x) =>
(forall a b.
 SpiderPushM x a -> (a -> SpiderPushM x b) -> SpiderPushM x b)
-> (forall a b.
    SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x b)
-> (forall a. a -> SpiderPushM x a)
-> Monad (SpiderPushM x)
SpiderPushM x a -> (a -> SpiderPushM x b) -> SpiderPushM x b
SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x b
forall x. Applicative (SpiderPushM x)
forall a. a -> SpiderPushM x a
forall x a. a -> SpiderPushM x a
forall a b. SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x b
forall a b.
SpiderPushM x a -> (a -> SpiderPushM x b) -> SpiderPushM x b
forall x a b. SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x b
forall x a b.
SpiderPushM x a -> (a -> SpiderPushM x b) -> SpiderPushM x b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> SpiderPushM x a
$creturn :: forall x a. a -> SpiderPushM x a
>> :: SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x b
$c>> :: forall x a b. SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x b
>>= :: SpiderPushM x a -> (a -> SpiderPushM x b) -> SpiderPushM x b
$c>>= :: forall x a b.
SpiderPushM x a -> (a -> SpiderPushM x b) -> SpiderPushM x b
$cp1Monad :: forall x. Applicative (SpiderPushM x)
Monad, Monad (SpiderPushM x)
Monad (SpiderPushM x) =>
(forall a. IO a -> SpiderPushM x a) -> MonadIO (SpiderPushM x)
IO a -> SpiderPushM x a
forall x. Monad (SpiderPushM x)
forall a. IO a -> SpiderPushM x a
forall x a. IO a -> SpiderPushM x a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> SpiderPushM x a
$cliftIO :: forall x a. IO a -> SpiderPushM x a
$cp1MonadIO :: forall x. Monad (SpiderPushM x)
MonadIO, Monad (SpiderPushM x)
Monad (SpiderPushM x) =>
(forall a. (a -> SpiderPushM x a) -> SpiderPushM x a)
-> MonadFix (SpiderPushM x)
(a -> SpiderPushM x a) -> SpiderPushM x a
forall x. Monad (SpiderPushM x)
forall a. (a -> SpiderPushM x a) -> SpiderPushM x a
forall x a. (a -> SpiderPushM x a) -> SpiderPushM x a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> SpiderPushM x a) -> SpiderPushM x a
$cmfix :: forall x a. (a -> SpiderPushM x a) -> SpiderPushM x a
$cp1MonadFix :: forall x. Monad (SpiderPushM x)
MonadFix)

instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where
  {-# SPECIALIZE instance R.Reflex (SpiderTimeline Global) #-}
  newtype Behavior (SpiderTimeline x) a = SpiderBehavior { Behavior (SpiderTimeline x) a -> Behavior x a
unSpiderBehavior :: Behavior x a }
  newtype Event (SpiderTimeline x) a = SpiderEvent { Event (SpiderTimeline x) a -> Event x a
unSpiderEvent :: Event x a }
  newtype Dynamic (SpiderTimeline x) a = SpiderDynamic { Dynamic (SpiderTimeline x) a -> DynamicS x (Identity a)
unSpiderDynamic :: DynamicS x (Identity a) } -- deriving (Functor, Applicative, Monad)
  newtype Incremental (SpiderTimeline x) p = SpiderIncremental { Incremental (SpiderTimeline x) p -> DynamicS x p
unSpiderIncremental :: DynamicS x p }
  type PullM (SpiderTimeline x) = SpiderPullM x
  type PushM (SpiderTimeline x) = SpiderPushM x
  {-# INLINABLE never #-}
  never :: Event (SpiderTimeline x) a
never = Event x a -> Event (SpiderTimeline x) a
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent Event x a
forall k (x :: k) a. Event x a
eventNever
  {-# INLINABLE constant #-}
  constant :: a -> Behavior (SpiderTimeline x) a
constant = Behavior x a -> Behavior (SpiderTimeline x) a
forall x a. Behavior x a -> Behavior (SpiderTimeline x) a
SpiderBehavior (Behavior x a -> Behavior (SpiderTimeline x) a)
-> (a -> Behavior x a) -> a -> Behavior (SpiderTimeline x) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Behavior x a
forall k a (x :: k). a -> Behavior x a
behaviorConst
  {-# INLINE push #-}
  push :: (a -> PushM (SpiderTimeline x) (Maybe b))
-> Event (SpiderTimeline x) a -> Event (SpiderTimeline x) b
push f :: a -> PushM (SpiderTimeline x) (Maybe b)
f = Event x b -> Event (SpiderTimeline x) b
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (Event x b -> Event (SpiderTimeline x) b)
-> (Event (SpiderTimeline x) a -> Event x b)
-> Event (SpiderTimeline x) a
-> Event (SpiderTimeline x) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
forall x a b.
HasSpiderTimeline x =>
(a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
push ((a -> SpiderPushM x (Maybe b)) -> a -> ComputeM x (Maybe b)
forall a b. Coercible a b => a -> b
coerce a -> PushM (SpiderTimeline x) (Maybe b)
a -> SpiderPushM x (Maybe b)
f) (Event x a -> Event x b)
-> (Event (SpiderTimeline x) a -> Event x a)
-> Event (SpiderTimeline x) a
-> Event x b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event (SpiderTimeline x) a -> Event x a
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent
  {-# INLINE pushCheap #-}
  pushCheap :: (a -> PushM (SpiderTimeline x) (Maybe b))
-> Event (SpiderTimeline x) a -> Event (SpiderTimeline x) b
pushCheap f :: a -> PushM (SpiderTimeline x) (Maybe b)
f = Event x b -> Event (SpiderTimeline x) b
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (Event x b -> Event (SpiderTimeline x) b)
-> (Event (SpiderTimeline x) a -> Event x b)
-> Event (SpiderTimeline x) a
-> Event (SpiderTimeline x) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
forall x a b.
HasSpiderTimeline x =>
(a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
pushCheap ((a -> SpiderPushM x (Maybe b)) -> a -> ComputeM x (Maybe b)
forall a b. Coercible a b => a -> b
coerce a -> PushM (SpiderTimeline x) (Maybe b)
a -> SpiderPushM x (Maybe b)
f) (Event x a -> Event x b)
-> (Event (SpiderTimeline x) a -> Event x a)
-> Event (SpiderTimeline x) a
-> Event x b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event (SpiderTimeline x) a -> Event x a
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent
  {-# INLINABLE pull #-}
  pull :: PullM (SpiderTimeline x) a -> Behavior (SpiderTimeline x) a
pull = Behavior x a -> Behavior (SpiderTimeline x) a
forall x a. Behavior x a -> Behavior (SpiderTimeline x) a
SpiderBehavior (Behavior x a -> Behavior (SpiderTimeline x) a)
-> (SpiderPullM x a -> Behavior x a)
-> SpiderPullM x a
-> Behavior (SpiderTimeline x) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BehaviorM x a -> Behavior x a
forall k (x :: k) a. BehaviorM x a -> Behavior x a
pull (BehaviorM x a -> Behavior x a)
-> (SpiderPullM x a -> BehaviorM x a)
-> SpiderPullM x a
-> Behavior x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpiderPullM x a -> BehaviorM x a
forall a b. Coercible a b => a -> b
coerce
  {-# INLINABLE fanG #-}
  fanG :: Event (SpiderTimeline x) (DMap k v)
-> EventSelectorG (SpiderTimeline x) k v
fanG e :: Event (SpiderTimeline x) (DMap k v)
e = (forall (a :: k). k a -> Event (SpiderTimeline x) (v a))
-> EventSelectorG (SpiderTimeline x) k v
forall k k (t :: k) (k :: k -> *) (v :: k -> *).
(forall (a :: k). k a -> Event t (v a)) -> EventSelectorG t k v
R.EventSelectorG ((forall (a :: k). k a -> Event (SpiderTimeline x) (v a))
 -> EventSelectorG (SpiderTimeline x) k v)
-> (forall (a :: k). k a -> Event (SpiderTimeline x) (v a))
-> EventSelectorG (SpiderTimeline x) k v
forall a b. (a -> b) -> a -> b
$ Event x (v a) -> Event (SpiderTimeline x) (v a)
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (Event x (v a) -> Event (SpiderTimeline x) (v a))
-> (k a -> Event x (v a)) -> k a -> Event (SpiderTimeline x) (v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventSelectorG x k v -> forall (a :: k). k a -> Event x (v a)
forall k (x :: k) k (k :: k -> *) (v :: k -> *).
EventSelectorG x k v -> forall (a :: k). k a -> Event x (v a)
selectG (Event x (DMap k v) -> EventSelectorG x k v
forall k x (k :: k -> *) (v :: k -> *).
(HasSpiderTimeline x, GCompare k) =>
Event x (DMap k v) -> EventSelectorG x k v
fanG (Event (SpiderTimeline x) (DMap k v) -> Event x (DMap k v)
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent Event (SpiderTimeline x) (DMap k v)
e))
  {-# INLINABLE mergeG #-}
  mergeG
    :: forall (k :: k2 -> *) q (v :: k2 -> *). GCompare k
    => (forall a. q a -> R.Event (SpiderTimeline x) (v a))
    -> DMap k q
    -> R.Event (SpiderTimeline x) (DMap k v)
  mergeG :: (forall (a :: k2). q a -> Event (SpiderTimeline x) (v a))
-> DMap k q -> Event (SpiderTimeline x) (DMap k v)
mergeG nt :: forall (a :: k2). q a -> Event (SpiderTimeline x) (v a)
nt = Event x (DMap k v) -> Event (SpiderTimeline x) (DMap k v)
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (Event x (DMap k v) -> Event (SpiderTimeline x) (DMap k v))
-> (DMap k q -> Event x (DMap k v))
-> DMap k q
-> Event (SpiderTimeline x) (DMap k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: k2). q a -> Event x (v a))
-> DynamicS x (PatchDMap k q) -> Event x (DMap k v)
forall k (k :: k -> *) (q :: k -> *) x (v :: k -> *).
(HasSpiderTimeline x, GCompare k) =>
(forall (a :: k). q a -> Event x (v a))
-> DynamicS x (PatchDMap k q) -> Event x (DMap k v)
mergeG (Event (SpiderTimeline x) (v a) -> Event x (v a)
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent (Event (SpiderTimeline x) (v a) -> Event x (v a))
-> (q a -> Event (SpiderTimeline x) (v a)) -> q a -> Event x (v a)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. q a -> Event (SpiderTimeline x) (v a)
forall (a :: k2). q a -> Event (SpiderTimeline x) (v a)
nt) (Dynamic x (DMap k q) (PatchDMap k q) -> Event x (DMap k v))
-> (DMap k q -> Dynamic x (DMap k q) (PatchDMap k q))
-> DMap k q
-> Event x (DMap k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DMap k q -> Dynamic x (DMap k q) (PatchDMap k q)
forall k p (x :: k). PatchTarget p -> DynamicS x p
dynamicConst
  {-# INLINABLE switch #-}
  switch :: Behavior (SpiderTimeline x) (Event (SpiderTimeline x) a)
-> Event (SpiderTimeline x) a
switch = Event x a -> Event (SpiderTimeline x) a
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (Event x a -> Event (SpiderTimeline x) a)
-> (Behavior (SpiderTimeline x) (Event (SpiderTimeline x) a)
    -> Event x a)
-> Behavior (SpiderTimeline x) (Event (SpiderTimeline x) a)
-> Event (SpiderTimeline x) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior x (Event x a) -> Event x a
forall x a.
HasSpiderTimeline x =>
Behavior x (Event x a) -> Event x a
switch (Behavior x (Event x a) -> Event x a)
-> (Behavior (SpiderTimeline x) (Event (SpiderTimeline x) a)
    -> Behavior x (Event x a))
-> Behavior (SpiderTimeline x) (Event (SpiderTimeline x) a)
-> Event x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
Behavior x (Event (SpiderTimeline x) a) -> Behavior x (Event x a)
forall a b. Coercible a b => a -> b
coerce :: Behavior x (R.Event (SpiderTimeline x) a) -> Behavior x (Event x a)) (Behavior x (Event (SpiderTimeline x) a) -> Behavior x (Event x a))
-> (Behavior (SpiderTimeline x) (Event (SpiderTimeline x) a)
    -> Behavior x (Event (SpiderTimeline x) a))
-> Behavior (SpiderTimeline x) (Event (SpiderTimeline x) a)
-> Behavior x (Event x a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior (SpiderTimeline x) (Event (SpiderTimeline x) a)
-> Behavior x (Event (SpiderTimeline x) a)
forall x a. Behavior (SpiderTimeline x) a -> Behavior x a
unSpiderBehavior
  {-# INLINABLE coincidence #-}
  coincidence :: Event (SpiderTimeline x) (Event (SpiderTimeline x) a)
-> Event (SpiderTimeline x) a
coincidence = Event x a -> Event (SpiderTimeline x) a
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (Event x a -> Event (SpiderTimeline x) a)
-> (Event (SpiderTimeline x) (Event (SpiderTimeline x) a)
    -> Event x a)
-> Event (SpiderTimeline x) (Event (SpiderTimeline x) a)
-> Event (SpiderTimeline x) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event x (Event x a) -> Event x a
forall x a. HasSpiderTimeline x => Event x (Event x a) -> Event x a
coincidence (Event x (Event x a) -> Event x a)
-> (Event (SpiderTimeline x) (Event (SpiderTimeline x) a)
    -> Event x (Event x a))
-> Event (SpiderTimeline x) (Event (SpiderTimeline x) a)
-> Event x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
Event x (Event (SpiderTimeline x) a) -> Event x (Event x a)
forall a b. Coercible a b => a -> b
coerce :: Event x (R.Event (SpiderTimeline x) a) -> Event x (Event x a)) (Event x (Event (SpiderTimeline x) a) -> Event x (Event x a))
-> (Event (SpiderTimeline x) (Event (SpiderTimeline x) a)
    -> Event x (Event (SpiderTimeline x) a))
-> Event (SpiderTimeline x) (Event (SpiderTimeline x) a)
-> Event x (Event x a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event (SpiderTimeline x) (Event (SpiderTimeline x) a)
-> Event x (Event (SpiderTimeline x) a)
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent
  {-# INLINABLE current #-}
  current :: Dynamic (SpiderTimeline x) a -> Behavior (SpiderTimeline x) a
current = Behavior x a -> Behavior (SpiderTimeline x) a
forall x a. Behavior x a -> Behavior (SpiderTimeline x) a
SpiderBehavior (Behavior x a -> Behavior (SpiderTimeline x) a)
-> (Dynamic (SpiderTimeline x) a -> Behavior x a)
-> Dynamic (SpiderTimeline x) a
-> Behavior (SpiderTimeline x) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic x a (Identity a) -> Behavior x a
forall k (x :: k) target p. Dynamic x target p -> Behavior x target
dynamicCurrent (Dynamic x a (Identity a) -> Behavior x a)
-> (Dynamic (SpiderTimeline x) a -> Dynamic x a (Identity a))
-> Dynamic (SpiderTimeline x) a
-> Behavior x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic (SpiderTimeline x) a -> Dynamic x a (Identity a)
forall x a. Dynamic (SpiderTimeline x) a -> DynamicS x (Identity a)
unSpiderDynamic
  {-# INLINABLE updated #-}
  updated :: Dynamic (SpiderTimeline x) a -> Event (SpiderTimeline x) a
updated = Event x a -> Event (SpiderTimeline x) a
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (Event x a -> Event (SpiderTimeline x) a)
-> (Dynamic x a a -> Event x a)
-> Dynamic x a a
-> Event (SpiderTimeline x) a
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Dynamic x a a -> Event x a
forall k (x :: k) target p. Dynamic x target p -> Event x p
dynamicUpdated (Dynamic x a a -> Event (SpiderTimeline x) a)
-> (Dynamic (SpiderTimeline x) a -> Dynamic x a a)
-> Dynamic (SpiderTimeline x) a
-> Event (SpiderTimeline x) a
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# (Identity a -> a) -> Dynamic x a (Identity a) -> Dynamic x a a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity a -> a
forall a b. Coercible a b => a -> b
coerce (Dynamic x a (Identity a) -> Dynamic x a a)
-> (Dynamic (SpiderTimeline x) a -> Dynamic x a (Identity a))
-> Dynamic (SpiderTimeline x) a
-> Dynamic x a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic (SpiderTimeline x) a -> Dynamic x a (Identity a)
forall x a. Dynamic (SpiderTimeline x) a -> DynamicS x (Identity a)
unSpiderDynamic
  {-# INLINABLE unsafeBuildDynamic #-}
  unsafeBuildDynamic :: PullM (SpiderTimeline x) a
-> Event (SpiderTimeline x) a -> Dynamic (SpiderTimeline x) a
unsafeBuildDynamic readV0 :: PullM (SpiderTimeline x) a
readV0 v' :: Event (SpiderTimeline x) a
v' = DynamicS x (Identity a) -> Dynamic (SpiderTimeline x) a
forall x a. DynamicS x (Identity a) -> Dynamic (SpiderTimeline x) a
SpiderDynamic (DynamicS x (Identity a) -> Dynamic (SpiderTimeline x) a)
-> DynamicS x (Identity a) -> Dynamic (SpiderTimeline x) a
forall a b. (a -> b) -> a -> b
$ Dyn x (Identity a) -> DynamicS x (Identity a)
forall x a.
HasSpiderTimeline x =>
Dyn x (Identity a) -> DynamicS x (Identity a)
dynamicDynIdentity (Dyn x (Identity a) -> DynamicS x (Identity a))
-> Dyn x (Identity a) -> DynamicS x (Identity a)
forall a b. (a -> b) -> a -> b
$ BehaviorM x (PatchTarget (Identity a))
-> Event x (Identity a) -> Dyn x (Identity a)
forall x p. BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
unsafeBuildDynamic (SpiderPullM x a -> BehaviorM x a
forall a b. Coercible a b => a -> b
coerce PullM (SpiderTimeline x) a
SpiderPullM x a
readV0) (Event x (Identity a) -> Dyn x (Identity a))
-> Event x (Identity a) -> Dyn x (Identity a)
forall a b. (a -> b) -> a -> b
$ Event x a -> Event x (Identity a)
forall a b. Coercible a b => a -> b
coerce (Event x a -> Event x (Identity a))
-> Event x a -> Event x (Identity a)
forall a b. (a -> b) -> a -> b
$ Event (SpiderTimeline x) a -> Event x a
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent Event (SpiderTimeline x) a
v'
  {-# INLINABLE unsafeBuildIncremental #-}
  unsafeBuildIncremental :: PullM (SpiderTimeline x) (PatchTarget p)
-> Event (SpiderTimeline x) p -> Incremental (SpiderTimeline x) p
unsafeBuildIncremental readV0 :: PullM (SpiderTimeline x) (PatchTarget p)
readV0 dv :: Event (SpiderTimeline x) p
dv = DynamicS x p -> Incremental (SpiderTimeline x) p
forall x p. DynamicS x p -> Incremental (SpiderTimeline x) p
SpiderIncremental (DynamicS x p -> Incremental (SpiderTimeline x) p)
-> DynamicS x p -> Incremental (SpiderTimeline x) p
forall a b. (a -> b) -> a -> b
$ Dyn x p -> DynamicS x p
forall x p.
(HasSpiderTimeline x, Patch p) =>
Dyn x p -> DynamicS x p
dynamicDyn (Dyn x p -> DynamicS x p) -> Dyn x p -> DynamicS x p
forall a b. (a -> b) -> a -> b
$ BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
forall x p. BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
unsafeBuildDynamic (SpiderPullM x (PatchTarget p) -> BehaviorM x (PatchTarget p)
forall a b. Coercible a b => a -> b
coerce PullM (SpiderTimeline x) (PatchTarget p)
SpiderPullM x (PatchTarget p)
readV0) (Event x p -> Dyn x p) -> Event x p -> Dyn x p
forall a b. (a -> b) -> a -> b
$ Event (SpiderTimeline x) p -> Event x p
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent Event (SpiderTimeline x) p
dv
  {-# INLINABLE mergeIncrementalG #-}
  mergeIncrementalG :: (forall (a :: k). q a -> Event (SpiderTimeline x) (v a))
-> Incremental (SpiderTimeline x) (PatchDMap k q)
-> Event (SpiderTimeline x) (DMap k v)
mergeIncrementalG nt :: forall (a :: k). q a -> Event (SpiderTimeline x) (v a)
nt = Event x (DMap k v) -> Event (SpiderTimeline x) (DMap k v)
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (Event x (DMap k v) -> Event (SpiderTimeline x) (DMap k v))
-> (Dynamic x (DMap k q) (PatchDMap k q) -> Event x (DMap k v))
-> Dynamic x (DMap k q) (PatchDMap k q)
-> Event (SpiderTimeline x) (DMap k v)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (forall (a :: k). q a -> Event x (v a))
-> DynamicS x (PatchDMap k q) -> Event x (DMap k v)
forall k (k :: k -> *) (q :: k -> *) x (v :: k -> *).
(HasSpiderTimeline x, GCompare k) =>
(forall (a :: k). q a -> Event x (v a))
-> DynamicS x (PatchDMap k q) -> Event x (DMap k v)
mergeG (Event (SpiderTimeline x) (v a) -> Event x (v a)
forall a b. Coercible a b => a -> b
coerce (Event (SpiderTimeline x) (v a) -> Event x (v a))
-> (q a -> Event (SpiderTimeline x) (v a)) -> q a -> Event x (v a)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. q a -> Event (SpiderTimeline x) (v a)
forall (a :: k). q a -> Event (SpiderTimeline x) (v a)
nt) (Dynamic x (DMap k q) (PatchDMap k q)
 -> Event (SpiderTimeline x) (DMap k v))
-> (Incremental (SpiderTimeline x) (PatchDMap k q)
    -> Dynamic x (DMap k q) (PatchDMap k q))
-> Incremental (SpiderTimeline x) (PatchDMap k q)
-> Event (SpiderTimeline x) (DMap k v)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Incremental (SpiderTimeline x) (PatchDMap k q)
-> Dynamic x (DMap k q) (PatchDMap k q)
forall x p. Incremental (SpiderTimeline x) p -> DynamicS x p
unSpiderIncremental
  {-# INLINABLE mergeIncrementalWithMoveG #-}
  mergeIncrementalWithMoveG :: (forall (a :: k). q a -> Event (SpiderTimeline x) (v a))
-> Incremental (SpiderTimeline x) (PatchDMapWithMove k q)
-> Event (SpiderTimeline x) (DMap k v)
mergeIncrementalWithMoveG nt :: forall (a :: k). q a -> Event (SpiderTimeline x) (v a)
nt = Event x (DMap k v) -> Event (SpiderTimeline x) (DMap k v)
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (Event x (DMap k v) -> Event (SpiderTimeline x) (DMap k v))
-> (Dynamic x (DMap k q) (PatchDMapWithMove k q)
    -> Event x (DMap k v))
-> Dynamic x (DMap k q) (PatchDMapWithMove k q)
-> Event (SpiderTimeline x) (DMap k v)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (forall (a :: k). q a -> Event x (v a))
-> DynamicS x (PatchDMapWithMove k q) -> Event x (DMap k v)
forall k (k :: k -> *) (v :: k -> *) (q :: k -> *) x.
(HasSpiderTimeline x, GCompare k) =>
(forall (a :: k). q a -> Event x (v a))
-> DynamicS x (PatchDMapWithMove k q) -> Event x (DMap k v)
mergeWithMove (Event (SpiderTimeline x) (v a) -> Event x (v a)
forall a b. Coercible a b => a -> b
coerce (Event (SpiderTimeline x) (v a) -> Event x (v a))
-> (q a -> Event (SpiderTimeline x) (v a)) -> q a -> Event x (v a)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. q a -> Event (SpiderTimeline x) (v a)
forall (a :: k). q a -> Event (SpiderTimeline x) (v a)
nt) (Dynamic x (DMap k q) (PatchDMapWithMove k q)
 -> Event (SpiderTimeline x) (DMap k v))
-> (Incremental (SpiderTimeline x) (PatchDMapWithMove k q)
    -> Dynamic x (DMap k q) (PatchDMapWithMove k q))
-> Incremental (SpiderTimeline x) (PatchDMapWithMove k q)
-> Event (SpiderTimeline x) (DMap k v)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Incremental (SpiderTimeline x) (PatchDMapWithMove k q)
-> Dynamic x (DMap k q) (PatchDMapWithMove k q)
forall x p. Incremental (SpiderTimeline x) p -> DynamicS x p
unSpiderIncremental
  {-# INLINABLE currentIncremental #-}
  currentIncremental :: Incremental (SpiderTimeline x) p
-> Behavior (SpiderTimeline x) (PatchTarget p)
currentIncremental = Behavior x (PatchTarget p)
-> Behavior (SpiderTimeline x) (PatchTarget p)
forall x a. Behavior x a -> Behavior (SpiderTimeline x) a
SpiderBehavior (Behavior x (PatchTarget p)
 -> Behavior (SpiderTimeline x) (PatchTarget p))
-> (Incremental (SpiderTimeline x) p -> Behavior x (PatchTarget p))
-> Incremental (SpiderTimeline x) p
-> Behavior (SpiderTimeline x) (PatchTarget p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic x (PatchTarget p) p -> Behavior x (PatchTarget p)
forall k (x :: k) target p. Dynamic x target p -> Behavior x target
dynamicCurrent (Dynamic x (PatchTarget p) p -> Behavior x (PatchTarget p))
-> (Incremental (SpiderTimeline x) p
    -> Dynamic x (PatchTarget p) p)
-> Incremental (SpiderTimeline x) p
-> Behavior x (PatchTarget p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Incremental (SpiderTimeline x) p -> Dynamic x (PatchTarget p) p
forall x p. Incremental (SpiderTimeline x) p -> DynamicS x p
unSpiderIncremental
  {-# INLINABLE updatedIncremental #-}
  updatedIncremental :: Incremental (SpiderTimeline x) p -> Event (SpiderTimeline x) p
updatedIncremental = Event x p -> Event (SpiderTimeline x) p
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (Event x p -> Event (SpiderTimeline x) p)
-> (Incremental (SpiderTimeline x) p -> Event x p)
-> Incremental (SpiderTimeline x) p
-> Event (SpiderTimeline x) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic x (PatchTarget p) p -> Event x p
forall k (x :: k) target p. Dynamic x target p -> Event x p
dynamicUpdated (Dynamic x (PatchTarget p) p -> Event x p)
-> (Incremental (SpiderTimeline x) p
    -> Dynamic x (PatchTarget p) p)
-> Incremental (SpiderTimeline x) p
-> Event x p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Incremental (SpiderTimeline x) p -> Dynamic x (PatchTarget p) p
forall x p. Incremental (SpiderTimeline x) p -> DynamicS x p
unSpiderIncremental
  {-# INLINABLE incrementalToDynamic #-}
  incrementalToDynamic :: Incremental (SpiderTimeline x) p
-> Dynamic (SpiderTimeline x) (PatchTarget p)
incrementalToDynamic (SpiderIncremental i) = DynamicS x (Identity (PatchTarget p))
-> Dynamic (SpiderTimeline x) (PatchTarget p)
forall x a. DynamicS x (Identity a) -> Dynamic (SpiderTimeline x) a
SpiderDynamic (DynamicS x (Identity (PatchTarget p))
 -> Dynamic (SpiderTimeline x) (PatchTarget p))
-> DynamicS x (Identity (PatchTarget p))
-> Dynamic (SpiderTimeline x) (PatchTarget p)
forall a b. (a -> b) -> a -> b
$ Dyn x (Identity (PatchTarget p))
-> DynamicS x (Identity (PatchTarget p))
forall x a.
HasSpiderTimeline x =>
Dyn x (Identity a) -> DynamicS x (Identity a)
dynamicDynIdentity (Dyn x (Identity (PatchTarget p))
 -> DynamicS x (Identity (PatchTarget p)))
-> Dyn x (Identity (PatchTarget p))
-> DynamicS x (Identity (PatchTarget p))
forall a b. (a -> b) -> a -> b
$ BehaviorM x (PatchTarget (Identity (PatchTarget p)))
-> Event x (Identity (PatchTarget p))
-> Dyn x (Identity (PatchTarget p))
forall x p. BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
unsafeBuildDynamic (Behavior x (PatchTarget p)
-> BehaviorM x (PatchTarget (Identity (PatchTarget p)))
forall k (x :: k) (m :: * -> *) a.
Defer (SomeHoldInit x) m =>
Behavior x a -> m a
readBehaviorUntracked (Behavior x (PatchTarget p)
 -> BehaviorM x (PatchTarget (Identity (PatchTarget p))))
-> Behavior x (PatchTarget p)
-> BehaviorM x (PatchTarget (Identity (PatchTarget p)))
forall a b. (a -> b) -> a -> b
$ Dynamic x (PatchTarget p) p -> Behavior x (PatchTarget p)
forall k (x :: k) target p. Dynamic x target p -> Behavior x target
dynamicCurrent Dynamic x (PatchTarget p) p
i) (Event x (Identity (PatchTarget p))
 -> Dyn x (Identity (PatchTarget p)))
-> Event x (Identity (PatchTarget p))
-> Dyn x (Identity (PatchTarget p))
forall a b. (a -> b) -> a -> b
$ ((p -> ComputeM x (Maybe (Identity (PatchTarget p))))
 -> Event x p -> Event x (Identity (PatchTarget p)))
-> Event x p
-> (p -> ComputeM x (Maybe (Identity (PatchTarget p))))
-> Event x (Identity (PatchTarget p))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (p -> ComputeM x (Maybe (Identity (PatchTarget p))))
-> Event x p -> Event x (Identity (PatchTarget p))
forall x a b.
HasSpiderTimeline x =>
(a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
push (Dynamic x (PatchTarget p) p -> Event x p
forall k (x :: k) target p. Dynamic x target p -> Event x p
dynamicUpdated Dynamic x (PatchTarget p) p
i) ((p -> ComputeM x (Maybe (Identity (PatchTarget p))))
 -> Event x (Identity (PatchTarget p)))
-> (p -> ComputeM x (Maybe (Identity (PatchTarget p))))
-> Event x (Identity (PatchTarget p))
forall a b. (a -> b) -> a -> b
$ \p :: p
p -> do
    PatchTarget p
c <- Behavior x (PatchTarget p) -> EventM x (PatchTarget p)
forall k (x :: k) (m :: * -> *) a.
Defer (SomeHoldInit x) m =>
Behavior x a -> m a
readBehaviorUntracked (Behavior x (PatchTarget p) -> EventM x (PatchTarget p))
-> Behavior x (PatchTarget p) -> EventM x (PatchTarget p)
forall a b. (a -> b) -> a -> b
$ Dynamic x (PatchTarget p) p -> Behavior x (PatchTarget p)
forall k (x :: k) target p. Dynamic x target p -> Behavior x target
dynamicCurrent Dynamic x (PatchTarget p) p
i
    Maybe (Identity (PatchTarget p))
-> ComputeM x (Maybe (Identity (PatchTarget p)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Identity (PatchTarget p))
 -> ComputeM x (Maybe (Identity (PatchTarget p))))
-> Maybe (Identity (PatchTarget p))
-> ComputeM x (Maybe (Identity (PatchTarget p)))
forall a b. (a -> b) -> a -> b
$ PatchTarget p -> Identity (PatchTarget p)
forall a. a -> Identity a
Identity (PatchTarget p -> Identity (PatchTarget p))
-> Maybe (PatchTarget p) -> Maybe (Identity (PatchTarget p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p -> PatchTarget p -> Maybe (PatchTarget p)
forall p. Patch p => p -> PatchTarget p -> Maybe (PatchTarget p)
apply p
p PatchTarget p
c --TODO: Avoid the redundant 'apply'
  eventCoercion :: Coercion a b
-> Coercion
     (Event (SpiderTimeline x) a) (Event (SpiderTimeline x) b)
eventCoercion Coercion = Coercion (Event (SpiderTimeline x) a) (Event (SpiderTimeline x) b)
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
  behaviorCoercion :: Coercion a b
-> Coercion
     (Behavior (SpiderTimeline x) a) (Behavior (SpiderTimeline x) b)
behaviorCoercion Coercion = Coercion
  (Behavior (SpiderTimeline x) a) (Behavior (SpiderTimeline x) b)
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
  dynamicCoercion :: Coercion a b
-> Coercion
     (Dynamic (SpiderTimeline x) a) (Dynamic (SpiderTimeline x) b)
dynamicCoercion Coercion = Coercion
  (Dynamic (SpiderTimeline x) a) (Dynamic (SpiderTimeline x) b)
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
  incrementalCoercion :: Coercion (PatchTarget a) (PatchTarget b)
-> Coercion a b
-> Coercion
     (Incremental (SpiderTimeline x) a)
     (Incremental (SpiderTimeline x) b)
incrementalCoercion Coercion Coercion = Coercion
  (Incremental (SpiderTimeline x) a)
  (Incremental (SpiderTimeline x) b)
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
  {-# INLINABLE mergeIntIncremental #-}
  mergeIntIncremental :: Incremental
  (SpiderTimeline x) (PatchIntMap (Event (SpiderTimeline x) a))
-> Event (SpiderTimeline x) (IntMap a)
mergeIntIncremental = Event x (IntMap a) -> Event (SpiderTimeline x) (IntMap a)
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (Event x (IntMap a) -> Event (SpiderTimeline x) (IntMap a))
-> (Incremental
      (SpiderTimeline x) (PatchIntMap (Event (SpiderTimeline x) a))
    -> Event x (IntMap a))
-> Incremental
     (SpiderTimeline x) (PatchIntMap (Event (SpiderTimeline x) a))
-> Event (SpiderTimeline x) (IntMap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic x (IntMap (Event x a)) (PatchIntMap (Event x a))
-> Event x (IntMap a)
forall x a.
HasSpiderTimeline x =>
DynamicS x (PatchIntMap (Event x a)) -> Event x (IntMap a)
mergeInt (Dynamic x (IntMap (Event x a)) (PatchIntMap (Event x a))
 -> Event x (IntMap a))
-> (Incremental
      (SpiderTimeline x) (PatchIntMap (Event (SpiderTimeline x) a))
    -> Dynamic x (IntMap (Event x a)) (PatchIntMap (Event x a)))
-> Incremental
     (SpiderTimeline x) (PatchIntMap (Event (SpiderTimeline x) a))
-> Event x (IntMap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Incremental
  (SpiderTimeline x) (PatchIntMap (Event (SpiderTimeline x) a))
-> Dynamic x (IntMap (Event x a)) (PatchIntMap (Event x a))
forall a b. Coercible a b => a -> b
coerce
  {-# INLINABLE fanInt #-}
  fanInt :: Event (SpiderTimeline x) (IntMap a)
-> EventSelectorInt (SpiderTimeline x) a
fanInt e :: Event (SpiderTimeline x) (IntMap a)
e = (Int -> Event (SpiderTimeline x) a)
-> EventSelectorInt (SpiderTimeline x) a
forall k (t :: k) a. (Int -> Event t a) -> EventSelectorInt t a
R.EventSelectorInt ((Int -> Event (SpiderTimeline x) a)
 -> EventSelectorInt (SpiderTimeline x) a)
-> (Int -> Event (SpiderTimeline x) a)
-> EventSelectorInt (SpiderTimeline x) a
forall a b. (a -> b) -> a -> b
$ Event x a -> Event (SpiderTimeline x) a
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (Event x a -> Event (SpiderTimeline x) a)
-> (Int -> Event x a) -> Int -> Event (SpiderTimeline x) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventSelectorInt x a -> Int -> Event x a
forall k (x :: k) a. EventSelectorInt x a -> Int -> Event x a
selectInt (Event x (IntMap a) -> EventSelectorInt x a
forall x a.
HasSpiderTimeline x =>
Event x (IntMap a) -> EventSelectorInt x a
fanInt (Event (SpiderTimeline x) (IntMap a) -> Event x (IntMap a)
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent Event (SpiderTimeline x) (IntMap a)
e))

data RootTrigger x a = forall k. GCompare k => RootTrigger (WeakBag (Subscriber x a), IORef (DMap k Identity), k a)

data SpiderEventHandle x a = SpiderEventHandle
  { SpiderEventHandle x a -> EventSubscription x
spiderEventHandleSubscription :: EventSubscription x
  , SpiderEventHandle x a -> IORef (Maybe a)
spiderEventHandleValue :: IORef (Maybe a)
  }

instance MonadRef (EventM x) where
  type Ref (EventM x) = Ref IO
  {-# INLINABLE newRef #-}
  {-# INLINABLE readRef #-}
  {-# INLINABLE writeRef #-}
  newRef :: a -> EventM x (Ref (EventM x) a)
newRef = IO (IORef a) -> EventM x (IORef a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef a) -> EventM x (IORef a))
-> (a -> IO (IORef a)) -> a -> EventM x (IORef a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO (IORef a)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef
  readRef :: Ref (EventM x) a -> EventM x a
readRef = IO a -> EventM x a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> EventM x a) -> (IORef a -> IO a) -> IORef a -> EventM x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef a -> IO a
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef
  writeRef :: Ref (EventM x) a -> a -> EventM x ()
writeRef r :: Ref (EventM x) a
r a :: a
a = IO () -> EventM x ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM x ()) -> IO () -> EventM x ()
forall a b. (a -> b) -> a -> b
$ Ref IO a -> a -> IO ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
writeRef Ref IO a
Ref (EventM x) a
r a
a

instance MonadAtomicRef (EventM x) where
  {-# INLINABLE atomicModifyRef #-}
  atomicModifyRef :: Ref (EventM x) a -> (a -> (a, b)) -> EventM x b
atomicModifyRef r :: Ref (EventM x) a
r f :: a -> (a, b)
f = IO b -> EventM x b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> EventM x b) -> IO b -> EventM x b
forall a b. (a -> b) -> a -> b
$ Ref IO a -> (a -> (a, b)) -> IO b
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef Ref IO a
Ref (EventM x) a
r a -> (a, b)
f

-- | The monad for actions that manipulate a Spider timeline identified by @x@
newtype SpiderHost (x :: Type) a = SpiderHost { SpiderHost x a -> IO a
unSpiderHost :: IO a } deriving (a -> SpiderHost x b -> SpiderHost x a
(a -> b) -> SpiderHost x a -> SpiderHost x b
(forall a b. (a -> b) -> SpiderHost x a -> SpiderHost x b)
-> (forall a b. a -> SpiderHost x b -> SpiderHost x a)
-> Functor (SpiderHost x)
forall a b. a -> SpiderHost x b -> SpiderHost x a
forall a b. (a -> b) -> SpiderHost x a -> SpiderHost x b
forall x a b. a -> SpiderHost x b -> SpiderHost x a
forall x a b. (a -> b) -> SpiderHost x a -> SpiderHost x b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SpiderHost x b -> SpiderHost x a
$c<$ :: forall x a b. a -> SpiderHost x b -> SpiderHost x a
fmap :: (a -> b) -> SpiderHost x a -> SpiderHost x b
$cfmap :: forall x a b. (a -> b) -> SpiderHost x a -> SpiderHost x b
Functor, Functor (SpiderHost x)
a -> SpiderHost x a
Functor (SpiderHost x) =>
(forall a. a -> SpiderHost x a)
-> (forall a b.
    SpiderHost x (a -> b) -> SpiderHost x a -> SpiderHost x b)
-> (forall a b c.
    (a -> b -> c)
    -> SpiderHost x a -> SpiderHost x b -> SpiderHost x c)
-> (forall a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x b)
-> (forall a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x a)
-> Applicative (SpiderHost x)
SpiderHost x a -> SpiderHost x b -> SpiderHost x b
SpiderHost x a -> SpiderHost x b -> SpiderHost x a
SpiderHost x (a -> b) -> SpiderHost x a -> SpiderHost x b
(a -> b -> c) -> SpiderHost x a -> SpiderHost x b -> SpiderHost x c
forall x. Functor (SpiderHost x)
forall a. a -> SpiderHost x a
forall x a. a -> SpiderHost x a
forall a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x a
forall a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x b
forall a b.
SpiderHost x (a -> b) -> SpiderHost x a -> SpiderHost x b
forall x a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x a
forall x a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x b
forall x a b.
SpiderHost x (a -> b) -> SpiderHost x a -> SpiderHost x b
forall a b c.
(a -> b -> c) -> SpiderHost x a -> SpiderHost x b -> SpiderHost x c
forall x a b c.
(a -> b -> c) -> SpiderHost x a -> SpiderHost x b -> SpiderHost x c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SpiderHost x a -> SpiderHost x b -> SpiderHost x a
$c<* :: forall x a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x a
*> :: SpiderHost x a -> SpiderHost x b -> SpiderHost x b
$c*> :: forall x a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x b
liftA2 :: (a -> b -> c) -> SpiderHost x a -> SpiderHost x b -> SpiderHost x c
$cliftA2 :: forall x a b c.
(a -> b -> c) -> SpiderHost x a -> SpiderHost x b -> SpiderHost x c
<*> :: SpiderHost x (a -> b) -> SpiderHost x a -> SpiderHost x b
$c<*> :: forall x a b.
SpiderHost x (a -> b) -> SpiderHost x a -> SpiderHost x b
pure :: a -> SpiderHost x a
$cpure :: forall x a. a -> SpiderHost x a
$cp1Applicative :: forall x. Functor (SpiderHost x)
Applicative, Monad (SpiderHost x)
Monad (SpiderHost x) =>
(forall a. (a -> SpiderHost x a) -> SpiderHost x a)
-> MonadFix (SpiderHost x)
(a -> SpiderHost x a) -> SpiderHost x a
forall x. Monad (SpiderHost x)
forall a. (a -> SpiderHost x a) -> SpiderHost x a
forall x a. (a -> SpiderHost x a) -> SpiderHost x a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> SpiderHost x a) -> SpiderHost x a
$cmfix :: forall x a. (a -> SpiderHost x a) -> SpiderHost x a
$cp1MonadFix :: forall x. Monad (SpiderHost x)
MonadFix, Monad (SpiderHost x)
Monad (SpiderHost x) =>
(forall a. IO a -> SpiderHost x a) -> MonadIO (SpiderHost x)
IO a -> SpiderHost x a
forall x. Monad (SpiderHost x)
forall a. IO a -> SpiderHost x a
forall x a. IO a -> SpiderHost x a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> SpiderHost x a
$cliftIO :: forall x a. IO a -> SpiderHost x a
$cp1MonadIO :: forall x. Monad (SpiderHost x)
MonadIO, Monad (SpiderHost x)
e -> SpiderHost x a
Monad (SpiderHost x) =>
(forall e a. Exception e => e -> SpiderHost x a)
-> (forall e a.
    Exception e =>
    SpiderHost x a -> (e -> SpiderHost x a) -> SpiderHost x a)
-> (forall a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x a)
-> MonadException (SpiderHost x)
SpiderHost x a -> (e -> SpiderHost x a) -> SpiderHost x a
SpiderHost x a -> SpiderHost x b -> SpiderHost x a
forall x. Monad (SpiderHost x)
forall e a. Exception e => e -> SpiderHost x a
forall e a.
Exception e =>
SpiderHost x a -> (e -> SpiderHost x a) -> SpiderHost x a
forall a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x a
forall x e a. Exception e => e -> SpiderHost x a
forall x e a.
Exception e =>
SpiderHost x a -> (e -> SpiderHost x a) -> SpiderHost x a
forall x a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a)
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. m a -> m b -> m a)
-> MonadException m
finally :: SpiderHost x a -> SpiderHost x b -> SpiderHost x a
$cfinally :: forall x a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x a
catch :: SpiderHost x a -> (e -> SpiderHost x a) -> SpiderHost x a
$ccatch :: forall x e a.
Exception e =>
SpiderHost x a -> (e -> SpiderHost x a) -> SpiderHost x a
throw :: e -> SpiderHost x a
$cthrow :: forall x e a. Exception e => e -> SpiderHost x a
$cp1MonadException :: forall x. Monad (SpiderHost x)
MonadException, MonadIO (SpiderHost x)
MonadException (SpiderHost x)
(MonadIO (SpiderHost x), MonadException (SpiderHost x)) =>
(forall b.
 ((forall a. SpiderHost x a -> SpiderHost x a) -> SpiderHost x b)
 -> SpiderHost x b)
-> MonadAsyncException (SpiderHost x)
((forall a. SpiderHost x a -> SpiderHost x a) -> SpiderHost x b)
-> SpiderHost x b
forall x. MonadIO (SpiderHost x)
forall x. MonadException (SpiderHost x)
forall b.
((forall a. SpiderHost x a -> SpiderHost x a) -> SpiderHost x b)
-> SpiderHost x b
forall x b.
((forall a. SpiderHost x a -> SpiderHost x a) -> SpiderHost x b)
-> SpiderHost x b
forall (m :: * -> *).
(MonadIO m, MonadException m) =>
(forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> MonadAsyncException m
mask :: ((forall a. SpiderHost x a -> SpiderHost x a) -> SpiderHost x b)
-> SpiderHost x b
$cmask :: forall x b.
((forall a. SpiderHost x a -> SpiderHost x a) -> SpiderHost x b)
-> SpiderHost x b
$cp2MonadAsyncException :: forall x. MonadException (SpiderHost x)
$cp1MonadAsyncException :: forall x. MonadIO (SpiderHost x)
MonadAsyncException)

instance Monad (SpiderHost x) where
  {-# INLINABLE (>>=) #-}
  SpiderHost x :: IO a
x >>= :: SpiderHost x a -> (a -> SpiderHost x b) -> SpiderHost x b
>>= f :: a -> SpiderHost x b
f = IO b -> SpiderHost x b
forall x a. IO a -> SpiderHost x a
SpiderHost (IO b -> SpiderHost x b) -> IO b -> SpiderHost x b
forall a b. (a -> b) -> a -> b
$ IO a
x IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SpiderHost x b -> IO b
forall x a. SpiderHost x a -> IO a
unSpiderHost (SpiderHost x b -> IO b) -> (a -> SpiderHost x b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SpiderHost x b
f
  {-# INLINABLE (>>) #-}
  SpiderHost x :: IO a
x >> :: SpiderHost x a -> SpiderHost x b -> SpiderHost x b
>> SpiderHost y :: IO b
y = IO b -> SpiderHost x b
forall x a. IO a -> SpiderHost x a
SpiderHost (IO b -> SpiderHost x b) -> IO b -> SpiderHost x b
forall a b. (a -> b) -> a -> b
$ IO a
x IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO b
y
  {-# INLINABLE return #-}
  return :: a -> SpiderHost x a
return x :: a
x = IO a -> SpiderHost x a
forall x a. IO a -> SpiderHost x a
SpiderHost (IO a -> SpiderHost x a) -> IO a -> SpiderHost x a
forall a b. (a -> b) -> a -> b
$ a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
#if !MIN_VERSION_base(4,13,0)
  {-# INLINABLE fail #-}
  fail = MonadFail.fail
#endif

instance MonadFail (SpiderHost x) where
  {-# INLINABLE fail #-}
  fail :: String -> SpiderHost x a
fail s :: String
s = IO a -> SpiderHost x a
forall x a. IO a -> SpiderHost x a
SpiderHost (IO a -> SpiderHost x a) -> IO a -> SpiderHost x a
forall a b. (a -> b) -> a -> b
$ String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
MonadFail.fail String
s

-- | Run an action affecting the global Spider timeline; this will be guarded by
-- a mutex for that timeline
runSpiderHost :: SpiderHost Global a -> IO a
runSpiderHost :: SpiderHost Global a -> IO a
runSpiderHost (SpiderHost a :: IO a
a) = IO a
a

-- | Run an action affecting a given Spider timeline; this will be guarded by a
-- mutex for that timeline
runSpiderHostForTimeline :: SpiderHost x a -> SpiderTimelineEnv x -> IO a
runSpiderHostForTimeline :: SpiderHost x a -> SpiderTimelineEnv x -> IO a
runSpiderHostForTimeline (SpiderHost a :: IO a
a) _ = IO a
a

newtype SpiderHostFrame (x :: Type) a = SpiderHostFrame { SpiderHostFrame x a -> EventM x a
runSpiderHostFrame :: EventM x a }
  deriving (a -> SpiderHostFrame x b -> SpiderHostFrame x a
(a -> b) -> SpiderHostFrame x a -> SpiderHostFrame x b
(forall a b.
 (a -> b) -> SpiderHostFrame x a -> SpiderHostFrame x b)
-> (forall a b. a -> SpiderHostFrame x b -> SpiderHostFrame x a)
-> Functor (SpiderHostFrame x)
forall a b. a -> SpiderHostFrame x b -> SpiderHostFrame x a
forall a b. (a -> b) -> SpiderHostFrame x a -> SpiderHostFrame x b
forall x a b. a -> SpiderHostFrame x b -> SpiderHostFrame x a
forall x a b.
(a -> b) -> SpiderHostFrame x a -> SpiderHostFrame x b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SpiderHostFrame x b -> SpiderHostFrame x a
$c<$ :: forall x a b. a -> SpiderHostFrame x b -> SpiderHostFrame x a
fmap :: (a -> b) -> SpiderHostFrame x a -> SpiderHostFrame x b
$cfmap :: forall x a b.
(a -> b) -> SpiderHostFrame x a -> SpiderHostFrame x b
Functor, Functor (SpiderHostFrame x)
a -> SpiderHostFrame x a
Functor (SpiderHostFrame x) =>
(forall a. a -> SpiderHostFrame x a)
-> (forall a b.
    SpiderHostFrame x (a -> b)
    -> SpiderHostFrame x a -> SpiderHostFrame x b)
-> (forall a b c.
    (a -> b -> c)
    -> SpiderHostFrame x a
    -> SpiderHostFrame x b
    -> SpiderHostFrame x c)
-> (forall a b.
    SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x b)
-> (forall a b.
    SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x a)
-> Applicative (SpiderHostFrame x)
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x b
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x a
SpiderHostFrame x (a -> b)
-> SpiderHostFrame x a -> SpiderHostFrame x b
(a -> b -> c)
-> SpiderHostFrame x a
-> SpiderHostFrame x b
-> SpiderHostFrame x c
forall x. Functor (SpiderHostFrame x)
forall a. a -> SpiderHostFrame x a
forall x a. a -> SpiderHostFrame x a
forall a b.
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x a
forall a b.
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x b
forall a b.
SpiderHostFrame x (a -> b)
-> SpiderHostFrame x a -> SpiderHostFrame x b
forall x a b.
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x a
forall x a b.
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x b
forall x a b.
SpiderHostFrame x (a -> b)
-> SpiderHostFrame x a -> SpiderHostFrame x b
forall a b c.
(a -> b -> c)
-> SpiderHostFrame x a
-> SpiderHostFrame x b
-> SpiderHostFrame x c
forall x a b c.
(a -> b -> c)
-> SpiderHostFrame x a
-> SpiderHostFrame x b
-> SpiderHostFrame x c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x a
$c<* :: forall x a b.
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x a
*> :: SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x b
$c*> :: forall x a b.
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x b
liftA2 :: (a -> b -> c)
-> SpiderHostFrame x a
-> SpiderHostFrame x b
-> SpiderHostFrame x c
$cliftA2 :: forall x a b c.
(a -> b -> c)
-> SpiderHostFrame x a
-> SpiderHostFrame x b
-> SpiderHostFrame x c
<*> :: SpiderHostFrame x (a -> b)
-> SpiderHostFrame x a -> SpiderHostFrame x b
$c<*> :: forall x a b.
SpiderHostFrame x (a -> b)
-> SpiderHostFrame x a -> SpiderHostFrame x b
pure :: a -> SpiderHostFrame x a
$cpure :: forall x a. a -> SpiderHostFrame x a
$cp1Applicative :: forall x. Functor (SpiderHostFrame x)
Applicative, Monad (SpiderHostFrame x)
Monad (SpiderHostFrame x) =>
(forall a. (a -> SpiderHostFrame x a) -> SpiderHostFrame x a)
-> MonadFix (SpiderHostFrame x)
(a -> SpiderHostFrame x a) -> SpiderHostFrame x a
forall x. Monad (SpiderHostFrame x)
forall a. (a -> SpiderHostFrame x a) -> SpiderHostFrame x a
forall x a. (a -> SpiderHostFrame x a) -> SpiderHostFrame x a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> SpiderHostFrame x a) -> SpiderHostFrame x a
$cmfix :: forall x a. (a -> SpiderHostFrame x a) -> SpiderHostFrame x a
$cp1MonadFix :: forall x. Monad (SpiderHostFrame x)
MonadFix, Monad (SpiderHostFrame x)
Monad (SpiderHostFrame x) =>
(forall a. IO a -> SpiderHostFrame x a)
-> MonadIO (SpiderHostFrame x)
IO a -> SpiderHostFrame x a
forall x. Monad (SpiderHostFrame x)
forall a. IO a -> SpiderHostFrame x a
forall x a. IO a -> SpiderHostFrame x a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> SpiderHostFrame x a
$cliftIO :: forall x a. IO a -> SpiderHostFrame x a
$cp1MonadIO :: forall x. Monad (SpiderHostFrame x)
MonadIO, Monad (SpiderHostFrame x)
e -> SpiderHostFrame x a
Monad (SpiderHostFrame x) =>
(forall e a. Exception e => e -> SpiderHostFrame x a)
-> (forall e a.
    Exception e =>
    SpiderHostFrame x a
    -> (e -> SpiderHostFrame x a) -> SpiderHostFrame x a)
-> (forall a b.
    SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x a)
-> MonadException (SpiderHostFrame x)
SpiderHostFrame x a
-> (e -> SpiderHostFrame x a) -> SpiderHostFrame x a
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x a
forall x. Monad (SpiderHostFrame x)
forall e a. Exception e => e -> SpiderHostFrame x a
forall e a.
Exception e =>
SpiderHostFrame x a
-> (e -> SpiderHostFrame x a) -> SpiderHostFrame x a
forall a b.
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x a
forall x e a. Exception e => e -> SpiderHostFrame x a
forall x e a.
Exception e =>
SpiderHostFrame x a
-> (e -> SpiderHostFrame x a) -> SpiderHostFrame x a
forall x a b.
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a)
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. m a -> m b -> m a)
-> MonadException m
finally :: SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x a
$cfinally :: forall x a b.
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x a
catch :: SpiderHostFrame x a
-> (e -> SpiderHostFrame x a) -> SpiderHostFrame x a
$ccatch :: forall x e a.
Exception e =>
SpiderHostFrame x a
-> (e -> SpiderHostFrame x a) -> SpiderHostFrame x a
throw :: e -> SpiderHostFrame x a
$cthrow :: forall x e a. Exception e => e -> SpiderHostFrame x a
$cp1MonadException :: forall x. Monad (SpiderHostFrame x)
MonadException, MonadIO (SpiderHostFrame x)
MonadException (SpiderHostFrame x)
(MonadIO (SpiderHostFrame x),
 MonadException (SpiderHostFrame x)) =>
(forall b.
 ((forall a. SpiderHostFrame x a -> SpiderHostFrame x a)
  -> SpiderHostFrame x b)
 -> SpiderHostFrame x b)
-> MonadAsyncException (SpiderHostFrame x)
((forall a. SpiderHostFrame x a -> SpiderHostFrame x a)
 -> SpiderHostFrame x b)
-> SpiderHostFrame x b
forall x. MonadIO (SpiderHostFrame x)
forall x. MonadException (SpiderHostFrame x)
forall b.
((forall a. SpiderHostFrame x a -> SpiderHostFrame x a)
 -> SpiderHostFrame x b)
-> SpiderHostFrame x b
forall x b.
((forall a. SpiderHostFrame x a -> SpiderHostFrame x a)
 -> SpiderHostFrame x b)
-> SpiderHostFrame x b
forall (m :: * -> *).
(MonadIO m, MonadException m) =>
(forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> MonadAsyncException m
mask :: ((forall a. SpiderHostFrame x a -> SpiderHostFrame x a)
 -> SpiderHostFrame x b)
-> SpiderHostFrame x b
$cmask :: forall x b.
((forall a. SpiderHostFrame x a -> SpiderHostFrame x a)
 -> SpiderHostFrame x b)
-> SpiderHostFrame x b
$cp2MonadAsyncException :: forall x. MonadException (SpiderHostFrame x)
$cp1MonadAsyncException :: forall x. MonadIO (SpiderHostFrame x)
MonadAsyncException)

instance Monad (SpiderHostFrame x) where
  {-# INLINABLE (>>=) #-}
  SpiderHostFrame x :: EventM x a
x >>= :: SpiderHostFrame x a
-> (a -> SpiderHostFrame x b) -> SpiderHostFrame x b
>>= f :: a -> SpiderHostFrame x b
f = EventM x b -> SpiderHostFrame x b
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame (EventM x b -> SpiderHostFrame x b)
-> EventM x b -> SpiderHostFrame x b
forall a b. (a -> b) -> a -> b
$ EventM x a
x EventM x a -> (a -> EventM x b) -> EventM x b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SpiderHostFrame x b -> EventM x b
forall x a. SpiderHostFrame x a -> EventM x a
runSpiderHostFrame (SpiderHostFrame x b -> EventM x b)
-> (a -> SpiderHostFrame x b) -> a -> EventM x b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SpiderHostFrame x b
f
  {-# INLINABLE (>>) #-}
  SpiderHostFrame x :: EventM x a
x >> :: SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x b
>> SpiderHostFrame y :: EventM x b
y = EventM x b -> SpiderHostFrame x b
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame (EventM x b -> SpiderHostFrame x b)
-> EventM x b -> SpiderHostFrame x b
forall a b. (a -> b) -> a -> b
$ EventM x a
x EventM x a -> EventM x b -> EventM x b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM x b
y
  {-# INLINABLE return #-}
  return :: a -> SpiderHostFrame x a
return x :: a
x = EventM x a -> SpiderHostFrame x a
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame (EventM x a -> SpiderHostFrame x a)
-> EventM x a -> SpiderHostFrame x a
forall a b. (a -> b) -> a -> b
$ a -> EventM x a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
#if !MIN_VERSION_base(4,13,0)
  {-# INLINABLE fail #-}
  fail s = SpiderHostFrame $ fail s
#endif

instance NotReady (SpiderTimeline x) (SpiderHostFrame x) where
  notReadyUntil :: Event (SpiderTimeline x) a -> SpiderHostFrame x ()
notReadyUntil _ = () -> SpiderHostFrame x ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  notReady :: SpiderHostFrame x ()
notReady = () -> SpiderHostFrame x ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

newEventWithTriggerIO :: forall x a. HasSpiderTimeline x => (RootTrigger x a -> IO (IO ())) -> IO (Event x a)
newEventWithTriggerIO :: (RootTrigger x a -> IO (IO ())) -> IO (Event x a)
newEventWithTriggerIO f :: RootTrigger x a -> IO (IO ())
f = do
  EventSelector x ((:~:) a)
es <- (forall a. (a :~: a) -> RootTrigger x a -> IO (IO ()))
-> IO (EventSelector x ((:~:) a))
forall x (k :: * -> *).
(HasSpiderTimeline x, GCompare k) =>
(forall a. k a -> RootTrigger x a -> IO (IO ()))
-> IO (EventSelector x k)
newFanEventWithTriggerIO ((forall a. (a :~: a) -> RootTrigger x a -> IO (IO ()))
 -> IO (EventSelector x ((:~:) a)))
-> (forall a. (a :~: a) -> RootTrigger x a -> IO (IO ()))
-> IO (EventSelector x ((:~:) a))
forall a b. (a -> b) -> a -> b
$ \Refl -> RootTrigger x a -> IO (IO ())
RootTrigger x a -> IO (IO ())
f
  Event x a -> IO (Event x a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event x a -> IO (Event x a)) -> Event x a -> IO (Event x a)
forall a b. (a -> b) -> a -> b
$ EventSelector x ((:~:) a) -> (a :~: a) -> Event x a
forall k (x :: k) (k :: * -> *).
EventSelector x k -> forall a. k a -> Event x a
select EventSelector x ((:~:) a)
es a :~: a
forall k (a :: k). a :~: a
Refl

newFanEventWithTriggerIO :: (HasSpiderTimeline x, GCompare k) => (forall a. k a -> RootTrigger x a -> IO (IO ())) -> IO (EventSelector x k)
newFanEventWithTriggerIO :: (forall a. k a -> RootTrigger x a -> IO (IO ()))
-> IO (EventSelector x k)
newFanEventWithTriggerIO f :: forall a. k a -> RootTrigger x a -> IO (IO ())
f = do
  IORef (DMap k Identity)
occRef <- DMap k Identity -> IO (IORef (DMap k Identity))
forall a. a -> IO (IORef a)
newIORef DMap k Identity
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f
DMap.empty
  IORef (DMap k (RootSubscribed x))
subscribedRef <- DMap k (RootSubscribed x) -> IO (IORef (DMap k (RootSubscribed x)))
forall a. a -> IO (IORef a)
newIORef DMap k (RootSubscribed x)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f
DMap.empty
  let !r :: Root x k
r = $WRoot :: forall k (x :: k) (k :: * -> *).
IORef (DMap k Identity)
-> IORef (DMap k (RootSubscribed x))
-> (forall a. k a -> RootTrigger x a -> IO (IO ()))
-> Root x k
Root
        { rootOccurrence :: IORef (DMap k Identity)
rootOccurrence = IORef (DMap k Identity)
occRef
        , rootSubscribed :: IORef (DMap k (RootSubscribed x))
rootSubscribed = IORef (DMap k (RootSubscribed x))
subscribedRef
        , rootInit :: forall a. k a -> RootTrigger x a -> IO (IO ())
rootInit = forall a. k a -> RootTrigger x a -> IO (IO ())
f
        }
  EventSelector x k -> IO (EventSelector x k)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventSelector x k -> IO (EventSelector x k))
-> EventSelector x k -> IO (EventSelector x k)
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> Event x a) -> EventSelector x k
forall k (x :: k) (k :: * -> *).
(forall a. k a -> Event x a) -> EventSelector x k
EventSelector ((forall a. k a -> Event x a) -> EventSelector x k)
-> (forall a. k a -> Event x a) -> EventSelector x k
forall a b. (a -> b) -> a -> b
$ \k :: k a
k -> k a -> Root x k -> Event x a
forall (k :: * -> *) x a.
(GCompare k, HasSpiderTimeline x) =>
k a -> Root x k -> Event x a
eventRoot k a
k Root x k
r

newtype ReadPhase x a = ReadPhase (ResultM x a) deriving (a -> ReadPhase x b -> ReadPhase x a
(a -> b) -> ReadPhase x a -> ReadPhase x b
(forall a b. (a -> b) -> ReadPhase x a -> ReadPhase x b)
-> (forall a b. a -> ReadPhase x b -> ReadPhase x a)
-> Functor (ReadPhase x)
forall k (x :: k) a b. a -> ReadPhase x b -> ReadPhase x a
forall k (x :: k) a b. (a -> b) -> ReadPhase x a -> ReadPhase x b
forall a b. a -> ReadPhase x b -> ReadPhase x a
forall a b. (a -> b) -> ReadPhase x a -> ReadPhase x b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ReadPhase x b -> ReadPhase x a
$c<$ :: forall k (x :: k) a b. a -> ReadPhase x b -> ReadPhase x a
fmap :: (a -> b) -> ReadPhase x a -> ReadPhase x b
$cfmap :: forall k (x :: k) a b. (a -> b) -> ReadPhase x a -> ReadPhase x b
Functor, Functor (ReadPhase x)
a -> ReadPhase x a
Functor (ReadPhase x) =>
(forall a. a -> ReadPhase x a)
-> (forall a b.
    ReadPhase x (a -> b) -> ReadPhase x a -> ReadPhase x b)
-> (forall a b c.
    (a -> b -> c) -> ReadPhase x a -> ReadPhase x b -> ReadPhase x c)
-> (forall a b. ReadPhase x a -> ReadPhase x b -> ReadPhase x b)
-> (forall a b. ReadPhase x a -> ReadPhase x b -> ReadPhase x a)
-> Applicative (ReadPhase x)
ReadPhase x a -> ReadPhase x b -> ReadPhase x b
ReadPhase x a -> ReadPhase x b -> ReadPhase x a
ReadPhase x (a -> b) -> ReadPhase x a -> ReadPhase x b
(a -> b -> c) -> ReadPhase x a -> ReadPhase x b -> ReadPhase x c
forall a. a -> ReadPhase x a
forall k (x :: k). Functor (ReadPhase x)
forall k (x :: k) a. a -> ReadPhase x a
forall k (x :: k) a b.
ReadPhase x a -> ReadPhase x b -> ReadPhase x a
forall k (x :: k) a b.
ReadPhase x a -> ReadPhase x b -> ReadPhase x b
forall k (x :: k) a b.
ReadPhase x (a -> b) -> ReadPhase x a -> ReadPhase x b
forall k (x :: k) a b c.
(a -> b -> c) -> ReadPhase x a -> ReadPhase x b -> ReadPhase x c
forall a b. ReadPhase x a -> ReadPhase x b -> ReadPhase x a
forall a b. ReadPhase x a -> ReadPhase x b -> ReadPhase x b
forall a b. ReadPhase x (a -> b) -> ReadPhase x a -> ReadPhase x b
forall a b c.
(a -> b -> c) -> ReadPhase x a -> ReadPhase x b -> ReadPhase x c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ReadPhase x a -> ReadPhase x b -> ReadPhase x a
$c<* :: forall k (x :: k) a b.
ReadPhase x a -> ReadPhase x b -> ReadPhase x a
*> :: ReadPhase x a -> ReadPhase x b -> ReadPhase x b
$c*> :: forall k (x :: k) a b.
ReadPhase x a -> ReadPhase x b -> ReadPhase x b
liftA2 :: (a -> b -> c) -> ReadPhase x a -> ReadPhase x b -> ReadPhase x c
$cliftA2 :: forall k (x :: k) a b c.
(a -> b -> c) -> ReadPhase x a -> ReadPhase x b -> ReadPhase x c
<*> :: ReadPhase x (a -> b) -> ReadPhase x a -> ReadPhase x b
$c<*> :: forall k (x :: k) a b.
ReadPhase x (a -> b) -> ReadPhase x a -> ReadPhase x b
pure :: a -> ReadPhase x a
$cpure :: forall k (x :: k) a. a -> ReadPhase x a
$cp1Applicative :: forall k (x :: k). Functor (ReadPhase x)
Applicative, Applicative (ReadPhase x)
a -> ReadPhase x a
Applicative (ReadPhase x) =>
(forall a b.
 ReadPhase x a -> (a -> ReadPhase x b) -> ReadPhase x b)
-> (forall a b. ReadPhase x a -> ReadPhase x b -> ReadPhase x b)
-> (forall a. a -> ReadPhase x a)
-> Monad (ReadPhase x)
ReadPhase x a -> (a -> ReadPhase x b) -> ReadPhase x b
ReadPhase x a -> ReadPhase x b -> ReadPhase x b
forall a. a -> ReadPhase x a
forall k (x :: k). Applicative (ReadPhase x)
forall k (x :: k) a. a -> ReadPhase x a
forall k (x :: k) a b.
ReadPhase x a -> ReadPhase x b -> ReadPhase x b
forall k (x :: k) a b.
ReadPhase x a -> (a -> ReadPhase x b) -> ReadPhase x b
forall a b. ReadPhase x a -> ReadPhase x b -> ReadPhase x b
forall a b. ReadPhase x a -> (a -> ReadPhase x b) -> ReadPhase x b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ReadPhase x a
$creturn :: forall k (x :: k) a. a -> ReadPhase x a
>> :: ReadPhase x a -> ReadPhase x b -> ReadPhase x b
$c>> :: forall k (x :: k) a b.
ReadPhase x a -> ReadPhase x b -> ReadPhase x b
>>= :: ReadPhase x a -> (a -> ReadPhase x b) -> ReadPhase x b
$c>>= :: forall k (x :: k) a b.
ReadPhase x a -> (a -> ReadPhase x b) -> ReadPhase x b
$cp1Monad :: forall k (x :: k). Applicative (ReadPhase x)
Monad, Monad (ReadPhase x)
Monad (ReadPhase x) =>
(forall a. (a -> ReadPhase x a) -> ReadPhase x a)
-> MonadFix (ReadPhase x)
(a -> ReadPhase x a) -> ReadPhase x a
forall a. (a -> ReadPhase x a) -> ReadPhase x a
forall k (x :: k). Monad (ReadPhase x)
forall k (x :: k) a. (a -> ReadPhase x a) -> ReadPhase x a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> ReadPhase x a) -> ReadPhase x a
$cmfix :: forall k (x :: k) a. (a -> ReadPhase x a) -> ReadPhase x a
$cp1MonadFix :: forall k (x :: k). Monad (ReadPhase x)
MonadFix)

instance MonadRef (SpiderHost x) where
  type Ref (SpiderHost x) = Ref IO
  newRef :: a -> SpiderHost x (Ref (SpiderHost x) a)
newRef = IO (IORef a) -> SpiderHost x (IORef a)
forall x a. IO a -> SpiderHost x a
SpiderHost (IO (IORef a) -> SpiderHost x (IORef a))
-> (a -> IO (IORef a)) -> a -> SpiderHost x (IORef a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO (IORef a)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef
  readRef :: Ref (SpiderHost x) a -> SpiderHost x a
readRef = IO a -> SpiderHost x a
forall x a. IO a -> SpiderHost x a
SpiderHost (IO a -> SpiderHost x a)
-> (IORef a -> IO a) -> IORef a -> SpiderHost x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef a -> IO a
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef
  writeRef :: Ref (SpiderHost x) a -> a -> SpiderHost x ()
writeRef r :: Ref (SpiderHost x) a
r = IO () -> SpiderHost x ()
forall x a. IO a -> SpiderHost x a
SpiderHost (IO () -> SpiderHost x ()) -> (a -> IO ()) -> a -> SpiderHost x ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref IO a -> a -> IO ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
writeRef Ref IO a
Ref (SpiderHost x) a
r

instance MonadAtomicRef (SpiderHost x) where
  atomicModifyRef :: Ref (SpiderHost x) a -> (a -> (a, b)) -> SpiderHost x b
atomicModifyRef r :: Ref (SpiderHost x) a
r = IO b -> SpiderHost x b
forall x a. IO a -> SpiderHost x a
SpiderHost (IO b -> SpiderHost x b)
-> ((a -> (a, b)) -> IO b) -> (a -> (a, b)) -> SpiderHost x b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref IO a -> (a -> (a, b)) -> IO b
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef Ref IO a
Ref (SpiderHost x) a
r

instance MonadRef (SpiderHostFrame x) where
  type Ref (SpiderHostFrame x) = Ref IO
  newRef :: a -> SpiderHostFrame x (Ref (SpiderHostFrame x) a)
newRef = EventM x (IORef a) -> SpiderHostFrame x (IORef a)
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame (EventM x (IORef a) -> SpiderHostFrame x (IORef a))
-> (a -> EventM x (IORef a)) -> a -> SpiderHostFrame x (IORef a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> EventM x (IORef a)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef
  readRef :: Ref (SpiderHostFrame x) a -> SpiderHostFrame x a
readRef = EventM x a -> SpiderHostFrame x a
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame (EventM x a -> SpiderHostFrame x a)
-> (IORef a -> EventM x a) -> IORef a -> SpiderHostFrame x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef a -> EventM x a
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef
  writeRef :: Ref (SpiderHostFrame x) a -> a -> SpiderHostFrame x ()
writeRef r :: Ref (SpiderHostFrame x) a
r = EventM x () -> SpiderHostFrame x ()
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame (EventM x () -> SpiderHostFrame x ())
-> (a -> EventM x ()) -> a -> SpiderHostFrame x ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref (EventM x) a -> a -> EventM x ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
writeRef Ref (SpiderHostFrame x) a
Ref (EventM x) a
r

instance MonadAtomicRef (SpiderHostFrame x) where
  atomicModifyRef :: Ref (SpiderHostFrame x) a -> (a -> (a, b)) -> SpiderHostFrame x b
atomicModifyRef r :: Ref (SpiderHostFrame x) a
r = EventM x b -> SpiderHostFrame x b
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame (EventM x b -> SpiderHostFrame x b)
-> ((a -> (a, b)) -> EventM x b)
-> (a -> (a, b))
-> SpiderHostFrame x b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref (EventM x) a -> (a -> (a, b)) -> EventM x b
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef Ref (SpiderHostFrame x) a
Ref (EventM x) a
r

instance PrimMonad (SpiderHostFrame x) where
  type PrimState (SpiderHostFrame x) = PrimState IO
  primitive :: (State# (PrimState (SpiderHostFrame x))
 -> (# State# (PrimState (SpiderHostFrame x)), a #))
-> SpiderHostFrame x a
primitive = EventM x a -> SpiderHostFrame x a
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame (EventM x a -> SpiderHostFrame x a)
-> ((State# RealWorld -> (# State# RealWorld, a #)) -> EventM x a)
-> (State# RealWorld -> (# State# RealWorld, a #))
-> SpiderHostFrame x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> EventM x a
forall k (x :: k) a. IO a -> EventM x a
EventM (IO a -> EventM x a)
-> ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #))
-> EventM x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive

instance NotReady (SpiderTimeline x) (SpiderHost x) where
  notReadyUntil :: Event (SpiderTimeline x) a -> SpiderHost x ()
notReadyUntil _ = () -> SpiderHost x ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  notReady :: SpiderHost x ()
notReady = () -> SpiderHost x ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance HasSpiderTimeline x => NotReady (SpiderTimeline x) (PerformEventT (SpiderTimeline x) (SpiderHost x)) where
  notReadyUntil :: Event (SpiderTimeline x) a
-> PerformEventT (SpiderTimeline x) (SpiderHost x) ()
notReadyUntil _ = () -> PerformEventT (SpiderTimeline x) (SpiderHost x) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  notReady :: PerformEventT (SpiderTimeline x) (SpiderHost x) ()
notReady = () -> PerformEventT (SpiderTimeline x) (SpiderHost x) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()