git.iko.soy/reflex
on 123b62e help sign in
90891e1
swap
5 ahead, 338 behind
ChangeLog.md+2−9
since splitsnapshots
unifiedsplit
@@ -17,21 +17,14 @@
17## 0.6.2.1
17## 0.6.2.1
18
18
19* Generalize `fan` to `fanG` to take a `DMap` with non-`Identity`
19* Generalize `fan` to `fanG` to take a `DMap` with non-`Identity`
20− functor:
20+ values.
21− * `fan` to `fanG`
22− * `EventSelectorG` for `fanG` result selector.
23−
24−* Reduce the amount of unsafeCoerce in coercing newtypes under Event/Dynamic/Behavior.
25− * Add fused ReaderIO for the purpose of coercion (ReaderT's third argument has nominal role preventing automated coerce)
26− * Add incrementalCoercion/coerceIncremental to go with dynamicCoercion/coerceDynamic
27
21
28* Generalize merging functions:
22* Generalize merging functions:
29 `merge` to `mergeG`,
23 `merge` to `mergeG`,
30 `mergeIncremental` to `mergeIncrementalG`,
24 `mergeIncremental` to `mergeIncrementalG`,
25+ `distributeDMapOverDynPure` to `distributeDMapOverDynPureG`,
31 `mergeIncrementalWithMove` to `mergeIncrementalWithMoveG`.
26 `mergeIncrementalWithMove` to `mergeIncrementalWithMoveG`.
32
27
33−* Generalize distribute function:
34− `distributeDMapOverDynPure` to `distributeDMapOverDynPureG`,
35
28
36## 0.6.2.0
29## 0.6.2.0
37
30
default.nix−1
@@ -23,7 +23,6 @@ mkDerivation {
23 base bifunctors containers deepseq dependent-map dependent-sum
23 base bifunctors containers deepseq dependent-map dependent-sum
24 mtl ref-tf split transformers data-default
24 mtl ref-tf split transformers data-default
25 random time unbounded-delays monoidal-containers witherable
25 random time unbounded-delays monoidal-containers witherable
26− profunctors
27 ] ++ (if ghc.isGhcjs or false then [
26 ] ++ (if ghc.isGhcjs or false then [
28 ghcjs-base
27 ghcjs-base
29 ] else []) ++ (if !useTemplateHaskell then [] else [
28 ] else []) ++ (if !useTemplateHaskell then [] else [
reflex.cabal+2
@@ -115,9 +115,11 @@ library
115 Reflex.Patch.Class,
115 Reflex.Patch.Class,
116 Reflex.Patch.DMap,
116 Reflex.Patch.DMap,
117 Reflex.Patch.DMapWithMove,
117 Reflex.Patch.DMapWithMove,
118+ Reflex.Patch.DMapWithReset,
118 Reflex.Patch.IntMap,
119 Reflex.Patch.IntMap,
119 Reflex.Patch.Map,
120 Reflex.Patch.Map,
120 Reflex.Patch.MapWithMove,
121 Reflex.Patch.MapWithMove,
122+ Reflex.Patch.Patchable,
121 Reflex.PerformEvent.Base,
123 Reflex.PerformEvent.Base,
122 Reflex.PerformEvent.Class,
124 Reflex.PerformEvent.Class,
123 Reflex.PostBuild.Base,
125 Reflex.PostBuild.Base,
src/Reflex/Patch/DMapWithReset.hsnew file+120
@@ -0,0 +1,120 @@
1+{-# LANGUAGE FlexibleContexts #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE LambdaCase #-}
4+{-# LANGUAGE MultiParamTypeClasses #-}
5+{-# LANGUAGE PolyKinds #-}
6+{-# LANGUAGE Rank2Types #-}
7+{-# LANGUAGE ScopedTypeVariables #-}
8+{-# LANGUAGE StandaloneDeriving #-}
9+{-# LANGUAGE TypeApplications #-}
10+{-# LANGUAGE TypeFamilies #-}
11+{-# LANGUAGE UndecidableInstances #-}
12+
13+{-# OPTIONS_GHC -Wall #-}
14+
15+-- | 'Patch'es on 'DMap' that consist only of insertions (or overwrites) and deletions.
16+module Reflex.Patch.DMapWithReset where
17+
18+import Reflex.Patch.Class
19+
20+import Data.Dependent.Map (DMap, GCompare (..))
21+import qualified Data.Dependent.Map as DMap
22+import Data.Semigroup (Semigroup (..))
23+import Data.Constraint.Extras
24+
25+-- | A set of changes to a 'DMap'. Any element may be inserted/updated or deleted.
26+-- Insertions are represented as @'ComposeMaybe' (Just value)@,
27+-- while deletions are represented as @'ComposeMaybe' Nothing@.
28+newtype PatchDMapWithReset k p = PatchDMapWithReset { unPatchDMapWithReset :: DMap k (By p) }
29+
30+-- | Holds the information about each key: where its new value should come from,
31+-- and where its old value should go to
32+data By p a
33+ = By_Insert (PatchTarget (p a)) -- ^ Insert the given value here
34+ | By_Delete -- ^ Delete the existing value, if any, from here
35+ | By_Patch (p a) -- ^ Patch the value here with the given patch
36+
37+instance (Semigroup (p a), Patch (p a)) => Semigroup (By p a) where
38+ x@(By_Insert _) <> _ = x
39+ By_Delete <> _ = By_Delete
40+ By_Patch x <> By_Insert y = By_Insert (applyAlways x y)
41+ By_Patch x <> By_Patch y = By_Patch (x <> y)
42+ By_Patch _ <> By_Delete = By_Delete
43+
44+instance (Monoid (p a), Patch (p a)) => Monoid (By p a) where
45+ mappend = (<>)
46+ mempty = By_Patch mempty
47+
48+instance
49+ ( GCompare k
50+ , Has' Semigroup k p
51+ , Has' Patch k p
52+ )
53+ => Semigroup (PatchDMapWithReset k p) where
54+ PatchDMapWithReset xs <> PatchDMapWithReset ys = PatchDMapWithReset $ DMap.unionWithKey
55+ (\k -> has' @Patch @p k
56+ $ has' @Semigroup @p k
57+ $ (<>)) xs ys
58+
59+instance
60+ ( GCompare k
61+ , Has' Semigroup k p
62+ , Has' Patch k p
63+ )
64+ => Monoid (PatchDMapWithReset k p) where
65+ mappend = (<>)
66+ mempty = PatchDMapWithReset DMap.empty
67+
68+class (Patch (p a), PatchTarget (p a) ~ Patches1LocallyTarget p a) => Patches1Locally p a where
69+ type Patches1LocallyTarget p :: k -> *
70+
71+data These1 f g x
72+ = This1 (f x)
73+ | That1 (g x)
74+ | These1 (f x) (g x)
75+
76+mergeWithKey
77+ :: forall k v1 v2 v.
78+ (GCompare k)
79+ => (forall x. k x -> v1 x -> Maybe (v x))
80+ -> (forall x. k x -> v2 x -> Maybe (v x))
81+ -> (forall x. k x -> v1 x -> v2 x -> Maybe (v x))
82+ -> DMap k v1 -> DMap k v2 -> DMap k v
83+mergeWithKey f g fg = \xs ys -> DMap.mapMaybeWithKey onlyThat $ DMap.unionWithKey doIt (DMap.map This1 xs) (DMap.map That1 ys)
84+ where
85+ doIt _ (This1 xs) (That1 ys) = These1 xs ys
86+ doIt _ _ _ = error "mergeWithKey misalligned keys"
87+
88+ onlyThat :: forall x. k x -> These1 v1 v2 x -> Maybe (v x)
89+ onlyThat k = \case
90+ This1 xs -> f k xs
91+ That1 ys -> g k ys
92+ These1 xs ys -> fg k xs ys
93+{-# INLINE mergeWithKey #-}
94+
95+-- | Apply the insertions or deletions to a given 'DMap'.
96+instance (GCompare k, Has (Patches1Locally p) k) => Patch (PatchDMapWithReset k p) where
97+
98+ type PatchTarget (PatchDMapWithReset k p) = DMap k (Patches1LocallyTarget p)
99+
100+ apply = go
101+ where
102+ go :: PatchDMapWithReset k p -> DMap k (Patches1LocallyTarget p) -> Maybe (DMap k (Patches1LocallyTarget p))
103+ go (PatchDMapWithReset diff) old = Just $! mergeWithKey (\_ -> Just) inserts updates old diff
104+ where
105+ updates :: forall x. k x -> Patches1LocallyTarget p x -> By p x -> Maybe (Patches1LocallyTarget p x)
106+ updates k ys = has @(Patches1Locally p) k $ \case
107+ By_Insert x -> Just x
108+ By_Delete -> Nothing
109+ By_Patch x -> Just $ applyAlways x ys
110+
111+ inserts :: forall x. k x -> By p x -> Maybe (Patches1LocallyTarget p x)
112+ inserts k = has @(Patches1Locally p) k $ \case
113+ By_Insert x -> Just x
114+ By_Delete -> Nothing
115+ By_Patch _ -> Nothing
116+
117+deriving instance (Patch (p a), Eq (p a), Eq (PatchTarget (p a))) => Eq (By p a)
118+deriving instance (Patch (p a), Show (p a), Show (PatchTarget (p a))) => Show (By p a)
119+deriving instance (Eq (DMap k (By p))) => Eq (PatchDMapWithReset k p)
120+deriving instance (Show (DMap k (By p))) => Show (PatchDMapWithReset k p)
src/Reflex/Patch/Patchable.hsnew file+44
@@ -0,0 +1,44 @@
1+{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE LambdaCase #-}
4+{-# LANGUAGE StandaloneDeriving #-}
5+{-# LANGUAGE TypeFamilies #-}
6+
7+-- The derived instances are undecidable in the case of a pathological instance like
8+-- instance Patch x where
9+-- type PatchTarget x = Patchable x
10+{-# LANGUAGE UndecidableInstances #-}
11+
12+module Reflex.Patch.Patchable where
13+
14+-- import Data.Aeson
15+import GHC.Generics
16+import Reflex.Patch
17+
18+-- | Like SemiMap/PartialMap but for anything patchable
19+data Patchable p
20+ = Patchable_Patch p
21+ | Patchable_Complete (PatchTarget p)
22+ deriving (Generic)
23+
24+completePatchable :: Patchable p -> Maybe (PatchTarget p)
25+completePatchable = \case
26+ Patchable_Complete t -> Just t
27+ Patchable_Patch _ -> Nothing
28+
29+deriving instance (Eq p, Eq (PatchTarget p)) => Eq (Patchable p)
30+deriving instance (Ord p, Ord (PatchTarget p)) => Ord (Patchable p)
31+deriving instance (Show p, Show (PatchTarget p)) => Show (Patchable p)
32+deriving instance (Read p, Read (PatchTarget p)) => Read (Patchable p)
33+-- instance (ToJSON p, ToJSON (PatchTarget p)) => ToJSON (Patchable p)
34+-- instance (FromJSON p, FromJSON (PatchTarget p)) => FromJSON (Patchable p)
35+
36+instance (Monoid p, Patch p) => Monoid (Patchable p) where
37+ mempty = Patchable_Patch mempty
38+ mappend = (<>)
39+
40+instance (Semigroup p, Patch p) => Semigroup (Patchable p) where
41+ (<>) = curry $ \case
42+ (Patchable_Patch a, Patchable_Patch b) -> Patchable_Patch $ a <> b
43+ (Patchable_Patch a, Patchable_Complete b) -> Patchable_Complete $ applyAlways a b
44+ (Patchable_Complete a, _) -> Patchable_Complete a
src/Reflex/Pure.hs+1−2
@@ -88,8 +88,7 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where
88 then Nothing
88 then Nothing
89 else Just currentOccurrences
89 else Just currentOccurrences
90
90
91−-- The instance signature doeesn't compile, leave commented for documentation
92−-- fanG :: GCompare k => Event (Pure t) (DMap k v) -> EventSelectorG (Pure t) k v
91+ -- fanG :: GCompare k => Event (Pure t) (DMap k v) -> EventSelectorG (Pure t) k v
93 fanG e = EventSelectorG $ \k -> Event $ \t -> unEvent e t >>= DMap.lookup k
92 fanG e = EventSelectorG $ \k -> Event $ \t -> unEvent e t >>= DMap.lookup k
94
93
95 switch :: Behavior (Pure t) (Event (Pure t) a) -> Event (Pure t) a
94 switch :: Behavior (Pure t) (Event (Pure t) a) -> Event (Pure t) a
src/Reflex/Spider/Internal.hs+46−51
@@ -211,6 +211,12 @@ nextNodeIdRef = unsafePerformIO $ newIORef 1
211
211
212newNodeId :: IO Int
212newNodeId :: IO Int
213newNodeId = atomicModifyIORef' nextNodeIdRef $ \n -> (succ n, n)
213newNodeId = atomicModifyIORef' nextNodeIdRef $ \n -> (succ n, n)
214+
215+{-# NOINLINE unsafeNodeId #-}
216+unsafeNodeId :: a -> Int
217+unsafeNodeId a = unsafePerformIO $ do
218+ touch a
219+ newNodeId
214#endif
220#endif
215
221
216--------------------------------------------------------------------------------
222--------------------------------------------------------------------------------
@@ -314,10 +320,9 @@ cacheEvent e =
314#else
320#else
315 Event $
321 Event $
316#endif
322#endif
317− unsafePerformIO $ do
318− mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a))
323+ let mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a))
319− <- newIORef emptyFastWeak
324+ !mSubscribedRef = unsafeNewIORef e emptyFastWeak
320− pure $ \sub -> {-# SCC "cacheEvent" #-} do
325+ in \sub -> {-# SCC "cacheEvent" #-} do
321#ifdef DEBUG_TRACE_EVENTS
326#ifdef DEBUG_TRACE_EVENTS
322 unless (BS8.null callSite) $ liftIO $ BS8.hPutStrLn stderr callSite
327 unless (BS8.null callSite) $ liftIO $ BS8.hPutStrLn stderr callSite
323#endif
328#endif
@@ -1206,12 +1211,18 @@ buildDynamic readV0 v' = do
1206 return d
1211 return d
1207
1212
1208unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
1213unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
1209−unsafeBuildDynamic readV0 v' =
1214+unsafeBuildDynamic readV0 v' = Dyn $ unsafeNewIORef x $ UnsafeDyn x
1210− Dyn $ unsafePerformIO $ newIORef $ UnsafeDyn (readV0, v')
1215+ where x = (readV0, v')
1211
1216
1212-- ResultM can read behaviors and events
1217-- ResultM can read behaviors and events
1213type ResultM = EventM
1218type ResultM = EventM
1214
1219
1220+{-# NOINLINE unsafeNewIORef #-}
1221+unsafeNewIORef :: a -> b -> IORef b
1222+unsafeNewIORef a b = unsafePerformIO $ do
1223+ touch a
1224+ newIORef b
1225+
1215instance HasSpiderTimeline x => Functor (Event x) where
1226instance HasSpiderTimeline x => Functor (Event x) where
1216 fmap f = push $ return . Just . f
1227 fmap f = push $ return . Just . f
1217
1228
@@ -1224,35 +1235,26 @@ push f e = cacheEvent (pushCheap f e)
1224
1235
1225{-# INLINABLE pull #-}
1236{-# INLINABLE pull #-}
1226pull :: BehaviorM x a -> Behavior x a
1237pull :: BehaviorM x a -> Behavior x a
1227−pull a = unsafePerformIO $ do
1238+pull a = behaviorPull $ Pull
1228− ref <- newIORef Nothing
1239+ { pullCompute = a
1240+ , pullValue = unsafeNewIORef a Nothing
1229#ifdef DEBUG_NODEIDS
1241#ifdef DEBUG_NODEIDS
1230− nid <- newNodeId
1242+ , pullNodeId = unsafeNodeId a
1231#endif
1243#endif
1232− pure $ behaviorPull $ Pull
1233− { pullCompute = a
1234− , pullValue = ref
1235−#ifdef DEBUG_NODEIDS
1236− , pullNodeId = nid
1237−#endif
1238− }
1244+ }
1239
1245
1240{-# INLINABLE switch #-}
1246{-# INLINABLE switch #-}
1241switch :: HasSpiderTimeline x => Behavior x (Event x a) -> Event x a
1247switch :: HasSpiderTimeline x => Behavior x (Event x a) -> Event x a
1242−switch a = unsafePerformIO $ do
1243− ref <- newIORef Nothing
1244− pure $ eventSwitch $ Switch
1248+switch a = eventSwitch $ Switch
1245− { switchParent = a
1249+ { switchParent = a
1246− , switchSubscribed = ref
1250+ , switchSubscribed = unsafeNewIORef a Nothing
1247− }
1251+ }
1248
1252
1249coincidence :: HasSpiderTimeline x => Event x (Event x a) -> Event x a
1253coincidence :: HasSpiderTimeline x => Event x (Event x a) -> Event x a
1250−coincidence a = unsafePerformIO $ do
1251− ref <- newIORef Nothing
1252− pure $ eventCoincidence $ Coincidence
1254+coincidence a = eventCoincidence $ Coincidence
1253− { coincidenceParent = a
1255+ { coincidenceParent = a
1254− , coincidenceSubscribed = ref
1256+ , coincidenceSubscribed = unsafeNewIORef a Nothing
1255− }
1257+ }
1256
1258
1257-- Propagate the given event occurrence; before cleaning up, run the given action, which may read the state of events and behaviors
1259-- Propagate the given event occurrence; before cleaning up, run the given action, which may read the state of events and behaviors
1258run :: forall x b. HasSpiderTimeline x => [DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b
1260run :: forall x b. HasSpiderTimeline x => [DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b
@@ -1456,9 +1458,6 @@ getRootSubscribed k r sub = do
1456 when debugPropagate $ putStrLn $ "getRootSubscribed: calling rootInit"
1458 when debugPropagate $ putStrLn $ "getRootSubscribed: calling rootInit"
1457 uninit <- rootInit r k $ RootTrigger (subs, rootOccurrence r, k)
1459 uninit <- rootInit r k $ RootTrigger (subs, rootOccurrence r, k)
1458 writeIORef uninitRef $! uninit
1460 writeIORef uninitRef $! uninit
1459−#ifdef DEBUG_NODEIDS
1460− nid <- newNodeId
1461−#endif
1462 let !subscribed = RootSubscribed
1461 let !subscribed = RootSubscribed
1463 { rootSubscribedKey = k
1462 { rootSubscribedKey = k
1464 , rootSubscribedCachedSubscribed = cached
1463 , rootSubscribedCachedSubscribed = cached
@@ -1467,7 +1466,7 @@ getRootSubscribed k r sub = do
1467 , rootSubscribedUninit = uninit
1466 , rootSubscribedUninit = uninit
1468 , rootSubscribedWeakSelf = weakSelf
1467 , rootSubscribedWeakSelf = weakSelf
1469#ifdef DEBUG_NODEIDS
1468#ifdef DEBUG_NODEIDS
1470− , rootSubscribedNodeId = nid
1469+ , rootSubscribedNodeId = unsafeNodeId (k, r, subs)
1471#endif
1470#endif
1472 }
1471 }
1473 -- If we die at the same moment that all our children die, they will
1472 -- If we die at the same moment that all our children die, they will
@@ -1516,10 +1515,16 @@ newFanInt = do
1516 , _fanInt_occRef = occRef
1515 , _fanInt_occRef = occRef
1517 }
1516 }
1518
1517
1518+{-# NOINLINE unsafeNewFanInt #-}
1519+unsafeNewFanInt :: b -> FanInt x a
1520+unsafeNewFanInt b = unsafePerformIO $ do
1521+ touch b
1522+ newFanInt
1523+
1519fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a
1524fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a
1520−fanInt p = unsafePerformIO $ do
1525+fanInt p =
1521− self <- newFanInt
1526+ let self = unsafeNewFanInt p
1522− pure $ EventSelectorInt $ \k -> Event $ \sub -> do
1527+ in EventSelectorInt $ \k -> Event $ \sub -> do
1523 isEmpty <- liftIO $ FastMutableIntMap.isEmpty (_fanInt_subscribers self)
1528 isEmpty <- liftIO $ FastMutableIntMap.isEmpty (_fanInt_subscribers self)
1524 when isEmpty $ do -- This is the first subscriber, so we need to subscribe to our input
1529 when isEmpty $ do -- This is the first subscriber, so we need to subscribe to our input
1525 (subscription, parentOcc) <- subscribeAndRead p $ Subscriber
1530 (subscription, parentOcc) <- subscribeAndRead p $ Subscriber
@@ -1573,16 +1578,13 @@ getFanSubscribed k f sub = do
1573 subscribersRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribersRef not yet initialized"
1578 subscribersRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribersRef not yet initialized"
1574 occRef <- liftIO $ newIORef parentOcc
1579 occRef <- liftIO $ newIORef parentOcc
1575 when (isJust parentOcc) $ scheduleClear occRef
1580 when (isJust parentOcc) $ scheduleClear occRef
1576−#ifdef DEBUG_NODEIDS
1577− nid <- liftIO newNodeId
1578−#endif
1579 let subscribed = FanSubscribed
1581 let subscribed = FanSubscribed
1580 { fanSubscribedCachedSubscribed = fanSubscribed f
1582 { fanSubscribedCachedSubscribed = fanSubscribed f
1581 , fanSubscribedOccurrence = occRef
1583 , fanSubscribedOccurrence = occRef
1582 , fanSubscribedParent = subscription
1584 , fanSubscribedParent = subscription
1583 , fanSubscribedSubscribers = subscribersRef
1585 , fanSubscribedSubscribers = subscribersRef
1584#ifdef DEBUG_NODEIDS
1586#ifdef DEBUG_NODEIDS
1585− , fanSubscribedNodeId = nid
1587+ , fanSubscribedNodeId = unsafeNodeId f
1586#endif
1588#endif
1587 }
1589 }
1588 let !self = (k, subscribed)
1590 let !self = (k, subscribed)
@@ -1642,9 +1644,6 @@ getSwitchSubscribed s sub = do
1642 when (isJust parentOcc) $ scheduleClear occRef
1644 when (isJust parentOcc) $ scheduleClear occRef
1643 weakSelf <- liftIO $ newIORef $ error "getSwitchSubscribed: weakSelf not yet initialized"
1645 weakSelf <- liftIO $ newIORef $ error "getSwitchSubscribed: weakSelf not yet initialized"
1644 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupSwitchSubscribed
1646 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupSwitchSubscribed
1645−#ifdef DEBUG_NODEIDS
1646− nid <- liftIO newNodeId
1647−#endif
1648 let !subscribed = SwitchSubscribed
1647 let !subscribed = SwitchSubscribed
1649 { switchSubscribedCachedSubscribed = switchSubscribed s
1648 { switchSubscribedCachedSubscribed = switchSubscribed s
1650 , switchSubscribedOccurrence = occRef
1649 , switchSubscribedOccurrence = occRef
@@ -1657,7 +1656,7 @@ getSwitchSubscribed s sub = do
1657 , switchSubscribedCurrentParent = subscriptionRef
1656 , switchSubscribedCurrentParent = subscriptionRef
1658 , switchSubscribedWeakSelf = weakSelf
1657 , switchSubscribedWeakSelf = weakSelf
1659#ifdef DEBUG_NODEIDS
1658#ifdef DEBUG_NODEIDS
1660− , switchSubscribedNodeId = nid
1659+ , switchSubscribedNodeId = unsafeNodeId s
1661#endif
1660#endif
1662 }
1661 }
1663 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf"
1662 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf"
@@ -1702,9 +1701,6 @@ getCoincidenceSubscribed c sub = do
1702 scheduleClear innerSubdRef
1701 scheduleClear innerSubdRef
1703 weakSelf <- liftIO $ newIORef $ error "getCoincidenceSubscribed: weakSelf not yet implemented"
1702 weakSelf <- liftIO $ newIORef $ error "getCoincidenceSubscribed: weakSelf not yet implemented"
1704 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupCoincidenceSubscribed
1703 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupCoincidenceSubscribed
1705−#ifdef DEBUG_NODEIDS
1706− nid <- liftIO newNodeId
1707−#endif
1708 let subscribed = CoincidenceSubscribed
1704 let subscribed = CoincidenceSubscribed
1709 { coincidenceSubscribedCachedSubscribed = coincidenceSubscribed c
1705 { coincidenceSubscribedCachedSubscribed = coincidenceSubscribed c
1710 , coincidenceSubscribedOccurrence = occRef
1706 , coincidenceSubscribedOccurrence = occRef
@@ -1715,7 +1711,7 @@ getCoincidenceSubscribed c sub = do
1715 , coincidenceSubscribedInnerParent = innerSubdRef
1711 , coincidenceSubscribedInnerParent = innerSubdRef
1716 , coincidenceSubscribedWeakSelf = weakSelf
1712 , coincidenceSubscribedWeakSelf = weakSelf
1717#ifdef DEBUG_NODEIDS
1713#ifdef DEBUG_NODEIDS
1718− , coincidenceSubscribedNodeId = nid
1714+ , coincidenceSubscribedNodeId = unsafeNodeId c
1719#endif
1715#endif
1720 }
1716 }
1721 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed"
1717 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed"
@@ -2089,13 +2085,12 @@ newtype EventSelector x k = EventSelector { select :: forall a. k a -> Event x a
2089newtype EventSelectorG x k v = EventSelectorG { selectG :: forall a. k a -> Event x (v a) }
2085newtype EventSelectorG x k v = EventSelectorG { selectG :: forall a. k a -> Event x (v a) }
2090
2086
2091fanG :: (HasSpiderTimeline x, GCompare k) => Event x (DMap k v) -> EventSelectorG x k v
2087fanG :: (HasSpiderTimeline x, GCompare k) => Event x (DMap k v) -> EventSelectorG x k v
2092−fanG e = unsafePerformIO $ do
2088+fanG e =
2093− ref <- newIORef Nothing
2094 let f = Fan
2089 let f = Fan
2095 { fanParent = e
2090 { fanParent = e
2096− , fanSubscribed = ref
2091+ , fanSubscribed = unsafeNewIORef e Nothing
2097 }
2092 }
2098− pure $ EventSelectorG $ \k -> eventFan k f
2093+ in EventSelectorG $ \k -> eventFan k f
2099
2094
2100runHoldInits :: HasSpiderTimeline x => IORef [SomeHoldInit x] -> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()
2095runHoldInits :: HasSpiderTimeline x => IORef [SomeHoldInit x] -> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()
2101runHoldInits holdInitRef dynInitRef mergeInitRef = do
2096runHoldInits holdInitRef dynInitRef mergeInitRef = do