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

#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.Catch (MonadMask, MonadThrow, MonadCatch)
import Control.Monad.Exception
import Control.Monad.Fix
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
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail)
#endif
import qualified Control.Monad.Fail as MonadFail
import Data.Align
import Data.Coerce
import Data.Dependent.Map (DMap)
import qualified Data.Dependent.Map as DMap
import Data.Dependent.Sum (DSum (..))
import Data.FastMutableIntMap (FastMutableIntMap)
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.Proxy
import Data.These
import Data.Traversable
import Data.Type.Equality ((:~:)(Refl))
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
import Witherable (Filterable, mapMaybe)

#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)

#ifdef DEBUG_HIDE_INTERNALS
import Data.List (isPrefixOf)
#endif

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 :: forall a. a -> String
showNodeId a
_ = String
""

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

#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
  { forall {k} (x :: k). EventSubscription x -> IO ()
_eventSubscription_unsubscribe :: !(IO ())
  , forall {k} (x :: k). EventSubscription x -> EventSubscribed x
_eventSubscription_subscribed :: {-# UNPACK #-} !(EventSubscribed x)
  }

unsubscribe :: EventSubscription x -> IO ()
unsubscribe :: forall {k} (x :: k). EventSubscription x -> IO ()
unsubscribe (EventSubscription IO ()
u EventSubscribed x
_) = IO ()
u

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

newtype Event x a = Event { forall {k} (x :: k) a.
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 :: forall {k} (x :: k) a.
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 :: (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
pushCheap :: forall {k} a (x :: k) b.
(a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
pushCheap !a -> ComputeM x (Maybe b)
f 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
$ \Subscriber x b
sub -> do
  (subscription, 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' String
"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
a -> do
        mb <- a -> ComputeM x (Maybe b)
f a
a
        mapM_ (subscriberPropagate sub) mb
    }
  occ' <- join <$> mapM f occ
  return (subscription, occ')

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

-- | Subscribe to an Event only for the duration of one occurrence
{-# INLINE subscribeAndReadHead #-}
subscribeAndReadHead :: Event x a -> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndReadHead :: forall {k} (x :: k) a.
Event x a
-> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
subscribeAndReadHead Event x a
e Subscriber x a
sub = do
  subscriptionRef <- IO (IORef (EventSubscription x))
-> EventM x (IORef (EventSubscription x))
forall a. IO a -> EventM x a
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 String
"subscribeAndReadHead: not initialized"
  (subscription, occ) <- subscribeAndRead e $ debugSubscriber' "head" $ sub
    { subscriberPropagate = \a
a -> do
        IO () -> EventM x ()
forall a. IO a -> EventM x a
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
    }
  liftIO $ case occ of
    Maybe a
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 a
_ -> EventSubscription x -> IO ()
forall {k} (x :: k). EventSubscription x -> IO ()
unsubscribe EventSubscription x
subscription
  return (subscription, occ)

--TODO: Make this lazy in its input event
headE :: (MonadIO m, Defer (SomeMergeInit x) m) => Event x a -> m (Event x a)
headE :: forall {k} (m :: * -> *) (x :: k) a.
(MonadIO m, Defer (SomeMergeInit x) m) =>
Event x a -> m (Event x a)
headE Event x a
originalE = do
  parent <- IO (IORef (Maybe (Event x a))) -> m (IORef (Maybe (Event x a)))
forall a. IO a -> m 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
  defer $ SomeMergeInit $ do --TODO: Rename SomeMergeInit appropriately
    let clearParent = IO () -> EventM x ()
forall a. IO a -> EventM x a
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) <- subscribeAndReadHead originalE $ terminalSubscriber $ const clearParent
    when (isJust occ) clearParent
  return $ Event $ \Subscriber x a
sub ->
    IO (Maybe (Event x a)) -> EventM x (Maybe (Event x a))
forall a. IO a -> EventM 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 a b. EventM x a -> (a -> EventM x b) -> EventM x b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe (Event x a)
Nothing -> EventM x (EventSubscription x, Maybe a)
forall {k} (x :: k) a. EventM x (EventSubscription x, Maybe a)
subscribeAndReadNever
      Just Event x a
e -> 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)
subscribeAndReadHead Event x a
e Subscriber x a
sub

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

nowSpiderEventM :: (HasSpiderTimeline x) => EventM x (R.Event (SpiderTimeline x) ())
nowSpiderEventM :: forall x.
HasSpiderTimeline x =>
EventM x (Event (SpiderTimeline x) ())
nowSpiderEventM =
  Event x () -> Event (SpiderTimeline x) ()
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (Event x () -> Event (SpiderTimeline x) ())
-> EventM x (Event x ()) -> EventM x (Event (SpiderTimeline x) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventM x (Event x ())
forall {k} (m :: * -> *) (x :: k).
(MonadIO m, Defer (Some Clear) m) =>
m (Event x ())
now

now :: (MonadIO m, Defer (Some Clear) m) => m (Event x ())
now :: forall {k} (m :: * -> *) (x :: k).
(MonadIO m, Defer (Some Clear) m) =>
m (Event x ())
now = do
  nowOrNot <- IO (IORef (Maybe ())) -> m (IORef (Maybe ()))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe ())) -> m (IORef (Maybe ())))
-> IO (IORef (Maybe ())) -> m (IORef (Maybe ()))
forall a b. (a -> b) -> a -> b
$ Maybe () -> IO (IORef (Maybe ()))
forall a. a -> IO (IORef a)
newIORef (Maybe () -> IO (IORef (Maybe ())))
-> Maybe () -> IO (IORef (Maybe ()))
forall a b. (a -> b) -> a -> b
$ () -> Maybe ()
forall a. a -> Maybe a
Just ()
  scheduleClear nowOrNot
  return . Event $ \Subscriber x ()
_ -> do
    occ <- IO (Maybe ()) -> EventM x (Maybe ())
forall a. IO a -> EventM x a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ()) -> EventM x (Maybe ()))
-> (IORef (Maybe ()) -> IO (Maybe ()))
-> IORef (Maybe ())
-> EventM x (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef (Maybe ()) -> IO (Maybe ())
forall a. IORef a -> IO a
readIORef (IORef (Maybe ()) -> EventM x (Maybe ()))
-> IORef (Maybe ()) -> EventM x (Maybe ())
forall a b. (a -> b) -> a -> b
$ IORef (Maybe ())
nowOrNot
    return ( EventSubscription (return ()) eventSubscribedNow
           , occ
           )

-- | 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 :: forall x a. HasSpiderTimeline x => Event x a -> Event x a
cacheEvent 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
    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
    pure $ \Subscriber x a
sub -> {-# SCC "cacheEvent" #-} do
#ifdef DEBUG_TRACE_EVENTS
          unless (BS8.null callSite) $ liftIO $ BS8.hPutStrLn stderr callSite
#endif
          subscribedTicket <- IO (Maybe (FastWeakTicket (CacheSubscribed x a)))
-> EventM x (Maybe (FastWeakTicket (CacheSubscribed x a)))
forall a. IO a -> EventM 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 a b. IO a -> (a -> IO b) -> IO b
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 a b. EventM x a -> (a -> EventM x b) -> EventM x b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just FastWeakTicket (CacheSubscribed x a)
subscribedTicket -> FastWeakTicket (CacheSubscribed x a)
-> EventM x (FastWeakTicket (CacheSubscribed x a))
forall a. a -> EventM x a
forall (m :: * -> *) a. Monad m => a -> m a
return FastWeakTicket (CacheSubscribed x a)
subscribedTicket
            Maybe (FastWeakTicket (CacheSubscribed x a))
Nothing -> do
#ifdef DEBUG_NODEIDS
              nodeId <- liftIO newNodeId
#endif
              subscribers <- IO (FastWeakBag (Subscriber x a))
-> EventM x (FastWeakBag (Subscriber x a))
forall a. IO a -> EventM x a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (FastWeakBag (Subscriber x a))
forall a. IO (FastWeakBag a)
FastWeakBag.empty
              occRef <- liftIO $ newIORef 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, occ) <- subscribeAndRead e $ Subscriber
#endif
                  { subscriberPropagate = \a
a -> do
                      IO () -> EventM x ()
forall a. IO a -> EventM x a
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 {k} (x :: k) a.
a -> FastWeakBag (Subscriber x a) -> EventM x ()
propagateFast a
a FastWeakBag (Subscriber x a)
subscribers
                  , subscriberInvalidateHeight = FastWeakBag.traverse_ subscribers . invalidateSubscriberHeight
                  , subscriberRecalculateHeight = FastWeakBag.traverse_ subscribers . recalculateSubscriberHeight
                  }
              when (isJust occ) $ do
                liftIO $ writeIORef occRef occ -- Set the initial value of occRef; we don't need to do this if occ is Nothing
                scheduleClear occRef
              let !subscribed = 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
                    }
              subscribedTicket <- liftIO $ mkFastWeakTicket subscribed
              liftIO $ writeIORef mSubscribedRef =<< getFastWeakTicketWeak subscribedTicket
              return subscribedTicket
          liftIO $ cacheSubscription sub mSubscribedRef subscribedTicket

cacheSubscription :: Subscriber x a -> IORef (FastWeak (CacheSubscribed x a))
                  -> FastWeakTicket (CacheSubscribed x a) -> IO (EventSubscription x, Maybe a)
cacheSubscription :: 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 = do
  subscribed <- FastWeakTicket (CacheSubscribed x a) -> IO (CacheSubscribed x a)
forall a. FastWeakTicket a -> IO a
getFastWeakTicketValue FastWeakTicket (CacheSubscribed x a)
subscribedTicket
  ticket <- FastWeakBag.insert sub $ _cacheSubscribed_subscribers subscribed
  occ <- readIORef $ _cacheSubscribed_occurrence subscribed

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

          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
          when isEmpty $ do
            writeIORef mSubscribedRef emptyFastWeak
            unsubscribe parentSub
          touch ticket
          touch subscribedTicket
        , _eventSubscription_subscribed :: EventSubscribed x
_eventSubscription_subscribed = 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
          }
        }
  return (es, occ)


subscribe :: Event x a -> Subscriber x a -> EventM x (EventSubscription x)
subscribe :: forall {k} (x :: k) a.
Event x a -> Subscriber x a -> EventM x (EventSubscription x)
subscribe Event x a
e 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 :: 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 t -> EventSubscribed x
tag Subscriber x a -> m (WeakBagTicket, t, Maybe a)
getSpecificSubscribed Subscriber x a
sub = do
  (sln, subd, occ) <- Subscriber x a -> m (WeakBagTicket, t, Maybe a)
getSpecificSubscribed Subscriber x a
sub
  let es = t -> EventSubscribed x
tag t
subd
  return (EventSubscription (WeakBag.remove sln >> touch sln) es, occ)

eventRoot :: (GCompare k, HasSpiderTimeline x) => k a -> Root x k -> Event x a
eventRoot :: forall (k :: * -> *) x a.
(GCompare k, HasSpiderTimeline x) =>
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 a. IO a -> EventM x 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 :: forall {k} (x :: k) a. EventM x (EventSubscription x, Maybe a)
subscribeAndReadNever = (EventSubscription x, Maybe a)
-> EventM x (EventSubscription x, Maybe a)
forall a. a -> EventM x 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 a. a -> IO a
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 :: forall {k} (x :: k) a. 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 :: 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 = (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 :: forall x a. HasSpiderTimeline x => 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 :: forall x a. HasSpiderTimeline x => 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 :: forall {k} (x :: k) p. 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 :: forall x p. (HasSpiderTimeline x, Patch p) => 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
$ \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 a b. EventM x a -> (a -> EventM x b) -> EventM x b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \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 :: forall x a.
HasSpiderTimeline x =>
Event x a
-> Height
-> CoincidenceSubscribed x a
-> EventM x (Maybe a, Height, EventSubscribed x)
subscribeCoincidenceInner Event x a
inner Height
outerHeight CoincidenceSubscribed x a
subscribedUnsafe = do
  subInner <- IO (Subscriber x a) -> EventM x (Subscriber x a)
forall a. IO a -> EventM 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 _ innerSubd), innerOcc) <- subscribeAndRead inner subInner
  innerHeight <- liftIO $ getEventSubscribedHeight innerSubd
  let height = Height -> Height -> Height
forall a. Ord a => a -> a -> a
max Height
innerHeight Height
outerHeight
  defer $ SomeResetCoincidence subscription $ if height > outerHeight then Just subscribedUnsafe else Nothing
  return (innerOcc, height, innerSubd)

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

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

newSubscriberHold :: (HasSpiderTimeline x, Patch p) => Hold x p -> IO (Subscriber x p)
newSubscriberHold :: forall x p.
(HasSpiderTimeline x, Patch p) =>
Hold x p -> IO (Subscriber x p)
newSubscriberHold Hold x p
h = Subscriber x p -> IO (Subscriber x p)
forall a. a -> IO a
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
$ 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 = \Height
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = \Height
_ -> () -> IO ()
forall a. a -> IO a
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 :: 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
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 (String
"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
$ Subscriber
  { subscriberPropagate :: DMap k v -> EventM x ()
subscriberPropagate = \DMap k v
a -> {-# SCC "traverseFan" #-} do
      subs <- IO (DMap k (FanSubscribedChildren x k v))
-> EventM x (DMap k (FanSubscribedChildren x k v))
forall a. IO a -> EventM x a
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} {k} (x :: k) (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
fanSubscribedSubscribers FanSubscribed x k v
subscribed
      tracePropagate (Proxy :: Proxy x) $ show (DMap.size subs) <> " keys subscribed, " <> show (DMap.size a) <> " keys firing"
      liftIO $ writeIORef (fanSubscribedOccurrence subscribed) $ Just a
      scheduleClear $ fanSubscribedOccurrence subscribed
      let f p
_ (Pair f a
v FanSubscribedChildren x k f a
subsubs) = do
            f a -> WeakBag (Subscriber x (f a)) -> EventM x ()
forall {k} (x :: k) a. 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} {k} (x :: 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 a. a -> EventM x a
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.traverseWithKey f $ DMap.intersectionWithKey (\k v
_ -> 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) a subs --TODO: Would be nice to have DMap.traverse_
      return ()
  , subscriberInvalidateHeight :: Height -> IO ()
subscriberInvalidateHeight = \Height
old -> do
      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} {k} (x :: k) (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
fanSubscribedSubscribers FanSubscribed x k v
subscribed
      forM_ (DMap.toList subscribers) $ \(k a
_ :=> 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} {k} (x :: 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 = \Height
new -> do
      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} {k} (x :: k) (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
fanSubscribedSubscribers FanSubscribed x k v
subscribed
      forM_ (DMap.toList subscribers) $ \(k a
_ :=> 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} {k} (x :: 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 :: forall x a.
HasSpiderTimeline x =>
SwitchSubscribed x a -> IO (Subscriber x a)
newSubscriberSwitch 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 (String
"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
$ Subscriber
  { subscriberPropagate :: a -> EventM x ()
subscriberPropagate = \a
a -> {-# SCC "traverseSwitch" #-} do
      IO () -> EventM x ()
forall a. IO a -> EventM x a
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 {k} (x :: k) a. 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 = \Height
_ -> do
      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
      when (oldHeight /= invalidHeight) $ do
        writeIORef (switchSubscribedHeight subscribed) $! invalidHeight
        WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight 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 :: forall x b.
HasSpiderTimeline x =>
CoincidenceSubscribed x b -> IO (Subscriber x (Event x b))
newSubscriberCoincidenceOuter 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 (String
"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
$ Subscriber
  { subscriberPropagate :: Event x b -> EventM x ()
subscriberPropagate = \Event x b
a -> {-# SCC "traverseCoincidenceOuter" #-} do
      outerHeight <- IO Height -> EventM x Height
forall a. IO a -> EventM x a
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
      tracePropagate (Proxy :: Proxy x) $ "  outerHeight = " <> show outerHeight
      (occ, innerHeight, innerSubd) <- subscribeCoincidenceInner a outerHeight subscribed
      tracePropagate (Proxy :: Proxy x) $ "  isJust occ = " <> show (isJust occ)
      tracePropagate (Proxy :: Proxy x) $ "  innerHeight = " <> show innerHeight

      liftIO $ writeIORef (coincidenceSubscribedInnerParent subscribed) $ Just innerSubd
      scheduleClear $ coincidenceSubscribedInnerParent subscribed
      case occ of
        Maybe b
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 a. IO a -> EventM x a
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 b
o -> do -- Since it's already firing, no need to adjust height
          IO () -> EventM x ()
forall a. IO a -> EventM x a
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 {k} (x :: k) a. 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  = \Height
_ -> CoincidenceSubscribed x b -> IO ()
forall {k} (x :: k) a. CoincidenceSubscribed x a -> IO ()
invalidateCoincidenceHeight CoincidenceSubscribed x b
subscribed
  , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = \Height
_ -> 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 :: forall x a.
HasSpiderTimeline x =>
CoincidenceSubscribed x a -> IO (Subscriber x a)
newSubscriberCoincidenceInner 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 (String
"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
$ Subscriber
  { subscriberPropagate :: a -> EventM x ()
subscriberPropagate = \a
a -> {-# SCC "traverseCoincidenceInner" #-} do
      occ <- IO (Maybe a) -> EventM x (Maybe a)
forall a. IO a -> EventM x 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 occ of
        Just a
_ -> () -> EventM x ()
forall a. a -> EventM x a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- SubscriberCoincidenceOuter must have already propagated this event
        Maybe a
Nothing -> do
          IO () -> EventM x ()
forall a. IO a -> EventM x a
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 {k} (x :: k) a. 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  = \Height
_ -> CoincidenceSubscribed x a -> IO ()
forall {k} (x :: k) a. CoincidenceSubscribed x a -> IO ()
invalidateCoincidenceHeight CoincidenceSubscribed x a
subscribed
  , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = \Height
_ -> 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 :: forall {k} (x :: k) a. 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 :: forall {k} (x :: k) a. 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. a -> WeakBag (Subscriber x a) -> EventM x ()
propagate :: forall {k} (x :: k) a. a -> WeakBag (Subscriber x a) -> EventM x ()
propagate a
a 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
$ \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. a -> FastWeakBag (Subscriber x a) -> EventM x ()
propagateFast :: forall {k} (x :: k) a.
a -> FastWeakBag (Subscriber x a) -> EventM x ()
propagateFast a
a 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
$ \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 :: forall a. 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
  { forall {k} (x :: k). EventSubscribed x -> IORef Height
eventSubscribedHeightRef :: {-# UNPACK #-} !(IORef Height)
  , forall {k} (x :: k). 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 :: forall {k} (x :: k) a. RootSubscribed x a -> EventSubscribed x
eventSubscribedRoot !RootSubscribed x a
r = 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 :: forall {k} (x :: k). EventSubscribed x
eventSubscribedNever = 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
  }
eventSubscribedNow :: EventSubscribed x
eventSubscribedNow :: forall {k} (x :: k). EventSubscribed x
eventSubscribedNow = 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 ["now"]
#endif
  }

eventSubscribedFan :: FanSubscribed x k v -> EventSubscribed x
eventSubscribedFan :: forall {k} {k} (x :: k) (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> EventSubscribed x
eventSubscribedFan !FanSubscribed x k v
subscribed = 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} {k} (x :: 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 :: forall {k} (x :: k) a. SwitchSubscribed x a -> EventSubscribed x
eventSubscribedSwitch !SwitchSubscribed x a
subscribed = 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 :: forall {k} (x :: k) a.
CoincidenceSubscribed x a -> EventSubscribed x
eventSubscribedCoincidence !CoincidenceSubscribed x a
subscribed = 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 :: forall {k} (x :: k). EventSubscribed x -> IO Height
getEventSubscribedHeight 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 :: forall {k} (x :: k) p.
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 { forall {k} (x :: k) a. Behavior x a -> BehaviorM x a
readBehaviorTracked :: BehaviorM x a }

behaviorHold :: Hold x p -> Behavior x (PatchTarget p)
behaviorHold :: forall {k} (x :: k) p. 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 :: forall {k} (x :: k) a. Hold x (Identity a) -> Behavior x a
behaviorHoldIdentity = Hold x (Identity a) -> Behavior x a
Hold x (Identity a) -> Behavior x (PatchTarget (Identity a))
forall {k} (x :: k) p. Hold x p -> Behavior x (PatchTarget p)
behaviorHold

behaviorConst :: a -> Behavior x a
behaviorConst :: forall {k} a (x :: k). 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 a. a -> BehaviorM x a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

behaviorPull :: Pull x a -> Behavior x a
behaviorPull :: forall {k} (x :: k) a. 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
    val <- IO (Maybe (PullSubscribed x a))
-> BehaviorM x (Maybe (PullSubscribed x a))
forall a. IO a -> BehaviorM 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 val of
      Just 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 a b. BehaviorM x a -> (a -> BehaviorM x b) -> BehaviorM x b
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_ (\IORef [SomeBehaviorSubscribed x]
r -> IO () -> BehaviorM x ()
forall a. IO a -> BehaviorM x a
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 a b. BehaviorM x a -> (a -> BehaviorM x b) -> BehaviorM x b
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_ (\Weak (Invalidator x)
wi -> IO () -> BehaviorM x ()
forall a. IO a -> BehaviorM x a
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 a. IO a -> BehaviorM x a
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 a. 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
      Maybe (PullSubscribed x a)
Nothing -> do
        i <- IO (Invalidator x) -> BehaviorM x (Invalidator x)
forall a. IO a -> BehaviorM x a
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
        wi <- liftIO $ mkWeakPtrWithDebug i "InvalidatorPull"
        parentsRef <- liftIO $ newIORef []
        holdInits <- askBehaviorHoldInits
        a <- liftIO $ runReaderIO (unBehaviorM $ pullCompute p) (Just (wi, parentsRef), holdInits)
        invsRef <- liftIO . newIORef . maybeToList =<< askInvalidator
        parents <- liftIO $ readIORef parentsRef
        let subscribed = 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
              }
        liftIO $ writeIORef (pullValue p) $ Just subscribed
        askParentsRef >>= mapM_ (\IORef [SomeBehaviorSubscribed x]
r -> IO () -> BehaviorM x ()
forall a. IO a -> BehaviorM x a
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]
:))
        return a

behaviorDyn :: Patch p => Dyn x p -> Behavior x (PatchTarget p)
behaviorDyn :: forall p x. Patch p => 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 :: forall {k} (x :: k) p. Hold x p -> BehaviorM x (PatchTarget p)
readHoldTracked Hold x p
h = do
  result <- IO (PatchTarget p) -> BehaviorM x (PatchTarget p)
forall a. IO a -> BehaviorM x a
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
  askInvalidator >>= mapM_ (\Weak (Invalidator x)
wi -> IO () -> BehaviorM x ()
forall a. IO a -> BehaviorM x a
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]
:))
  askParentsRef >>= mapM_ (\IORef [SomeBehaviorSubscribed x]
r -> IO () -> BehaviorM x ()
forall a. IO a -> BehaviorM x a
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 (ZonkAny 1) -> Some (BehaviorSubscribed x)
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Hold x p -> BehaviorSubscribed x (ZonkAny 1)
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]
:))
  liftIO $ touch h -- Otherwise, if this gets inlined enough, the hold's parent reference may get collected
  return result

{-# INLINABLE readBehaviorUntracked #-}
readBehaviorUntracked :: Defer (SomeHoldInit x) m => Behavior x a -> m a
readBehaviorUntracked :: forall {k} (x :: k) (m :: * -> *) a.
Defer (SomeHoldInit x) m =>
Behavior x a -> m a
readBehaviorUntracked Behavior x a
b = do
  holdInits <- m (IORef [SomeHoldInit x])
forall a (m :: * -> *). Defer a m => m (IORef [a])
getDeferralQueue
  liftIO $ runBehaviorM (readBehaviorTracked b) Nothing 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
  { forall {k} (x :: k) target p.
Dynamic x target p -> Behavior x target
dynamicCurrent :: !(Behavior x target)
  , forall {k} (x :: k) target p. 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 :: forall {k} (x :: k) p. Hold x p -> DynamicS x p
dynamicHold !Hold x p
h = 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 :: forall {k} (x :: k) a.
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 :: forall {k} p (x :: k). PatchTarget p -> DynamicS x p
dynamicConst !PatchTarget p
a = 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 :: forall x p.
(HasSpiderTimeline x, Patch p) =>
Dyn x p -> DynamicS x p
dynamicDyn !Dyn x p
d = 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 :: forall x a.
HasSpiderTimeline x =>
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 { forall {k} (x :: k) p. Hold x p -> IORef (PatchTarget p)
holdValue :: !(IORef (PatchTarget p))
          , forall {k} (x :: k) p. Hold x p -> IORef [Weak (Invalidator x)]
holdInvalidators :: !(IORef [Weak (Invalidator x)])
          , forall {k} (x :: k) p. Hold x p -> Event x p
holdEvent :: Event x p -- This must be lazy, or holds cannot be defined before their input Events
          , forall {k} (x :: k) p.
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 {forall x. 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
  { forall x. SpiderTimelineEnv' x -> MVar ()
_spiderTimeline_lock :: {-# UNPACK #-} !(MVar ())
  , forall x. 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 -> SpiderTimelineEnv x -> Bool
== SpiderTimelineEnv x
_ = Bool
True -- Since only one exists of each type

instance GEq SpiderTimelineEnv where
  SpiderTimelineEnv a
a geq :: forall a b.
SpiderTimelineEnv a -> SpiderTimelineEnv b -> Maybe (a :~: b)
`geq` 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
$ (ZonkAny 3 :~: ZonkAny 3) -> a :~: b
forall a b. a -> b
unsafeCoerce ZonkAny 3 :~: ZonkAny 3
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 { forall x. EventEnv x -> IORef [SomeAssignment x]
eventEnvAssignments :: !(IORef [SomeAssignment x]) -- Needed for Subscribe
              , forall x. EventEnv x -> IORef [SomeHoldInit x]
eventEnvHoldInits :: !(IORef [SomeHoldInit x]) -- Needed for Subscribe
              , forall x. EventEnv x -> IORef [SomeDynInit x]
eventEnvDynInits :: !(IORef [SomeDynInit x])
              , forall x. EventEnv x -> IORef [SomeMergeUpdate x]
eventEnvMergeUpdates :: !(IORef [SomeMergeUpdate x])
              , forall x. EventEnv x -> IORef [SomeMergeInit x]
eventEnvMergeInits :: !(IORef [SomeMergeInit x]) -- Needed for Subscribe
              , forall x. EventEnv x -> IORef [Some Clear]
eventEnvClears :: !(IORef [Some Clear]) -- Needed for Subscribe
              , forall x. EventEnv x -> IORef [Some IntClear]
eventEnvIntClears :: !(IORef [Some IntClear])
              , forall x. EventEnv x -> IORef [Some RootClear]
eventEnvRootClears :: !(IORef [Some RootClear])
              , forall x. EventEnv x -> IORef Height
eventEnvCurrentHeight :: !(IORef Height) -- Needed for Subscribe
              , forall x. EventEnv x -> IORef [SomeResetCoincidence x]
eventEnvResetCoincidences :: !(IORef [SomeResetCoincidence x]) -- Needed for Subscribe
              , forall x. EventEnv x -> IORef (IntMap [EventM x ()])
eventEnvDelayedMerges :: !(IORef (IntMap [EventM x ()]))
              }

{-# INLINE runEventM #-}
runEventM :: EventM x a -> IO a
runEventM :: forall {k} (x :: k) a. 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 :: forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a
asksEventEnv EventEnv x -> a
f = a -> EventM x a
forall a. 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 :: forall a (m :: * -> *). Defer a m => a -> m ()
defer a
a = do
  q <- m (IORef [a])
forall a (m :: * -> *). Defer a m => m (IORef [a])
getDeferralQueue
  liftIO $ modifyIORef' q (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
  (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]),
   IORef [SomeHoldInit x])
  (IORef [SomeHoldInit x])
-> BehaviorM x (IORef [SomeHoldInit x])
forall {k} (x :: k) a. ReaderIO (BehaviorEnv x) a -> BehaviorM x a
BehaviorM (ReaderIO
   (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]),
    IORef [SomeHoldInit x])
   (IORef [SomeHoldInit x])
 -> BehaviorM x (IORef [SomeHoldInit x]))
-> ReaderIO
     (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]),
      IORef [SomeHoldInit x])
     (IORef [SomeHoldInit x])
-> BehaviorM x (IORef [SomeHoldInit x])
forall a b. (a -> b) -> a -> b
$ ((Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]),
  IORef [SomeHoldInit x])
 -> IORef [SomeHoldInit x])
-> ReaderIO
     (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]),
      IORef [SomeHoldInit x])
     (IORef [SomeHoldInit x])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]),
 IORef [SomeHoldInit 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
    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
    liftIO $ readIORef heightRef
  {-# INLINE scheduleMerge #-}
  scheduleMerge :: Height -> EventM x () -> EventM x ()
scheduleMerge Height
height EventM x ()
subscribed = do
    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
    liftIO $ modifyIORef' delayedRef $ IntMap.insertWith (++) (unHeight height) [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 :: forall x. HasSpiderTimeline x => Height -> EventM x ()
putCurrentHeight Height
h = do
  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
  liftIO $ writeIORef heightRef $! 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 :: forall (m :: * -> *) a.
Defer (Some Clear) m =>
IORef (Maybe a) -> m ()
scheduleClear 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 :: forall (m :: * -> *) a.
Defer (Some IntClear) m =>
IORef (IntMap a) -> m ()
scheduleIntClear 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 :: forall (m :: * -> *) (k :: * -> *).
Defer (Some RootClear) m =>
IORef (DMap k Identity) -> m ()
scheduleRootClear 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 :: 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
e = do
  valRef <- IO (IORef (PatchTarget p)) -> m (IORef (PatchTarget p))
forall a. IO a -> m a
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
  invsRef <- liftIO $ newIORef []
  parentRef <- liftIO $ newIORef Nothing
#ifdef DEBUG_NODEIDS
  nodeId <- liftIO newNodeId
#endif
  let h = 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
        }
  defer $ SomeHoldInit h
  return h

{-# INLINE getHoldEventSubscription #-}
getHoldEventSubscription :: forall p x. (HasSpiderTimeline x, Patch p) => Hold x p -> EventM x (EventSubscription x)
getHoldEventSubscription :: forall p x.
(HasSpiderTimeline x, Patch p) =>
Hold x p -> EventM x (EventSubscription x)
getHoldEventSubscription Hold x p
h = do
  ep <- IO (Maybe (EventSubscription x))
-> EventM x (Maybe (EventSubscription x))
forall a. IO a -> EventM x a
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 ep of
    Just EventSubscription x
subd -> EventSubscription x -> EventM x (EventSubscription x)
forall a. a -> EventM x a
forall (m :: * -> *) a. Monad m => a -> m a
return EventSubscription x
subd
    Maybe (EventSubscription x)
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
      subscriptionRef <- IO (IORef (EventSubscription x))
-> EventM x (IORef (EventSubscription x))
forall a. IO a -> EventM x a
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 String
"getHoldEventSubscription: subdRef uninitialized"
      (subscription@(EventSubscription _ _), occ) <- subscribeAndRead e =<< liftIO (newSubscriberHold h)
      liftIO $ writeIORef subscriptionRef $! subscription
      case occ of
        Maybe p
Nothing -> () -> EventM x ()
forall a. a -> EventM x a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just p
o -> do
          old <- IO (PatchTarget p) -> EventM x (PatchTarget p)
forall a. IO a -> EventM x a
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 apply o old of
            Maybe (PatchTarget p)
Nothing -> () -> EventM x ()
forall a. a -> EventM x a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just PatchTarget p
new -> do
              -- Need to evaluate these so that we don't retain the Hold itself
              v <- IO (IORef (PatchTarget p)) -> EventM x (IORef (PatchTarget p))
forall a. IO a -> EventM x a
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
              i <- liftIO $ evaluate $ holdInvalidators h
              defer $ SomeAssignment v i new
      liftIO $ writeIORef (holdParent h) $ Just subscription
      return subscription

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

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

instance Monad (BehaviorM x) where
  {-# INLINE (>>=) #-}
  BehaviorM ReaderIO (BehaviorEnv x) a
x >>= :: forall a b. BehaviorM x a -> (a -> BehaviorM x b) -> BehaviorM x b
>>= 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 a b.
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
#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 { forall {k} (x :: k) a. PullSubscribed x a -> a
pullSubscribedValue :: !a
                    , forall {k} (x :: k) a.
PullSubscribed x a -> IORef [Weak (Invalidator x)]
pullSubscribedInvalidators :: !(IORef [Weak (Invalidator x)])
                    , forall {k} (x :: k) a. PullSubscribed x a -> Invalidator x
pullSubscribedOwnInvalidator :: !(Invalidator x)
                    , forall {k} (x :: k) a.
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 { forall {k} (x :: k) a.
Pull x a -> IORef (Maybe (PullSubscribed x a))
pullValue :: !(IORef (Maybe (PullSubscribed x a)))
          , forall {k} (x :: k) 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
  , forall {k} (x :: k) a.
RootSubscribed x a -> WeakBag (Subscriber x a)
rootSubscribedSubscribers :: !(WeakBag (Subscriber x a))
  , forall {k} (x :: k) a. RootSubscribed x a -> IO (Maybe a)
rootSubscribedOccurrence :: !(IO (Maybe a)) -- Lookup from rootOccurrence
  , forall {k} (x :: k) a. RootSubscribed x a -> IO ()
rootSubscribedUninit :: IO ()
  , forall {k} (x :: k) a.
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 { forall {k} (x :: k) (k :: * -> *).
Root x k -> IORef (DMap k Identity)
rootOccurrence :: !(IORef (DMap k Identity)) -- The currently-firing occurrence of this event
          , forall {k} (x :: k) (k :: * -> *).
Root x k -> IORef (DMap k (RootSubscribed x))
rootSubscribed :: !(IORef (DMap k (RootSubscribed x)))
          , forall {k} (x :: k) (k :: * -> *).
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
  { forall {k} (x :: k).
SomeMergeUpdate x -> EventM x [EventSubscription x]
_someMergeUpdate_update :: !(EventM x [EventSubscription x])
  , forall {k} (x :: k). SomeMergeUpdate x -> IO ()
_someMergeUpdate_invalidateHeight :: !(IO ())
  , forall {k} (x :: k). SomeMergeUpdate x -> IO ()
_someMergeUpdate_recalculateHeight :: !(IO ())
  }

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

-- EventM can do everything BehaviorM can, plus create holds
newtype EventM x a = EventM { forall {k} (x :: k) a. EventM x a -> IO a
unEventM :: IO a }
  deriving ((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
$cfmap :: forall k (x :: k) a b. (a -> b) -> EventM x a -> EventM x b
fmap :: forall a b. (a -> b) -> EventM x a -> EventM x b
$c<$ :: forall k (x :: k) a b. a -> EventM x b -> EventM x a
<$ :: forall a b. a -> EventM x b -> EventM x a
Functor, Functor (EventM x)
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)
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
$cpure :: forall k (x :: k) a. a -> EventM x a
pure :: forall a. a -> EventM x a
$c<*> :: forall k (x :: k) a b.
EventM x (a -> b) -> EventM x a -> EventM x b
<*> :: forall a b. EventM x (a -> b) -> EventM x a -> EventM x b
$cliftA2 :: forall k (x :: k) a b c.
(a -> b -> c) -> EventM x a -> EventM x b -> EventM x c
liftA2 :: forall a b c.
(a -> b -> c) -> EventM x a -> EventM x b -> EventM x c
$c*> :: forall k (x :: k) a b. EventM x a -> EventM x b -> EventM x b
*> :: forall a b. EventM x a -> EventM x b -> EventM x b
$c<* :: forall k (x :: k) a b. EventM x a -> EventM x b -> EventM x a
<* :: forall a b. EventM x a -> EventM x b -> EventM x a
Applicative, Applicative (EventM x)
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)
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
$c>>= :: forall k (x :: k) a b.
EventM x a -> (a -> EventM x b) -> EventM x b
>>= :: forall a b. EventM x a -> (a -> EventM x b) -> EventM x b
$c>> :: forall k (x :: k) a b. EventM x a -> EventM x b -> EventM x b
>> :: forall a b. EventM x a -> EventM x b -> EventM x b
$creturn :: forall k (x :: k) a. a -> EventM x a
return :: forall a. a -> EventM x a
Monad, Monad (EventM x)
Monad (EventM x) =>
(forall a. IO a -> EventM x a) -> MonadIO (EventM x)
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
$cliftIO :: forall k (x :: k) a. IO a -> EventM x a
liftIO :: forall a. IO a -> EventM x a
MonadIO, Monad (EventM x)
Monad (EventM x) =>
(forall a. (a -> EventM x a) -> EventM x a) -> MonadFix (EventM x)
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
$cmfix :: forall k (x :: k) a. (a -> EventM x a) -> EventM x a
mfix :: forall a. (a -> EventM x a) -> EventM x a
MonadFix, Monad (EventM x)
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)
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
$cthrow :: forall k (x :: k) e a. Exception e => e -> EventM x a
throw :: forall e a. Exception e => e -> EventM x a
$ccatch :: forall k (x :: k) e a.
Exception e =>
EventM x a -> (e -> EventM x a) -> EventM x a
catch :: forall e a.
Exception e =>
EventM x a -> (e -> EventM x a) -> EventM x a
$cfinally :: forall k (x :: k) a b. EventM x a -> EventM x b -> EventM x a
finally :: forall a b. EventM x a -> EventM x b -> EventM x a
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 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
$cmask :: forall k (x :: k) b.
((forall a. EventM x a -> EventM x a) -> EventM x b) -> EventM x b
mask :: forall b.
((forall a. EventM x a -> EventM x a) -> EventM x b) -> EventM x b
MonadAsyncException, MonadThrow (EventM x)
MonadThrow (EventM x) =>
(forall e a.
 (HasCallStack, Exception e) =>
 EventM x a -> (e -> EventM x a) -> EventM x a)
-> MonadCatch (EventM x)
forall k (x :: k). MonadThrow (EventM x)
forall k (x :: k) e a.
(HasCallStack, Exception e) =>
EventM x a -> (e -> EventM x a) -> EventM x a
forall e a.
(HasCallStack, Exception e) =>
EventM x a -> (e -> EventM x a) -> EventM x a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall k (x :: k) e a.
(HasCallStack, Exception e) =>
EventM x a -> (e -> EventM x a) -> EventM x a
catch :: forall e a.
(HasCallStack, Exception e) =>
EventM x a -> (e -> EventM x a) -> EventM x a
MonadCatch, Monad (EventM x)
Monad (EventM x) =>
(forall e a. (HasCallStack, Exception e) => e -> EventM x a)
-> MonadThrow (EventM x)
forall k (x :: k). Monad (EventM x)
forall k (x :: k) e a.
(HasCallStack, Exception e) =>
e -> EventM x a
forall e a. (HasCallStack, Exception e) => e -> EventM x a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall k (x :: k) e a.
(HasCallStack, Exception e) =>
e -> EventM x a
throwM :: forall e a. (HasCallStack, Exception e) => e -> EventM x a
MonadThrow, MonadCatch (EventM x)
MonadCatch (EventM x) =>
(forall b.
 HasCallStack =>
 ((forall a. EventM x a -> EventM x a) -> EventM x b) -> EventM x b)
-> (forall b.
    HasCallStack =>
    ((forall a. EventM x a -> EventM x a) -> EventM x b) -> EventM x b)
-> (forall a b c.
    HasCallStack =>
    EventM x a
    -> (a -> ExitCase b -> EventM x c)
    -> (a -> EventM x b)
    -> EventM x (b, c))
-> MonadMask (EventM x)
forall b.
HasCallStack =>
((forall a. EventM x a -> EventM x a) -> EventM x b) -> EventM x b
forall k (x :: k). MonadCatch (EventM x)
forall k (x :: k) b.
HasCallStack =>
((forall a. EventM x a -> EventM x a) -> EventM x b) -> EventM x b
forall k (x :: k) a b c.
HasCallStack =>
EventM x a
-> (a -> ExitCase b -> EventM x c)
-> (a -> EventM x b)
-> EventM x (b, c)
forall a b c.
HasCallStack =>
EventM x a
-> (a -> ExitCase b -> EventM x c)
-> (a -> EventM x b)
-> EventM x (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall k (x :: k) b.
HasCallStack =>
((forall a. EventM x a -> EventM x a) -> EventM x b) -> EventM x b
mask :: forall b.
HasCallStack =>
((forall a. EventM x a -> EventM x a) -> EventM x b) -> EventM x b
$cuninterruptibleMask :: forall k (x :: k) b.
HasCallStack =>
((forall a. EventM x a -> EventM x a) -> EventM x b) -> EventM x b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. EventM x a -> EventM x a) -> EventM x b) -> EventM x b
$cgeneralBracket :: forall k (x :: k) a b c.
HasCallStack =>
EventM x a
-> (a -> ExitCase b -> EventM x c)
-> (a -> EventM x b)
-> EventM x (b, c)
generalBracket :: forall a b c.
HasCallStack =>
EventM x a
-> (a -> ExitCase b -> EventM x c)
-> (a -> EventM x b)
-> EventM x (b, c)
MonadMask)

newtype MergeSubscribedParent x a = MergeSubscribedParent { forall {k} {k} (x :: k) (a :: k).
MergeSubscribedParent x a -> EventSubscription x
unMergeSubscribedParent :: EventSubscription x }

data MergeSubscribedParentWithMove x k a = MergeSubscribedParentWithMove
  { forall {k} {k} (x :: k) (k :: k -> *) (a :: k).
MergeSubscribedParentWithMove x k a -> EventSubscription x
_mergeSubscribedParentWithMove_subscription :: !(EventSubscription x)
  , forall {k} {k} (x :: k) (k :: k -> *) (a :: k).
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
$cshowsPrec :: Int -> HeightBag -> String -> String
showsPrec :: Int -> HeightBag -> String -> String
$cshow :: HeightBag -> String
show :: HeightBag -> String
$cshowList :: [HeightBag] -> String -> String
showList :: [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
$creadsPrec :: Int -> ReadS HeightBag
readsPrec :: Int -> ReadS HeightBag
$creadList :: ReadS [HeightBag]
readList :: ReadS [HeightBag]
$creadPrec :: ReadPrec HeightBag
readPrec :: ReadPrec HeightBag
$creadListPrec :: ReadPrec [HeightBag]
readListPrec :: ReadPrec [HeightBag]
Read, HeightBag -> HeightBag -> Bool
(HeightBag -> HeightBag -> Bool)
-> (HeightBag -> HeightBag -> Bool) -> Eq HeightBag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeightBag -> HeightBag -> Bool
== :: HeightBag -> HeightBag -> Bool
$c/= :: HeightBag -> HeightBag -> Bool
/= :: 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
$ccompare :: HeightBag -> HeightBag -> Ordering
compare :: HeightBag -> HeightBag -> Ordering
$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
>= :: HeightBag -> HeightBag -> Bool
$cmax :: HeightBag -> HeightBag -> HeightBag
max :: HeightBag -> HeightBag -> HeightBag
$cmin :: HeightBag -> HeightBag -> HeightBag
min :: HeightBag -> HeightBag -> 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 Int
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 [Height]
heights = HeightBag -> HeightBag
heightBagVerify (HeightBag -> HeightBag) -> HeightBag -> HeightBag
forall a b. (a -> b) -> a -> b
$ (HeightBag -> Height -> HeightBag)
-> HeightBag -> [Height] -> HeightBag
forall b a. (b -> a -> b) -> b -> [a] -> b
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 Int
h) (HeightBag Int
s 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 (\Int
_ Word
_ Word
old -> Word -> Word
forall a. Enum a => a -> a
succ Word
old) Int
h Word
0 IntMap Word
c

heightBagRemove :: Height -> HeightBag -> HeightBag
heightBagRemove :: Height -> HeightBag -> HeightBag
heightBagRemove (Height Int
h) b :: HeightBag
b@(HeightBag Int
s 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
  Maybe Word
Nothing -> String -> HeightBag
forall a. HasCallStack => String -> a
error (String -> HeightBag) -> String -> HeightBag
forall a b. (a -> b) -> a -> b
$ String
"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
<> String
" 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 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
    Word
0 -> Int -> IntMap Word -> IntMap Word
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
h IntMap Word
c
    Word
_ -> 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 Int
h) (HeightBag Int
s 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 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
    Word
0 -> Int -> IntMap Word -> IntMap Word
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
h IntMap Word
c
    Word
_ -> 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 Int
_ 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 ((Int
h, Word
_), IntMap Word
_) -> Int -> Height
Height Int
h
  Maybe ((Int, Word), IntMap Word)
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
  { forall {k} {k} (x :: k) (k :: k -> *) (v :: k -> *) (a :: k).
FanSubscribedChildren x k v a -> WeakBag (Subscriber x (v a))
_fanSubscribedChildren_list :: !(WeakBag (Subscriber x (v a)))
  , forall {k} {k} (x :: k) (k :: k -> *) (v :: k -> *) (a :: k).
FanSubscribedChildren x k v a -> (k a, FanSubscribed x k v)
_fanSubscribedChildren_self :: {-# NOUNPACK #-} !(k a, FanSubscribed x k v)
  , forall {k} {k} (x :: k) (k :: k -> *) (v :: k -> *) (a :: k).
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 { forall {k} {k} (x :: k) (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (Maybe (FanSubscribed x k v))
fanSubscribedCachedSubscribed :: !(IORef (Maybe (FanSubscribed x k v)))
                   , forall {k} {k} (x :: k) (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (Maybe (DMap k v))
fanSubscribedOccurrence :: !(IORef (Maybe (DMap k v)))
                   , forall {k} {k} (x :: k) (k :: k -> *) (v :: k -> *).
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
                   , forall {k} {k} (x :: k) (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> EventSubscription x
fanSubscribedParent :: !(EventSubscription x)
#ifdef DEBUG_NODEIDS
                   , fanSubscribedNodeId :: Int
#endif
                   }

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

data SwitchSubscribed x a
   = SwitchSubscribed { forall {k} (x :: k) a.
SwitchSubscribed x a -> IORef (Maybe (SwitchSubscribed x a))
switchSubscribedCachedSubscribed :: !(IORef (Maybe (SwitchSubscribed x a)))
                      , forall {k} (x :: k) a. SwitchSubscribed x a -> IORef (Maybe a)
switchSubscribedOccurrence :: !(IORef (Maybe a))
                      , forall {k} (x :: k) a. SwitchSubscribed x a -> IORef Height
switchSubscribedHeight :: !(IORef Height)
                      , forall {k} (x :: k) a.
SwitchSubscribed x a -> WeakBag (Subscriber x a)
switchSubscribedSubscribers :: !(WeakBag (Subscriber x a))
                      , forall {k} (x :: k) a. SwitchSubscribed x a -> Invalidator x
switchSubscribedOwnInvalidator :: {-# NOUNPACK #-} !(Invalidator x)
                      , forall {k} (x :: k) a.
SwitchSubscribed x a -> IORef (Weak (Invalidator x))
switchSubscribedOwnWeakInvalidator :: !(IORef (Weak (Invalidator x)))
                      , forall {k} (x :: k) a.
SwitchSubscribed x a -> IORef [SomeBehaviorSubscribed x]
switchSubscribedBehaviorParents :: !(IORef [SomeBehaviorSubscribed x])
                      , forall {k} (x :: k) a.
SwitchSubscribed x a -> Behavior x (Event x a)
switchSubscribedParent :: !(Behavior x (Event x a))
                      , forall {k} (x :: k) a.
SwitchSubscribed x a -> IORef (EventSubscription x)
switchSubscribedCurrentParent :: !(IORef (EventSubscription x))
                      , forall {k} (x :: k) a.
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 { forall {k} (x :: k) a. Switch x a -> Behavior x (Event x a)
switchParent :: !(Behavior x (Event x a))
            , forall {k} (x :: k) 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 { forall {k} (x :: k) a.
CoincidenceSubscribed x a
-> IORef (Maybe (CoincidenceSubscribed x a))
coincidenceSubscribedCachedSubscribed :: !(IORef (Maybe (CoincidenceSubscribed x a)))
                           , forall {k} (x :: k) a. CoincidenceSubscribed x a -> IORef (Maybe a)
coincidenceSubscribedOccurrence :: !(IORef (Maybe a))
                           , forall {k} (x :: k) a.
CoincidenceSubscribed x a -> WeakBag (Subscriber x a)
coincidenceSubscribedSubscribers :: !(WeakBag (Subscriber x a))
                           , forall {k} (x :: k) a. CoincidenceSubscribed x a -> IORef Height
coincidenceSubscribedHeight :: !(IORef Height)
                           , forall {k} (x :: k) a.
CoincidenceSubscribed x a -> Subscriber x (Event x a)
coincidenceSubscribedOuter :: {-# NOUNPACK #-} (Subscriber x (Event x a))
                           , forall {k} (x :: k) a.
CoincidenceSubscribed x a -> EventSubscription x
coincidenceSubscribedOuterParent :: !(EventSubscription x)
                           , forall {k} (x :: k) a.
CoincidenceSubscribed x a -> IORef (Maybe (EventSubscribed x))
coincidenceSubscribedInnerParent :: !(IORef (Maybe (EventSubscribed x)))
                           , forall {k} (x :: k) a.
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 { forall {k} (x :: k) a. Coincidence x a -> Event x (Event x a)
coincidenceParent :: !(Event x (Event x a))
                 , forall {k} (x :: k) 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 :: forall {k} (x :: k) a. SwitchSubscribed x a -> IO (Invalidator x)
newInvalidatorSwitch SwitchSubscribed x a
subd = Invalidator x -> IO (Invalidator x)
forall a. a -> IO a
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 :: forall {k} (x :: k) a. Pull x a -> IO (Invalidator x)
newInvalidatorPull Pull x a
p = Invalidator x -> IO (Invalidator x)
forall a. a -> IO a
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 :: forall a b. (a -> Maybe b) -> Event x a -> Event x b
mapMaybe 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 a. a -> EventM x a
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 :: forall a. 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 :: forall a b. Event x a -> Event x b -> Event x (These a b)
align Event x a
ea 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 a b. (a -> Maybe b) -> Event x a -> Event x 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 Event x a -> Event x (Identity a)
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 :: forall a b. Event x a -> Event x b -> Event x (a, b)
zip Event x a
x Event x b
y = (These a b -> Maybe (a, b))
-> Event x (These a b) -> Event x (a, b)
forall a b. (a -> Maybe b) -> Event x a -> Event x 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 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 { forall x p. 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 :: forall x a b.
HasSpiderTimeline x =>
(a -> b) -> DynamicS x (Identity a) -> DynamicS x (Identity b)
newMapDyn a -> b
f 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 -> PatchTarget (Identity b))
-> BehaviorM x a -> BehaviorM x (PatchTarget (Identity b))
forall a b. (a -> b) -> BehaviorM x a -> BehaviorM x b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
a -> PatchTarget (Identity 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 :: forall x a b c.
HasSpiderTimeline x =>
(a -> b -> c)
-> DynamicS x (Identity a)
-> DynamicS x (Identity b)
-> DynamicS x (Identity c)
zipDynWith a -> b -> c
f DynamicS x (Identity a)
da 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 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 (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
$ \These (Identity a) (Identity b)
o -> do
        (a, b) <- case These (Identity a) (Identity b)
o of
          This (Identity a
a) -> do
            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
            return (a, b)
          That (Identity b
b) -> do
            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
            return (a, b)
          These (Identity a
a) (Identity b
b) -> (a, b) -> EventM x (a, b)
forall a. a -> EventM x a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)
        return $ Just $ Identity $ f a 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 a b. BehaviorM x (a -> b) -> BehaviorM x a -> BehaviorM x b
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 :: forall x (m :: * -> *) p.
(Defer (SomeDynInit x) m, Patch p) =>
EventM x (PatchTarget p) -> Event x p -> m (Dyn x p)
buildDynamic EventM x (PatchTarget p)
readV0 Event x p
v' = do
  result <- IO (IORef (DynType x p)) -> m (IORef (DynType x p))
forall a. IO a -> m a
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 = IORef (DynType x p) -> Dyn x p
forall x p. IORef (DynType x p) -> Dyn x p
Dyn IORef (DynType x p)
result
  defer $ SomeDynInit d
  return d

unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
unsafeBuildDynamic :: forall x p. BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
unsafeBuildDynamic BehaviorM x (PatchTarget p)
readV0 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 :: forall a b. (a -> b) -> Event x a -> Event x b
fmap 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 a. a -> EventM x a
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 :: forall a b. (a -> b) -> Behavior x a -> Behavior x b
fmap 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 a b. (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 :: forall x a b.
HasSpiderTimeline x =>
(a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
push a -> ComputeM x (Maybe b)
f 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 {k} a (x :: k) b.
(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 :: forall {k} (x :: k) a. BehaviorM x a -> Behavior x a
pull 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
  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
  pure $ behaviorPull $ Pull
    { pullCompute = a
    , pullValue = ref
#ifdef DEBUG_NODEIDS
    , pullNodeId = nid
#endif
    }

{-# INLINABLE switch #-}
switch :: HasSpiderTimeline x => Behavior x (Event x a) -> Event x a
switch :: forall x a.
HasSpiderTimeline x =>
Behavior x (Event x a) -> Event x a
switch 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
  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
  pure $ eventSwitch $ Switch
    { switchParent = a
    , switchSubscribed = ref
    }

coincidence :: HasSpiderTimeline x => Event x (Event x a) -> Event x a
coincidence :: forall x a. HasSpiderTimeline x => Event x (Event x a) -> Event x a
coincidence 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
  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
  pure $ eventCoincidence $ Coincidence
    { coincidenceParent = a
    , coincidenceSubscribed = 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 :: forall x b.
HasSpiderTimeline x =>
[DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b
run [DSum (RootTrigger x) Identity]
roots 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
$ String
"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 a. [a] -> 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
<> String
" events"
  let t :: SpiderTimelineEnv x
t = SpiderTimelineEnv x
forall x. HasSpiderTimeline x => SpiderTimelineEnv x
spiderTimeline :: SpiderTimelineEnv x
  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
    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 (WeakBag (Subscriber x a)
_, IORef (DMap k Identity)
occRef, k a
k) :=> Identity a
a) -> do
      occBefore <- IO (DMap k Identity) -> EventM x (DMap k Identity)
forall a. IO a -> EventM x a
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
        occBefore <- IORef (DMap k Identity) -> IO (DMap k Identity)
forall a. IORef a -> IO a
readIORef IORef (DMap k Identity)
occRef
        writeIORef occRef $! DMap.insert k a occBefore
        return occBefore
      if DMap.null occBefore
        then do scheduleRootClear occRef
                return $ Just r
        else return Nothing
    forM_ (catMaybes rootsToPropagate) $ \(RootTrigger (WeakBag (Subscriber x a)
subscribersRef, IORef (DMap k Identity)
_, k a
_) :=> Identity a
a) -> do
      a -> WeakBag (Subscriber x a) -> EventM x ()
forall {k} (x :: k) a. a -> WeakBag (Subscriber x a) -> EventM x ()
propagate a
a WeakBag (Subscriber x a)
subscribersRef
    delayedRef <- asksEventEnv eventEnvDelayedMerges
    let go = do
          delayed <- IO (IntMap [EventM x ()]) -> EventM x (IntMap [EventM x ()])
forall a. IO a -> EventM x a
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.minViewWithKey delayed of
            Maybe ((Int, [EventM x ()]), IntMap [EventM x ()])
Nothing -> () -> EventM x ()
forall a. a -> EventM x a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just ((Int
currentHeight, [EventM x ()]
cur), 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
$ String
"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 a. IO a -> EventM x a
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
    go
    putCurrentHeight maxBound
    after
  tracePropagate (Proxy :: Proxy x) "Done running an event frame"
  return result

scheduleMerge' :: HasSpiderTimeline x => Height -> IORef Height -> EventM x () -> EventM x ()
scheduleMerge' :: forall x.
HasSpiderTimeline x =>
Height -> IORef Height -> EventM x () -> EventM x ()
scheduleMerge' Height
initialHeight IORef Height
heightRef 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 <- IO Height -> EventM x Height
forall a. IO a -> EventM x a
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
  currentHeight <- getCurrentHeight
  case height `compare` currentHeight of
    Ordering
LT -> String -> EventM x ()
forall a. HasCallStack => String -> a
error String
"Somehow a merge's height has been decreased after it was scheduled"
    Ordering
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?)
    Ordering
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 :: forall a. a -> String -> IO (Weak a)
mkWeakPtrWithDebug a
x String
debugNote = do
  x' <- a -> IO a
forall a. a -> IO a
evaluate a
x
  mkWeakPtr x' $
    if debugFinalize
    then Just $ debugStrLn $ "finalizing: " ++ debugNote
    else 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 :: forall {k} {k} (proxy :: k -> *) (x :: k) (m :: k -> *) (a :: k).
proxy x -> m a -> m a
withIncreasedDepth proxy x
_ = m a -> m a
forall a. a -> a
id

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

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

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

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

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



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

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

#endif

whoCreatedIORef :: IORef a -> IO [String]
whoCreatedIORef :: forall a. IORef a -> IO [String]
whoCreatedIORef (IORef 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 :: forall a. Eq a => [NonEmpty a] -> [(a, NonEmpty [a])]
groupByHead = \case
  [] -> []
  (a
x :| [a]
xs) : [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@((a
y, NonEmpty [a]
yss) : [(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 :: forall a. Eq a => [[a]] -> Forest a
listsToForest [[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])] -> [Tree 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 a b. (a -> Maybe b) -> [a] -> [b]
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, t [a]
lists') = a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
a ([Tree a] -> Tree a) -> [Tree a] -> Tree a
forall a b. (a -> b) -> a -> b
$ [[a]] -> [Tree a]
forall a. Eq a => [[a]] -> Forest a
listsToForest ([[a]] -> [Tree a]) -> [[a]] -> [Tree a]
forall a b. (a -> b) -> a -> b
$ t [a] -> [[a]]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t [a]
lists'

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

filterStack :: String -> [String] -> [String]
#ifdef DEBUG_HIDE_INTERNALS
filterStack prefix = filter (not . (prefix `isPrefixOf`))
#else
filterStack :: String -> [String] -> [String]
filterStack 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
EventLoopException = String
"causality loop detected: \n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
    String
"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 :: forall x p.
(HasSpiderTimeline x, Patch p) =>
Hold x p -> p -> EventM x ()
propagateSubscriberHold Hold x p
h 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 a. IO a -> EventM x a
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
    invalidators <- IO [Weak (Invalidator x)] -> IO [Weak (Invalidator x)]
forall a. IO a -> IO a
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
    return $ "SubscriberHold" <> showNodeId h <> ": " ++ show (length invalidators)

  v <- {-# SCC "read" #-} IO (PatchTarget p) -> EventM x (PatchTarget p)
forall a. IO a -> EventM x a
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" #-} apply a v of
    Maybe (PatchTarget p)
Nothing -> () -> EventM x ()
forall a. a -> EventM x a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just 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) (String
"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)
      vRef <- {-# SCC "vRef" #-} IO (IORef (PatchTarget p)) -> EventM x (IORef (PatchTarget p))
forall a. IO a -> EventM x a
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
      iRef <- {-# SCC "iRef" #-} liftIO $ evaluate $ holdInvalidators h
      defer $ {-# SCC "assignment" #-} SomeAssignment vRef iRef 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 :: forall {k} (x :: k) a.
BehaviorM x a
-> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
-> IORef [SomeHoldInit x]
-> IO a
runBehaviorM BehaviorM x a
a Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
mwi 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 :: forall {k} (x :: k). BehaviorM x (Maybe (Weak (Invalidator x)))
askInvalidator = do
  (!m, _) <- BehaviorM
  x
  (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]),
   IORef [SomeHoldInit x])
forall r (m :: * -> *). MonadReader r m => m r
ask
  case m of
    Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
Nothing -> Maybe (Weak (Invalidator x))
-> BehaviorM x (Maybe (Weak (Invalidator x)))
forall a. a -> BehaviorM x a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Weak (Invalidator x))
forall a. Maybe a
Nothing
    Just (!Weak (Invalidator x)
wi, IORef [SomeBehaviorSubscribed x]
_) -> Maybe (Weak (Invalidator x))
-> BehaviorM x (Maybe (Weak (Invalidator x)))
forall a. a -> BehaviorM x a
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 :: forall {k} (x :: k).
BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
askParentsRef = do
  (!m, _) <- BehaviorM
  x
  (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]),
   IORef [SomeHoldInit x])
forall r (m :: * -> *). MonadReader r m => m r
ask
  case m of
    Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x])
Nothing -> Maybe (IORef [SomeBehaviorSubscribed x])
-> BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
forall a. a -> BehaviorM x a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IORef [SomeBehaviorSubscribed x])
forall a. Maybe a
Nothing
    Just (Weak (Invalidator x)
_, !IORef [SomeBehaviorSubscribed x]
p) -> Maybe (IORef [SomeBehaviorSubscribed x])
-> BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
forall a. a -> BehaviorM x a
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 :: forall {k} (x :: k). BehaviorM x (IORef [SomeHoldInit x])
askBehaviorHoldInits = do
  (_, !his) <- BehaviorM
  x
  (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]),
   IORef [SomeHoldInit x])
forall r (m :: * -> *). MonadReader r m => m r
ask
  return his

{-# INLINE getDynHold #-}
getDynHold :: (Defer (SomeHoldInit x) m, Patch p) => Dyn x p -> m (Hold x p)
getDynHold :: forall x (m :: * -> *) p.
(Defer (SomeHoldInit x) m, Patch p) =>
Dyn x p -> m (Hold x p)
getDynHold Dyn x p
d = do
  mh <- IO (DynType x p) -> m (DynType x p)
forall a. IO a -> m a
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 mh of
    HoldDyn Hold x p
h -> Hold x p -> m (Hold x p)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Hold x p
h
    UnsafeDyn (BehaviorM x (PatchTarget p)
readV0, Event x p
v') -> do
      holdInits <- m (IORef [SomeHoldInit x])
forall a (m :: * -> *). Defer a m => m (IORef [a])
getDeferralQueue
      v0 <- liftIO $ runBehaviorM readV0 Nothing holdInits
      hold' v0 v'
    BuildDyn (EventM x (PatchTarget p)
readV0, Event x p
v') -> do
      v0 <- IO (PatchTarget p) -> m (PatchTarget p)
forall a. IO a -> m a
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
      hold' v0 v'
  where
    hold' :: PatchTarget p -> Event x p -> m (Hold x p)
hold' PatchTarget p
v0 Event x p
v' = do
      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'
      liftIO $ writeIORef (unDyn d) $ HoldDyn h
      return 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 :: 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 Subscriber x a
sub = do
  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 = (DMap k Identity -> Maybe a)
-> IO (DMap k Identity) -> IO (Maybe a)
forall a b. (a -> b) -> IO a -> IO b
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 DMap.lookup k mSubscribed of
    Just RootSubscribed x a
subscribed -> {-# SCC "hitRoot" #-} do
      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
      occ <- getOcc
      return (sln, subscribed, occ)
    Maybe (RootSubscribed x a)
Nothing -> {-# SCC "missRoot" #-} do
      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 String
"getRootSubscribed: weakSelfRef not initialized"
      let !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
      uninitRef <- newIORef $ error "getRootsubscribed: uninitRef not initialized"
      (subs, sln) <- WeakBag.singleton sub weakSelf cleanupRootSubscribed

      tracePropagate (Proxy::Proxy x) $  "getRootSubscribed: calling rootInit"

      uninit <- rootInit r k $ RootTrigger (subs, rootOccurrence r, k)
      writeIORef uninitRef $! uninit
#ifdef DEBUG_NODEIDS
      nid <- newNodeId
#endif
      let !subscribed = 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 = do
            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
            when (not $ IntMap.null cs) (cleanupRootSubscribed subscribed)
      writeIORef weakSelf =<< evaluate =<< mkWeakPtr subscribed (Just finalCleanup)
      modifyIORef' (rootSubscribed r) $ DMap.insertWith (error $ "getRootSubscribed: duplicate key inserted into Root") k subscribed --TODO: I think we can just write back mSubscribed rather than re-reading it
      occ <- getOcc
      return (sln, subscribed, occ)

#ifdef USE_TEMPLATE_HASKELL
{-# ANN cleanupRootSubscribed "HLint: ignore Redundant bracket" #-}
#endif
cleanupRootSubscribed :: RootSubscribed x a -> IO ()
cleanupRootSubscribed :: forall {k} (x :: k) a. 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 :: forall {k} (x :: k) a.
RootSubscribed x a -> Subscriber x a -> IO WeakBagTicket
subscribeRootSubscribed RootSubscribed x a
subscribed 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 { forall {k} (x :: k) a. EventSelectorInt x a -> Int -> Event x a
selectInt :: Int -> Event x a }

data FanInt x a = FanInt
  { forall {k} (x :: k) a.
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
  , forall {k} (x :: k) a. FanInt x a -> IORef (EventSubscription x)
_fanInt_subscriptionRef :: {-# UNPACK #-} !(IORef (EventSubscription x)) -- This should have a valid subscription iff subscribers is non-empty
  , forall {k} (x :: k) a. 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 :: forall {k} (x :: k) a. IO (FanInt x a)
newFanInt = do
  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
  subscriptionRef <- newIORef $ error "fanInt: no subscription"
  occRef <- newIORef $ error "fanInt: no occurrence"
#ifdef DEBUG_NODEIDS
  nodeId <- newNodeId
#endif
  return $ FanInt
    { _fanInt_subscribers = subscribers
    , _fanInt_subscriptionRef = subscriptionRef
    , _fanInt_occRef = occRef
#ifdef DEBUG_NODEIDS
    , _fanInt_nodeId = nodeId
#endif
    }

fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a
fanInt :: forall x a.
HasSpiderTimeline x =>
Event x (IntMap a) -> EventSelectorInt x a
fanInt 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
  self <- IO (FanInt x a)
forall {k} (x :: k) a. IO (FanInt x a)
newFanInt
  pure $ EventSelectorInt $ \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
$ \Subscriber x a
sub -> do
    isEmpty <- IO Bool -> EventM x Bool
forall a. IO a -> EventM x a
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)
    when isEmpty $ do -- This is the first subscriber, so we need to subscribe to our input
      let desc = String
"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
<> String
", k = "  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
k
      (subscription, parentOcc) <- subscribeAndRead p $ debugSubscriber' desc $ Subscriber
        { subscriberPropagate = \IntMap a
m -> do
            IO () -> EventM x ()
forall a. IO a -> EventM x a
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
$ \FastWeakBag (Subscriber x a)
b 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
$ \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
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
$ \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
$ \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
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
$ \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
$ \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
        }
      liftIO $ do
        writeIORef (_fanInt_subscriptionRef self) subscription
        writeIORef (_fanInt_occRef self) $ fromMaybe IntMap.empty parentOcc
      scheduleIntClear $ _fanInt_occRef self
    liftIO $ do
      b <- FastMutableIntMap.lookup (_fanInt_subscribers self) k >>= \case
        Maybe (FastWeakBag (Subscriber x a))
Nothing -> do
          b <- IO (FastWeakBag (Subscriber x a))
forall a. IO (FastWeakBag a)
FastWeakBag.empty
          FastMutableIntMap.insert (_fanInt_subscribers self) k b
          return b
        Just FastWeakBag (Subscriber x a)
b -> FastWeakBag (Subscriber x a) -> IO (FastWeakBag (Subscriber x a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FastWeakBag (Subscriber x a)
b
      ticket <- liftIO $ FastWeakBag.insert sub b
      currentOcc <- readIORef (_fanInt_occRef self)

      subscribed <- fanIntSubscribed ticket self
      return (EventSubscription (FastWeakBag.remove ticket) subscribed, IntMap.lookup k currentOcc)

fanIntSubscribed :: FastWeakBagTicket k -> FanInt x a -> IO (EventSubscribed x)
fanIntSubscribed :: forall {k} k (x :: k) a.
FastWeakBagTicket k -> FanInt x a -> IO (EventSubscribed x)
fanIntSubscribed FastWeakBagTicket k
ticket FanInt x a
self = do
  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)
  return $ EventSubscribed
    { eventSubscribedHeightRef = eventSubscribedHeightRef subscribedParent
    , eventSubscribedRetained = toAny (_fanInt_subscriptionRef self, 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 :: 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 Subscriber x (v a)
sub = do
  mSubscribed <- IO (Maybe (FanSubscribed x k v))
-> EventM x (Maybe (FanSubscribed x k v))
forall a. IO a -> EventM x a
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} {k} (x :: k) (k :: k -> *) (v :: k -> *).
Fan x k v -> IORef (Maybe (FanSubscribed x k v))
fanSubscribed Fan x k v
f
  case mSubscribed of
    Just 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 a. IO a -> EventM x 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
      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
      occ <- readIORef $ fanSubscribedOccurrence subscribed
      return (sln, subscribed, coerce $ DMap.lookup k =<< occ)
    Maybe (FanSubscribed x k v)
Nothing -> {-# SCC "missFan" #-} do
      subscribedRef <- IO (IORef (FanSubscribed x k v))
-> EventM x (IORef (FanSubscribed x k v))
forall a. IO a -> EventM x a
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 String
"getFanSubscribed: subscribedRef not yet initialized"
      subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
      s <- liftIO $ newSubscriberFan subscribedUnsafe
      (subscription, parentOcc) <- subscribeAndRead (fanParent f) s
      weakSelf <- liftIO $ newIORef $ error "getFanSubscribed: weakSelf not yet initialized"
      (subsForK, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupFanSubscribed
      subscribersRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribersRef not yet initialized"
      occRef <- liftIO $ newIORef parentOcc
      when (isJust parentOcc) $ scheduleClear occRef
#ifdef DEBUG_NODEIDS
      nid <- liftIO newNodeId
#endif
      let subscribed = FanSubscribed
            { fanSubscribedCachedSubscribed :: IORef (Maybe (FanSubscribed x k v))
fanSubscribedCachedSubscribed = Fan x k v -> IORef (Maybe (FanSubscribed x k v))
forall {k} {k} (x :: 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
k, FanSubscribed x k v
subscribed)
      liftIO $ writeIORef subscribersRef $! DMap.singleton k $ FanSubscribedChildren subsForK self weakSelf
      liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug self "FanSubscribed"
      liftIO $ writeIORef subscribedRef $! subscribed
      liftIO $ writeIORef (fanSubscribed f) $ Just subscribed
      return (slnForSub, subscribed, coerce $ DMap.lookup k =<< parentOcc)

cleanupFanSubscribed :: GCompare k => (k a, FanSubscribed x k v) -> IO ()
cleanupFanSubscribed :: forall {k} {k} (k :: k -> *) (a :: k) (x :: k) (v :: k -> *).
GCompare k =>
(k a, FanSubscribed x k v) -> IO ()
cleanupFanSubscribed (k a
k, FanSubscribed x k v
subscribed) = do
  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} {k} (x :: k) (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
fanSubscribedSubscribers FanSubscribed x k v
subscribed
  let 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.null reducedSubscribers
    then do
      unsubscribe $ fanSubscribedParent subscribed
      -- Not necessary in this case, because this whole FanSubscribed is dead: writeIORef (fanSubscribedSubscribers subscribed) reducedSubscribers
      writeIORef (fanSubscribedCachedSubscribed subscribed) Nothing
    else writeIORef (fanSubscribedSubscribers subscribed) $! reducedSubscribers

{-# INLINE subscribeFanSubscribed #-}
subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed x k v -> Subscriber x (v a) -> IO WeakBagTicket
subscribeFanSubscribed :: 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 = do
  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} {k} (x :: k) (k :: k -> *) (v :: k -> *).
FanSubscribed x k v -> IORef (DMap k (FanSubscribedChildren x k v))
fanSubscribedSubscribers FanSubscribed x k v
subscribed
  case DMap.lookup k subscribers of
    Maybe (FanSubscribedChildren x k v a)
Nothing -> {-# SCC "missSubscribeFanSubscribed" #-} do
      let !self :: (k a, FanSubscribed x k v)
self = (k a
k, FanSubscribed x k v
subscribed)
      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 String
"FanSubscribed"
      (list, sln) <- WeakBag.singleton sub weakSelf cleanupFanSubscribed
      writeIORef (fanSubscribedSubscribers subscribed) $! DMap.insertWith (error "subscribeFanSubscribed: key that we just failed to find is present - should be impossible") k (FanSubscribedChildren list self weakSelf) subscribers
      return sln
    Just (FanSubscribedChildren WeakBag (Subscriber x (v a))
list (k a, FanSubscribed x k v)
_ 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 :: forall x a.
HasSpiderTimeline x =>
Switch x a
-> Subscriber x a
-> EventM x (WeakBagTicket, SwitchSubscribed x a, Maybe a)
getSwitchSubscribed Switch x a
s Subscriber x a
sub = do
  mSubscribed <- IO (Maybe (SwitchSubscribed x a))
-> EventM x (Maybe (SwitchSubscribed x a))
forall a. IO a -> EventM 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 mSubscribed of
    Just SwitchSubscribed x a
subscribed -> {-# SCC "hitSwitch" #-} IO (WeakBagTicket, SwitchSubscribed x a, Maybe a)
-> EventM x (WeakBagTicket, SwitchSubscribed x a, Maybe a)
forall a. IO a -> EventM x 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
      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
      occ <- readIORef $ switchSubscribedOccurrence subscribed
      return (sln, subscribed, occ)
    Maybe (SwitchSubscribed x a)
Nothing -> {-# SCC "missSwitch" #-} do
      subscribedRef <- IO (IORef (SwitchSubscribed x a))
-> EventM x (IORef (SwitchSubscribed x a))
forall a. IO a -> EventM 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 String
"getSwitchSubscribed: subscribed has not yet been created"
      subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
      i <- liftIO $ newInvalidatorSwitch subscribedUnsafe
      mySub <- liftIO $ newSubscriberSwitch subscribedUnsafe
      wi <- liftIO $ mkWeakPtrWithDebug i "InvalidatorSwitch"
      wiRef <- liftIO $ newIORef wi
      parentsRef <- liftIO $ newIORef [] --TODO: This should be unnecessary, because it will always be filled with just the single parent behavior
      holdInits <- getDeferralQueue
      e <- liftIO $ runBehaviorM (readBehaviorTracked (switchParent s)) (Just (wi, parentsRef)) holdInits
      (subscription@(EventSubscription _ subd), parentOcc) <- subscribeAndRead e mySub
      heightRef <- liftIO $ newIORef =<< getEventSubscribedHeight subd
      subscriptionRef <- liftIO $ newIORef subscription
      occRef <- liftIO $ newIORef parentOcc
      when (isJust parentOcc) $ scheduleClear occRef
      weakSelf <- liftIO $ newIORef $ error "getSwitchSubscribed: weakSelf not yet initialized"
      (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupSwitchSubscribed
#ifdef DEBUG_NODEIDS
      nid <- liftIO newNodeId
#endif
      let !subscribed = 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
            }
      liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf"
      liftIO $ writeIORef subscribedRef $! subscribed
      liftIO $ writeIORef (switchSubscribed s) $ Just subscribed
      return (slnForSub, subscribed, parentOcc)

cleanupSwitchSubscribed :: SwitchSubscribed x a -> IO ()
cleanupSwitchSubscribed :: forall {k} (x :: k) a. SwitchSubscribed x a -> IO ()
cleanupSwitchSubscribed 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 :: forall {k} (x :: k) a.
SwitchSubscribed x a -> Subscriber x a -> IO WeakBagTicket
subscribeSwitchSubscribed SwitchSubscribed x a
subscribed 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 :: forall x a.
HasSpiderTimeline x =>
Coincidence x a
-> Subscriber x a
-> EventM x (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)
getCoincidenceSubscribed Coincidence x a
c Subscriber x a
sub = do
  mSubscribed <- IO (Maybe (CoincidenceSubscribed x a))
-> EventM x (Maybe (CoincidenceSubscribed x a))
forall a. IO a -> EventM 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 mSubscribed of
    Just CoincidenceSubscribed x a
subscribed -> {-# SCC "hitCoincidence" #-} IO (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)
-> EventM x (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)
forall a. IO a -> EventM x 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
      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
      occ <- readIORef $ coincidenceSubscribedOccurrence subscribed
      return (sln, subscribed, occ)
    Maybe (CoincidenceSubscribed x a)
Nothing -> {-# SCC "missCoincidence" #-} do
      subscribedRef <- IO (IORef (CoincidenceSubscribed x a))
-> EventM x (IORef (CoincidenceSubscribed x a))
forall a. IO a -> EventM 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 String
"getCoincidenceSubscribed: subscribed has not yet been created"
      subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
      subOuter <- liftIO $ newSubscriberCoincidenceOuter subscribedUnsafe
      (outerSubscription@(EventSubscription _ outerSubd), outerOcc) <- subscribeAndRead (coincidenceParent c) subOuter
      outerHeight <- liftIO $ getEventSubscribedHeight outerSubd
      (occ, height, mInnerSubd) <- case outerOcc of
        Maybe (Event x a)
Nothing -> (Maybe a, Height, Maybe (EventSubscribed x))
-> EventM x (Maybe a, Height, Maybe (EventSubscribed x))
forall a. a -> EventM x a
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 Event x a
o -> do
          (occ, height, 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
          return (occ, height, Just innerSubd)
      occRef <- liftIO $ newIORef occ
      when (isJust occ) $ scheduleClear occRef
      heightRef <- liftIO $ newIORef height
      innerSubdRef <- liftIO $ newIORef mInnerSubd
      scheduleClear innerSubdRef
      weakSelf <- liftIO $ newIORef $ error "getCoincidenceSubscribed: weakSelf not yet implemented"
      (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupCoincidenceSubscribed
#ifdef DEBUG_NODEIDS
      nid <- liftIO newNodeId
#endif
      let subscribed = 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
            }
      liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed"
      liftIO $ writeIORef subscribedRef $! subscribed
      liftIO $ writeIORef (coincidenceSubscribed c) $ Just subscribed
      return (slnForSub, subscribed, occ)

cleanupCoincidenceSubscribed :: CoincidenceSubscribed x a -> IO ()
cleanupCoincidenceSubscribed :: forall {k} (x :: k) a. CoincidenceSubscribed x a -> IO ()
cleanupCoincidenceSubscribed 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 :: forall {k} (x :: k) a.
CoincidenceSubscribed x a -> Subscriber x a -> IO WeakBagTicket
subscribeCoincidenceSubscribed CoincidenceSubscribed x a
subscribed 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 {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 :: k). q a -> Event x (v a)
nt 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 q a -> Event x (v a)
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 {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 forall (a :: k). q a -> Event x (v a)
nt 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 q a -> Event x (v a)
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 {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 = MergeGetSubscription x (MergeSubscribedParent x)
-> MergeInitFunc k v q x (MergeSubscribedParent x)
-> MergeUpdateFunc k v x (PatchDMap k q) (MergeSubscribedParent x)
-> MergeDestroyFunc k (MergeSubscribedParent x)
-> Dynamic x (PatchTarget (PatchDMap k q)) (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' MergeSubscribedParent x a -> EventSubscription x
MergeGetSubscription x (MergeSubscribedParent x)
forall {k} {k} (x :: 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 forall (a :: k). EventM x (k a) -> Subscriber x (v a)
subscriber IORef HeightBag
heightBagRef DMap k (MergeSubscribedParent x)
oldParents (PatchDMap 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 ([EventSubscription x]
subscriptionsToKill, DMap k (MergeSubscribedParent x)
ps) (k a
k :=> ComposeMaybe Maybe (q a)
me) = do
              (mOldSubd, newPs) <- case Maybe (q a)
me of
                Maybe (q a)
Nothing -> (Maybe (MergeSubscribedParent x a),
 DMap k (MergeSubscribedParent x))
-> EventM
     x
     (Maybe (MergeSubscribedParent x a),
      DMap k (MergeSubscribedParent x))
forall a. a -> EventM x a
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 (\k a
_ MergeSubscribedParent x a
_ -> Maybe (MergeSubscribedParent x a)
forall a. Maybe a
Nothing) k a
k DMap k (MergeSubscribedParent x)
ps
                Just 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 a. a -> EventM x a
forall (m :: * -> *) a. Monad m => a -> m a
return k a
k
                  subscription@(EventSubscription _ 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
                  newParentHeight <- liftIO $ getEventSubscribedHeight subd
                  let newParent = EventSubscription x -> MergeSubscribedParent x a
forall {k} {k} (x :: k) (a :: k).
EventSubscription x -> MergeSubscribedParent x a
MergeSubscribedParent EventSubscription x
subscription
                  liftIO $ modifyIORef' heightBagRef $ heightBagAdd newParentHeight
                  return $ DMap.insertLookupWithKey' (\k a
_ MergeSubscribedParent x a
new MergeSubscribedParent x a
_ -> MergeSubscribedParent x a
new) k newParent ps
              forM_ mOldSubd $ \MergeSubscribedParent x a
oldSubd -> do
                oldHeight <- IO Height -> EventM x Height
forall a. IO a -> EventM x a
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} {k} (x :: k) (a :: k).
MergeSubscribedParent x a -> EventSubscription x
unMergeSubscribedParent MergeSubscribedParent x a
oldSubd

                liftIO $ modifyIORef heightBagRef $ heightBagRemove oldHeight
              return (maybeToList (unMergeSubscribedParent <$> mOldSubd) ++ subscriptionsToKill, 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 DMap k q
initialParents forall (a :: k). EventM x (k a) -> Subscriber x (v a)
subscriber = do
        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 a
k :=> 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 a. a -> EventM x a
forall (m :: * -> *) a. Monad m => a -> m a
return k a
k
          (subscription@(EventSubscription _ parentSubd), 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 <- liftIO $ getEventSubscribedHeight parentSubd
          return (fmap (k :=>) parentOcc, height, k :=> MergeSubscribedParent subscription)
        return ( DMap.fromDistinctAscList $ mapMaybe (\(Maybe (DSum k v)
x, Height
_, DSum k (MergeSubscribedParent x)
_) -> Maybe (DSum k v)
x) subscribers
               , fmap (\(Maybe (DSum k v)
_, Height
h, DSum k (MergeSubscribedParent x)
_) -> Height
h) subscribers --TODO: Assert that there's no invalidHeight in here
               , DMap.fromDistinctAscList $ map (\(Maybe (DSum k v)
_, Height
_, DSum k (MergeSubscribedParent x)
x) -> DSum k (MergeSubscribedParent x)
x) subscribers
               )

      destroy :: MergeDestroyFunc k (MergeSubscribedParent x)
      destroy :: MergeDestroyFunc k (MergeSubscribedParent x)
destroy 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
$ \(k a
_ :=> MergeSubscribedParent 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 {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 = 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)
-> Dynamic
     x (PatchTarget (PatchDMapWithMove k q)) (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' MergeSubscribedParentWithMove x k a -> EventSubscription x
MergeGetSubscription x (MergeSubscribedParentWithMove x k)
forall {k} {k} (x :: 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 forall (a :: k). EventM x (k a) -> Subscriber x (v a)
subscriber IORef HeightBag
heightBagRef DMap k (MergeSubscribedParentWithMove x k)
oldParents 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 :: forall (a :: k).
k a
-> Event x (v a) -> EventM x (MergeSubscribedParentWithMove x k a)
subscribeParent k a
k Event x (v a)
e = do
              keyRef <- IO (IORef (k a)) -> EventM x (IORef (k a))
forall a. IO a -> EventM x 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 = 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 a. IO a -> EventM x 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 _ subd) <- subscribe e s
              liftIO $ do
                newParentHeight <- getEventSubscribedHeight subd
                modifyIORef' heightBagRef $ heightBagAdd newParentHeight
                return $ MergeSubscribedParentWithMove subscription keyRef
        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 a
k 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
ni 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
              Maybe (k a)
Nothing -> do
                oldHeight <- IO Height -> EventM x Height
forall a. IO a -> EventM x a
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} {k} (x :: k) (k :: k -> *) (a :: k).
MergeSubscribedParentWithMove x k a -> EventSubscription x
_mergeSubscribedParentWithMove_subscription MergeSubscribedParentWithMove x k a
parent

                liftIO $ modifyIORef heightBagRef $ heightBagRemove oldHeight
                return $ Just $ _mergeSubscribedParentWithMove_subscription parent
              Just k a
toKey -> do
                IO () -> EventM x ()
forall a. IO a -> EventM x a
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} {k} (x :: 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 a. a -> EventM x a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (EventSubscription x)
forall a. Maybe a
Nothing
        toDelete <- fmap catMaybes $ mapM (\(k a
_ :=> Constant (EventM x (Maybe (EventSubscription x))) a
v) -> Constant (EventM x (Maybe (EventSubscription x))) a
-> EventM x (Maybe (EventSubscription x))
forall {k} a (b :: k). Constant a b -> a
getConstant Constant (EventM x (Maybe (EventSubscription x))) a
v) $ DMap.toList $
          DMap.intersectionWithKey moveOrDelete (unPatchDMapWithMove p) oldParents

        return (toDelete, applyAlways p' oldParents)
      getInitialSubscribers :: MergeInitFunc k v q x (MergeSubscribedParentWithMove x k)
      getInitialSubscribers :: MergeInitFunc k v q x (MergeSubscribedParentWithMove x k)
getInitialSubscribers DMap k q
initialParents forall (a :: k). EventM x (k a) -> Subscriber x (v a)
subscriber = do
        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 a
k :=> q a
e) -> do
          keyRef <- IO (IORef (k a)) -> EventM x (IORef (k a))
forall a. IO a -> EventM x 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 = 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 a. IO a -> EventM x 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 _ parentSubd), parentOcc) <- subscribeAndRead (nt e) s
          height <- liftIO $ getEventSubscribedHeight parentSubd
          return (fmap (k :=>) parentOcc, height, k :=> MergeSubscribedParentWithMove subscription keyRef)
        return ( DMap.fromDistinctAscList $ mapMaybe (\(Maybe (DSum k v)
x, Height
_, DSum k (MergeSubscribedParentWithMove x k)
_) -> Maybe (DSum k v)
x) subscribers
               , fmap (\(Maybe (DSum k v)
_, Height
h, DSum k (MergeSubscribedParentWithMove x k)
_) -> Height
h) subscribers --TODO: Assert that there's no invalidHeight in here
               , DMap.fromDistinctAscList $ map (\(Maybe (DSum k v)
_, Height
_, DSum k (MergeSubscribedParentWithMove x k)
x) -> DSum k (MergeSubscribedParentWithMove x k)
x) subscribers
               )

      destroy :: MergeDestroyFunc k (MergeSubscribedParentWithMove x k)
      destroy :: MergeDestroyFunc k (MergeSubscribedParentWithMove x k)
destroy 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
$ \(k a
_ :=> MergeSubscribedParentWithMove EventSubscription x
sub IORef (k a)
_) -> 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
  { forall {k} {k} (x :: k) (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef (DMap k s)
_merge_parentsRef :: {-# UNPACK #-} !(IORef (DMap k s))
  , forall {k} {k} (x :: k) (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef HeightBag
_merge_heightBagRef :: {-# UNPACK #-} !(IORef HeightBag)
  , forall {k} {k} (x :: k) (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef Height
_merge_heightRef :: {-# UNPACK #-} !(IORef Height)
  , forall {k} {k} (x :: k) (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> Subscriber x (DMap k v)
_merge_sub :: {-# UNPACK #-} !(Subscriber x (DMap k v))
  , forall {k} {k} (x :: k) (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IORef (DMap k v)
_merge_accumRef :: {-# UNPACK #-} !(IORef (DMap k v))
  }

invalidateMergeHeight :: Merge x k v s -> IO ()
invalidateMergeHeight :: forall {k} {k} (x :: k) (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IO ()
invalidateMergeHeight 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} {k} (x :: 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} {k} (x :: 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' :: forall {k} (x :: k) a. IORef Height -> Subscriber x a -> IO ()
invalidateMergeHeight' IORef Height
heightRef Subscriber x a
sub = do
  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
  when (oldHeight /= invalidHeight) $ do
    writeIORef heightRef $! invalidHeight
    subscriberInvalidateHeight sub oldHeight

revalidateMergeHeight :: Merge x k v s -> IO ()
revalidateMergeHeight :: forall {k} {k} (x :: k) (k :: k -> *) (v :: k -> *) (s :: k -> *).
Merge x k v s -> IO ()
revalidateMergeHeight Merge x k v s
m = do
  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} {k} (x :: 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
  when (currentHeight == invalidHeight) $ do
    heights <- readIORef $ _merge_heightBagRef m
    parents <- readIORef $ _merge_parentsRef m
    -- When the number of heights in the bag reaches the number of parents, we should have a valid height
    case heightBagSize heights `compare` DMap.size parents of
      Ordering
LT -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Ordering
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
$ String
"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} {k} (x :: 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} {k} (x :: 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
      Ordering
GT -> String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"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
<> String
") 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
<> String
") for Merge"

scheduleMergeSelf :: HasSpiderTimeline x => Merge x k v s -> Height -> EventM x ()
scheduleMergeSelf :: 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 = 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} {k} (x :: 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
  vals <- IO (DMap k v) -> EventM x (DMap k v)
forall a. IO a -> EventM x a
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} {k} (x :: 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
  liftIO $ writeIORef (_merge_accumRef m) $! DMap.empty
  --TODO: Assert that m is not empty
  subscriberPropagate (_merge_sub m) vals

checkCycle :: EventSubscribed x -> EventM x ()
checkCycle :: forall {k} (x :: k). EventSubscribed x -> EventM x ()
checkCycle EventSubscribed x
subscribed = IO () -> EventM x ()
forall a. IO a -> EventM x a
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 <- 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 $
    when (height == invalidHeight) $
#ifdef DEBUG_CYCLES
          do
            nodesInvolvedInCycle <- walkInvalidHeightParents subscribed
            stacks <- forM nodesInvolvedInCycle whoCreatedEventSubscribed
            throwIO (EventLoopException stacks)
#else
          throwIO 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 :: 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 EventM x (k a)
getKey = Subscriber
  { subscriberPropagate :: v a -> EventM x ()
subscriberPropagate = \v a
a -> do
      oldM <- IO (DMap k v) -> EventM x (DMap k v)
forall a. IO a -> EventM x a
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} {k} (x :: 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 <- getKey
      let 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 String
"Same key fired multiple times for Merge") k a
k v a
a DMap k v
oldM
      tracePropagate (Proxy :: Proxy x) $ "  DMap.size oldM = " <> show (DMap.size oldM) <> "; DMap.size newM = " <> show (DMap.size newM)
      liftIO $ writeIORef (_merge_accumRef m) $! newM
      when (DMap.null oldM) $ do -- Only schedule the firing once
        height <- liftIO $ readIORef $ _merge_heightRef m
        checkCycle subscribed

        scheduleMergeSelf m height
  , subscriberInvalidateHeight :: Height -> IO ()
subscriberInvalidateHeight = \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} {k} (x :: 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 = \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} {k} (x :: 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 :: 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
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
          oldParents <- IO (DMap k s) -> EventM x (DMap k s)
forall a. IO a -> EventM x a
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} {k} (x :: 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, newParents) <- updateFunc (mergeSubscriber subscribed m) (_merge_heightBagRef m) oldParents p
          liftIO $ writeIORef (_merge_parentsRef m) $! newParents
          return 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' :: 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 s
getParent MergeInitFunc k v q x s
getInitialSubscribers MergeUpdateFunc k v x p s
updateFunc MergeDestroyFunc k s
destroy 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
$ \Subscriber x (DMap k v)
sub -> do
  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
  accumRef <- liftIO $ newIORef $ error "merge: accumRef not yet initialized"
  heightRef <- liftIO $ newIORef $ error "merge: heightRef not yet initialized"
  heightBagRef <- liftIO $ newIORef $ error "merge: heightBagRef not yet initialized"
  parentsRef :: IORef (DMap k s) <- liftIO $ newIORef $ error "merge: parentsRef not yet initialized"
  changeSubdRef <- liftIO $ newIORef $ error "getMergeSubscribed: changeSubdRef not yet initialized"

  let subscribed = 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
        { _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, heights, initialParentState) <- getInitialSubscribers initialParents $ mergeSubscriber subscribed m
  let 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 = if Height
invalidHeight Height -> [Height] -> Bool
forall a. Eq a => a -> [a] -> 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
  currentHeight <- getCurrentHeight
  let (occ, accum) = if currentHeight >= myHeight -- If we should have fired by now
                     then (if DMap.null dm then Nothing else Just dm, DMap.empty)
                     else (Nothing, dm)
  unless (DMap.null accum) $ scheduleMergeSelf m myHeight
  liftIO $ writeIORef accumRef $! accum
  liftIO $ writeIORef heightRef $! myHeight
  liftIO $ writeIORef heightBagRef $! myHeightBag
  liftIO $ writeIORef parentsRef $! initialParentState
  defer $ SomeMergeInit $ do
    let changeSubscriber = Subscriber
          { subscriberPropagate :: p -> EventM x ()
subscriberPropagate = \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) String
"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 = \Height
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = \Height
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          }
    (changeSubscription, change) <- subscribeAndRead (dynamicUpdated d) changeSubscriber
    forM_ change $ \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.
    liftIO $ writeIORef changeSubdRef (changeSubscriber, changeSubscription)
  let 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

  return (EventSubscription unsubscribeAll subscribed, occ)


mergeInt :: forall x a. (HasSpiderTimeline x) => DynamicS x (PatchIntMap (Event x a)) -> Event x (IntMap a)
mergeInt :: forall x a.
HasSpiderTimeline x =>
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)
Dynamic
  x (PatchTarget (PatchIntMap (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 :: forall x a.
HasSpiderTimeline x =>
DynamicS x (PatchIntMap (Event x a)) -> Event x (IntMap a)
mergeIntCheap 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
$ \Subscriber x (IntMap a)
sub -> do
  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
  accum <- liftIO $ FastMutableIntMap.newEmpty
  heightRef <- liftIO $ newIORef zeroHeight
  heightBagRef <- liftIO $ newIORef heightBagEmpty
  parents <- liftIO $ FastMutableIntMap.newEmpty
  changeSubdRef <- liftIO $ newIORef $ error "getMergeSubscribed: changeSubdRef not yet initialized"
  let subscribed = 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 = do
        height <- IO Height -> EventM x Height
forall a. IO a -> EventM x a
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
        scheduleMerge' height heightRef $ do
          vals <- liftIO $ FastMutableIntMap.getFrozenAndClear accum
          subscriberPropagate sub vals
      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 = do
        currentHeight <- IORef Height -> IO Height
forall a. IORef a -> IO a
readIORef IORef Height
heightRef
        when (currentHeight == invalidHeight) $ do --TODO: This will almost always be true; can we get rid of this check and just proceed to the next one always?
          heights <- readIORef heightBagRef
          numParents <- FastMutableIntMap.size parents
          case heightBagSize heights `compare` numParents of
            Ordering
LT -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Ordering
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
$ String
"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
            Ordering
GT -> String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"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
<> String
") 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
<> String
") for Merge"
      mySubscriber Int
k = Subscriber
        { subscriberPropagate :: a -> EventM x ()
subscriberPropagate = \a
a -> do
            EventSubscribed x -> EventM x ()
forall {k} (x :: k). EventSubscribed x -> EventM x ()
checkCycle EventSubscribed x
subscribed

            wasEmpty <- IO Bool -> EventM x Bool
forall a. IO a -> EventM x a
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
            liftIO $ FastMutableIntMap.insert accum k a
            when wasEmpty scheduleSelf
        , subscriberInvalidateHeight :: Height -> IO ()
subscriberInvalidateHeight = \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 = \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
        }
  forM_ (IntMap.toList initialParents) $ \(Int
k, Event x a
p) -> do
    (subscription@(EventSubscription _ parentSubd), 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
    liftIO $ do
      forM_ parentOcc $ FastMutableIntMap.insert accum k
      FastMutableIntMap.insert parents k subscription
      height <- getEventSubscribedHeight parentSubd
      if height == invalidHeight
        then writeIORef heightRef invalidHeight
        else do
          modifyIORef' heightBagRef $ heightBagAdd height
          modifyIORef' heightRef $ \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
  myHeight <- liftIO $ readIORef heightRef
  currentHeight <- getCurrentHeight
  isEmpty <- liftIO $ FastMutableIntMap.isEmpty accum
  occ <- if currentHeight >= myHeight -- If we should have fired by now
    then if isEmpty
         then return Nothing
         else liftIO $ Just <$> FastMutableIntMap.getFrozenAndClear accum
    else do when (not isEmpty) scheduleSelf -- We have things accumulated, but we shouldn't have fired them yet
            return Nothing
  defer $ SomeMergeInit $ do
    let updateMe 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 Int
k Event x a
newParent = do
                    subscription@(EventSubscription _ 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
                    newParentHeight <- liftIO $ getEventSubscribedHeight subd
                    liftIO $ modifyIORef' heightBagRef $ heightBagAdd newParentHeight
                    return subscription
              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
              oldParents <- liftIO $ FastMutableIntMap.applyPatch parents newSubscriptions
              liftIO $ for_ oldParents $ \EventSubscription x
oldParent -> do
                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

                print ("updateMe", oldParentHeight)
                modifyIORef' heightBagRef $ heightBagRemove oldParentHeight
              return $ IntMap.elems oldParents
    let changeSubscriber = Subscriber
          { subscriberPropagate :: PatchIntMap (Event x a) -> EventM x ()
subscriberPropagate = \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
$ String
"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 = \Height
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          , subscriberRecalculateHeight :: Height -> IO ()
subscriberRecalculateHeight = \Height
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          }
    (changeSubscription, change) <- subscribeAndRead (dynamicUpdated d) changeSubscriber
    forM_ change $ \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.
    liftIO $ writeIORef changeSubdRef (changeSubscriber, changeSubscription)
  let 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


  return (EventSubscription unsubscribeAll subscribed, occ)

newtype EventSelector x k = EventSelector { forall {k} (x :: k) (k :: * -> *).
EventSelector x k -> forall a. k a -> Event x a
select :: forall a. k a -> Event x a }
newtype EventSelectorG x k v = EventSelectorG { forall {k} {k} (x :: k) (k :: k -> *) (v :: k -> *).
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 :: forall {k} x (k :: k -> *) (v :: k -> *).
(HasSpiderTimeline x, GCompare k) =>
Event x (DMap k v) -> EventSelectorG x k v
fanG 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
  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
        { 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
        }
  pure $ EventSelectorG $ \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 :: 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 = do
  holdInits <- IO [SomeHoldInit x] -> EventM x [SomeHoldInit x]
forall a. IO a -> EventM x a
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
  dynInits <- liftIO $ readIORef dynInitRef
  mergeInits <- liftIO $ readIORef mergeInitRef
  unless (null holdInits && null dynInits && null mergeInits) $ do
    liftIO $ writeIORef holdInitRef []
    liftIO $ writeIORef dynInitRef []
    liftIO $ writeIORef mergeInitRef []
    mapM_ initHold holdInits
    mapM_ initDyn dynInits
    mapM_ unSomeMergeInit mergeInits
    runHoldInits holdInitRef dynInitRef mergeInitRef

initHold :: HasSpiderTimeline x => SomeHoldInit x -> EventM x ()
initHold :: forall x. HasSpiderTimeline x => SomeHoldInit x -> EventM x ()
initHold (SomeHoldInit 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 :: forall x. HasSpiderTimeline x => SomeDynInit x -> EventM x ()
initDyn (SomeDynInit 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 :: forall x. IO (EventEnv x)
newEventEnv = do
  toAssignRef <- [SomeAssignment x] -> IO (IORef [SomeAssignment x])
forall a. a -> IO (IORef a)
newIORef [] -- This should only actually get used when events are firing
  holdInitRef <- newIORef []
  dynInitRef <- newIORef []
  mergeUpdateRef <- newIORef []
  mergeInitRef <- newIORef []
  heightRef <- newIORef zeroHeight
  toClearRef <- newIORef []
  toClearIntRef <- newIORef []
  toClearRootRef <- newIORef []
  coincidenceInfosRef <- newIORef []
  delayedRef <- newIORef IntMap.empty
  return $ EventEnv toAssignRef holdInitRef dynInitRef mergeUpdateRef mergeInitRef toClearRef toClearIntRef toClearRootRef heightRef coincidenceInfosRef delayedRef

clearEventEnv :: EventEnv x -> IO ()
clearEventEnv :: forall x. EventEnv x -> IO ()
clearEventEnv (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) = 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 :: forall x a. HasSpiderTimeline x => EventM x a -> SpiderHost x a
runFrame 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
        result <- EventM x a
a
        runHoldInits (eventEnvHoldInits env) (eventEnvDynInits env) (eventEnvMergeInits env) -- This must happen before doing the assignments, in case subscribing a Hold causes existing Holds to be read by the newly-propagated events
        return result
  result <- EventM x a -> IO a
forall {k} (x :: k) a. EventM x a -> IO a
runEventM EventM x a
go
  toClear <- readIORef $ eventEnvClears env
  forM_ toClear $ \(Some (Clear 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
  toClearInt <- readIORef $ eventEnvIntClears env
  forM_ toClearInt $ \(Some (IntClear 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
  toClearRoot <- readIORef $ eventEnvRootClears env
  forM_ toClearRoot $ \(Some (RootClear 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
  toAssign <- readIORef $ eventEnvAssignments env
  toReconnectRef <- newIORef []
  coincidenceInfos <- readIORef $ eventEnvResetCoincidences env
  forM_ toAssign $ \(SomeAssignment IORef a
vRef IORef [Weak (Invalidator x)]
iRef 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
$ String
"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
  mergeUpdates <- readIORef $ eventEnvMergeUpdates env
  writeIORef (eventEnvMergeUpdates env) []
  tracePropagate (Proxy::Proxy x) $ "Updating merges"
  mergeSubscriptionsToKill <- runEventM $ concat <$> mapM _someMergeUpdate_update mergeUpdates
  tracePropagate (Proxy::Proxy x) $ "Updating merges done"
  toReconnect <- readIORef toReconnectRef
  clearEventEnv env
  switchSubscriptionsToKill <- forM toReconnect $ \(SomeSwitchSubscribed SwitchSubscribed x a
subscribed) -> {-# SCC "switchSubscribed" #-} do
    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
    wi <- readIORef $ switchSubscribedOwnWeakInvalidator subscribed
    traceInvalidate $ "Finalizing invalidator for Switch" <> showNodeId subscribed
    finalize wi
    i <- evaluate $ switchSubscribedOwnInvalidator subscribed
    wi' <- mkWeakPtrWithDebug i "wi'"
    writeIORef (switchSubscribedOwnWeakInvalidator subscribed) $! wi'
    writeIORef (switchSubscribedBehaviorParents subscribed) []
    writeIORef (eventEnvHoldInits env) [] --TODO: Should we reuse this?
    e <- runBehaviorM (readBehaviorTracked (switchSubscribedParent subscribed)) (Just (wi', switchSubscribedBehaviorParents subscribed)) $ eventEnvHoldInits env
    runEventM $ runHoldInits (eventEnvHoldInits env) (eventEnvDynInits env) (eventEnvMergeInits 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
    sub <- newSubscriberSwitch subscribed
    subscription <- unSpiderHost $ runFrame $ {-# SCC "subscribeSwitch" #-} subscribe e 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"
    -}
    writeIORef (switchSubscribedCurrentParent subscribed) $! subscription
    return oldSubscription
  liftIO $ mapM_ unsubscribe mergeSubscriptionsToKill
  liftIO $ mapM_ unsubscribe switchSubscriptionsToKill
  forM_ toReconnect $ \(SomeSwitchSubscribed SwitchSubscribed x a
subscribed) -> {-# SCC "switchSubscribed" #-} do
    EventSubscription _ 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
    parentHeight <- getEventSubscribedHeight subd'
    myHeight <- readIORef $ switchSubscribedHeight subscribed
    when (parentHeight /= myHeight) $ do
      writeIORef (switchSubscribedHeight subscribed) $! invalidHeight
      WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight myHeight
  mapM_ _someMergeUpdate_invalidateHeight 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
  forM_ coincidenceInfos $ \(SomeResetCoincidence EventSubscription x
subscription 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
  forM_ coincidenceInfos $ \(SomeResetCoincidence EventSubscription x
_ 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
  mapM_ _someMergeUpdate_recalculateHeight mergeUpdates
  forM_ toReconnect $ \(SomeSwitchSubscribed SwitchSubscribed x a
subscribed) -> do
    height <- SwitchSubscribed x a -> IO Height
forall {k} (x :: k) a. SwitchSubscribed x a -> IO Height
calculateSwitchHeight SwitchSubscribed x a
subscribed
    updateSwitchHeight height subscribed
  return 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
$cshowsPrec :: Int -> Height -> String -> String
showsPrec :: Int -> Height -> String -> String
$cshow :: Height -> String
show :: Height -> String
$cshowList :: [Height] -> String -> String
showList :: [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
$creadsPrec :: Int -> ReadS Height
readsPrec :: Int -> ReadS Height
$creadList :: ReadS [Height]
readList :: ReadS [Height]
$creadPrec :: ReadPrec Height
readPrec :: ReadPrec Height
$creadListPrec :: ReadPrec [Height]
readListPrec :: ReadPrec [Height]
Read, Height -> Height -> Bool
(Height -> Height -> Bool)
-> (Height -> Height -> Bool) -> Eq Height
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Height -> Height -> Bool
== :: Height -> Height -> Bool
$c/= :: Height -> Height -> Bool
/= :: 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
$ccompare :: Height -> Height -> Ordering
compare :: Height -> Height -> Ordering
$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
>= :: Height -> Height -> Bool
$cmax :: Height -> Height -> Height
max :: Height -> Height -> Height
$cmin :: Height -> Height -> Height
min :: Height -> Height -> Height
Ord, Height
Height -> Height -> Bounded Height
forall a. a -> a -> Bounded a
$cminBound :: Height
minBound :: Height
$cmaxBound :: Height
maxBound :: Height
Bounded)

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

{-# INLINE invalidHeight #-}
invalidHeight :: Height
invalidHeight :: Height
invalidHeight = Int -> Height
Height (-Int
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 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 :: forall {k} (x :: k) a. CoincidenceSubscribed x a -> IO ()
invalidateCoincidenceHeight CoincidenceSubscribed x a
subscribed = do
  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
  when (oldHeight /= invalidHeight) $ do
    writeIORef (coincidenceSubscribedHeight subscribed) $! invalidHeight
    WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight

updateSwitchHeight :: Height -> SwitchSubscribed x a -> IO ()
updateSwitchHeight :: forall {k} (x :: k) a. Height -> SwitchSubscribed x a -> IO ()
updateSwitchHeight Height
new SwitchSubscribed x a
subscribed = do
  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
  when (oldHeight == invalidHeight) $ do --TODO: This 'when' should probably be an assertion
    when (new /= invalidHeight) $ do --TODO: This 'when' should probably be an assertion
      writeIORef (switchSubscribedHeight subscribed) $! new
      WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ recalculateSubscriberHeight new

recalculateCoincidenceHeight :: CoincidenceSubscribed x a -> IO ()
recalculateCoincidenceHeight :: forall {k} (x :: k) a. CoincidenceSubscribed x a -> IO ()
recalculateCoincidenceHeight CoincidenceSubscribed x a
subscribed = do
  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
  when (oldHeight == invalidHeight) $ do --TODO: This 'when' should probably be an assertion
    height <- calculateCoincidenceHeight subscribed
    when (height /= invalidHeight) $ do
      writeIORef (coincidenceSubscribedHeight subscribed) $! height
      WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight height

calculateSwitchHeight :: SwitchSubscribed x a -> IO Height
calculateSwitchHeight :: forall {k} (x :: k) a. SwitchSubscribed x a -> IO Height
calculateSwitchHeight 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 :: forall {k} (x :: k) a. CoincidenceSubscribed x a -> IO Height
calculateCoincidenceHeight CoincidenceSubscribed x a
subscribed = do
  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
  innerHeight <- maybe (return zeroHeight) getEventSubscribedHeight =<< readIORef (coincidenceSubscribedInnerParent subscribed)
  return $ if outerHeight == invalidHeight || innerHeight == invalidHeight then invalidHeight else max outerHeight innerHeight

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

invalidate :: IORef [SomeSwitchSubscribed x] -> WeakList (Invalidator x) -> IO (WeakList (Invalidator x))
invalidate :: forall {k} (x :: k).
IORef [SomeSwitchSubscribed x]
-> WeakList (Invalidator x) -> IO (WeakList (Invalidator x))
invalidate IORef [SomeSwitchSubscribed x]
toReconnectRef 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
$ \Weak (Invalidator x)
wi -> do
    mi <- Weak (Invalidator x) -> IO (Maybe (Invalidator x))
forall v. Weak v -> IO (Maybe v)
deRefWeak Weak (Invalidator x)
wi
    case mi of
      Maybe (Invalidator x)
Nothing -> do
        String -> IO ()
traceInvalidate String
"invalidate Dead"
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO: Should we clean this up here?
      Just 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 Pull x a
p -> do
            String -> IO ()
traceInvalidate (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"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
            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
            forM_ mVal $ \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 SwitchSubscribed x a
subscribed -> do
            String -> IO ()
traceInvalidate (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"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 a. a -> IO a
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 :: forall a. Behavior (SpiderTimeline x) a -> EventM x a
sample (SpiderBehavior Behavior x a
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 :: forall a.
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 :: forall a.
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 :: forall p.
Patch p =>
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 :: forall a.
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)
SpiderPushM 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 :: forall a.
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
  {-# INLINABLE now #-}
  now :: EventM x (Event (SpiderTimeline x) ())
now = EventM x (Event (SpiderTimeline x) ())
forall x.
HasSpiderTimeline x =>
EventM x (Event (SpiderTimeline x) ())
nowSpiderEventM

instance Reflex.Class.MonadSample (SpiderTimeline x) (SpiderPullM x) where
  {-# INLINABLE sample #-}
  sample :: forall a. 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 :: forall a. Behavior (SpiderTimeline x) a -> SpiderPushM x a
sample (SpiderBehavior Behavior x a
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 :: forall a.
a
-> Event (SpiderTimeline x) a
-> SpiderPushM x (Behavior (SpiderTimeline x) a)
hold a
v0 Event (SpiderTimeline x) a
e = Dynamic (SpiderTimeline x) a -> Behavior (SpiderTimeline x) a
forall a.
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 a.
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 :: forall a.
a
-> Event (SpiderTimeline x) a
-> SpiderPushM x (Dynamic (SpiderTimeline x) a)
holdDyn a
v0 (SpiderEvent Event x a
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 a b. (a -> b) -> EventM x a -> EventM x b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a
DynamicS x (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)
Hold x (Identity a) -> DynamicS x (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 :: forall p.
Patch p =>
PatchTarget p
-> Event (SpiderTimeline x) p
-> SpiderPushM x (Incremental (SpiderTimeline x) p)
holdIncremental PatchTarget p
v0 (SpiderEvent Event x p
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 :: forall a.
PushM (SpiderTimeline x) a
-> Event (SpiderTimeline x) a
-> SpiderPushM x (Dynamic (SpiderTimeline x) a)
buildDynamic PushM (SpiderTimeline x) a
getV0 (SpiderEvent Event x a
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 a b. (a -> b) -> EventM x a -> EventM x b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a
DynamicS x (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)
Dyn x (Identity a) -> DynamicS x (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 :: forall a.
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
  {-# INLINABLE now #-}
  now :: SpiderPushM x (Event (SpiderTimeline x) ())
now = ComputeM x (Event (SpiderTimeline x) ())
-> SpiderPushM x (Event (SpiderTimeline x) ())
forall x a. ComputeM x a -> SpiderPushM x a
SpiderPushM ComputeM x (Event (SpiderTimeline x) ())
forall x.
HasSpiderTimeline x =>
EventM x (Event (SpiderTimeline x) ())
nowSpiderEventM


instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x)) where
  {-# INLINE (>>=) #-}
  Dynamic (SpiderTimeline x) a
x >>= :: forall a b.
Dynamic (SpiderTimeline x) a
-> (a -> Dynamic (SpiderTimeline x) b)
-> Dynamic (SpiderTimeline x) b
>>= 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 -> DynamicS x (Identity b))
-> Dynamic x (PatchTarget (Identity a)) (Identity a)
-> DynamicS x (Identity (DynamicS x (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)
Dynamic (SpiderTimeline x) b -> DynamicS x (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) (Dynamic x (PatchTarget (Identity a)) (Identity a)
 -> DynamicS x (Identity (DynamicS x (Identity b))))
-> Dynamic x (PatchTarget (Identity a)) (Identity a)
-> DynamicS x (Identity (DynamicS x (Identity b)))
forall a b. (a -> b) -> a -> b
$ Dynamic (SpiderTimeline x) a
-> Dynamic x (PatchTarget (Identity a)) (Identity a)
forall x a. Dynamic (SpiderTimeline x) a -> DynamicS x (Identity a)
unSpiderDynamic Dynamic (SpiderTimeline x) a
x
#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 :: forall x a.
HasSpiderTimeline x =>
DynamicS x (Identity (DynamicS x (Identity a)))
-> Dyn x (Identity a)
newJoinDyn 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 a b. (a -> b) -> EventM x a -> EventM x b
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 :: forall a b.
(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
  a
x <$ :: forall a b.
a -> Dynamic (SpiderTimeline x) b -> Dynamic (SpiderTimeline x) a
<$ Dynamic (SpiderTimeline x) b
d = PullM (SpiderTimeline x) a
-> Event (SpiderTimeline x) a -> Dynamic (SpiderTimeline x) a
forall a.
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 a. 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 a b.
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 a.
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) b
d

mapDynamicSpider :: HasSpiderTimeline x => (a -> b) -> Reflex.Class.Dynamic (SpiderTimeline x) a -> Reflex.Class.Dynamic (SpiderTimeline x) b
mapDynamicSpider :: forall x a b.
HasSpiderTimeline x =>
(a -> b)
-> Dynamic (SpiderTimeline x) a -> Dynamic (SpiderTimeline x) b
mapDynamicSpider a -> b
f = Dynamic x b (Identity b) -> Dynamic (SpiderTimeline x) b
DynamicS x (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)
Dynamic (SpiderTimeline x) a -> DynamicS x (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 :: forall a. a -> Dynamic (SpiderTimeline x) a
pure = Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a
DynamicS x (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)
PatchTarget (Identity a) -> DynamicS x (Identity a)
forall {k} p (x :: k). PatchTarget p -> DynamicS x p
dynamicConst
#if MIN_VERSION_base(4,10,0)
  liftA2 :: forall a b c.
(a -> b -> c)
-> Dynamic (SpiderTimeline x) a
-> Dynamic (SpiderTimeline x) b
-> Dynamic (SpiderTimeline x) c
liftA2 a -> b -> c
f Dynamic (SpiderTimeline x) a
a 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 DynamicS x (Identity (a -> b))
a <*> :: forall a b.
Dynamic (SpiderTimeline x) (a -> b)
-> Dynamic (SpiderTimeline x) a -> Dynamic (SpiderTimeline x) b
<*> SpiderDynamic DynamicS x (Identity a)
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
  Dynamic (SpiderTimeline x) a
a *> :: forall a b.
Dynamic (SpiderTimeline x) a
-> Dynamic (SpiderTimeline x) b -> Dynamic (SpiderTimeline x) b
*> Dynamic (SpiderTimeline x) b
b = PullM (SpiderTimeline x) b
-> Event (SpiderTimeline x) b -> Dynamic (SpiderTimeline x) b
forall a.
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 (Behavior (SpiderTimeline x) b -> PullM (SpiderTimeline x) b
forall a.
Behavior (SpiderTimeline x) a -> PullM (SpiderTimeline x) a
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 a.
Dynamic (SpiderTimeline x) a -> Behavior (SpiderTimeline x) a
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 a.
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) 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 a.
Dynamic (SpiderTimeline x) a -> Behavior (SpiderTimeline x) a
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 a.
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]
  <* :: forall a b.
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 a 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
(*>) -- 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 :: forall x a.
HasSpiderTimeline x =>
a
-> Event (SpiderTimeline x) a
-> EventM x (Behavior (SpiderTimeline x) a)
holdSpiderEventM a
v0 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 a b. (a -> b) -> EventM x a -> EventM x b
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 :: forall x a.
HasSpiderTimeline x =>
a
-> Event (SpiderTimeline x) a
-> EventM x (Dynamic (SpiderTimeline x) a)
holdDynSpiderEventM a
v0 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 a b. (a -> b) -> EventM x a -> EventM x b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a
DynamicS x (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)
Hold x (Identity a) -> DynamicS x (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 :: forall x p.
(HasSpiderTimeline x, Patch p) =>
PatchTarget p
-> Event (SpiderTimeline x) p
-> EventM x (Incremental (SpiderTimeline x) p)
holdIncrementalSpiderEventM PatchTarget p
v0 Event (SpiderTimeline x) p
e = (Hold x p -> Incremental (SpiderTimeline x) p)
-> EventM x (Hold x p)
-> EventM x (Incremental (SpiderTimeline x) p)
forall a b. (a -> b) -> EventM x a -> EventM x b
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 :: forall x a.
HasSpiderTimeline x =>
SpiderPushM x a
-> Event (SpiderTimeline x) a
-> EventM x (Dynamic (SpiderTimeline x) a)
buildDynamicSpiderEventM SpiderPushM x a
getV0 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 a b. (a -> b) -> EventM x a -> EventM x b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a
DynamicS x (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)
Dyn x (Identity a) -> DynamicS x (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 :: forall a.
a
-> Event (SpiderTimeline x) a
-> SpiderHost x (Behavior (SpiderTimeline x) a)
hold a
v0 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 a.
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 :: forall a.
a
-> Event (SpiderTimeline x) a
-> SpiderHost x (Dynamic (SpiderTimeline x) a)
holdDyn a
v0 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 a.
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 :: forall p.
Patch p =>
PatchTarget p
-> Event (SpiderTimeline x) p
-> SpiderHost x (Incremental (SpiderTimeline x) p)
holdIncremental PatchTarget p
v0 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 p.
Patch p =>
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 :: forall a.
PushM (SpiderTimeline x) a
-> Event (SpiderTimeline x) a
-> SpiderHost x (Dynamic (SpiderTimeline x) a)
buildDynamic PushM (SpiderTimeline x) a
getV0 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 a.
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 :: forall a.
Event (SpiderTimeline x) a
-> SpiderHost x (Event (SpiderTimeline x) a)
headE 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 a.
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
  {-# INLINABLE now #-}
  now :: SpiderHost x (Event (SpiderTimeline x) ())
now = EventM x (Event (SpiderTimeline x) ())
-> SpiderHost x (Event (SpiderTimeline x) ())
forall x a. HasSpiderTimeline x => EventM x a -> SpiderHost x a
runFrame (EventM x (Event (SpiderTimeline x) ())
 -> SpiderHost x (Event (SpiderTimeline x) ()))
-> (SpiderHostFrame x (Event (SpiderTimeline x) ())
    -> EventM x (Event (SpiderTimeline x) ()))
-> SpiderHostFrame x (Event (SpiderTimeline x) ())
-> SpiderHost x (Event (SpiderTimeline x) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpiderHostFrame x (Event (SpiderTimeline x) ())
-> EventM x (Event (SpiderTimeline x) ())
forall x a. SpiderHostFrame x a -> EventM x a
runSpiderHostFrame (SpiderHostFrame x (Event (SpiderTimeline x) ())
 -> SpiderHost x (Event (SpiderTimeline x) ()))
-> SpiderHostFrame x (Event (SpiderTimeline x) ())
-> SpiderHost x (Event (SpiderTimeline x) ())
forall a b. (a -> b) -> a -> b
$ SpiderHostFrame x (Event (SpiderTimeline x) ())
forall {k} (t :: k) (m :: * -> *). MonadHold t m => m (Event t ())
Reflex.Class.now


instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where
  sample :: forall a. 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 :: forall a.
a
-> Event (SpiderTimeline x) a
-> SpiderHostFrame x (Behavior (SpiderTimeline x) a)
hold a
v0 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 a b. (a -> b) -> EventM x a -> EventM x b
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 :: forall a.
a
-> Event (SpiderTimeline x) a
-> SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
holdDyn a
v0 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 a b. (a -> b) -> EventM x a -> EventM x b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a
DynamicS x (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)
Hold x (Identity a) -> DynamicS x (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 :: forall p.
Patch p =>
PatchTarget p
-> Event (SpiderTimeline x) p
-> SpiderHostFrame x (Incremental (SpiderTimeline x) p)
holdIncremental PatchTarget p
v0 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 a b. (a -> b) -> EventM x a -> EventM x b
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 :: forall a.
PushM (SpiderTimeline x) a
-> Event (SpiderTimeline x) a
-> SpiderHostFrame x (Dynamic (SpiderTimeline x) a)
buildDynamic PushM (SpiderTimeline x) a
getV0 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 a b. (a -> b) -> EventM x a -> EventM x b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dynamic x a (Identity a) -> Dynamic (SpiderTimeline x) a
DynamicS x (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)
Dyn x (Identity a) -> DynamicS x (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 :: forall a.
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
  {-# INLINABLE now #-}
  now :: SpiderHostFrame x (Event (SpiderTimeline x) ())
now = EventM x (Event (SpiderTimeline x) ())
-> SpiderHostFrame x (Event (SpiderTimeline x) ())
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame EventM x (Event (SpiderTimeline x) ())
forall {k} (t :: k) (m :: * -> *). MonadHold t m => m (Event t ())
Reflex.Class.now

instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHost x) where
  {-# INLINABLE sample #-}
  sample :: forall a. 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 :: forall a. 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 a. Behavior (SpiderTimeline x) a -> EventM 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 :: forall a.
a
-> Event (SpiderTimeline x) a
-> ReadPhase x (Behavior (SpiderTimeline x) a)
hold a
v0 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 a.
a
-> Event (SpiderTimeline x) a
-> EventM 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 :: forall a.
a
-> Event (SpiderTimeline x) a
-> ReadPhase x (Dynamic (SpiderTimeline x) a)
holdDyn a
v0 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 a.
a
-> Event (SpiderTimeline x) a
-> EventM 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 :: forall p.
Patch p =>
PatchTarget p
-> Event (SpiderTimeline x) p
-> ReadPhase x (Incremental (SpiderTimeline x) p)
holdIncremental PatchTarget p
v0 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 p.
Patch p =>
PatchTarget p
-> Event (SpiderTimeline x) p
-> EventM 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 :: forall a.
PushM (SpiderTimeline x) a
-> Event (SpiderTimeline x) a
-> ReadPhase x (Dynamic (SpiderTimeline x) a)
buildDynamic PushM (SpiderTimeline x) a
getV0 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 a.
PushM (SpiderTimeline x) a
-> Event (SpiderTimeline x) a
-> EventM 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 :: forall a.
Event (SpiderTimeline x) a
-> ReadPhase x (Event (SpiderTimeline x) a)
headE 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 a.
Event (SpiderTimeline x) a -> EventM 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
  {-# INLINABLE now #-}
  now :: ReadPhase x (Event (SpiderTimeline x) ())
now = ResultM x (Event (SpiderTimeline x) ())
-> ReadPhase x (Event (SpiderTimeline x) ())
forall {k} (x :: k) a. ResultM x a -> ReadPhase x a
Reflex.Spider.Internal.ReadPhase ResultM x (Event (SpiderTimeline x) ())
forall {k} (t :: k) (m :: * -> *). MonadHold t m => m (Event t ())
Reflex.Class.now

--------------------------------------------------------------------------------
-- 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 :: forall a.
Event (SpiderTimeline x) a
-> SpiderHostFrame x (EventHandle (SpiderTimeline x) a)
subscribeEvent Event (SpiderTimeline x) a
e = EventM x (EventHandle (SpiderTimeline x) a)
-> SpiderHostFrame x (EventHandle (SpiderTimeline x) a)
forall x a. EventM x a -> SpiderHostFrame x a
SpiderHostFrame (EventM x (EventHandle (SpiderTimeline x) a)
 -> SpiderHostFrame x (EventHandle (SpiderTimeline x) a))
-> EventM x (EventHandle (SpiderTimeline 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)
    val <- IO (IORef (Maybe a)) -> EventM x (IORef (Maybe a))
forall a. IO a -> EventM x 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
    subscription <- subscribe (unSpiderEvent e) $ Subscriber
      { subscriberPropagate = \a
a -> do
          IO () -> EventM x ()
forall a. IO a -> EventM x a
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 ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      , subscriberRecalculateHeight = \Height
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      }
    return $ SpiderEventHandle
      { spiderEventHandleSubscription = subscription
      , spiderEventHandleValue = 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 :: forall a.
EventHandle (SpiderTimeline x) a
-> ReadPhase x (Maybe (ReadPhase x a))
readEvent 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 a b. (a -> b) -> EventM x a -> EventM x b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> ReadPhase x a) -> Maybe a -> Maybe (ReadPhase x a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ReadPhase x a
forall a. 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 a. IO a -> EventM x 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
    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
    touch h
    return result

instance HasSpiderTimeline x => Reflex.Host.Class.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHost x) where
  newEventWithTrigger :: forall a.
(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 a b. (a -> b) -> IO a -> IO b
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 (k :: * -> *).
GCompare k =>
(forall a. k a -> EventTrigger (SpiderTimeline x) a -> IO (IO ()))
-> SpiderHost x (EventSelector (SpiderTimeline x) k)
newFanEventWithTrigger 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
    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 k a -> EventTrigger (SpiderTimeline x) a -> IO (IO ())
k a -> RootTrigger x a -> IO (IO ())
forall a. k a -> EventTrigger (SpiderTimeline x) a -> IO (IO ())
forall a. k a -> RootTrigger x a -> IO (IO ())
f
    return $ Reflex.Class.EventSelector $ SpiderEvent . Reflex.Spider.Internal.select es

instance HasSpiderTimeline x => Reflex.Host.Class.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHostFrame x) where
  newEventWithTrigger :: forall a.
(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 a. IO a -> IO 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 a b. (a -> b) -> IO a -> IO b
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 (k :: * -> *).
GCompare k =>
(forall a. k a -> EventTrigger (SpiderTimeline x) a -> IO (IO ()))
-> SpiderHostFrame x (EventSelector (SpiderTimeline x) k)
newFanEventWithTrigger 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 a. IO a -> IO a
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
    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 k a -> EventTrigger (SpiderTimeline x) a -> IO (IO ())
k a -> RootTrigger x a -> IO (IO ())
forall a. k a -> EventTrigger (SpiderTimeline x) a -> IO (IO ())
forall a. k a -> RootTrigger x a -> IO (IO ())
f
    return $ Reflex.Class.EventSelector $ SpiderEvent . Reflex.Spider.Internal.select es

instance HasSpiderTimeline x => Reflex.Host.Class.MonadSubscribeEvent (SpiderTimeline x) (SpiderHost x) where
  {-# INLINABLE subscribeEvent #-}
  subscribeEvent :: forall a.
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 (EventHandle (SpiderTimeline x) a)
Event (SpiderTimeline x) a
-> SpiderHostFrame x (SpiderEventHandle x a)
forall a.
Event (SpiderTimeline x) a
-> SpiderHostFrame x (EventHandle (SpiderTimeline 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 :: forall a.
[DSum (EventTrigger (SpiderTimeline x)) Identity]
-> ReadPhase (SpiderHost x) a -> SpiderHost x a
fireEventsAndRead [DSum (EventTrigger (SpiderTimeline x)) Identity]
es (Reflex.Spider.Internal.ReadPhase ResultM x a
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 :: forall a. 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 :: forall x. IO (SpiderTimelineEnv x)
unsafeNewSpiderTimelineEnv = do
  lock <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
  env <- newEventEnv
#ifdef DEBUG
  depthRef <- newIORef 0
#endif
  return $ STE $ SpiderTimelineEnv
    { _spiderTimeline_lock = lock
    , _spiderTimeline_eventEnv = 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 a. a -> IO a
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
forall (proxy :: k -> *). proxy s -> SpiderTimelineEnv x
reflect (Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s)

localSpiderTimeline
  :: proxy s
  -> SpiderTimelineEnv x
  -> SpiderTimelineEnv (LocalSpiderTimeline x s)
localSpiderTimeline :: forall {k} (proxy :: k -> *) (s :: k) x.
proxy s
-> SpiderTimelineEnv x
-> SpiderTimelineEnv (LocalSpiderTimeline x s)
localSpiderTimeline proxy s
_ = 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 r.
(forall x. HasSpiderTimeline x => SpiderTimelineEnv x -> IO r)
-> IO r
withSpiderTimeline forall x. HasSpiderTimeline x => SpiderTimelineEnv x -> IO r
k = do
  env <- IO (SpiderTimelineEnv (ZonkAny 0))
forall x. IO (SpiderTimelineEnv x)
unsafeNewSpiderTimelineEnv
  reify env $ \Proxy s
s -> SpiderTimelineEnv (LocalSpiderTimeline (ZonkAny 0) s) -> IO r
forall x. HasSpiderTimeline x => SpiderTimelineEnv x -> IO r
k (SpiderTimelineEnv (LocalSpiderTimeline (ZonkAny 0) s) -> IO r)
-> SpiderTimelineEnv (LocalSpiderTimeline (ZonkAny 0) s) -> IO r
forall a b. (a -> b) -> a -> b
$ Proxy s
-> SpiderTimelineEnv (ZonkAny 0)
-> SpiderTimelineEnv (LocalSpiderTimeline (ZonkAny 0) s)
forall {k} (proxy :: k -> *) (s :: k) x.
proxy s
-> SpiderTimelineEnv x
-> SpiderTimelineEnv (LocalSpiderTimeline x s)
localSpiderTimeline Proxy s
s SpiderTimelineEnv (ZonkAny 0)
env

newtype SpiderPullM (x :: Type) a = SpiderPullM (BehaviorM x a) deriving ((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
$cfmap :: forall x a b. (a -> b) -> SpiderPullM x a -> SpiderPullM x b
fmap :: forall a b. (a -> b) -> SpiderPullM x a -> SpiderPullM x b
$c<$ :: forall x a b. a -> SpiderPullM x b -> SpiderPullM x a
<$ :: forall a b. a -> SpiderPullM x b -> SpiderPullM x a
Functor, Functor (SpiderPullM x)
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)
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
$cpure :: forall x a. a -> SpiderPullM x a
pure :: forall a. a -> SpiderPullM x a
$c<*> :: forall x a b.
SpiderPullM x (a -> b) -> SpiderPullM x a -> SpiderPullM x b
<*> :: forall a b.
SpiderPullM x (a -> b) -> SpiderPullM x a -> SpiderPullM x b
$cliftA2 :: forall x a b c.
(a -> b -> c)
-> SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x c
liftA2 :: forall a b c.
(a -> b -> c)
-> SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x c
$c*> :: forall x a b. SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x b
*> :: forall a b. SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x b
$c<* :: forall x a b. SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x a
<* :: forall a b. SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x a
Applicative, Applicative (SpiderPullM x)
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)
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
$c>>= :: forall x a b.
SpiderPullM x a -> (a -> SpiderPullM x b) -> SpiderPullM x b
>>= :: forall a b.
SpiderPullM x a -> (a -> SpiderPullM x b) -> SpiderPullM x b
$c>> :: forall x a b. SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x b
>> :: forall a b. SpiderPullM x a -> SpiderPullM x b -> SpiderPullM x b
$creturn :: forall x a. a -> SpiderPullM x a
return :: forall a. a -> SpiderPullM x a
Monad, Monad (SpiderPullM x)
Monad (SpiderPullM x) =>
(forall a. IO a -> SpiderPullM x a) -> MonadIO (SpiderPullM x)
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
$cliftIO :: forall x a. IO a -> SpiderPullM x a
liftIO :: forall a. IO a -> SpiderPullM x a
MonadIO, Monad (SpiderPullM x)
Monad (SpiderPullM x) =>
(forall a. (a -> SpiderPullM x a) -> SpiderPullM x a)
-> MonadFix (SpiderPullM x)
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
$cmfix :: forall x a. (a -> SpiderPullM x a) -> SpiderPullM x a
mfix :: forall a. (a -> SpiderPullM x a) -> SpiderPullM x a
MonadFix)

type ComputeM = EventM

newtype SpiderPushM (x :: Type) a = SpiderPushM (ComputeM x a) deriving ((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
$cfmap :: forall x a b. (a -> b) -> SpiderPushM x a -> SpiderPushM x b
fmap :: forall a b. (a -> b) -> SpiderPushM x a -> SpiderPushM x b
$c<$ :: forall x a b. a -> SpiderPushM x b -> SpiderPushM x a
<$ :: forall a b. a -> SpiderPushM x b -> SpiderPushM x a
Functor, Functor (SpiderPushM x)
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)
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
$cpure :: forall x a. a -> SpiderPushM x a
pure :: forall a. a -> SpiderPushM x a
$c<*> :: forall x a b.
SpiderPushM x (a -> b) -> SpiderPushM x a -> SpiderPushM x b
<*> :: forall a b.
SpiderPushM x (a -> b) -> SpiderPushM x a -> SpiderPushM x b
$cliftA2 :: forall x a b c.
(a -> b -> c)
-> SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x c
liftA2 :: forall a b c.
(a -> b -> c)
-> SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x c
$c*> :: forall x a b. SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x b
*> :: forall a b. SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x b
$c<* :: forall x a b. SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x a
<* :: forall a b. SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x a
Applicative, Applicative (SpiderPushM x)
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)
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
$c>>= :: forall x a b.
SpiderPushM x a -> (a -> SpiderPushM x b) -> SpiderPushM x b
>>= :: forall a b.
SpiderPushM x a -> (a -> SpiderPushM x b) -> SpiderPushM x b
$c>> :: forall x a b. SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x b
>> :: forall a b. SpiderPushM x a -> SpiderPushM x b -> SpiderPushM x b
$creturn :: forall x a. a -> SpiderPushM x a
return :: forall a. a -> SpiderPushM x a
Monad, Monad (SpiderPushM x)
Monad (SpiderPushM x) =>
(forall a. IO a -> SpiderPushM x a) -> MonadIO (SpiderPushM x)
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
$cliftIO :: forall x a. IO a -> SpiderPushM x a
liftIO :: forall a. IO a -> SpiderPushM x a
MonadIO, Monad (SpiderPushM x)
Monad (SpiderPushM x) =>
(forall a. (a -> SpiderPushM x a) -> SpiderPushM x a)
-> MonadFix (SpiderPushM x)
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
$cmfix :: forall x a. (a -> SpiderPushM x a) -> SpiderPushM x a
mfix :: forall a. (a -> SpiderPushM x a) -> SpiderPushM x a
MonadFix)

instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where
  {-# SPECIALIZE instance R.Reflex (SpiderTimeline Global) #-}
  newtype Behavior (SpiderTimeline x) a = SpiderBehavior { forall x a. Behavior (SpiderTimeline x) a -> Behavior x a
unSpiderBehavior :: Behavior x a }
  newtype Event (SpiderTimeline x) a = SpiderEvent { forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent :: Event x a }
  newtype Dynamic (SpiderTimeline x) a = SpiderDynamic { forall x a. Dynamic (SpiderTimeline x) a -> DynamicS x (Identity a)
unSpiderDynamic :: DynamicS x (Identity a) } -- deriving (Functor, Applicative, Monad)
  newtype Incremental (SpiderTimeline x) p = SpiderIncremental { forall x p. 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 :: forall a. 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 :: forall a. 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 :: forall a b.
(a -> PushM (SpiderTimeline x) (Maybe b))
-> Event (SpiderTimeline x) a -> Event (SpiderTimeline x) b
push 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 :: forall a b.
(a -> PushM (SpiderTimeline x) (Maybe b))
-> Event (SpiderTimeline x) a -> Event (SpiderTimeline x) b
pushCheap 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 {k} a (x :: k) b.
(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 :: forall a.
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 :: forall {k1} (k2 :: k1 -> *) (v :: k1 -> *).
GCompare k2 =>
Event (SpiderTimeline x) (DMap k2 v)
-> EventSelectorG (SpiderTimeline x) k2 v
fanG Event (SpiderTimeline x) (DMap k2 v)
e = (forall (a :: k1). k2 a -> Event (SpiderTimeline x) (v a))
-> EventSelectorG (SpiderTimeline x) k2 v
forall {k} {k1} (t :: k) (k2 :: k1 -> *) (v :: k1 -> *).
(forall (a :: k1). k2 a -> Event t (v a)) -> EventSelectorG t k2 v
R.EventSelectorG ((forall (a :: k1). k2 a -> Event (SpiderTimeline x) (v a))
 -> EventSelectorG (SpiderTimeline x) k2 v)
-> (forall (a :: k1). k2 a -> Event (SpiderTimeline x) (v a))
-> EventSelectorG (SpiderTimeline x) k2 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))
-> (k2 a -> Event x (v a))
-> k2 a
-> Event (SpiderTimeline x) (v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventSelectorG x k2 v -> forall (a :: k1). k2 a -> Event x (v a)
forall {k} {k} (x :: k) (k :: k -> *) (v :: k -> *).
EventSelectorG x k v -> forall (a :: k). k a -> Event x (v a)
selectG (Event x (DMap k2 v) -> EventSelectorG x k2 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 k2 v) -> Event x (DMap k2 v)
forall x a. Event (SpiderTimeline x) a -> Event x a
unSpiderEvent Event (SpiderTimeline x) (DMap k2 v)
e))
  {-# INLINABLE mergeG #-}
  mergeG
    :: forall k2 (k :: k2 -> Type) q (v :: k2 -> Type). GCompare k
    => (forall a. q a -> R.Event (SpiderTimeline x) (v a))
    -> DMap k q
    -> R.Event (SpiderTimeline x) (DMap k v)
  mergeG :: forall {k1} (k2 :: k1 -> *) (q :: k1 -> *) (v :: k1 -> *).
GCompare k2 =>
(forall (a :: k1). q a -> Event (SpiderTimeline x) (v a))
-> DMap k2 q -> Event (SpiderTimeline x) (DMap k2 v)
mergeG 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 a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
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)
PatchTarget (PatchDMap k q) -> DynamicS x (PatchDMap k q)
forall {k} p (x :: k). PatchTarget p -> DynamicS x p
dynamicConst
  {-# INLINABLE switch #-}
  switch :: forall a.
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
. (Behavior x (Event (SpiderTimeline x) a) -> Behavior x (Event x a)
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 :: forall a.
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
. (Event x (Event (SpiderTimeline x) a) -> Event x (Event x a)
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 :: forall a.
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)
Dynamic (SpiderTimeline x) a -> DynamicS x (Identity a)
forall x a. Dynamic (SpiderTimeline x) a -> DynamicS x (Identity a)
unSpiderDynamic
  {-# INLINABLE updated #-}
  updated :: forall a.
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 a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
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 a b c (q :: * -> * -> *).
Coercible b a =>
(b -> c) -> q a b -> a -> c
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 a b. (a -> b) -> Dynamic x a a -> Dynamic x a b
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)
Dynamic (SpiderTimeline x) a -> DynamicS x (Identity a)
forall x a. Dynamic (SpiderTimeline x) a -> DynamicS x (Identity a)
unSpiderDynamic
  {-# INLINABLE unsafeBuildDynamic #-}
  unsafeBuildDynamic :: forall a.
PullM (SpiderTimeline x) a
-> Event (SpiderTimeline x) a -> Dynamic (SpiderTimeline x) a
unsafeBuildDynamic PullM (SpiderTimeline x) a
readV0 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 :: forall p.
Patch p =>
PullM (SpiderTimeline x) (PatchTarget p)
-> Event (SpiderTimeline x) p -> Incremental (SpiderTimeline x) p
unsafeBuildIncremental PullM (SpiderTimeline x) (PatchTarget p)
readV0 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 {k1} (k2 :: k1 -> *) (q :: k1 -> *) (v :: k1 -> *).
GCompare k2 =>
(forall (a :: k1). q a -> Event (SpiderTimeline x) (v a))
-> Incremental (SpiderTimeline x) (PatchDMap k2 q)
-> Event (SpiderTimeline x) (DMap k2 v)
mergeIncrementalG forall (a :: k1). q a -> Event (SpiderTimeline x) (v a)
nt = Event x (DMap k2 v) -> Event (SpiderTimeline x) (DMap k2 v)
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (Event x (DMap k2 v) -> Event (SpiderTimeline x) (DMap k2 v))
-> (Dynamic x (DMap k2 q) (PatchDMap k2 q) -> Event x (DMap k2 v))
-> Dynamic x (DMap k2 q) (PatchDMap k2 q)
-> Event (SpiderTimeline x) (DMap k2 v)
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (forall (a :: k1). q a -> Event x (v a))
-> DynamicS x (PatchDMap k2 q) -> Event x (DMap k2 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 a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
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 :: k1). q a -> Event (SpiderTimeline x) (v a)
nt) (Dynamic x (DMap k2 q) (PatchDMap k2 q)
 -> Event (SpiderTimeline x) (DMap k2 v))
-> (Incremental (SpiderTimeline x) (PatchDMap k2 q)
    -> Dynamic x (DMap k2 q) (PatchDMap k2 q))
-> Incremental (SpiderTimeline x) (PatchDMap k2 q)
-> Event (SpiderTimeline x) (DMap k2 v)
forall a b c (q :: * -> * -> *).
Coercible b a =>
(b -> c) -> q a b -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Incremental (SpiderTimeline x) (PatchDMap k2 q)
-> Dynamic x (DMap k2 q) (PatchDMap k2 q)
Incremental (SpiderTimeline x) (PatchDMap k2 q)
-> DynamicS x (PatchDMap k2 q)
forall x p. Incremental (SpiderTimeline x) p -> DynamicS x p
unSpiderIncremental
  {-# INLINABLE mergeIncrementalWithMoveG #-}
  mergeIncrementalWithMoveG :: forall {k1} (k2 :: k1 -> *) (q :: k1 -> *) (v :: k1 -> *).
GCompare k2 =>
(forall (a :: k1). q a -> Event (SpiderTimeline x) (v a))
-> Incremental (SpiderTimeline x) (PatchDMapWithMove k2 q)
-> Event (SpiderTimeline x) (DMap k2 v)
mergeIncrementalWithMoveG forall (a :: k1). q a -> Event (SpiderTimeline x) (v a)
nt = Event x (DMap k2 v) -> Event (SpiderTimeline x) (DMap k2 v)
forall x a. Event x a -> Event (SpiderTimeline x) a
SpiderEvent (Event x (DMap k2 v) -> Event (SpiderTimeline x) (DMap k2 v))
-> (Dynamic x (DMap k2 q) (PatchDMapWithMove k2 q)
    -> Event x (DMap k2 v))
-> Dynamic x (DMap k2 q) (PatchDMapWithMove k2 q)
-> Event (SpiderTimeline x) (DMap k2 v)
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (forall (a :: k1). q a -> Event x (v a))
-> DynamicS x (PatchDMapWithMove k2 q) -> Event x (DMap k2 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 a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
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 :: k1). q a -> Event (SpiderTimeline x) (v a)
nt) (Dynamic x (DMap k2 q) (PatchDMapWithMove k2 q)
 -> Event (SpiderTimeline x) (DMap k2 v))
-> (Incremental (SpiderTimeline x) (PatchDMapWithMove k2 q)
    -> Dynamic x (DMap k2 q) (PatchDMapWithMove k2 q))
-> Incremental (SpiderTimeline x) (PatchDMapWithMove k2 q)
-> Event (SpiderTimeline x) (DMap k2 v)
forall a b c (q :: * -> * -> *).
Coercible b a =>
(b -> c) -> q a b -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Incremental (SpiderTimeline x) (PatchDMapWithMove k2 q)
-> Dynamic x (DMap k2 q) (PatchDMapWithMove k2 q)
Incremental (SpiderTimeline x) (PatchDMapWithMove k2 q)
-> DynamicS x (PatchDMapWithMove k2 q)
forall x p. Incremental (SpiderTimeline x) p -> DynamicS x p
unSpiderIncremental
  {-# INLINABLE currentIncremental #-}
  currentIncremental :: forall p.
Patch p =>
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 :: forall p.
Patch p =>
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 :: forall p.
Patch p =>
Incremental (SpiderTimeline x) p
-> Dynamic (SpiderTimeline x) (PatchTarget p)
incrementalToDynamic (SpiderIncremental DynamicS x p
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 (Identity (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 (Identity (PatchTarget p)))
 -> BehaviorM x (PatchTarget (Identity (PatchTarget p))))
-> Behavior x (PatchTarget (Identity (PatchTarget p)))
-> BehaviorM x (PatchTarget (Identity (PatchTarget p)))
forall a b. (a -> b) -> a -> b
$ Dynamic x (PatchTarget (Identity (PatchTarget p))) p
-> Behavior x (PatchTarget (Identity (PatchTarget p)))
forall {k} (x :: k) target p.
Dynamic x target p -> Behavior x target
dynamicCurrent DynamicS x p
Dynamic x (PatchTarget (Identity (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 (DynamicS x p -> Event x p
forall {k} (x :: k) target p. Dynamic x target p -> Event x p
dynamicUpdated DynamicS x 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 -> do
    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
$ DynamicS x p -> Behavior x (PatchTarget p)
forall {k} (x :: k) target p.
Dynamic x target p -> Behavior x target
dynamicCurrent DynamicS x p
i
    return $ Identity <$> apply p c --TODO: Avoid the redundant 'apply'
  eventCoercion :: forall a b.
Coercion a b
-> Coercion
     (Event (SpiderTimeline x) a) (Event (SpiderTimeline x) b)
eventCoercion Coercion a b
Coercion = Coercion (Event (SpiderTimeline x) a) (Event (SpiderTimeline x) b)
forall {k} (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
  behaviorCoercion :: forall a b.
Coercion a b
-> Coercion
     (Behavior (SpiderTimeline x) a) (Behavior (SpiderTimeline x) b)
behaviorCoercion Coercion a b
Coercion = Coercion
  (Behavior (SpiderTimeline x) a) (Behavior (SpiderTimeline x) b)
forall {k} (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
  dynamicCoercion :: forall a b.
Coercion a b
-> Coercion
     (Dynamic (SpiderTimeline x) a) (Dynamic (SpiderTimeline x) b)
dynamicCoercion Coercion a b
Coercion = Coercion
  (Dynamic (SpiderTimeline x) a) (Dynamic (SpiderTimeline x) b)
forall {k} (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
  incrementalCoercion :: forall a b.
Coercion (PatchTarget a) (PatchTarget b)
-> Coercion a b
-> Coercion
     (Incremental (SpiderTimeline x) a)
     (Incremental (SpiderTimeline x) b)
incrementalCoercion Coercion (PatchTarget a) (PatchTarget b)
Coercion Coercion a b
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 :: forall a.
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)
DynamicS x (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 :: forall a.
Event (SpiderTimeline x) (IntMap a)
-> EventSelectorInt (SpiderTimeline x) a
fanInt 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
  { forall {k} (x :: k) a. SpiderEventHandle x a -> EventSubscription x
spiderEventHandleSubscription :: EventSubscription x
  , forall {k} (x :: k) a. 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 :: forall a. a -> EventM x (Ref (EventM x) a)
newRef = IO (IORef a) -> EventM x (IORef a)
forall a. IO a -> EventM x 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)
a -> IO (Ref IO a)
forall a. a -> IO (Ref IO a)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef
  readRef :: forall a. Ref (EventM x) a -> EventM x a
readRef = IO a -> EventM x a
forall a. 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
Ref IO a -> IO a
forall a. Ref IO a -> IO a
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef
  writeRef :: forall a. Ref (EventM x) a -> a -> EventM x ()
writeRef Ref (EventM x) a
r a
a = IO () -> EventM x ()
forall a. IO a -> EventM x a
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 a. 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 :: forall a b. Ref (EventM x) a -> (a -> (a, b)) -> EventM x b
atomicModifyRef Ref (EventM x) a
r a -> (a, b)
f = IO b -> EventM x b
forall a. IO a -> EventM x a
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 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 { forall x a. SpiderHost x a -> IO a
unSpiderHost :: IO a }
  deriving ((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
$cfmap :: forall x a b. (a -> b) -> SpiderHost x a -> SpiderHost x b
fmap :: forall a b. (a -> b) -> SpiderHost x a -> SpiderHost x b
$c<$ :: forall x a b. a -> SpiderHost x b -> SpiderHost x a
<$ :: forall a b. a -> SpiderHost x b -> SpiderHost x a
Functor, Functor (SpiderHost x)
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)
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
$cpure :: forall x a. a -> SpiderHost x a
pure :: forall a. a -> SpiderHost x a
$c<*> :: forall x a b.
SpiderHost x (a -> b) -> SpiderHost x a -> SpiderHost x b
<*> :: forall a b.
SpiderHost x (a -> b) -> SpiderHost x a -> SpiderHost x b
$cliftA2 :: forall x a b c.
(a -> b -> c) -> SpiderHost x a -> SpiderHost x b -> SpiderHost x c
liftA2 :: forall a b c.
(a -> b -> c) -> SpiderHost x a -> SpiderHost x b -> SpiderHost x c
$c*> :: forall x a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x b
*> :: forall a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x b
$c<* :: forall x a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x a
<* :: forall a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x a
Applicative, Monad (SpiderHost x)
Monad (SpiderHost x) =>
(forall a. (a -> SpiderHost x a) -> SpiderHost x a)
-> MonadFix (SpiderHost x)
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
$cmfix :: forall x a. (a -> SpiderHost x a) -> SpiderHost x a
mfix :: forall a. (a -> SpiderHost x a) -> SpiderHost x a
MonadFix, Monad (SpiderHost x)
Monad (SpiderHost x) =>
(forall a. IO a -> SpiderHost x a) -> MonadIO (SpiderHost x)
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
$cliftIO :: forall x a. IO a -> SpiderHost x a
liftIO :: forall a. IO a -> SpiderHost x a
MonadIO, Monad (SpiderHost 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)
-> MonadException (SpiderHost x)
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
$cthrow :: forall x e a. Exception e => e -> SpiderHost x a
throw :: forall e a. Exception e => e -> SpiderHost x a
$ccatch :: forall x e a.
Exception e =>
SpiderHost x a -> (e -> SpiderHost x a) -> SpiderHost x a
catch :: forall e a.
Exception e =>
SpiderHost x a -> (e -> SpiderHost x a) -> SpiderHost x a
$cfinally :: forall x a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x a
finally :: forall a b. SpiderHost x a -> SpiderHost x b -> SpiderHost x a
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 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
$cmask :: forall x b.
((forall a. SpiderHost x a -> SpiderHost x a) -> SpiderHost x b)
-> SpiderHost x b
mask :: forall b.
((forall a. SpiderHost x a -> SpiderHost x a) -> SpiderHost x b)
-> SpiderHost x b
MonadAsyncException)

instance Monad (SpiderHost x) where
  {-# INLINABLE (>>=) #-}
  SpiderHost IO a
x >>= :: forall a b.
SpiderHost x a -> (a -> SpiderHost x b) -> SpiderHost x b
>>= 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 a b. 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
#if !MIN_VERSION_base(4,13,0)
  {-# INLINABLE fail #-}
  fail = MonadFail.fail
#endif

instance MonadFail (SpiderHost x) where
  {-# INLINABLE fail #-}
  fail :: forall a. String -> SpiderHost x a
fail 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 a. 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 :: forall a. SpiderHost Global a -> IO a
runSpiderHost (SpiderHost 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 :: forall x a. SpiderHost x a -> SpiderTimelineEnv x -> IO a
runSpiderHostForTimeline (SpiderHost IO a
a) SpiderTimelineEnv x
_ = IO a
a

newtype SpiderHostFrame (x :: Type) a = SpiderHostFrame { forall x a. SpiderHostFrame x a -> EventM x a
runSpiderHostFrame :: EventM x a }
  deriving ((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
$cfmap :: forall x a b.
(a -> b) -> SpiderHostFrame x a -> SpiderHostFrame x b
fmap :: forall a b. (a -> b) -> SpiderHostFrame x a -> SpiderHostFrame x b
$c<$ :: forall x a b. a -> SpiderHostFrame x b -> SpiderHostFrame x a
<$ :: forall a b. a -> SpiderHostFrame x b -> SpiderHostFrame x a
Functor, Functor (SpiderHostFrame x)
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)
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
$cpure :: forall x a. a -> SpiderHostFrame x a
pure :: forall a. a -> SpiderHostFrame x a
$c<*> :: forall x a b.
SpiderHostFrame x (a -> b)
-> SpiderHostFrame x a -> SpiderHostFrame x b
<*> :: forall a b.
SpiderHostFrame x (a -> b)
-> SpiderHostFrame x a -> SpiderHostFrame x b
$cliftA2 :: forall x a b c.
(a -> b -> c)
-> SpiderHostFrame x a
-> SpiderHostFrame x b
-> SpiderHostFrame x c
liftA2 :: forall a b c.
(a -> b -> c)
-> SpiderHostFrame x a
-> SpiderHostFrame x b
-> SpiderHostFrame x c
$c*> :: forall x a b.
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x b
*> :: forall a b.
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x b
$c<* :: forall x a b.
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x a
<* :: forall a b.
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x a
Applicative, Monad (SpiderHostFrame x)
Monad (SpiderHostFrame x) =>
(forall a. (a -> SpiderHostFrame x a) -> SpiderHostFrame x a)
-> MonadFix (SpiderHostFrame x)
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
$cmfix :: forall x a. (a -> SpiderHostFrame x a) -> SpiderHostFrame x a
mfix :: forall a. (a -> SpiderHostFrame x a) -> SpiderHostFrame x a
MonadFix, Monad (SpiderHostFrame x)
Monad (SpiderHostFrame x) =>
(forall a. IO a -> SpiderHostFrame x a)
-> MonadIO (SpiderHostFrame x)
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
$cliftIO :: forall x a. IO a -> SpiderHostFrame x a
liftIO :: forall a. IO a -> SpiderHostFrame x a
MonadIO, Monad (SpiderHostFrame 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)
-> MonadException (SpiderHostFrame x)
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
$cthrow :: forall x e a. Exception e => e -> SpiderHostFrame x a
throw :: forall e a. Exception e => e -> SpiderHostFrame x a
$ccatch :: forall x e a.
Exception e =>
SpiderHostFrame x a
-> (e -> SpiderHostFrame x a) -> SpiderHostFrame x a
catch :: forall e a.
Exception e =>
SpiderHostFrame x a
-> (e -> SpiderHostFrame x a) -> SpiderHostFrame x a
$cfinally :: forall x a b.
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x a
finally :: forall a b.
SpiderHostFrame x a -> SpiderHostFrame x b -> SpiderHostFrame x a
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 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
$cmask :: forall x b.
((forall a. SpiderHostFrame x a -> SpiderHostFrame x a)
 -> SpiderHostFrame x b)
-> SpiderHostFrame x b
mask :: forall b.
((forall a. SpiderHostFrame x a -> SpiderHostFrame x a)
 -> SpiderHostFrame x b)
-> SpiderHostFrame x b
MonadAsyncException, MonadCatch (SpiderHostFrame x)
MonadCatch (SpiderHostFrame x) =>
(forall b.
 HasCallStack =>
 ((forall a. SpiderHostFrame x a -> SpiderHostFrame x a)
  -> SpiderHostFrame x b)
 -> SpiderHostFrame x b)
-> (forall b.
    HasCallStack =>
    ((forall a. SpiderHostFrame x a -> SpiderHostFrame x a)
     -> SpiderHostFrame x b)
    -> SpiderHostFrame x b)
-> (forall a b c.
    HasCallStack =>
    SpiderHostFrame x a
    -> (a -> ExitCase b -> SpiderHostFrame x c)
    -> (a -> SpiderHostFrame x b)
    -> SpiderHostFrame x (b, c))
-> MonadMask (SpiderHostFrame x)
forall x. MonadCatch (SpiderHostFrame x)
forall b.
HasCallStack =>
((forall a. SpiderHostFrame x a -> SpiderHostFrame x a)
 -> SpiderHostFrame x b)
-> SpiderHostFrame x b
forall x b.
HasCallStack =>
((forall a. SpiderHostFrame x a -> SpiderHostFrame x a)
 -> SpiderHostFrame x b)
-> SpiderHostFrame x b
forall a b c.
HasCallStack =>
SpiderHostFrame x a
-> (a -> ExitCase b -> SpiderHostFrame x c)
-> (a -> SpiderHostFrame x b)
-> SpiderHostFrame x (b, c)
forall x a b c.
HasCallStack =>
SpiderHostFrame x a
-> (a -> ExitCase b -> SpiderHostFrame x c)
-> (a -> SpiderHostFrame x b)
-> SpiderHostFrame x (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall x b.
HasCallStack =>
((forall a. SpiderHostFrame x a -> SpiderHostFrame x a)
 -> SpiderHostFrame x b)
-> SpiderHostFrame x b
mask :: forall b.
HasCallStack =>
((forall a. SpiderHostFrame x a -> SpiderHostFrame x a)
 -> SpiderHostFrame x b)
-> SpiderHostFrame x b
$cuninterruptibleMask :: forall x b.
HasCallStack =>
((forall a. SpiderHostFrame x a -> SpiderHostFrame x a)
 -> SpiderHostFrame x b)
-> SpiderHostFrame x b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. SpiderHostFrame x a -> SpiderHostFrame x a)
 -> SpiderHostFrame x b)
-> SpiderHostFrame x b
$cgeneralBracket :: forall x a b c.
HasCallStack =>
SpiderHostFrame x a
-> (a -> ExitCase b -> SpiderHostFrame x c)
-> (a -> SpiderHostFrame x b)
-> SpiderHostFrame x (b, c)
generalBracket :: forall a b c.
HasCallStack =>
SpiderHostFrame x a
-> (a -> ExitCase b -> SpiderHostFrame x c)
-> (a -> SpiderHostFrame x b)
-> SpiderHostFrame x (b, c)
MonadMask, Monad (SpiderHostFrame x)
Monad (SpiderHostFrame x) =>
(forall e a.
 (HasCallStack, Exception e) =>
 e -> SpiderHostFrame x a)
-> MonadThrow (SpiderHostFrame x)
forall x. Monad (SpiderHostFrame x)
forall e a. (HasCallStack, Exception e) => e -> SpiderHostFrame x a
forall x e a.
(HasCallStack, Exception e) =>
e -> SpiderHostFrame x a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall x e a.
(HasCallStack, Exception e) =>
e -> SpiderHostFrame x a
throwM :: forall e a. (HasCallStack, Exception e) => e -> SpiderHostFrame x a
MonadThrow, MonadThrow (SpiderHostFrame x)
MonadThrow (SpiderHostFrame x) =>
(forall e a.
 (HasCallStack, Exception e) =>
 SpiderHostFrame x a
 -> (e -> SpiderHostFrame x a) -> SpiderHostFrame x a)
-> MonadCatch (SpiderHostFrame x)
forall x. MonadThrow (SpiderHostFrame x)
forall e a.
(HasCallStack, Exception e) =>
SpiderHostFrame x a
-> (e -> SpiderHostFrame x a) -> SpiderHostFrame x a
forall x e a.
(HasCallStack, Exception e) =>
SpiderHostFrame x a
-> (e -> SpiderHostFrame x a) -> SpiderHostFrame x a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall x e a.
(HasCallStack, Exception e) =>
SpiderHostFrame x a
-> (e -> SpiderHostFrame x a) -> SpiderHostFrame x a
catch :: forall e a.
(HasCallStack, Exception e) =>
SpiderHostFrame x a
-> (e -> SpiderHostFrame x a) -> SpiderHostFrame x a
MonadCatch)

instance Monad (SpiderHostFrame x) where
  {-# INLINABLE (>>=) #-}
  SpiderHostFrame EventM x a
x >>= :: forall a b.
SpiderHostFrame x a
-> (a -> SpiderHostFrame x b) -> SpiderHostFrame x b
>>= 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 a b. 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
#if !MIN_VERSION_base(4,13,0)
  {-# INLINABLE fail #-}
  fail s = SpiderHostFrame $ fail s
#endif

instance NotReady (SpiderTimeline x) (SpiderHostFrame x) where
  notReadyUntil :: forall a. Event (SpiderTimeline x) a -> SpiderHostFrame x ()
notReadyUntil Event (SpiderTimeline x) a
_ = () -> SpiderHostFrame x ()
forall a. a -> SpiderHostFrame x a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  notReady :: SpiderHostFrame x ()
notReady = () -> SpiderHostFrame x ()
forall a. a -> SpiderHostFrame x a
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 :: forall x a.
HasSpiderTimeline x =>
(RootTrigger x a -> IO (IO ())) -> IO (Event x a)
newEventWithTriggerIO RootTrigger x a -> IO (IO ())
f = do
  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
$ \a :~: a
Refl -> RootTrigger x a -> IO (IO ())
RootTrigger x a -> IO (IO ())
f
  return $ select es Refl

newFanEventWithTriggerIO :: (HasSpiderTimeline x, GCompare k) => (forall a. k a -> RootTrigger x a -> IO (IO ())) -> IO (EventSelector x k)
newFanEventWithTriggerIO :: 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 -> RootTrigger x a -> IO (IO ())
f = do
  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
  subscribedRef <- newIORef DMap.empty
  let !r = 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 = k a -> RootTrigger x a -> IO (IO ())
forall a. k a -> RootTrigger x a -> IO (IO ())
f
        }
  return $ EventSelector $ \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 ((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
$cfmap :: forall k (x :: k) a b. (a -> b) -> ReadPhase x a -> ReadPhase x b
fmap :: forall a b. (a -> b) -> ReadPhase x a -> ReadPhase x b
$c<$ :: forall k (x :: k) a b. a -> ReadPhase x b -> ReadPhase x a
<$ :: forall a b. a -> ReadPhase x b -> ReadPhase x a
Functor, Functor (ReadPhase x)
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)
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
$cpure :: forall k (x :: k) a. a -> ReadPhase x a
pure :: forall a. a -> ReadPhase x a
$c<*> :: forall k (x :: k) a b.
ReadPhase x (a -> b) -> ReadPhase x a -> ReadPhase x b
<*> :: forall a b. ReadPhase x (a -> b) -> ReadPhase x a -> ReadPhase x b
$cliftA2 :: forall k (x :: k) a b c.
(a -> b -> c) -> ReadPhase x a -> ReadPhase x b -> ReadPhase x c
liftA2 :: forall a b c.
(a -> b -> c) -> ReadPhase x a -> ReadPhase x b -> ReadPhase x c
$c*> :: forall k (x :: k) a b.
ReadPhase x a -> ReadPhase x b -> ReadPhase x b
*> :: forall a b. ReadPhase x a -> ReadPhase x b -> ReadPhase x b
$c<* :: forall k (x :: k) a b.
ReadPhase x a -> ReadPhase x b -> ReadPhase x a
<* :: forall a b. ReadPhase x a -> ReadPhase x b -> ReadPhase x a
Applicative, Applicative (ReadPhase x)
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)
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
$c>>= :: forall k (x :: k) a b.
ReadPhase x a -> (a -> ReadPhase x b) -> ReadPhase x b
>>= :: forall a b. ReadPhase x a -> (a -> ReadPhase x b) -> ReadPhase x b
$c>> :: forall k (x :: k) a b.
ReadPhase x a -> ReadPhase x b -> ReadPhase x b
>> :: forall a b. ReadPhase x a -> ReadPhase x b -> ReadPhase x b
$creturn :: forall k (x :: k) a. a -> ReadPhase x a
return :: forall a. a -> ReadPhase x a
Monad, Monad (ReadPhase x)
Monad (ReadPhase x) =>
(forall a. (a -> ReadPhase x a) -> ReadPhase x a)
-> MonadFix (ReadPhase x)
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
$cmfix :: forall k (x :: k) a. (a -> ReadPhase x a) -> ReadPhase x a
mfix :: forall a. (a -> ReadPhase x a) -> ReadPhase x a
MonadFix)

instance MonadRef (SpiderHost x) where
  type Ref (SpiderHost x) = Ref IO
  newRef :: forall a. 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)
a -> IO (Ref IO a)
forall a. a -> IO (Ref IO a)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef
  readRef :: forall a. 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
Ref IO a -> IO a
forall a. Ref IO a -> IO a
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef
  writeRef :: forall a. Ref (SpiderHost x) a -> a -> SpiderHost x ()
writeRef 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 a. 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 :: forall a b. Ref (SpiderHost x) a -> (a -> (a, b)) -> SpiderHost x b
atomicModifyRef 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 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 (SpiderHost x) a
r

instance MonadRef (SpiderHostFrame x) where
  type Ref (SpiderHostFrame x) = Ref IO
  newRef :: forall a. 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)
a -> EventM x (Ref (EventM x) a)
forall a. a -> EventM x (Ref (EventM x) a)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef
  readRef :: forall a. 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
Ref (EventM x) a -> EventM x a
forall a. Ref (EventM x) a -> EventM x a
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef
  writeRef :: forall a. Ref (SpiderHostFrame x) a -> a -> SpiderHostFrame x ()
writeRef 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 a. 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 :: forall a b.
Ref (SpiderHostFrame x) a -> (a -> (a, b)) -> SpiderHostFrame x b
atomicModifyRef 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 a b. 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 :: forall a.
(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
(State# (PrimState IO) -> (# State# (PrimState IO), a #)) -> IO a
forall a.
(State# (PrimState IO) -> (# State# (PrimState IO), 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 :: forall a. Event (SpiderTimeline x) a -> SpiderHost x ()
notReadyUntil Event (SpiderTimeline x) a
_ = () -> SpiderHost x ()
forall a. a -> SpiderHost x a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  notReady :: SpiderHost x ()
notReady = () -> SpiderHost x ()
forall a. a -> SpiderHost x a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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