61f6f0f · patch · git.iko.soy

git.iko.soy/patch

Add 'x' parameter to everything in Spider.Internal

commit61f6f0f6fbca995db23d7fb140b64ba7ed3e5453 authorRyan Trinkle <ryan.trinkle@gmail.com> dateTue 2 Aug 2016, 16:20 (10 years ago) parent3a0f375

1 file changed+297−297

compare with develop

unifiedsplit

src/Reflex/Spider/Internal.hs+297−297

src/Reflex/Spider/Internal.hs+297−297

@@ -76,8 +76,8 @@ import qualified Reflex.Host.Class as R

7676-- Note: must come last to silence warnings due to AMP on GHC < 7.10

7777import Prelude hiding (any, concat, mapM, mapM_, sequence)

7878

79−type SubscriberList a = WeakBag (Subscriber a)

80−type SubscriberListTicket a = WeakBagTicket (Subscriber a)

79+type SubscriberList x a = WeakBag (Subscriber x a)

80+type SubscriberListTicket x a = WeakBagTicket (Subscriber x a)

8181

8282debugPropagate :: Bool

8383

@@ -98,35 +98,35 @@ debugInvalidate = True

9898class HasNodeId a where

9999 getNodeId :: a -> Int

100100

101−instance HasNodeId (Hold p a) where

101+instance HasNodeId (Hold x p a) where

102102 getNodeId = holdNodeId

103103

104−instance HasNodeId (PushSubscribed a b) where

104+instance HasNodeId (PushSubscribed x a b) where

105105 getNodeId = pushSubscribedNodeId

106106

107−instance HasNodeId (SwitchSubscribed a) where

107+instance HasNodeId (SwitchSubscribed x a) where

108108 getNodeId = switchSubscribedNodeId

109109

110−instance HasNodeId (MergeSubscribed a) where

110+instance HasNodeId (MergeSubscribed x a) where

111111 getNodeId = mergeSubscribedNodeId

112112

113−instance HasNodeId (FanSubscribed a) where

113+instance HasNodeId (FanSubscribed x a) where

114114 getNodeId = fanSubscribedNodeId

115115

116−instance HasNodeId (CoincidenceSubscribed a) where

116+instance HasNodeId (CoincidenceSubscribed x a) where

117117 getNodeId = coincidenceSubscribedNodeId

118118

119−instance HasNodeId (RootSubscribed a) where

119+instance HasNodeId (RootSubscribed x a) where

120120 getNodeId = rootSubscribedNodeId

121121

122−instance HasNodeId (Pull a) where

122+instance HasNodeId (Pull x a) where

123123 getNodeId = pullNodeId

124124

125125{-# INLINE showNodeId #-}

126126showNodeId :: HasNodeId a => a -> String

127127showNodeId = ("#"<>) . show . getNodeId

128128

129−showSubscriberType :: Subscriber a -> String

129+showSubscriberType :: Subscriber x a -> String

130130showSubscriberType = \case

131131 SubscriberPush _ _ -> "SubscriberPush"

132132 SubscriberMerge _ _ -> "SubscriberMerge"

@@ -139,7 +139,7 @@ showSubscriberType = \case

139139 SubscriberCoincidenceInner _ -> "SubscriberCoincidenceInner"

140140 SubscriberHandle -> "SubscriberHandle"

141141

142−showEventType :: Event a -> String

142+showEventType :: Event x a -> String

143143showEventType = \case

144144 EventRoot _ _ -> "EventRoot"

145145 EventNever -> "EventNever"

@@ -187,48 +187,48 @@ unsafeNodeId a = unsafePerformIO $ do

187187-- Event

188188--------------------------------------------------------------------------------

189189

190−newtype Event a = Event { subscribe :: forall x. Subscriber a -> EventM x (EventSubscription a) }

190+newtype Event x a = Event { subscribe :: Subscriber x a -> EventM x (EventSubscription x a) }

191191

192−wrap :: Monad m => (t -> EventSubscribed a) -> (Subscriber a -> m (SubscriberListTicket a, t)) -> Subscriber a -> m (EventSubscription a)

192+wrap :: Monad m => (t -> EventSubscribed x a) -> (Subscriber x a -> m (SubscriberListTicket x a, t)) -> Subscriber x a -> m (EventSubscription x a)

193193wrap tag getSpecificSubscribed sub = do

194194 (sln, subd) <- getSpecificSubscribed sub

195195 return $ EventSubscription (Just sln) $ tag subd

196196

197−eventRoot :: GCompare k => k a -> Root k -> Event a

197+eventRoot :: GCompare k => k a -> Root x k -> Event x a

198198eventRoot !k !r = Event $ wrap EventSubscribedRoot $ liftIO . getRootSubscribed k r

199199

200−eventNever :: Event a

200+eventNever :: Event x a

201201eventNever = Event $ \_ -> return $ EventSubscription Nothing EventSubscribedNever

202202

203−eventPush :: Push b a -> Event a

203+eventPush :: Push x b a -> Event x a

204204eventPush !p = Event $ wrap EventSubscribedPush $ getPushSubscribed p

205205

206−eventMerge :: (GCompare k, a ~ DMap k Identity) => Merge k -> Event a

206+eventMerge :: (GCompare k, a ~ DMap k Identity) => Merge x k -> Event x a

207207eventMerge !m = Event $ wrap EventSubscribedMerge $ getMergeSubscribed m

208208

209−eventFan :: GCompare k => k a -> Fan k -> Event a

209+eventFan :: GCompare k => k a -> Fan x k -> Event x a

210210eventFan !k !f = Event $ wrap (EventSubscribedFan k) $ getFanSubscribed k f

211211

212−eventSwitch :: Switch a -> Event a

212+eventSwitch :: Switch x a -> Event x a

213213eventSwitch !s = Event $ wrap EventSubscribedSwitch $ getSwitchSubscribed s

214214

215−eventCoincidence :: Coincidence a -> Event a

215+eventCoincidence :: Coincidence x a -> Event x a

216216eventCoincidence !c = Event $ wrap EventSubscribedCoincidence $ getCoincidenceSubscribed c

217217

218−eventHold :: (a ~ p b, R.Patch p) => Hold p b -> Event a

218+eventHold :: (a ~ p b, R.Patch p) => Hold x p b -> Event x a

219219eventHold !h = Event $ subscribeHoldEvent h

220220

221−eventDyn :: (a ~ p b, R.Patch p) => Dyn p b -> Event a

221+eventDyn :: (a ~ p b, R.Patch p) => Dyn x p b -> Event x a

222222eventDyn !j = Event $ \sub -> getDynHold j >>= \h -> subscribeHoldEvent h sub

223223

224−eventHoldIdentity :: (a ~ Identity b) => Hold Identity b -> Event a

224+eventHoldIdentity :: (a ~ Identity b) => Hold x Identity b -> Event x a

225225eventHoldIdentity !h = Event $ subscribeHoldEvent h

226226

227−eventDynIdentity :: (a ~ Identity b) => Dyn Identity b -> Event a

227+eventDynIdentity :: (a ~ Identity b) => Dyn x Identity b -> Event x a

228228eventDynIdentity !j = Event $ \sub -> getDynHold j >>= \h -> subscribeHoldEvent h sub

229229

230230{-# INLINE subscribeCoincidenceInner #-}

231−subscribeCoincidenceInner :: CanSubscribe x m => Event a -> Height -> CoincidenceSubscribed a -> m (Maybe a, Height, EventSubscribed a)

231+subscribeCoincidenceInner :: CanSubscribe x m => Event x a -> Height -> CoincidenceSubscribed x a -> m (Maybe a, Height, EventSubscribed x a)

232232subscribeCoincidenceInner inner outerHeight subscribedUnsafe = do

233233 subInner <- liftIO $ newSubscriberCoincidenceInner subscribedUnsafe

234234 subscription@(EventSubscription _ innerSubd) <- subscribe inner subInner

@@ -242,16 +242,16 @@ subscribeCoincidenceInner inner outerHeight subscribedUnsafe = do

242242-- EventSubscribed

243243--------------------------------------------------------------------------------

244244

245−data EventSubscribed a

246− = EventSubscribedRoot {-# NOUNPACK #-} (RootSubscribed a)

245+data EventSubscribed x a

246+ = EventSubscribedRoot {-# NOUNPACK #-} (RootSubscribed x a)

247247 | EventSubscribedNever

248− | forall b. EventSubscribedPush !(PushSubscribed b a)

249− | forall k. (GCompare k, a ~ DMap k Identity) => EventSubscribedMerge !(MergeSubscribed k)

250− | forall k. GCompare k => EventSubscribedFan !(k a) !(FanSubscribed k)

251− | EventSubscribedSwitch !(SwitchSubscribed a)

252− | EventSubscribedCoincidence !(CoincidenceSubscribed a)

248+ | forall b. EventSubscribedPush !(PushSubscribed x b a)

249+ | forall k. (GCompare k, a ~ DMap k Identity) => EventSubscribedMerge !(MergeSubscribed x k)

250+ | forall k. GCompare k => EventSubscribedFan !(k a) !(FanSubscribed x k)

251+ | EventSubscribedSwitch !(SwitchSubscribed x a)

252+ | EventSubscribedCoincidence !(CoincidenceSubscribed x a)

253253

254−readEventSubscribed :: EventSubscribed a -> IO (Maybe a)

254+readEventSubscribed :: EventSubscribed x a -> IO (Maybe a)

255255readEventSubscribed = \case

256256 EventSubscribedRoot rs -> readRootSubscribed rs

257257 EventSubscribedNever -> return Nothing

@@ -262,7 +262,7 @@ readEventSubscribed = \case

262262 EventSubscribedCoincidence cs -> readCoincidenceSubscribed cs

263263

264264{-# INLINE subscribeEventSubscribed #-}

265−subscribeEventSubscribed :: EventSubscribed a -> Subscriber a -> IO (Maybe (SubscriberListTicket a))

265+subscribeEventSubscribed :: EventSubscribed x a -> Subscriber x a -> IO (Maybe (SubscriberListTicket x a))

266266subscribeEventSubscribed es sub = case es of

267267 EventSubscribedRoot r -> do

268268 traceSubscribe $ "subscribeEventSubscribed Root"

@@ -287,7 +287,7 @@ subscribeEventSubscribed es sub = case es of

287287 Just <$> subscribeCoincidenceSubscribed subscribed sub

288288

289289{-# INLINE eventSubscribedGetParents #-}

290−eventSubscribedGetParents :: EventSubscribed a -> IO [Some EventSubscribed]

290+eventSubscribedGetParents :: EventSubscribed x a -> IO [Some (EventSubscribed x)]

291291eventSubscribedGetParents = \case

292292 EventSubscribedRoot _ -> return []

293293 EventSubscribedNever -> return []

@@ -305,11 +305,11 @@ eventSubscribedGetParents = \case

305305 innerParents = maybeToList $ fmap Some.This innerSubscription

306306 return $ outerParent : innerParents

307307

308−getEventSubscribedHeight :: EventSubscribed a -> IO Height

308+getEventSubscribedHeight :: EventSubscribed x a -> IO Height

309309getEventSubscribedHeight es = readIORef $ eventSubscribedHeightRef es

310310

311311{-# INLINE eventSubscribedHeightRef #-}

312−eventSubscribedHeightRef :: EventSubscribed a -> IORef Height

312+eventSubscribedHeightRef :: EventSubscribed x a -> IORef Height

313313eventSubscribedHeightRef = \case

314314 EventSubscribedRoot _ -> zeroRef

315315 EventSubscribedNever -> zeroRef

@@ -319,7 +319,7 @@ eventSubscribedHeightRef = \case

319319 EventSubscribedSwitch subscribed -> switchSubscribedHeight subscribed

320320 EventSubscribedCoincidence subscribed -> coincidenceSubscribedHeight subscribed

321321

322−whoCreatedEventSubscribed :: EventSubscribed a -> IO [String]

322+whoCreatedEventSubscribed :: EventSubscribed x a -> IO [String]

323323whoCreatedEventSubscribed = \case

324324 EventSubscribedRoot _ -> return ["root"]

325325 EventSubscribedNever -> return ["never"]

@@ -330,7 +330,7 @@ whoCreatedEventSubscribed = \case

330330 EventSubscribedCoincidence subscribed -> whoCreatedIORef $ coincidenceSubscribedCachedSubscribed subscribed

331331

332332{-# INLINE eventSubscribedHasOwnHeightRef #-}

333−eventSubscribedHasOwnHeightRef :: EventSubscribed a -> Bool

333+eventSubscribedHasOwnHeightRef :: EventSubscribed x a -> Bool

334334eventSubscribedHasOwnHeightRef = \case

335335 EventSubscribedRoot _ -> False

336336 EventSubscribedNever -> False

@@ -340,7 +340,7 @@ eventSubscribedHasOwnHeightRef = \case

340340 EventSubscribedSwitch _ -> True

341341 EventSubscribedCoincidence _ -> True

342342

343−walkInvalidHeightParents :: EventSubscribed a -> IO [Some EventSubscribed]

343+walkInvalidHeightParents :: EventSubscribed x a -> IO [Some (EventSubscribed x)]

344344walkInvalidHeightParents s0 = do

345345 subscribers <- flip execStateT mempty $ ($ Some.This s0) $ fix $ \loop (Some.This s) -> do

346346 h <- liftIO $ readIORef $ eventSubscribedHeightRef s

@@ -355,12 +355,12 @@ walkInvalidHeightParents s0 = do

355355-- EventSubscription

356356--------------------------------------------------------------------------------

357357

358−data EventSubscription a = EventSubscription

359− { _eventSubscription_ticket :: !(Maybe (SubscriberListTicket a))

360− , _eventSubscription_subscribed :: !(EventSubscribed a)

358+data EventSubscription x a = EventSubscription

359+ { _eventSubscription_ticket :: !(Maybe (SubscriberListTicket x a))

360+ , _eventSubscription_subscribed :: !(EventSubscribed x a)

361361 }

362362

363−unsubscribe :: EventSubscription a -> IO ()

363+unsubscribe :: EventSubscription x a -> IO ()

364364unsubscribe (EventSubscription msln _) = forM_ msln $ \sln -> WeakBag.remove sln

365365

366366--------------------------------------------------------------------------------

@@ -371,10 +371,10 @@ unsubscribe (EventSubscription msln _) = forM_ msln $ \sln -> WeakBag.remove sln

371371--representational so we can use coerce

372372

373373--type role Hold representational

374−data Hold p a

374+data Hold x p a

375375 = Hold { holdValue :: !(IORef a)

376− , holdInvalidators :: !(IORef [Weak Invalidator])

377− , holdParent :: !(IORef (Either (Event (p a)) (EventSubscription (p a)))) -- Keeps its parent alive (will be undefined until the hold is initialized) --TODO: Probably shouldn't be an IORef

376+ , holdInvalidators :: !(IORef [Weak (Invalidator x)])

377+ , holdParent :: !(IORef (Either (Event x (p a)) (EventSubscription x (p a)))) -- Keeps its parent alive (will be undefined until the hold is initialized) --TODO: Probably shouldn't be an IORef

378378#ifdef DEBUG_NODEIDS

379379 , holdNodeId :: Int

380380#endif

@@ -382,15 +382,15 @@ data Hold p a

382382

383383data EventEnv x

384384 = EventEnv { eventEnvSpiderEnv :: !(SpiderEnv x)

385− , eventEnvAssignments :: !(IORef [SomeAssignment]) -- Needed for Subscribe

386− , eventEnvHoldInits :: !(IORef [SomeHoldInit]) -- Needed for Subscribe

387− , eventEnvMergeUpdates :: !(IORef [SomeMergeUpdate])

388− , eventEnvMergeInits :: !(IORef [SomeMergeInit]) -- Needed for Subscribe

385+ , eventEnvAssignments :: !(IORef [SomeAssignment x]) -- Needed for Subscribe

386+ , eventEnvHoldInits :: !(IORef [SomeHoldInit x]) -- Needed for Subscribe

387+ , eventEnvMergeUpdates :: !(IORef [SomeMergeUpdate x])

388+ , eventEnvMergeInits :: !(IORef [SomeMergeInit x]) -- Needed for Subscribe

389389 , eventEnvClears :: !(IORef [SomeClear]) -- Needed for Subscribe

390390 , eventEnvRootClears :: !(IORef [SomeRootClear])

391391 , eventEnvCurrentHeight :: !(IORef Height) -- Needed for Subscribe

392− , eventEnvResetCoincidences :: !(IORef [SomeResetCoincidence]) -- Needed for Subscribe

393− , eventEnvDelayedMerges :: !(IORef (IntMap [DelayedMerge]))

392+ , eventEnvResetCoincidences :: !(IORef [SomeResetCoincidence x]) -- Needed for Subscribe

393+ , eventEnvDelayedMerges :: !(IORef (IntMap [DelayedMerge x]))

394394 }

395395

396396{-# INLINE runEventM #-}

@@ -406,31 +406,31 @@ defer a = do

406406 q <- getDeferralQueue

407407 liftIO $ modifyIORef' q (a:)

408408

409−instance Defer SomeAssignment (EventM x) where

409+instance Defer (SomeAssignment x) (EventM x) where

410410 {-# INLINE getDeferralQueue #-}

411411 getDeferralQueue = EventM $ asks eventEnvAssignments

412412

413−instance Defer SomeHoldInit (EventM x) where

413+instance Defer (SomeHoldInit x) (EventM x) where

414414 {-# INLINE getDeferralQueue #-}

415415 getDeferralQueue = EventM $ asks eventEnvHoldInits

416416

417−instance Defer SomeHoldInit BehaviorM where

417+instance Defer (SomeHoldInit x) (BehaviorM x) where

418418 {-# INLINE getDeferralQueue #-}

419419 getDeferralQueue = BehaviorM $ asks snd

420420

421−instance Defer SomeMergeUpdate (EventM x) where

421+instance Defer (SomeMergeUpdate x) (EventM x) where

422422 {-# INLINE getDeferralQueue #-}

423423 getDeferralQueue = EventM $ asks eventEnvMergeUpdates

424424

425−instance Defer SomeMergeInit (EventM x) where

425+instance Defer (SomeMergeInit x) (EventM x) where

426426 {-# INLINE getDeferralQueue #-}

427427 getDeferralQueue = EventM $ asks eventEnvMergeInits

428428

429−class HasCurrentHeight m where

429+class HasCurrentHeight x m | m -> x where

430430 getCurrentHeight :: m Height

431− scheduleMerge :: Height -> MergeSubscribed a -> m ()

431+ scheduleMerge :: Height -> MergeSubscribed x a -> m ()

432432

433−instance HasCurrentHeight (EventM x) where

433+instance HasCurrentHeight x (EventM x) where

434434 {-# INLINE getCurrentHeight #-}

435435 getCurrentHeight = EventM $ do

436436 heightRef <- asks eventEnvCurrentHeight

@@ -473,14 +473,14 @@ instance Defer SomeRootClear (EventM x) where

473473scheduleRootClear :: Defer SomeRootClear m => IORef (DMap k Identity) -> m ()

474474scheduleRootClear r = defer $ SomeRootClear r

475475

476−instance Defer SomeResetCoincidence (EventM x) where

476+instance Defer (SomeResetCoincidence x) (EventM x) where

477477 {-# INLINE getDeferralQueue #-}

478478 getDeferralQueue = EventM $ asks eventEnvResetCoincidences

479479

480480-- Note: hold cannot examine its event until after the phase is over

481−{-# SPECIALIZE hold :: R.Patch p => a -> Event (p a) -> EventM x (Hold p a) #-}

482−{-# SPECIALIZE hold :: R.Patch p => a -> Event (p a) -> ComputeM (Hold p a) #-}

483−hold :: (R.Patch p, Defer SomeHoldInit m) => a -> Event (p a) -> m (Hold p a)

481+{-# SPECIALIZE hold :: R.Patch p => a -> Event x (p a) -> EventM x (Hold x p a) #-}

482+{-# SPECIALIZE hold :: R.Patch p => a -> Event x (p a) -> ComputeM x (Hold x p a) #-}

483+hold :: (R.Patch p, Defer (SomeHoldInit x) m) => a -> Event x (p a) -> m (Hold x p a)

484484hold v0 e = do

485485 valRef <- liftIO $ newIORef v0

486486 invsRef <- liftIO $ newIORef []

@@ -500,7 +500,7 @@ hold v0 e = do

500500 return h

501501

502502{-# INLINE getHoldEventSubscription #-}

503−getHoldEventSubscription :: forall m p a x. (Defer SomeAssignment m, Defer SomeHoldInit m, Defer SomeClear m, R.Patch p, HasCurrentHeight m, Defer SomeMergeInit m, Defer SomeResetCoincidence m, HasSpiderEnv x m, m ~ EventM x) => Hold p a -> m (EventSubscription (p a))

503+getHoldEventSubscription :: forall m p a x. (Defer (SomeAssignment x) m, Defer (SomeHoldInit x) m, Defer SomeClear m, R.Patch p, HasCurrentHeight x m, Defer (SomeMergeInit x) m, Defer (SomeResetCoincidence x) m, HasSpiderEnv x m, m ~ EventM x) => Hold x p a -> m (EventSubscription x (p a))

504504getHoldEventSubscription h = do

505505 ep <- liftIO $ readIORef $ holdParent h

506506 case ep of

@@ -524,13 +524,13 @@ getHoldEventSubscription h = do

524524 liftIO $ writeIORef (holdParent h) $ Right subscription

525525 return subscription

526526

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

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

528528

529529--type role BehaviorM representational

530530-- BehaviorM can sample behaviors

531−newtype BehaviorM a = BehaviorM { unBehaviorM :: ReaderT BehaviorEnv IO a } deriving (Functor, Applicative, MonadIO, MonadFix)

531+newtype BehaviorM x a = BehaviorM { unBehaviorM :: ReaderT (BehaviorEnv x) IO a } deriving (Functor, Applicative, MonadIO, MonadFix)

532532

533−instance Monad BehaviorM where

533+instance Monad (BehaviorM x) where

534534 {-# INLINE (>>=) #-}

535535 BehaviorM x >>= f = BehaviorM $ x >>= unBehaviorM . f

536536 {-# INLINE (>>) #-}

@@ -540,93 +540,93 @@ instance Monad BehaviorM where

540540 {-# INLINE fail #-}

541541 fail s = BehaviorM $ fail s

542542

543−data BehaviorSubscribed a

544− = forall p. BehaviorSubscribedHold (Hold p a)

545− | BehaviorSubscribedPull (PullSubscribed a)

543+data BehaviorSubscribed x a

544+ = forall p. BehaviorSubscribedHold (Hold x p a)

545+ | BehaviorSubscribedPull (PullSubscribed x a)

546546

547−data SomeBehaviorSubscribed = forall a. SomeBehaviorSubscribed (BehaviorSubscribed a)

547+data SomeBehaviorSubscribed x = forall a. SomeBehaviorSubscribed (BehaviorSubscribed x a)

548548

549549--type role PullSubscribed representational

550−data PullSubscribed a

550+data PullSubscribed x a

551551 = PullSubscribed { pullSubscribedValue :: !a

552− , pullSubscribedInvalidators :: !(IORef [Weak Invalidator])

553− , pullSubscribedOwnInvalidator :: !Invalidator

554− , pullSubscribedParents :: ![SomeBehaviorSubscribed] -- Need to keep parent behaviors alive, or they won't let us know when they're invalidated

552+ , pullSubscribedInvalidators :: !(IORef [Weak (Invalidator x)])

553+ , pullSubscribedOwnInvalidator :: !(Invalidator x)

554+ , pullSubscribedParents :: ![SomeBehaviorSubscribed x] -- Need to keep parent behaviors alive, or they won't let us know when they're invalidated

555555 }

556556

557557--type role Pull representational

558−data Pull a

559− = Pull { pullValue :: !(IORef (Maybe (PullSubscribed a)))

560− , pullCompute :: !(BehaviorM a)

558+data Pull x a

559+ = Pull { pullValue :: !(IORef (Maybe (PullSubscribed x a)))

560+ , pullCompute :: !(BehaviorM x a)

561561#ifdef DEBUG_NODEIDS

562562 , pullNodeId :: Int

563563#endif

564564 }

565565

566−data Invalidator

567− = forall a. InvalidatorPull (Pull a)

568− | forall a. InvalidatorSwitch (SwitchSubscribed a)

566+data Invalidator x

567+ = forall a. InvalidatorPull (Pull x a)

568+ | forall a. InvalidatorSwitch (SwitchSubscribed x a)

569569

570−data RootSubscribed a = forall k. GCompare k => RootSubscribed

570+data RootSubscribed x a = forall k. GCompare k => RootSubscribed

571571 { rootSubscribedKey :: !(k a)

572− , rootSubscribedCachedSubscribed :: !(IORef (DMap k RootSubscribed)) -- From the original Root

573− , rootSubscribedSubscribers :: !(SubscriberList a)

572+ , rootSubscribedCachedSubscribed :: !(IORef (DMap k (RootSubscribed x))) -- From the original Root

573+ , rootSubscribedSubscribers :: !(SubscriberList x a)

574574 , rootSubscribedOccurrence :: !(IO (Maybe a)) -- Lookup from rootOccurrence

575575 , rootSubscribedUninit :: IO ()

576− , rootSubscribedWeakSelf :: !(IORef (Weak (RootSubscribed a))) --TODO: Can we make this a lazy non-IORef and then force it manually to avoid an indirection each time we use it?

576+ , 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?

577577#ifdef DEBUG_NODEIDS

578578 , rootSubscribedNodeId :: Int

579579#endif

580580 }

581581

582−data Root (k :: * -> *)

582+data Root x (k :: * -> *)

583583 = Root { rootOccurrence :: !(IORef (DMap k Identity)) -- The currently-firing occurrence of this event

584− , rootSubscribed :: !(IORef (DMap k RootSubscribed))

585− , rootInit :: !(forall a. k a -> RootTrigger a -> IO (IO ()))

584+ , rootSubscribed :: !(IORef (DMap k (RootSubscribed x)))

585+ , rootInit :: !(forall a. k a -> RootTrigger x a -> IO (IO ()))

586586 }

587587

588−data SomeHoldInit = forall p a. R.Patch p => SomeHoldInit !(Hold p a)

588+data SomeHoldInit x = forall p a. R.Patch p => SomeHoldInit !(Hold x p a)

589589

590−data SomeMergeUpdate = forall k. GCompare k => SomeMergeUpdate (R.PatchDMap (DMap k Event)) (MergeSubscribed k)

590+data SomeMergeUpdate x = forall k. GCompare k => SomeMergeUpdate (R.PatchDMap (DMap k (Event x))) (MergeSubscribed x k)

591591

592−data SomeMergeInit = forall k. GCompare k => SomeMergeInit !(MergeSubscribed k) !(Event (R.PatchDMap (DMap k Event)))

592+data SomeMergeInit x = forall k. GCompare k => SomeMergeInit !(MergeSubscribed x k) !(Event x (R.PatchDMap (DMap k (Event x))))

593593

594−data SomeEventSubscription = forall a. SomeEventSubscription (EventSubscription a)

594+data SomeEventSubscription x = forall a. SomeEventSubscription (EventSubscription x a)

595595

596596-- EventM can do everything BehaviorM can, plus create holds

597−newtype EventM x a = EventM { unEventM :: ReaderT (EventEnv x) IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadException, MonadAsyncException) -- The environment should be Nothing if we are not in a frame, and Just if we are - in which case it is a list of assignments to be done after the frame is over

597+newtype EventM x (a :: *) = EventM { unEventM :: ReaderT (EventEnv x) IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadException, MonadAsyncException) -- The environment should be Nothing if we are not in a frame, and Just if we are - in which case it is a list of assignments to be done after the frame is over

598598

599−data PushSubscribed a b

600− = PushSubscribed { pushSubscribedCachedSubscribed :: !(IORef (Maybe (PushSubscribed a b)))

599+data PushSubscribed x a b

600+ = PushSubscribed { pushSubscribedCachedSubscribed :: !(IORef (Maybe (PushSubscribed x a b)))

601601 , pushSubscribedOccurrence :: !(IORef (Maybe b)) -- If the current height is less than our height, this should always be Nothing; during our height, this will get filled in at some point, always before our children are notified; after our height, this will be filled in with the correct value (Nothing if we are not firing, Just if we are)

602602 , pushSubscribedHeight :: !(IORef Height)

603− , pushSubscribedSubscribers :: !(SubscriberList b)

604− , pushSubscribedSelf :: !(Subscriber a) -- Hold this in memory to ensure our WeakReferences don't die --TODO: Probably unneeded now

605− , pushSubscribedWeakSelf :: !(IORef (Weak (PushSubscribed a b)))

606− , pushSubscribedParent :: !(EventSubscription a)

603+ , pushSubscribedSubscribers :: !(SubscriberList x b)

604+ , pushSubscribedSelf :: !(Subscriber x a) -- Hold this in memory to ensure our WeakReferences don't die --TODO: Probably unneeded now

605+ , pushSubscribedWeakSelf :: !(IORef (Weak (PushSubscribed x a b)))

606+ , pushSubscribedParent :: !(EventSubscription x a)

607607#ifdef DEBUG_NODEIDS

608608 , pushSubscribedNodeId :: Int

609609#endif

610610 }

611611

612−newtype ComputeM a = ComputeM (ReaderT (IORef [SomeHoldInit]) IO a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

612+newtype ComputeM x a = ComputeM (ReaderT (IORef [SomeHoldInit x]) IO a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

613613

614−instance Defer SomeHoldInit ComputeM where

614+instance Defer (SomeHoldInit x) (ComputeM x) where

615615 getDeferralQueue = ComputeM ask

616616

617−{-# SPECIALIZE runComputeM :: ComputeM a -> EventM x a #-}

618−runComputeM :: Defer SomeHoldInit m => ComputeM a -> m a

617+{-# SPECIALIZE runComputeM :: ComputeM x a -> EventM x a #-}

618+runComputeM :: Defer (SomeHoldInit x) m => ComputeM x a -> m a

619619runComputeM (ComputeM a) = liftIO . runReaderT a =<< getDeferralQueue

620620

621−data Push a b

622− = Push { pushCompute :: !(a -> ComputeM (Maybe b)) -- Compute the current firing value; assumes that its parent has been computed --TODO: This only uses Defer SomeHoldInit EventM; perhaps only the hold init queue should be passed in (also, perhaps those hold inits can be accelerated - can there be a loop we would need to worry about?)

623− , pushParent :: !(Event a)

624− , pushSubscribed :: !(IORef (Maybe (PushSubscribed a b))) --TODO: Can we replace this with an unsafePerformIO thunk?

621+data Push x a b

622+ = Push { pushCompute :: !(a -> ComputeM x (Maybe b)) -- Compute the current firing value; assumes that its parent has been computed --TODO: This only uses Defer SomeHoldInit EventM; perhaps only the hold init queue should be passed in (also, perhaps those hold inits can be accelerated - can there be a loop we would need to worry about?)

623+ , pushParent :: !(Event x a)

624+ , pushSubscribed :: !(IORef (Maybe (PushSubscribed x a b))) --TODO: Can we replace this with an unsafePerformIO thunk?

625625 }

626626

627−data MergeSubscribedParent k a = MergeSubscribedParent !(EventSubscription a) !(Subscriber a)

627+data MergeSubscribedParent (x :: *) k a = MergeSubscribedParent !(EventSubscription x a) !(Subscriber x a)

628628

629−mergeSubscribedParentSubscription :: MergeSubscribedParent k a -> EventSubscription a

629+mergeSubscribedParentSubscription :: MergeSubscribedParent x k a -> EventSubscription x a

630630mergeSubscribedParentSubscription (MergeSubscribedParent es _) = es

631631

632632data HeightBag = HeightBag

@@ -671,98 +671,98 @@ heightBagVerify b@(HeightBag s c) = if

671671heightBagVerify = id

672672#endif

673673

674−data MergeSubscribed k

675− = MergeSubscribed { mergeSubscribedCachedSubscribed :: !(IORef (Maybe (MergeSubscribed k))) -- From the original merge

674+data MergeSubscribed x k

675+ = MergeSubscribed { mergeSubscribedCachedSubscribed :: !(IORef (Maybe (MergeSubscribed x k))) -- From the original merge

676676 , mergeSubscribedOccurrence :: !(IORef (Maybe (DMap k Identity)))

677677 , mergeSubscribedAccum :: !(IORef (DMap k Identity)) -- This will accumulate occurrences until our height is reached, at which point it will be transferred to mergeSubscribedOccurrence

678678 , mergeSubscribedHeight :: !(IORef Height)

679679 , mergeSubscribedHeightBag :: !(IORef HeightBag)

680− , mergeSubscribedSubscribers :: !(SubscriberList (DMap k Identity))

681− , mergeSubscribedChange :: !(IORef (Subscriber (R.PatchDMap (DMap k Event)), EventSubscribed (R.PatchDMap (DMap k Event))))

682− , mergeSubscribedParents :: !(IORef (DMap k (MergeSubscribedParent k)))

683− , mergeSubscribedWeakSelf :: !(IORef (Weak (MergeSubscribed k)))

680+ , mergeSubscribedSubscribers :: !(SubscriberList x (DMap k Identity))

681+ , mergeSubscribedChange :: !(IORef (Subscriber x (R.PatchDMap (DMap k (Event x))), EventSubscribed x (R.PatchDMap (DMap k (Event x)))))

682+ , mergeSubscribedParents :: !(IORef (DMap k (MergeSubscribedParent x k)))

683+ , mergeSubscribedWeakSelf :: !(IORef (Weak (MergeSubscribed x k)))

684684#ifdef DEBUG_NODEIDS

685685 , mergeSubscribedNodeId :: Int

686686#endif

687687 }

688688

689689--TODO: DMap sucks; we should really write something better (with a functor for the value as well as the key)

690−data Merge k

691− = Merge { mergeParents :: !(Dynamic R.PatchDMap (DMap k Event))

692− , mergeSubscribed :: !(IORef (Maybe (MergeSubscribed k)))

690+data Merge x k

691+ = Merge { mergeParents :: !(Dynamic x R.PatchDMap (DMap k (Event x)))

692+ , mergeSubscribed :: !(IORef (Maybe (MergeSubscribed x k)))

693693 }

694694

695−data FanSubscribedChildren k a = FanSubscribedChildren

696− { _fanSubscribedChildren_list :: !(SubscriberList a)

697− , _fanSubscribedChildren_self :: {-# NOUNPACK #-} !(k a, FanSubscribed k)

698− , _fanSubscribedChildren_weakSelf :: !(IORef (Weak (k a, FanSubscribed k)))

695+data FanSubscribedChildren (x :: *) k a = FanSubscribedChildren

696+ { _fanSubscribedChildren_list :: !(SubscriberList x a)

697+ , _fanSubscribedChildren_self :: {-# NOUNPACK #-} !(k a, FanSubscribed x k)

698+ , _fanSubscribedChildren_weakSelf :: !(IORef (Weak (k a, FanSubscribed x k)))

699699 }

700700

701−data FanSubscribed k

702− = FanSubscribed { fanSubscribedCachedSubscribed :: !(IORef (Maybe (FanSubscribed k)))

703− , fanSubscribedSubscribers :: !(IORef (DMap k (FanSubscribedChildren k))) -- This DMap should never be empty

704− , fanSubscribedParent :: !(EventSubscription (DMap k Identity))

701+data FanSubscribed (x :: *) k

702+ = FanSubscribed { fanSubscribedCachedSubscribed :: !(IORef (Maybe (FanSubscribed x k)))

703+ , fanSubscribedSubscribers :: !(IORef (DMap k (FanSubscribedChildren x k))) -- This DMap should never be empty

704+ , fanSubscribedParent :: !(EventSubscription x (DMap k Identity))

705705#ifdef DEBUG_NODEIDS

706706 , fanSubscribedNodeId :: Int

707707#endif

708708 }

709709

710−data Fan k

711− = Fan { fanParent :: !(Event (DMap k Identity))

712− , fanSubscribed :: !(IORef (Maybe (FanSubscribed k)))

710+data Fan x k

711+ = Fan { fanParent :: !(Event x (DMap k Identity))

712+ , fanSubscribed :: !(IORef (Maybe (FanSubscribed x k)))

713713 }

714714

715−data SwitchSubscribed a

716− = SwitchSubscribed { switchSubscribedCachedSubscribed :: !(IORef (Maybe (SwitchSubscribed a)))

715+data SwitchSubscribed x a

716+ = SwitchSubscribed { switchSubscribedCachedSubscribed :: !(IORef (Maybe (SwitchSubscribed x a)))

717717 , switchSubscribedOccurrence :: !(IORef (Maybe a))

718718 , switchSubscribedHeight :: !(IORef Height)

719− , switchSubscribedSubscribers :: !(SubscriberList a)

720− , switchSubscribedOwnInvalidator :: {-# NOUNPACK #-} !Invalidator

721− , switchSubscribedOwnWeakInvalidator :: !(IORef (Weak Invalidator))

722− , switchSubscribedBehaviorParents :: !(IORef [SomeBehaviorSubscribed])

723− , switchSubscribedParent :: !(Behavior (Event a))

724− , switchSubscribedCurrentParent :: !(IORef (EventSubscription a))

725− , switchSubscribedWeakSelf :: !(IORef (Weak (SwitchSubscribed a)))

719+ , switchSubscribedSubscribers :: !(SubscriberList x a)

720+ , switchSubscribedOwnInvalidator :: {-# NOUNPACK #-} !(Invalidator x)

721+ , switchSubscribedOwnWeakInvalidator :: !(IORef (Weak (Invalidator x)))

722+ , switchSubscribedBehaviorParents :: !(IORef [SomeBehaviorSubscribed x])

723+ , switchSubscribedParent :: !(Behavior x (Event x a))

724+ , switchSubscribedCurrentParent :: !(IORef (EventSubscription x a))

725+ , switchSubscribedWeakSelf :: !(IORef (Weak (SwitchSubscribed x a)))

726726#ifdef DEBUG_NODEIDS

727727 , switchSubscribedNodeId :: Int

728728#endif

729729 }

730730

731−data Switch a

732− = Switch { switchParent :: !(Behavior (Event a))

733− , switchSubscribed :: !(IORef (Maybe (SwitchSubscribed a)))

731+data Switch x a

732+ = Switch { switchParent :: !(Behavior x (Event x a))

733+ , switchSubscribed :: !(IORef (Maybe (SwitchSubscribed x a)))

734734 }

735735

736736{-# ANN CoincidenceSubscribed "HLint: ignore Redundant bracket" #-}

737−data CoincidenceSubscribed a

738− = CoincidenceSubscribed { coincidenceSubscribedCachedSubscribed :: !(IORef (Maybe (CoincidenceSubscribed a)))

737+data CoincidenceSubscribed x a

738+ = CoincidenceSubscribed { coincidenceSubscribedCachedSubscribed :: !(IORef (Maybe (CoincidenceSubscribed x a)))

739739 , coincidenceSubscribedOccurrence :: !(IORef (Maybe a))

740− , coincidenceSubscribedSubscribers :: !(SubscriberList a)

740+ , coincidenceSubscribedSubscribers :: !(SubscriberList x a)

741741 , coincidenceSubscribedHeight :: !(IORef Height)

742− , coincidenceSubscribedOuter :: {-# NOUNPACK #-} (Subscriber (Event a))

743− , coincidenceSubscribedOuterParent :: !(EventSubscription (Event a))

744− , coincidenceSubscribedInnerParent :: !(IORef (Maybe (EventSubscribed a)))

745− , coincidenceSubscribedWeakSelf :: !(IORef (Weak (CoincidenceSubscribed a)))

742+ , coincidenceSubscribedOuter :: {-# NOUNPACK #-} (Subscriber x (Event x a))

743+ , coincidenceSubscribedOuterParent :: !(EventSubscription x (Event x a))

744+ , coincidenceSubscribedInnerParent :: !(IORef (Maybe (EventSubscribed x a)))

745+ , coincidenceSubscribedWeakSelf :: !(IORef (Weak (CoincidenceSubscribed x a)))

746746#ifdef DEBUG_NODEIDS

747747 , coincidenceSubscribedNodeId :: Int

748748#endif

749749 }

750750

751−data Coincidence a

752− = Coincidence { coincidenceParent :: !(Event (Event a))

753− , coincidenceSubscribed :: !(IORef (Maybe (CoincidenceSubscribed a)))

751+data Coincidence x a

752+ = Coincidence { coincidenceParent :: !(Event x (Event x a))

753+ , coincidenceSubscribed :: !(IORef (Maybe (CoincidenceSubscribed x a)))

754754 }

755755

756−data Subscriber a

757− = forall b. SubscriberPush (a -> ComputeM (Maybe b)) (PushSubscribed a b) --TODO: Why does this have the pushCompute in it?

758− | forall k. GCompare k => SubscriberMerge !(k a) (MergeSubscribed k) --TODO: Can we inline the GCompare?

759− | forall k. (a ~ R.PatchDMap (DMap k Event), GCompare k) => SubscriberMergeChange (MergeSubscribed k)

760− | forall k. (GCompare k, a ~ DMap k Identity) => SubscriberFan (FanSubscribed k)

761− | forall p b. (a ~ p b, R.Patch p) => SubscriberHold !(Hold p b)

762− | forall b. (a ~ Identity b) => SubscriberHoldIdentity !(Hold Identity b)

763− | SubscriberSwitch (SwitchSubscribed a)

764− | forall b. a ~ Event b => SubscriberCoincidenceOuter (CoincidenceSubscribed b)

765− | SubscriberCoincidenceInner (CoincidenceSubscribed a)

756+data Subscriber x a

757+ = forall b. SubscriberPush (a -> ComputeM x (Maybe b)) (PushSubscribed x a b) --TODO: Why does this have the pushCompute in it?

758+ | forall k. GCompare k => SubscriberMerge !(k a) (MergeSubscribed x k) --TODO: Can we inline the GCompare?

759+ | forall k. (a ~ R.PatchDMap (DMap k (Event x)), GCompare k) => SubscriberMergeChange (MergeSubscribed x k)

760+ | forall k. (GCompare k, a ~ DMap k Identity) => SubscriberFan (FanSubscribed x k)

761+ | forall p b. (a ~ p b, R.Patch p) => SubscriberHold !(Hold x p b)

762+ | forall b. (a ~ Identity b) => SubscriberHoldIdentity !(Hold x Identity b)

763+ | SubscriberSwitch (SwitchSubscribed x a)

764+ | forall b. a ~ Event x b => SubscriberCoincidenceOuter (CoincidenceSubscribed x b)

765+ | SubscriberCoincidenceInner (CoincidenceSubscribed x a)

766766 | SubscriberHandle

767767

768768-- These function are constructor functions that are marked NOINLINE so they are

@@ -776,61 +776,61 @@ data Subscriber a

776776

777777--TODO: I think all of these noinlines are now unnecessary

778778{-# NOINLINE newSubscriberPush #-}

779−newSubscriberPush :: (a -> ComputeM (Maybe b)) -> PushSubscribed a b -> IO (Subscriber a)

779+newSubscriberPush :: (a -> ComputeM x (Maybe b)) -> PushSubscribed x a b -> IO (Subscriber x a)

780780newSubscriberPush compute subd = return $! SubscriberPush compute subd

781781

782782{-# RULES

783783 "newSubscriberHold/Identity" forall h. newSubscriberHold h = newSubscriberHoldIdentity h

784784 #-}

785785{-# NOINLINE newSubscriberHold #-}

786−newSubscriberHold :: R.Patch p => Hold p a -> IO (Subscriber (p a))

786+newSubscriberHold :: R.Patch p => Hold x p a -> IO (Subscriber x (p a))

787787newSubscriberHold h = return $! SubscriberHold h

788788

789789{-# NOINLINE newSubscriberHoldIdentity #-}

790−newSubscriberHoldIdentity :: Hold Identity a -> IO (Subscriber (Identity a))

790+newSubscriberHoldIdentity :: Hold x Identity a -> IO (Subscriber x (Identity a))

791791newSubscriberHoldIdentity h = return $! SubscriberHoldIdentity h

792792

793793{-# NOINLINE newSubscriberMerge #-}

794−newSubscriberMerge :: GCompare k => k a -> MergeSubscribed k -> IO (Subscriber a)

794+newSubscriberMerge :: GCompare k => k a -> MergeSubscribed x k -> IO (Subscriber x a)

795795newSubscriberMerge k subd = return $! SubscriberMerge k subd

796796

797797{-# NOINLINE newSubscriberMergeChange #-}

798−newSubscriberMergeChange :: GCompare k => MergeSubscribed k -> IO (Subscriber (R.PatchDMap (DMap k Event)))

798+newSubscriberMergeChange :: GCompare k => MergeSubscribed x k -> IO (Subscriber x (R.PatchDMap (DMap k (Event x))))

799799newSubscriberMergeChange subd = return $! SubscriberMergeChange subd

800800

801801{-# NOINLINE newSubscriberFan #-}

802−newSubscriberFan :: GCompare k => FanSubscribed k -> IO (Subscriber (DMap k Identity))

802+newSubscriberFan :: GCompare k => FanSubscribed x k -> IO (Subscriber x (DMap k Identity))

803803newSubscriberFan subd = return $! SubscriberFan subd

804804

805805{-# NOINLINE newSubscriberSwitch #-}

806−newSubscriberSwitch :: SwitchSubscribed a -> IO (Subscriber a)

806+newSubscriberSwitch :: SwitchSubscribed x a -> IO (Subscriber x a)

807807newSubscriberSwitch subd = return $! SubscriberSwitch subd

808808

809809{-# NOINLINE newSubscriberCoincidenceOuter #-}

810−newSubscriberCoincidenceOuter :: CoincidenceSubscribed b -> IO (Subscriber (Event b))

810+newSubscriberCoincidenceOuter :: CoincidenceSubscribed x b -> IO (Subscriber x (Event x b))

811811newSubscriberCoincidenceOuter subd = return $! SubscriberCoincidenceOuter subd

812812

813813{-# NOINLINE newSubscriberCoincidenceInner #-}

814−newSubscriberCoincidenceInner :: CoincidenceSubscribed a -> IO (Subscriber a)

814+newSubscriberCoincidenceInner :: CoincidenceSubscribed x a -> IO (Subscriber x a)

815815newSubscriberCoincidenceInner subd = return $! SubscriberCoincidenceInner subd

816816

817817{-# NOINLINE newInvalidatorSwitch #-}

818−newInvalidatorSwitch :: SwitchSubscribed a -> IO Invalidator

818+newInvalidatorSwitch :: SwitchSubscribed x a -> IO (Invalidator x)

819819newInvalidatorSwitch subd = return $! InvalidatorSwitch subd

820820

821821{-# NOINLINE newInvalidatorPull #-}

822−newInvalidatorPull :: Pull a -> IO Invalidator

822+newInvalidatorPull :: Pull x a -> IO (Invalidator x)

823823newInvalidatorPull p = return $! InvalidatorPull p

824824

825−data Dynamic p a

826− = DynamicHold !(Hold p a)

827− | p ~ Identity => DynamicHoldIdentity !(Hold Identity a)

825+data Dynamic x p a

826+ = DynamicHold !(Hold x p a)

827+ | p ~ Identity => DynamicHoldIdentity !(Hold x Identity a)

828828 | DynamicConst !a

829− | DynamicDyn !(Dyn p a)

830− | p ~ Identity => DynamicDynIdentity !(Dyn Identity a)

829+ | DynamicDyn !(Dyn x p a)

830+ | p ~ Identity => DynamicDynIdentity !(Dyn x Identity a)

831831

832832{-# INLINE current #-}

833−current :: R.Patch p => Dynamic p a -> Behavior a

833+current :: R.Patch p => Dynamic x p a -> Behavior x a

834834current = \case

835835 DynamicHold h -> BehaviorHold h

836836 DynamicHoldIdentity h -> BehaviorHoldIdentity h

@@ -840,7 +840,7 @@ current = \case

840840

841841--TODO: If you only need updated, not current, can we avoid actually constructing the Hold?

842842{-# INLINE updated #-}

843−updated :: R.Patch p => Dynamic p a -> Event (p a)

843+updated :: R.Patch p => Dynamic x p a -> Event x (p a)

844844updated = \case

845845 DynamicHold h -> eventHold h

846846 DynamicHoldIdentity h -> eventHoldIdentity h

@@ -848,27 +848,27 @@ updated = \case

848848 DynamicDyn d -> eventDyn d

849849 DynamicDynIdentity d -> eventDynIdentity d

850850

851−newMapDyn :: (a -> b) -> Dynamic Identity a -> Dynamic Identity b

851+newMapDyn :: (a -> b) -> Dynamic x Identity a -> Dynamic x Identity b

852852newMapDyn f d = DynamicDynIdentity $ unsafeDyn (fmap f $ readBehaviorTracked $ current d) (Identity . f . runIdentity <$> updated d)

853853

854−instance Functor (Dynamic Identity) where

854+instance Functor (Dynamic x Identity) where

855855 fmap = newMapDyn

856856

857−instance Applicative (Dynamic Identity) where

857+instance Applicative (Dynamic x Identity) where

858858 pure = DynamicConst

859859 (<*>) = zipDynWith ($)

860860 _ *> b = b

861861 a <* _ = a

862862

863−instance R.FunctorMaybe Event where

863+instance R.FunctorMaybe (Event x) where

864864 fmapMaybe f = push $ return . f

865865

866−instance Align Event where

866+instance Align (Event x) where

867867 nil = eventNever

868868 align ea eb = R.fmapMaybe R.dmapToThese $ merge $ DynamicConst $ DMap.fromList [R.LeftTag :=> ea, R.RightTag :=> eb]

869869

870870--TODO: Avoid the duplication between this and R.zipDynWith

871−zipDynWith :: (a -> b -> c) -> Dynamic Identity a -> Dynamic Identity b -> Dynamic Identity c

871+zipDynWith :: (a -> b -> c) -> Dynamic x Identity a -> Dynamic x Identity b -> Dynamic x Identity c

872872zipDynWith f da db =

873873 let eab = align (updated da) (updated db)

874874 ec = flip push eab $ \o -> do

@@ -883,7 +883,7 @@ zipDynWith f da db =

883883 return $ Just $ Identity $ f a b

884884 in DynamicDynIdentity $ unsafeDyn (f <$> readBehaviorUntracked (current da) <*> readBehaviorUntracked (current db)) ec

885885

886−instance Monad (Dynamic Identity) where

886+instance Monad (Dynamic x Identity) where

887887 {-# INLINE return #-}

888888 return = pure

889889 {-# INLINE (>>=) #-}

@@ -893,13 +893,13 @@ instance Monad (Dynamic Identity) where

893893 {-# INLINE fail #-}

894894 fail _ = error "Dynamic does not support 'fail'"

895895

896−newtype Dyn p a = Dyn { unDyn :: IORef (Either (BehaviorM a, Event (p a)) (Hold p a)) }

896+newtype Dyn x p a = Dyn { unDyn :: IORef (Either (BehaviorM x a, Event x (p a)) (Hold x p a)) }

897897

898−unsafeDyn :: BehaviorM a -> Event (p a) -> Dyn p a

898+unsafeDyn :: BehaviorM x a -> Event x (p a) -> Dyn x p a

899899unsafeDyn readV0 v' = Dyn $ unsafeNewIORef x $ Left x

900900 where x = (readV0, v')

901901

902−newJoinDyn :: Dynamic Identity (Dynamic Identity a) -> Dyn Identity a

902+newJoinDyn :: Dynamic x Identity (Dynamic x Identity a) -> Dyn x Identity a

903903newJoinDyn d =

904904 let readV0 = readBehaviorTracked . current =<< readBehaviorTracked (current d)

905905 eOuter = push (fmap (Just . Identity) . readBehaviorUntracked . current . runIdentity) $ updated d

@@ -909,13 +909,13 @@ newJoinDyn d =

909909 in unsafeDyn readV0 v'

910910

911911--type role Behavior representational

912−data Behavior a

913− = forall p. BehaviorHold !(Hold p a)

914− | BehaviorHoldIdentity !(Hold Identity a)

912+data Behavior x a

913+ = forall p. BehaviorHold !(Hold x p a)

914+ | BehaviorHoldIdentity !(Hold x Identity a)

915915 | BehaviorConst !a

916− | BehaviorPull !(Pull a)

917− | BehaviorDynIdentity !(Dyn Identity a)

918− | forall p. R.Patch p => BehaviorDyn !(Dyn p a)

916+ | BehaviorPull !(Pull x a)

917+ | BehaviorDynIdentity !(Dyn x Identity a)

918+ | forall p. R.Patch p => BehaviorDyn !(Dyn x p a)

919919

920920-- ResultM can read behaviors and events

921921type ResultM = EventM

@@ -924,14 +924,14 @@ type ResultM = EventM

924924unsafeNewIORef :: a -> b -> IORef b

925925unsafeNewIORef _ b = unsafePerformIO $ newIORef b

926926

927−instance Functor Event where

927+instance Functor (Event x) where

928928 fmap f = push $ return . Just . f

929929

930−instance Functor Behavior where

930+instance Functor (Behavior x) where

931931 fmap f = pull . fmap f . readBehaviorTracked

932932

933933{-# NOINLINE push #-} --TODO: If this is helpful, we can get rid of the unsafeNewIORef and use unsafePerformIO directly

934−push :: forall a b. (a -> ComputeM (Maybe b)) -> Event a -> Event b

934+push :: (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b

935935push f e = eventPush $ Push

936936 { pushCompute = f

937937 , pushParent = e

@@ -940,7 +940,7 @@ push f e = eventPush $ Push

940940-- DISABLED: {- RULES "push/push" forall f g e. push f (push g e) = push (maybe (return Nothing) f <=< g) e #-}

941941

942942{-# NOINLINE pull #-}

943−pull :: BehaviorM a -> Behavior a

943+pull :: BehaviorM x a -> Behavior x a

944944pull a = BehaviorPull $ Pull

945945 { pullCompute = a

946946 , pullValue = unsafeNewIORef a Nothing

@@ -950,24 +950,24 @@ pull a = BehaviorPull $ Pull

950950 }

951951

952952{-# NOINLINE switch #-}

953−switch :: Behavior (Event a) -> Event a

953+switch :: Behavior x (Event x a) -> Event x a

954954switch a = eventSwitch $ Switch

955955 { switchParent = a

956956 , switchSubscribed = unsafeNewIORef a Nothing

957957 }

958958

959−coincidence :: Event (Event a) -> Event a

959+coincidence :: Event x (Event x a) -> Event x a

960960coincidence a = eventCoincidence $ Coincidence

961961 { coincidenceParent = a

962962 , coincidenceSubscribed = unsafeNewIORef a Nothing

963963 }

964964

965−propagateAndUpdateSubscribersRef :: SubscriberList a -> a -> EventM x ()

965+propagateAndUpdateSubscribersRef :: SubscriberList x a -> a -> EventM x ()

966966propagateAndUpdateSubscribersRef subscribersRef a = do

967967 propagate a subscribersRef

968968

969969-- Propagate the given event occurrence; before cleaning up, run the given action, which may read the state of events and behaviors

970−run :: [DSum RootTrigger Identity] -> ResultM x b -> SpiderHost x b

970+run :: [DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b

971971run roots after = do

972972 tracePropagate $ "Running an event frame with " <> show (length roots) <> " events"

973973 spiderEnv <- SpiderHost ask

@@ -1016,9 +1016,9 @@ data SomeClear = forall a. SomeClear (IORef (Maybe a))

10161016

10171017data SomeRootClear = forall k. SomeRootClear (IORef (DMap k Identity))

10181018

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

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

10201020

1021−data DelayedMerge = forall k. DelayedMerge (MergeSubscribed k)

1021+data DelayedMerge x = forall k. DelayedMerge (MergeSubscribed x k)

10221022

10231023debugFinalize :: Bool

10241024debugFinalize = False

@@ -1093,7 +1093,7 @@ listsToForest :: Eq a => [[a]] -> Forest a

10931093listsToForest l = fmap (\(a, l') -> Node a $ listsToForest $ toList l') $ groupByHead $ catMaybes $ fmap nonEmpty l

10941094

10951095-- | Propagate everything at the current height

1096−propagate :: a -> SubscriberList a -> EventM x ()

1096+propagate :: a -> SubscriberList x a -> EventM x ()

10971097propagate a subscribers = withIncreasedDepth $ do

10981098 -- 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

10991099 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work

@@ -1178,7 +1178,7 @@ propagate a subscribers = withIncreasedDepth $ do

11781178 SubscriberHandle -> {-# SCC "traverseHandle" #-} tracePropagate "SubscriberHandle"

11791179

11801180{-# INLINE propagateSubscriberHold #-}

1181−propagateSubscriberHold :: R.Patch p => Hold p a -> p a -> EventM x ()

1181+propagateSubscriberHold :: R.Patch p => Hold x p a -> p a -> EventM x ()

11821182propagateSubscriberHold h a = do

11831183 {-# SCC "trace" #-} traceMWhen debugPropagate $ liftIO $ do

11841184 invalidators <- liftIO $ readIORef $ holdInvalidators h

@@ -1192,38 +1192,38 @@ propagateSubscriberHold h a = do

11921192 iRef <- {-# SCC "iRef" #-} liftIO $ evaluate $ holdInvalidators h

11931193 defer $ {-# SCC "assignment" #-} SomeAssignment vRef iRef v'

11941194

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

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

11961196

1197−{-# SPECIALIZE readBehaviorUntracked :: Behavior a -> BehaviorM a #-}

1198−{-# SPECIALIZE readBehaviorUntracked :: Behavior a -> EventM x a #-}

1199−readBehaviorUntracked :: Defer SomeHoldInit m => Behavior a -> m a

1197+{-# SPECIALIZE readBehaviorUntracked :: Behavior x a -> BehaviorM x a #-}

1198+{-# SPECIALIZE readBehaviorUntracked :: Behavior x a -> EventM x a #-}

1199+readBehaviorUntracked :: Defer (SomeHoldInit x) m => Behavior x a -> m a

12001200readBehaviorUntracked b = do

12011201 holdInits <- getDeferralQueue

12021202 liftIO $ runBehaviorM (readBehaviorTracked b) Nothing holdInits --TODO: Specialize readBehaviorTracked to the Nothing and Just cases

12031203

1204−runBehaviorM :: BehaviorM a -> Maybe (Weak Invalidator, IORef [SomeBehaviorSubscribed]) -> IORef [SomeHoldInit] -> IO a

1204+runBehaviorM :: BehaviorM x a -> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]) -> IORef [SomeHoldInit x] -> IO a

12051205runBehaviorM a mwi holdInits = runReaderT (unBehaviorM a) (mwi, holdInits)

12061206

1207−askInvalidator :: BehaviorM (Maybe (Weak Invalidator))

1207+askInvalidator :: BehaviorM x (Maybe (Weak (Invalidator x)))

12081208askInvalidator = do

12091209 (!m, _) <- BehaviorM ask

12101210 case m of

12111211 Nothing -> return Nothing

12121212 Just (!wi, _) -> return $ Just wi

12131213

1214−askParentsRef :: BehaviorM (Maybe (IORef [SomeBehaviorSubscribed]))

1214+askParentsRef :: BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))

12151215askParentsRef = do

12161216 (!m, _) <- BehaviorM ask

12171217 case m of

12181218 Nothing -> return Nothing

12191219 Just (_, !p) -> return $ Just p

12201220

1221−askBehaviorHoldInits :: BehaviorM (IORef [SomeHoldInit])

1221+askBehaviorHoldInits :: BehaviorM x (IORef [SomeHoldInit x])

12221222askBehaviorHoldInits = do

12231223 (_, !his) <- BehaviorM ask

12241224 return his

12251225

1226−readBehaviorTracked :: Behavior a -> BehaviorM a

1226+readBehaviorTracked :: Behavior x a -> BehaviorM x a

12271227readBehaviorTracked b = case b of

12281228 BehaviorHold h -> readHoldTracked h

12291229 BehaviorHoldIdentity h -> readHoldTracked h

@@ -1257,7 +1257,7 @@ readBehaviorTracked b = case b of

12571257 BehaviorDynIdentity d -> readHoldTracked =<< getDynHold d

12581258

12591259{-# INLINE readHoldTracked #-}

1260−readHoldTracked :: Hold p a -> BehaviorM a

1260+readHoldTracked :: Hold x p a -> BehaviorM x a

12611261readHoldTracked h = do

12621262 result <- liftIO $ readIORef $ holdValue h

12631263 askInvalidator >>= mapM_ (\wi -> liftIO $ modifyIORef' (holdInvalidators h) (wi:))

@@ -1265,7 +1265,7 @@ readHoldTracked h = do

12651265 return result

12661266

12671267{-# INLINE getDynHold #-}

1268−getDynHold :: (Defer SomeHoldInit m, R.Patch p) => Dyn p a -> m (Hold p a)

1268+getDynHold :: (Defer (SomeHoldInit x) m, R.Patch p) => Dyn x p a -> m (Hold x p a)

12691269getDynHold d = do

12701270 mh <- liftIO $ readIORef $ unDyn d

12711271 case mh of

@@ -1277,33 +1277,33 @@ getDynHold d = do

12771277 liftIO $ writeIORef (unDyn d) $ Right h

12781278 return h

12791279

1280−readRootSubscribed :: RootSubscribed a -> IO (Maybe a)

1280+readRootSubscribed :: RootSubscribed x a -> IO (Maybe a)

12811281readRootSubscribed = rootSubscribedOccurrence

12821282

1283−readPushSubscribed :: PushSubscribed b a -> IO (Maybe a)

1283+readPushSubscribed :: PushSubscribed x b a -> IO (Maybe a)

12841284readPushSubscribed subscribed = do

12851285 result <- readIORef $ pushSubscribedOccurrence subscribed -- Since ResultM is always called after the final height is reached, this will always be valid

12861286 touch $ pushSubscribedSelf subscribed

12871287 return result

12881288

1289−readMergeSubscribed :: MergeSubscribed k -> IO (Maybe (DMap k Identity))

1289+readMergeSubscribed :: MergeSubscribed x k -> IO (Maybe (DMap k Identity))

12901290readMergeSubscribed subscribed = do

12911291 result <- readIORef $ mergeSubscribedOccurrence subscribed

12921292 touch $ mergeSubscribedParents subscribed

12931293 return result

12941294

1295−readFanSubscribed :: GCompare k => k a -> FanSubscribed k -> IO (Maybe a)

1295+readFanSubscribed :: GCompare k => k a -> FanSubscribed x k -> IO (Maybe a)

12961296readFanSubscribed k fs = do

12971297 parentOcc <- readEventSubscribed $ _eventSubscription_subscribed $ fanSubscribedParent fs

12981298 return $ coerce $ DMap.lookup k =<< parentOcc

12991299

1300−readSwitchSubscribed :: SwitchSubscribed a -> IO (Maybe a)

1300+readSwitchSubscribed :: SwitchSubscribed x a -> IO (Maybe a)

13011301readSwitchSubscribed subscribed = do

13021302 result <- readIORef $ switchSubscribedOccurrence subscribed

13031303 touch $ switchSubscribedOwnInvalidator subscribed

13041304 return result

13051305

1306−readCoincidenceSubscribed :: CoincidenceSubscribed a -> IO (Maybe a)

1306+readCoincidenceSubscribed :: CoincidenceSubscribed x a -> IO (Maybe a)

13071307readCoincidenceSubscribed subscribed = do

13081308 result <- readIORef $ coincidenceSubscribedOccurrence subscribed

13091309 touch $ coincidenceSubscribedOuter subscribed

@@ -1316,7 +1316,7 @@ zeroRef :: IORef Height

13161316zeroRef = unsafePerformIO $ newIORef zeroHeight

13171317

13181318{-# INLINE subscribeHoldEvent #-}

1319−subscribeHoldEvent :: (CanSubscribe x m, R.Patch p) => Hold p a -> Subscriber (p a) -> m (EventSubscription (p a))

1319+subscribeHoldEvent :: (CanSubscribe x m, R.Patch p) => Hold x p a -> Subscriber x (p a) -> m (EventSubscription x (p a))

13201320subscribeHoldEvent h sub = do

13211321 EventSubscription _ subd <- getHoldEventSubscription h

13221322 sln <- liftIO $ subscribeEventSubscribed subd sub

@@ -1329,15 +1329,15 @@ debugSubscribe = False

13291329

13301330type CanSubscribe x m =

13311331 ( HasSpiderEnv x m

1332− , HasCurrentHeight m

1333− , Defer SomeHoldInit m, Defer SomeMergeInit m -- The things we need to lazily initialize state

1332+ , HasCurrentHeight x m

1333+ , Defer (SomeHoldInit x) m, Defer (SomeMergeInit x) m -- The things we need to lazily initialize state

13341334 , Defer SomeClear m -- Wiping out event firings

1335− , Defer SomeAssignment m -- Updating state

1336− , Defer SomeResetCoincidence m

1335+ , Defer (SomeAssignment x) m -- Updating state

1336+ , Defer (SomeResetCoincidence x) m

13371337 , m ~ EventM x

13381338 )

13391339

1340−getRootSubscribed :: GCompare k => k a -> Root k -> Subscriber a -> IO (SubscriberListTicket a, RootSubscribed a)

1340+getRootSubscribed :: GCompare k => k a -> Root x k -> Subscriber x a -> IO (SubscriberListTicket x a, RootSubscribed x a)

13411341getRootSubscribed k r sub = do

13421342 mSubscribed <- readIORef $ rootSubscribed r

13431343 case DMap.lookup k mSubscribed of

@@ -1368,18 +1368,18 @@ getRootSubscribed k r sub = do

13681368 return (sln, subscribed)

13691369

13701370{-# ANN cleanupRootSubscribed "HLint: ignore Redundant bracket" #-}

1371−cleanupRootSubscribed :: RootSubscribed a -> IO ()

1371+cleanupRootSubscribed :: RootSubscribed x a -> IO ()

13721372cleanupRootSubscribed self@(RootSubscribed { rootSubscribedKey = k, rootSubscribedCachedSubscribed = cached }) = do

13731373 rootSubscribedUninit self

13741374 modifyIORef' cached $ DMap.delete k

13751375

13761376{-# INLINE subscribeRootSubscribed #-}

1377−subscribeRootSubscribed :: RootSubscribed a -> Subscriber a -> IO (SubscriberListTicket a)

1377+subscribeRootSubscribed :: RootSubscribed x a -> Subscriber x a -> IO (SubscriberListTicket x a)

13781378subscribeRootSubscribed subscribed sub = WeakBag.insert sub (rootSubscribedSubscribers subscribed) (rootSubscribedWeakSelf subscribed) cleanupRootSubscribed

13791379

13801380-- When getPushSubscribed returns, the PushSubscribed returned will have a fully filled-in

1381−{-# SPECIALIZE getPushSubscribed :: Push a b -> Subscriber b -> EventM x (SubscriberListTicket b, PushSubscribed a b) #-}

1382−getPushSubscribed :: CanSubscribe x m => Push a b -> Subscriber b -> m (SubscriberListTicket b, PushSubscribed a b)

1381+{-# SPECIALIZE getPushSubscribed :: Push x a b -> Subscriber x b -> EventM x (SubscriberListTicket x b, PushSubscribed x a b) #-}

1382+getPushSubscribed :: CanSubscribe x m => Push x a b -> Subscriber x b -> m (SubscriberListTicket x b, PushSubscribed x a b)

13831383getPushSubscribed p sub = do

13841384 mSubscribed <- liftIO $ readIORef $ pushSubscribed p

13851385 case mSubscribed of

@@ -1415,17 +1415,17 @@ getPushSubscribed p sub = do

14151415 liftIO $ writeIORef (pushSubscribed p) $ Just subscribed

14161416 return (sln, subscribed)

14171417

1418−cleanupPushSubscribed :: PushSubscribed a b -> IO ()

1418+cleanupPushSubscribed :: PushSubscribed x a b -> IO ()

14191419cleanupPushSubscribed self = do

14201420 unsubscribe $ pushSubscribedParent self

14211421 writeIORef (pushSubscribedCachedSubscribed self) $ Nothing

14221422

14231423{-# INLINE subscribePushSubscribed #-}

1424−subscribePushSubscribed :: PushSubscribed a b -> Subscriber b -> IO (SubscriberListTicket b)

1424+subscribePushSubscribed :: PushSubscribed x a b -> Subscriber x b -> IO (SubscriberListTicket x b)

14251425subscribePushSubscribed subscribed sub = WeakBag.insert sub (pushSubscribedSubscribers subscribed) (pushSubscribedWeakSelf subscribed) cleanupPushSubscribed

14261426

1427−{-# SPECIALIZE getMergeSubscribed :: GCompare k => Merge k -> Subscriber (DMap k Identity) -> EventM x (SubscriberListTicket (DMap k Identity), MergeSubscribed k) #-}

1428−getMergeSubscribed :: forall x k m. (CanSubscribe x m, GCompare k) => Merge k -> Subscriber (DMap k Identity) -> m (SubscriberListTicket (DMap k Identity), MergeSubscribed k)

1427+{-# SPECIALIZE getMergeSubscribed :: GCompare k => Merge x k -> Subscriber x (DMap k Identity) -> EventM x (SubscriberListTicket x (DMap k Identity), MergeSubscribed x k) #-}

1428+getMergeSubscribed :: forall x k m. (CanSubscribe x m, GCompare k) => Merge x k -> Subscriber x (DMap k Identity) -> m (SubscriberListTicket x (DMap k Identity), MergeSubscribed x k)

14291429getMergeSubscribed m sub = do

14301430 mSubscribed <- liftIO $ readIORef $ mergeSubscribed m

14311431 case mSubscribed of

@@ -1436,7 +1436,7 @@ getMergeSubscribed m sub = do

14361436 subscribedRef <- liftIO $ newIORef $ error "getMergeSubscribed: subscribedRef not yet initialized"

14371437 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef

14381438 initialParents <- readBehaviorUntracked $ current $ mergeParents m

1439− subscribers :: [(Maybe (DSum k Identity), Height, DSum k (MergeSubscribedParent k))] <- forM (DMap.toList initialParents) $ {-# SCC "getMergeSubscribed.a" #-} \(k :=> e) -> do

1439+ subscribers :: [(Maybe (DSum k Identity), Height, DSum k (MergeSubscribedParent x k))] <- forM (DMap.toList initialParents) $ {-# SCC "getMergeSubscribed.a" #-} \(k :=> e) -> do

14401440 s <- {-# SCC "getMergeSubscribed.a.1" #-} liftIO $ newSubscriberMerge k subscribedUnsafe

14411441 subscription@(EventSubscription _ parentSubd) <- {-# SCC "getMergeSubscribed.a.2" #-} subscribe e s

14421442 parentOcc <- {-# SCC "getMergeSubscribed.a.3" #-} liftIO $ readEventSubscribed parentSubd

@@ -1483,7 +1483,7 @@ getMergeSubscribed m sub = do

14831483 liftIO $ writeIORef (mergeSubscribed m) $ Just subscribed

14841484 return (sln, subscribed)

14851485

1486−cleanupMergeSubscribed :: MergeSubscribed k -> IO ()

1486+cleanupMergeSubscribed :: MergeSubscribed x k -> IO ()

14871487cleanupMergeSubscribed subscribed = do

14881488 parents <- readIORef $ mergeSubscribedParents subscribed

14891489 forM_ (DMap.toList parents) $ \(_ :=> msp) -> unsubscribe $ mergeSubscribedParentSubscription msp

@@ -1491,11 +1491,11 @@ cleanupMergeSubscribed subscribed = do

14911491 writeIORef (mergeSubscribedCachedSubscribed subscribed) $ Nothing -- Get rid of the cached subscribed

14921492

14931493{-# INLINE subscribeMergeSubscribed #-}

1494−subscribeMergeSubscribed :: MergeSubscribed k -> Subscriber (DMap k Identity) -> IO (SubscriberListTicket (DMap k Identity))

1494+subscribeMergeSubscribed :: MergeSubscribed x k -> Subscriber x (DMap k Identity) -> IO (SubscriberListTicket x (DMap k Identity))

14951495subscribeMergeSubscribed subscribed sub = WeakBag.insert sub (mergeSubscribedSubscribers subscribed) (mergeSubscribedWeakSelf subscribed) cleanupMergeSubscribed

14961496

1497−{-# SPECIALIZE getFanSubscribed :: GCompare k => k a -> Fan k -> Subscriber a -> EventM x (SubscriberListTicket a, FanSubscribed k) #-}

1498−getFanSubscribed :: (Defer SomeAssignment m, Defer SomeHoldInit m, Defer SomeMergeInit m, Defer SomeClear m, HasCurrentHeight m, Defer SomeResetCoincidence m, HasSpiderEnv x m, m ~ EventM x, GCompare k) => k a -> Fan k -> Subscriber a -> m (SubscriberListTicket a, FanSubscribed k)

1497+{-# SPECIALIZE getFanSubscribed :: GCompare k => k a -> Fan x k -> Subscriber x a -> EventM x (SubscriberListTicket x a, FanSubscribed x k) #-}

1498+getFanSubscribed :: (Defer (SomeAssignment x) m, Defer (SomeHoldInit x) m, Defer (SomeMergeInit x) m, Defer SomeClear m, HasCurrentHeight x m, Defer (SomeResetCoincidence x) m, HasSpiderEnv x m, m ~ EventM x, GCompare k) => k a -> Fan x k -> Subscriber x a -> m (SubscriberListTicket x a, FanSubscribed x k)

14991499getFanSubscribed k f sub = do

15001500 mSubscribed <- liftIO $ readIORef $ fanSubscribed f

15011501 case mSubscribed of

@@ -1525,7 +1525,7 @@ getFanSubscribed k f sub = do

15251525 liftIO $ writeIORef (fanSubscribed f) $ Just subscribed

15261526 return (slnForSub, subscribed)

15271527

1528−cleanupFanSubscribed :: GCompare k => (k a, FanSubscribed k) -> IO ()

1528+cleanupFanSubscribed :: GCompare k => (k a, FanSubscribed x k) -> IO ()

15291529cleanupFanSubscribed (k, subscribed) = do

15301530 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

15311531 let reducedSubscribers = DMap.delete k subscribers

@@ -1537,7 +1537,7 @@ cleanupFanSubscribed (k, subscribed) = do

15371537 else writeIORef (fanSubscribedSubscribers subscribed) $! reducedSubscribers

15381538

15391539{-# INLINE subscribeFanSubscribed #-}

1540−subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed k -> Subscriber a -> IO (SubscriberListTicket a)

1540+subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed x k -> Subscriber x a -> IO (SubscriberListTicket x a)

15411541subscribeFanSubscribed k subscribed sub = do

15421542 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

15431543 case DMap.lookup k subscribers of

@@ -1549,8 +1549,8 @@ subscribeFanSubscribed k subscribed sub = do

15491549 return sln

15501550 Just (FanSubscribedChildren list _ weakSelf) -> {-# SCC "hitSubscribeFanSubscribed" #-} WeakBag.insert sub list weakSelf cleanupFanSubscribed

15511551

1552−{-# SPECIALIZE getSwitchSubscribed :: Switch a -> Subscriber a -> EventM x (SubscriberListTicket a, SwitchSubscribed a) #-}

1553−getSwitchSubscribed :: (Defer SomeHoldInit m, Defer SomeAssignment m, Defer SomeMergeInit m, Defer SomeClear m, Defer SomeResetCoincidence m, HasCurrentHeight m, HasSpiderEnv x m, m ~ EventM x) => Switch a -> Subscriber a -> m (SubscriberListTicket a, SwitchSubscribed a)

1552+{-# SPECIALIZE getSwitchSubscribed :: Switch x a -> Subscriber x a -> EventM x (SubscriberListTicket x a, SwitchSubscribed x a) #-}

1553+getSwitchSubscribed :: (Defer (SomeHoldInit x) m, Defer (SomeAssignment x) m, Defer (SomeMergeInit x) m, Defer SomeClear m, Defer (SomeResetCoincidence x) m, HasCurrentHeight x m, HasSpiderEnv x m, m ~ EventM x) => Switch x a -> Subscriber x a -> m (SubscriberListTicket x a, SwitchSubscribed x a)

15541554getSwitchSubscribed s sub = do

15551555 mSubscribed <- liftIO $ readIORef $ switchSubscribed s

15561556 case mSubscribed of

@@ -1595,18 +1595,18 @@ getSwitchSubscribed s sub = do

15951595 liftIO $ writeIORef (switchSubscribed s) $ Just subscribed

15961596 return (slnForSub, subscribed)

15971597

1598−cleanupSwitchSubscribed :: SwitchSubscribed a -> IO ()

1598+cleanupSwitchSubscribed :: SwitchSubscribed x a -> IO ()

15991599cleanupSwitchSubscribed subscribed = do

16001600 unsubscribe =<< readIORef (switchSubscribedCurrentParent subscribed)

16011601 finalize =<< readIORef (switchSubscribedOwnWeakInvalidator subscribed) -- We don't need to get invalidated if we're dead

16021602 writeIORef (switchSubscribedCachedSubscribed subscribed) Nothing

16031603

16041604{-# INLINE subscribeSwitchSubscribed #-}

1605−subscribeSwitchSubscribed :: SwitchSubscribed a -> Subscriber a -> IO (SubscriberListTicket a)

1605+subscribeSwitchSubscribed :: SwitchSubscribed x a -> Subscriber x a -> IO (SubscriberListTicket x a)

16061606subscribeSwitchSubscribed subscribed sub = WeakBag.insert sub (switchSubscribedSubscribers subscribed) (switchSubscribedWeakSelf subscribed) cleanupSwitchSubscribed

16071607

1608−{-# SPECIALIZE getCoincidenceSubscribed :: Coincidence a -> Subscriber a -> EventM x (SubscriberListTicket a, CoincidenceSubscribed a) #-}

1609−getCoincidenceSubscribed :: forall x a m. (Defer SomeAssignment m, Defer SomeHoldInit m, Defer SomeMergeInit m, Defer SomeClear m, HasCurrentHeight m, Defer SomeResetCoincidence m, HasSpiderEnv x m, m ~ EventM x) => Coincidence a -> Subscriber a -> m (SubscriberListTicket a, CoincidenceSubscribed a)

1608+{-# SPECIALIZE getCoincidenceSubscribed :: Coincidence x a -> Subscriber x a -> EventM x (SubscriberListTicket x a, CoincidenceSubscribed x a) #-}

1609+getCoincidenceSubscribed :: forall x a m. (Defer (SomeAssignment x) m, Defer (SomeHoldInit x) m, Defer (SomeMergeInit x) m, Defer SomeClear m, HasCurrentHeight x m, Defer (SomeResetCoincidence x) m, HasSpiderEnv x m, m ~ EventM x) => Coincidence x a -> Subscriber x a -> m (SubscriberListTicket x a, CoincidenceSubscribed x a)

16101610getCoincidenceSubscribed c sub = do

16111611 mSubscribed <- liftIO $ readIORef $ coincidenceSubscribed c

16121612 case mSubscribed of

@@ -1650,25 +1650,25 @@ getCoincidenceSubscribed c sub = do

16501650 liftIO $ writeIORef (coincidenceSubscribed c) $ Just subscribed

16511651 return (slnForSub, subscribed)

16521652

1653−cleanupCoincidenceSubscribed :: CoincidenceSubscribed a -> IO ()

1653+cleanupCoincidenceSubscribed :: CoincidenceSubscribed x a -> IO ()

16541654cleanupCoincidenceSubscribed subscribed = do

16551655 unsubscribe $ coincidenceSubscribedOuterParent subscribed

16561656 writeIORef (coincidenceSubscribedCachedSubscribed subscribed) Nothing

16571657

16581658{-# INLINE subscribeCoincidenceSubscribed #-}

1659−subscribeCoincidenceSubscribed :: CoincidenceSubscribed a -> Subscriber a -> IO (SubscriberListTicket a)

1659+subscribeCoincidenceSubscribed :: CoincidenceSubscribed x a -> Subscriber x a -> IO (SubscriberListTicket x a)

16601660subscribeCoincidenceSubscribed subscribed sub = WeakBag.insert sub (coincidenceSubscribedSubscribers subscribed) (coincidenceSubscribedWeakSelf subscribed) cleanupCoincidenceSubscribed

16611661

16621662{-# INLINE merge #-}

1663−merge :: GCompare k => Dynamic R.PatchDMap (DMap k Event) -> Event (DMap k Identity)

1663+merge :: GCompare k => Dynamic x R.PatchDMap (DMap k (Event x)) -> Event x (DMap k Identity)

16641664merge m = eventMerge $ Merge

16651665 { mergeParents = m

16661666 , mergeSubscribed = unsafeNewIORef m Nothing

16671667 }

16681668

1669−newtype EventSelector k = EventSelector { select :: forall a. k a -> Event a }

1669+newtype EventSelector x k = EventSelector { select :: forall a. k a -> Event x a }

16701670

1671−fan :: GCompare k => Event (DMap k Identity) -> EventSelector k

1671+fan :: GCompare k => Event x (DMap k Identity) -> EventSelector x k

16721672fan e =

16731673 let f = Fan

16741674 { fanParent = e

@@ -1676,7 +1676,7 @@ fan e =

16761676 }

16771677 in EventSelector $ \k -> eventFan k f

16781678

1679−runHoldInits :: IORef [SomeHoldInit] -> IORef [SomeMergeInit] -> EventM x ()

1679+runHoldInits :: IORef [SomeHoldInit x] -> IORef [SomeMergeInit x] -> EventM x ()

16801680runHoldInits holdInitRef mergeInitRef = do

16811681 holdInits <- liftIO $ readIORef holdInitRef

16821682 mergeInits <- liftIO $ readIORef mergeInitRef

@@ -1687,10 +1687,10 @@ runHoldInits holdInitRef mergeInitRef = do

16871687 mapM_ initMerge mergeInits

16881688 runHoldInits holdInitRef mergeInitRef

16891689

1690−initHold :: SomeHoldInit -> EventM x ()

1690+initHold :: SomeHoldInit x -> EventM x ()

16911691initHold (SomeHoldInit h) = void $ getHoldEventSubscription h

16921692

1693−initMerge :: SomeMergeInit -> EventM x ()

1693+initMerge :: SomeMergeInit x -> EventM x ()

16941694initMerge (SomeMergeInit subscribed changed) = do

16951695 changeSub <- liftIO $ newSubscriberMergeChange subscribed

16961696 EventSubscription _ changeSubd <- subscribe changed changeSub

@@ -1699,7 +1699,7 @@ initMerge (SomeMergeInit subscribed changed) = do

16991699 liftIO $ writeIORef (mergeSubscribedChange subscribed) (changeSub, changeSubd)

17001700

17011701-- | Run an event action outside of a frame

1702−runFrame :: EventM x a -> SpiderHost x a --TODO: This function also needs to hold the mutex

1702+runFrame :: forall x a. EventM x a -> SpiderHost x a --TODO: This function also needs to hold the mutex

17031703runFrame a = SpiderHost $ ask >>= \spiderEnv -> lift $ do

17041704 -- Clear out pending unsubscriptions; these will need to happen eventually anyway, and might cause us a lot of extra work during the frame, so get rid of them now

17051705 pendingCleanups <- atomicModifyIORef (_spiderEnv_cleanups spiderEnv) $ \x -> ([], x)

@@ -1732,8 +1732,8 @@ runFrame a = SpiderHost $ ask >>= \spiderEnv -> lift $ do

17321732 writeIORef iRef =<< evaluate =<< invalidate toReconnectRef =<< readIORef iRef

17331733 mergeUpdates <- readIORef mergeUpdateRef

17341734 writeIORef mergeUpdateRef []

1735− let updateMerge :: SomeMergeUpdate -> IO [SomeEventSubscription]

1736− updateMerge (SomeMergeUpdate (R.PatchDMap p :: R.PatchDMap (DMap k Event)) m) = do

1735+ let updateMerge :: SomeMergeUpdate x -> IO [SomeEventSubscription x]

1736+ updateMerge (SomeMergeUpdate (R.PatchDMap p :: R.PatchDMap (DMap k (Event x))) m) = do

17371737 oldParents <- readIORef $ mergeSubscribedParents m

17381738 let f (subscriptionsToKill, ps) (k :=> Compose me) = do

17391739 (mOldSubd, newPs) <- case me of

@@ -1823,7 +1823,7 @@ succHeight h@(Height a) =

18231823 then invalidHeight

18241824 else Height $ succ a

18251825

1826−invalidateSubscriberHeight :: Height -> Subscriber a -> IO ()

1826+invalidateSubscriberHeight :: Height -> Subscriber x a -> IO ()

18271827invalidateSubscriberHeight old s = case s of

18281828 SubscriberPush _ subscribed -> do

18291829 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberPush" <> showNodeId subscribed

@@ -1859,14 +1859,14 @@ invalidateSubscriberHeight old s = case s of

18591859 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed <> " done"

18601860 SubscriberHandle -> return ()

18611861

1862−removeMergeHeight :: Height -> MergeSubscribed k -> IO ()

1862+removeMergeHeight :: Height -> MergeSubscribed x k -> IO ()

18631863removeMergeHeight oldParentHeight subscribed = do

18641864 when debugInvalidateHeight $ putStrLn $ "removeMergeHeight: " <> show oldParentHeight <> " Merge" <> showNodeId subscribed

18651865 oldHeights <- readIORef $ mergeSubscribedHeightBag subscribed

18661866 let newHeights = heightBagRemove oldParentHeight oldHeights

18671867 writeIORef (mergeSubscribedHeightBag subscribed) $! newHeights

18681868

1869−invalidateMergeHeight :: MergeSubscribed k -> IO ()

1869+invalidateMergeHeight :: MergeSubscribed x k -> IO ()

18701870invalidateMergeHeight subscribed = do

18711871 oldHeight <- readIORef $ mergeSubscribedHeight subscribed

18721872 -- If the height used to be valid, it must be invalid now; we should never have *more* heights than we have parents

@@ -1874,14 +1874,14 @@ invalidateMergeHeight subscribed = do

18741874 writeIORef (mergeSubscribedHeight subscribed) $! invalidHeight

18751875 WeakBag.traverse (mergeSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight

18761876

1877−addMergeHeight :: Height -> MergeSubscribed k -> IO ()

1877+addMergeHeight :: Height -> MergeSubscribed x k -> IO ()

18781878addMergeHeight newParentHeight subscribed = do

18791879 when debugInvalidateHeight $ putStrLn $ "addMergeHeight: " <> show newParentHeight <> " Merge" <> showNodeId subscribed

18801880 oldHeights <- readIORef $ mergeSubscribedHeightBag subscribed

18811881 let newHeights = heightBagAdd newParentHeight oldHeights

18821882 writeIORef (mergeSubscribedHeightBag subscribed) $! newHeights

18831883

1884−revalidateMergeHeight :: MergeSubscribed k -> IO ()

1884+revalidateMergeHeight :: MergeSubscribed x k -> IO ()

18851885revalidateMergeHeight subscribed = do

18861886 currentHeight <- readIORef $ mergeSubscribedHeight subscribed

18871887 when (currentHeight == invalidHeight) $ do -- revalidateMergeHeight may be called multiple times; perhaps the's a way to finesse it to avoid this check

@@ -1897,14 +1897,14 @@ revalidateMergeHeight subscribed = do

18971897 WeakBag.traverse (mergeSubscribedSubscribers subscribed) $ recalculateSubscriberHeight height

18981898 GT -> error $ "revalidateMergeHeight: more heights than parents for Merge" <> showNodeId subscribed

18991899

1900−invalidateCoincidenceHeight :: CoincidenceSubscribed a -> IO ()

1900+invalidateCoincidenceHeight :: CoincidenceSubscribed x a -> IO ()

19011901invalidateCoincidenceHeight subscribed = do

19021902 oldHeight <- readIORef $ coincidenceSubscribedHeight subscribed

19031903 when (oldHeight /= invalidHeight) $ do

19041904 writeIORef (coincidenceSubscribedHeight subscribed) $! invalidHeight

19051905 WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight

19061906

1907−recalculateSubscriberHeight :: Height -> Subscriber a -> IO ()

1907+recalculateSubscriberHeight :: Height -> Subscriber x a -> IO ()

19081908recalculateSubscriberHeight new s = case s of

19091909 SubscriberPush _ subscribed -> do

19101910 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberPush" <> showNodeId subscribed

@@ -1937,7 +1937,7 @@ recalculateSubscriberHeight new s = case s of

19371937 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed <> " done"

19381938 SubscriberHandle -> return ()

19391939

1940−updateSwitchHeight :: Height -> SwitchSubscribed a -> IO ()

1940+updateSwitchHeight :: Height -> SwitchSubscribed x a -> IO ()

19411941updateSwitchHeight new subscribed = do

19421942 oldHeight <- readIORef $ switchSubscribedHeight subscribed

19431943 when (oldHeight == invalidHeight) $ do --TODO: This 'when' should probably be an assertion

@@ -1945,7 +1945,7 @@ updateSwitchHeight new subscribed = do

19451945 writeIORef (switchSubscribedHeight subscribed) $! new

19461946 WeakBag.traverse (switchSubscribedSubscribers subscribed) $ recalculateSubscriberHeight new

19471947

1948−recalculateCoincidenceHeight :: CoincidenceSubscribed a -> IO ()

1948+recalculateCoincidenceHeight :: CoincidenceSubscribed x a -> IO ()

19491949recalculateCoincidenceHeight subscribed = do

19501950 oldHeight <- readIORef $ coincidenceSubscribedHeight subscribed

19511951 when (oldHeight == invalidHeight) $ do --TODO: This 'when' should probably be an assertion

@@ -1954,18 +1954,18 @@ recalculateCoincidenceHeight subscribed = do

19541954 writeIORef (coincidenceSubscribedHeight subscribed) $! height

19551955 WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight height

19561956

1957−calculateSwitchHeight :: SwitchSubscribed a -> IO Height

1957+calculateSwitchHeight :: SwitchSubscribed x a -> IO Height

19581958calculateSwitchHeight subscribed = getEventSubscribedHeight . _eventSubscription_subscribed =<< readIORef (switchSubscribedCurrentParent subscribed)

19591959

1960−calculateCoincidenceHeight :: CoincidenceSubscribed a -> IO Height

1960+calculateCoincidenceHeight :: CoincidenceSubscribed x a -> IO Height

19611961calculateCoincidenceHeight subscribed = do

19621962 outerHeight <- getEventSubscribedHeight $ _eventSubscription_subscribed $ coincidenceSubscribedOuterParent subscribed

19631963 innerHeight <- maybe (return zeroHeight) getEventSubscribedHeight =<< readIORef (coincidenceSubscribedInnerParent subscribed)

19641964 return $ if outerHeight == invalidHeight || innerHeight == invalidHeight then invalidHeight else max outerHeight innerHeight

19651965

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

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

19671967

1968−invalidate :: IORef [SomeSwitchSubscribed] -> WeakList Invalidator -> IO (WeakList Invalidator)

1968+invalidate :: IORef [SomeSwitchSubscribed x] -> WeakList (Invalidator x) -> IO (WeakList (Invalidator x))

19691969invalidate toReconnectRef wis = do

19701970 forM_ wis $ \wi -> do

19711971 mi <- deRefWeak wi

@@ -2004,7 +2004,7 @@ globalSpiderEnv = unsafePerformIO unsafeNewSpiderEnv

20042004-- | Stores all global data relevant to a particular Spider timeline; only one

20052005-- value should exist for each type @x@

20062006data SpiderEnv x = SpiderEnv

2007− { _spiderEnv_toUnsubscribe :: !(IORef [SomeEventSubscription])

2007+ { _spiderEnv_toUnsubscribe :: !(IORef [SomeEventSubscription x])

20082008 , _spiderEnv_lock :: !(MVar ())

20092009 , _spiderEnv_cleanups :: !(IORef [IO ()])

20102010#ifdef DEBUG

@@ -2014,7 +2014,7 @@ data SpiderEnv x = SpiderEnv

20142014type role SpiderEnv nominal

20152015

20162016instance GEq SpiderEnv where

2017− a `geq` b = if _spiderEnv_toUnsubscribe a == _spiderEnv_toUnsubscribe b

2017+ a `geq` b = if _spiderEnv_lock a == _spiderEnv_lock b

20182018 then Just $ unsafeCoerce Refl -- This unsafeCoerce is safe because the same SpiderEnv can't have two different 'x' arguments

20192019 else Nothing

20202020

@@ -2039,15 +2039,15 @@ unsafeNewSpiderEnv = do

20392039newSpiderEnv :: IO (Some SpiderEnv)

20402040newSpiderEnv = Some.This <$> unsafeNewSpiderEnv

20412041

2042−newtype SpiderPullM x a = SpiderPullM (BehaviorM a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2042+newtype SpiderPullM x a = SpiderPullM (BehaviorM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

20432043

2044−newtype SpiderPushM x a = SpiderPushM (ComputeM a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2044+newtype SpiderPushM x a = SpiderPushM (ComputeM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

20452045

20462046instance R.Reflex (SpiderEnv x) where

2047− newtype Behavior (SpiderEnv x) a = SpiderBehavior { unSpiderBehavior :: Behavior a }

2048− newtype Event (SpiderEnv x) a = SpiderEvent { unSpiderEvent :: Event a }

2049− newtype Dynamic (SpiderEnv x) a = SpiderDynamic { unSpiderDynamic :: Dynamic Identity a } deriving (Functor, Applicative, Monad)

2050− newtype Incremental (SpiderEnv x) p a = SpiderIncremental { unSpiderIncremental :: Dynamic p a }

2047+ newtype Behavior (SpiderEnv x) a = SpiderBehavior { unSpiderBehavior :: Behavior x a }

2048+ newtype Event (SpiderEnv x) a = SpiderEvent { unSpiderEvent :: Event x a }

2049+ newtype Dynamic (SpiderEnv x) a = SpiderDynamic { unSpiderDynamic :: Dynamic x Identity a } deriving (Functor, Applicative, Monad)

2050+ newtype Incremental (SpiderEnv x) p a = SpiderIncremental { unSpiderIncremental :: Dynamic x p a }

20512051 type PullM (SpiderEnv x) = SpiderPullM x

20522052 type PushM (SpiderEnv x) = SpiderPushM x

20532053 {-# INLINABLE never #-}

@@ -2059,13 +2059,13 @@ instance R.Reflex (SpiderEnv x) where

20592059 {-# INLINABLE pull #-}

20602060 pull = SpiderBehavior . pull . coerce

20612061 {-# INLINABLE merge #-}

2062− merge = SpiderEvent . merge . DynamicConst . (unsafeCoerce :: DMap k (R.Event (SpiderEnv x)) -> DMap k Event)

2062+ merge = SpiderEvent . merge . DynamicConst . (unsafeCoerce :: DMap k (R.Event (SpiderEnv x)) -> DMap k (Event x))

20632063 {-# INLINABLE fan #-}

20642064 fan e = R.EventSelector $ SpiderEvent . select (fan (unSpiderEvent e))

20652065 {-# INLINABLE switch #-}

2066− switch = SpiderEvent . switch . (unsafeCoerce :: Behavior (R.Event (SpiderEnv x) a) -> Behavior (Event a)) . unSpiderBehavior

2066+ switch = SpiderEvent . switch . (unsafeCoerce :: Behavior x (R.Event (SpiderEnv x) a) -> Behavior x (Event x a)) . unSpiderBehavior

20672067 {-# INLINABLE coincidence #-}

2068− coincidence = SpiderEvent . coincidence . (unsafeCoerce :: Event (R.Event (SpiderEnv x) a) -> Event (Event a)) . unSpiderEvent

2068+ coincidence = SpiderEvent . coincidence . (unsafeCoerce :: Event x (R.Event (SpiderEnv x) a) -> Event x (Event x a)) . unSpiderEvent

20692069 {-# INLINABLE current #-}

20702070 current = SpiderBehavior . current . unSpiderDynamic

20712071 {-# INLINABLE updated #-}

@@ -2075,7 +2075,7 @@ instance R.Reflex (SpiderEnv x) where

20752075 {-# INLINABLE unsafeBuildIncremental #-}

20762076 unsafeBuildIncremental readV0 dv = SpiderIncremental $ DynamicDyn $ unsafeDyn (coerce readV0) $ unSpiderEvent dv

20772077 {-# INLINABLE mergeIncremental #-}

2078− mergeIncremental = SpiderEvent . merge . (unsafeCoerce :: Dynamic R.PatchDMap (DMap k (R.Event (SpiderEnv x))) -> Dynamic R.PatchDMap (DMap k Event)) . unSpiderIncremental

2078+ mergeIncremental = SpiderEvent . merge . (unsafeCoerce :: Dynamic x R.PatchDMap (DMap k (R.Event (SpiderEnv x))) -> Dynamic x R.PatchDMap (DMap k (Event x))) . unSpiderIncremental

20792079 {-# INLINABLE currentIncremental #-}

20802080 currentIncremental = SpiderBehavior . current . unSpiderIncremental

20812081 {-# INLINABLE updatedIncremental #-}

@@ -2134,8 +2134,8 @@ instance R.MonadHold (SpiderEnv x) (SpiderPushM x) where

21342134 {-# INLINABLE holdIncremental #-}

21352135 holdIncremental v0 (SpiderEvent e) = SpiderPushM $ SpiderIncremental . DynamicHold <$> hold v0 e

21362136

2137−data RootTrigger a = forall k. GCompare k => RootTrigger (SubscriberList a, IORef (DMap k Identity), k a)

2138−newtype SpiderEventHandle a = SpiderEventHandle { unSpiderEventHandle :: EventSubscription a }

2137+data RootTrigger x a = forall k. GCompare k => RootTrigger (SubscriberList x a, IORef (DMap k Identity), k a)

2138+newtype SpiderEventHandle x a = SpiderEventHandle { unSpiderEventHandle :: EventSubscription x a }

21392139

21402140instance R.MonadSubscribeEvent (SpiderEnv x) (SpiderHostFrame x) where

21412141 {-# INLINABLE subscribeEvent #-}

@@ -2144,8 +2144,8 @@ instance R.MonadSubscribeEvent (SpiderEnv x) (SpiderHostFrame x) where

21442144 return $ SpiderEventHandle subscription

21452145

21462146instance R.ReflexHost (SpiderEnv x) where

2147− type EventTrigger (SpiderEnv x) = RootTrigger

2148− type EventHandle (SpiderEnv x) = SpiderEventHandle

2147+ type EventTrigger (SpiderEnv x) = RootTrigger x

2148+ type EventHandle (SpiderEnv x) = SpiderEventHandle x

21492149 type HostFrame (SpiderEnv x) = SpiderHostFrame x

21502150

21512151instance R.MonadReadEvent (SpiderEnv x) (ReadPhase x) where

@@ -2202,7 +2202,7 @@ instance Monad (SpiderHostFrame x) where

22022202instance R.MonadSample (SpiderEnv x) (SpiderHostFrame x) where

22032203 sample = SpiderHostFrame . readBehaviorUntracked . unSpiderBehavior --TODO: This can cause problems with laziness, so we should get rid of it if we can

22042204

2205−addIdentity :: Event a -> Event (Identity a)

2205+addIdentity :: Event x a -> Event x (Identity a)

22062206--addIdentity = fmap Identity

22072207addIdentity = unsafeCoerce

22082208

@@ -2214,12 +2214,12 @@ instance R.MonadHold (SpiderEnv x) (SpiderHostFrame x) where

22142214 {-# INLINABLE holdIncremental #-}

22152215 holdIncremental v0 e = SpiderHostFrame $ fmap (SpiderIncremental . DynamicHold) $ hold v0 $ unSpiderEvent e

22162216

2217−newEventWithTriggerIO :: forall a. (RootTrigger a -> IO (IO ())) -> IO (Event a)

2217+newEventWithTriggerIO :: (RootTrigger x a -> IO (IO ())) -> IO (Event x a)

22182218newEventWithTriggerIO f = do

22192219 es <- newFanEventWithTriggerIO $ \Refl -> f

22202220 return $ select es Refl

22212221

2222−newFanEventWithTriggerIO :: GCompare k => (forall a. k a -> RootTrigger a -> IO (IO ())) -> IO (EventSelector k)

2222+newFanEventWithTriggerIO :: GCompare k => (forall a. k a -> RootTrigger x a -> IO (IO ())) -> IO (EventSelector x k)

22232223newFanEventWithTriggerIO f = do

22242224 occRef <- newIORef DMap.empty

22252225 subscribedRef <- newIORef DMap.empty