@@ -1,4 +1,4 @@
1−{-# LANGUAGE ExistentialQuantification, GADTs, ScopedTypeVariables, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, RankNTypes, BangPatterns, UndecidableInstances, EmptyDataDecls, RecursiveDo, RoleAnnotations, LambdaCase #-}
1+{-# LANGUAGE CPP, ExistentialQuantification, GADTs, ScopedTypeVariables, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, RankNTypes, BangPatterns, UndecidableInstances, EmptyDataDecls, RecursiveDo, RoleAnnotations, LambdaCase #-}
22module Reflex.Spider.Internal where
33
44import Prelude hiding (mapM, mapM_, any, sequence, concat)
@@ -30,6 +30,65 @@ import System.IO.Unsafe
3030import Unsafe.Coerce
3131import Control.Monad.Primitive
3232
33+debugPropagate :: Bool
34+
35+debugInvalidateHeight :: Bool
36+
37+class HasNodeId a where
38+ getNodeId :: a -> Int
39+
40+showNodeId :: HasNodeId a => a -> String
41+showNodeId = ("#"<>) . show . getNodeId
42+
43+#ifdef DEBUG
44+
45+#define DEBUG_NODEIDS
46+
47+debugPropagate = True
48+
49+debugInvalidateHeight = True
50+
51+instance HasNodeId (Hold a) where
52+ getNodeId = holdNodeId
53+
54+instance HasNodeId (PushSubscribed a b) where
55+ getNodeId = pushSubscribedNodeId
56+
57+instance HasNodeId (SwitchSubscribed a) where
58+ getNodeId = switchSubscribedNodeId
59+
60+instance HasNodeId (MergeSubscribed a) where
61+ getNodeId = mergeSubscribedNodeId
62+
63+instance HasNodeId (FanSubscribed a) where
64+ getNodeId = fanSubscribedNodeId
65+
66+instance HasNodeId (CoincidenceSubscribed a) where
67+ getNodeId = coincidenceSubscribedNodeId
68+
69+#else
70+
71+debugPropagate = False
72+
73+debugInvalidateHeight = False
74+
75+instance HasNodeId a where
76+ getNodeId = const ""
77+
78+#endif
79+
80+#ifdef DEBUG_NODEIDS
81+{-# NOINLINE nextNodeIdRef #-}
82+nextNodeIdRef :: IORef Int
83+nextNodeIdRef = unsafePerformIO $ newIORef 1
84+
85+{-# NOINLINE unsafeNodeId #-}
86+unsafeNodeId :: a -> Int
87+unsafeNodeId a = unsafePerformIO $ do
88+ touch a
89+ atomicModifyIORef' nextNodeIdRef $ \n -> (succ n, n)
90+#endif
91+
3392--TODO: Figure out why certain things are not 'representational', then make them representational so we can use coerce
3493--type role Hold representational
3594data Hold a
@@ -38,6 +97,9 @@ data Hold a
3897 -- We need to use 'Any' for the next two things, because otherwise Hold inherits a nominal role for its 'a' parameter, and we want to be able to use 'coerce'
3998 , holdSubscriber :: !(IORef Any) -- Keeps its subscription alive; for some reason, a regular (or strict) reference to the Subscriber itself wasn't working, so had to use an IORef
4099 , holdParent :: !(IORef Any) -- Keeps its parent alive (will be undefined until the hold is initialized --TODO: Probably shouldn't be an IORef
100+#ifdef DEBUG_NODEIDS
101+ , holdNodeId :: Int
102+#endif
41103 }
42104
43105data EventEnv
@@ -97,6 +159,9 @@ hold v0 e = do
97159 , holdInvalidators = invsRef
98160 , holdSubscriber = subscriberRef
99161 , holdParent = parentRef
162+#ifdef DEBUG_NODEIDS
163+ , holdNodeId = unsafeNodeId (v0, e)
164+#endif
100165 }
101166 !s = SubscriberHold h
102167 writeIORef subscriberRef $ unsafeCoerce s
@@ -165,6 +230,9 @@ data PushSubscribed a b
165230 , pushSubscribedSubscribers :: !(IORef [WeakSubscriber b])
166231 , pushSubscribedSelf :: !(Subscriber a) -- Hold this in memory to ensure our WeakReferences don't die
167232 , pushSubscribedParent :: !(EventSubscribed a)
233+#ifdef DEBUG_NODEIDS
234+ , pushSubscribedNodeId :: Int
235+#endif
168236 }
169237
170238data Push a b
@@ -180,6 +248,9 @@ data MergeSubscribed k
180248 , mergeSubscribedSubscribers :: !(IORef [WeakSubscriber (DMap k)])
181249 , mergeSubscribedSelf :: !Any -- Hold all our Subscribers in memory
182250 , mergeSubscribedParents :: !(DMap (WrapArg EventSubscribed k))
251+#ifdef DEBUG_NODEIDS
252+ , mergeSubscribedNodeId :: Int
253+#endif
183254 }
184255
185256--TODO: DMap sucks; we should really write something better (with a functor for the value as well as the key)
@@ -206,6 +277,9 @@ data FanSubscribed k
206277 = FanSubscribed { fanSubscribedSubscribers :: !(IORef (DMap (FanSubscriberKey k)))
207278 , fanSubscribedParent :: !(EventSubscribed (DMap k))
208279 , fanSubscribedSelf :: !(Subscriber (DMap k))
280+#ifdef DEBUG_NODEIDS
281+ , fanSubscribedNodeId :: Int
282+#endif
209283 }
210284
211285data Fan k
@@ -224,6 +298,9 @@ data SwitchSubscribed a
224298 , switchSubscribedBehaviorParents :: !(IORef [SomeBehaviorSubscribed])
225299 , switchSubscribedParent :: !(Behavior (Event a))
226300 , switchSubscribedCurrentParent :: !(IORef (EventSubscribed a))
301+#ifdef DEBUG_NODEIDS
302+ , switchSubscribedNodeId :: Int
303+#endif
227304 }
228305
229306data Switch a
@@ -238,6 +315,9 @@ data CoincidenceSubscribed a
238315 , coincidenceSubscribedOuter :: !(Subscriber (Event a))
239316 , coincidenceSubscribedOuterParent :: !(EventSubscribed (Event a))
240317 , coincidenceSubscribedInnerParent :: !(IORef (Maybe (EventSubscribed a)))
318+#ifdef DEBUG_NODEIDS
319+ , coincidenceSubscribedNodeId :: Int
320+#endif
241321 }
242322
243323data Coincidence a
@@ -379,7 +459,7 @@ propagateAndUpdateSubscribersRef subscribersRef a = do
379459run :: [DSum RootTrigger] -> ResultM b -> IO b
380460run roots after = do
381461 when debugPropagate $ putStrLn "Running an event frame"
382− runFrame $ do
462+ result <- runFrame $ do
383463 forM_ roots $ \(RootTrigger (_, occRef) :=> a) -> do
384464 liftIO $ writeIORef occRef $ Just a
385465 scheduleClear occRef
@@ -411,6 +491,8 @@ run roots after = do
411491 go
412492 putCurrentHeight maxBound
413493 after
494+ when debugPropagate $ putStrLn "Done running an event frame"
495+ return result
414496
415497data SomeMaybeIORef = forall a. SomeMaybeIORef (IORef (Maybe a))
416498
@@ -427,9 +509,6 @@ mkWeakPtrWithDebug x debugNote = mkWeakPtr x $
427509 then Just $ putStrLn $ "finalizing: " ++ debugNote
428510 else Nothing
429511
430−debugPropagate :: Bool
431−debugPropagate = False
432−
433512type WeakList a = [Weak a]
434513
435514--TODO: Is it faster to clean up every time, or to occasionally go through and clean up as needed?
@@ -450,7 +529,7 @@ propagate :: a -> [WeakSubscriber a] -> EventM [WeakSubscriber a]
450529propagate a subscribers = do
451530 traverseAndCleanWeakList_ (liftIO . deRefWeakSubscriber) subscribers $ \s -> case s of
452531 SubscriberPush compute subscribed -> do
453− when debugPropagate $ liftIO $ putStrLn "SubscriberPush"
532+ when debugPropagate $ liftIO $ putStrLn $ "SubscriberPush" <> showNodeId subscribed
454533 occ <- compute a
455534 case occ of
456535 Nothing -> return () -- No need to write a Nothing back into the Ref
@@ -459,7 +538,7 @@ propagate a subscribers = do
459538 scheduleClear $ pushSubscribedOccurrence subscribed
460539 liftIO . writeIORef (pushSubscribedSubscribers subscribed) =<< propagate o =<< liftIO (readIORef (pushSubscribedSubscribers subscribed))
461540 SubscriberMerge k subscribed -> do
462− when debugPropagate $ liftIO $ putStrLn $ "SubscriberMerge"
541+ when debugPropagate $ liftIO $ putStrLn $ "SubscriberMerge" <> showNodeId subscribed
463542 oldM <- liftIO $ readIORef $ mergeSubscribedAccum subscribed
464543 liftIO $ writeIORef (mergeSubscribedAccum subscribed) $ DMap.insertWith (error "Same key fired multiple times for") k a oldM
465544 when (DMap.null oldM) $ do -- Only schedule the firing once
@@ -470,7 +549,7 @@ propagate a subscribers = do
470549 scheduleMerge height subscribed
471550 SubscriberFan subscribed -> do
472551 subs <- liftIO $ readIORef $ fanSubscribedSubscribers subscribed
473− when debugPropagate $ liftIO $ putStrLn $ "SubscriberFan: " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"
552+ when debugPropagate $ liftIO $ putStrLn $ "SubscriberFan" <> showNodeId subscribed <> ": " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"
474553 --TODO: We need a better DMap intersection; here, we are assuming that the number of firing keys is small and the number of subscribers is large
475554 forM_ (DMap.toList a) $ \(k :=> v) -> case DMap.lookup (FanSubscriberKey k) subs of
476555 Nothing -> do
@@ -486,17 +565,17 @@ propagate a subscribers = do
486565 liftIO $ writeIORef (fanSubscribedSubscribers subscribed) $ DMap.fromDistinctAscList $ catMaybes subs'
487566 SubscriberHold h -> do
488567 invalidators <- liftIO $ readIORef $ holdInvalidators h
489− when debugPropagate $ liftIO $ putStrLn $ "SubscriberHold: " ++ show (length invalidators)
568+ when debugPropagate $ liftIO $ putStrLn $ "SubscriberHold" <> showNodeId h <> ": " ++ show (length invalidators)
490569 toAssignRef <- askToAssignRef
491570 liftIO $ modifyIORef' toAssignRef (SomeAssignment h a :)
492571 SubscriberSwitch subscribed -> do
493− when debugPropagate $ liftIO $ putStrLn "SubscriberSwitch"
572+ when debugPropagate $ liftIO $ putStrLn $ "SubscriberSwitch" <> showNodeId subscribed
494573 liftIO $ writeIORef (switchSubscribedOccurrence subscribed) $ Just a
495574 scheduleClear $ switchSubscribedOccurrence subscribed
496575 subs <- liftIO $ readIORef $ switchSubscribedSubscribers subscribed
497576 liftIO . writeIORef (switchSubscribedSubscribers subscribed) =<< propagate a subs
498577 SubscriberCoincidenceOuter subscribed -> do
499− when debugPropagate $ liftIO $ putStrLn "SubscriberCoincidenceOuter"
578+ when debugPropagate $ liftIO $ putStrLn $ "SubscriberCoincidenceOuter" <> showNodeId subscribed
500579 outerHeight <- liftIO $ readIORef $ coincidenceSubscribedHeight subscribed
501580 when debugPropagate $ liftIO $ putStrLn $ " outerHeight = " <> show outerHeight
502581 (occ, innerHeight, innerSubd) <- subscribeCoincidenceInner a outerHeight subscribed
@@ -515,7 +594,7 @@ propagate a subscribers = do
515594 scheduleClear $ coincidenceSubscribedOccurrence subscribed
516595 liftIO . writeIORef (coincidenceSubscribedSubscribers subscribed) =<< propagate o =<< liftIO (readIORef (coincidenceSubscribedSubscribers subscribed))
517596 SubscriberCoincidenceInner subscribed -> do
518− when debugPropagate $ liftIO $ putStrLn "SubscriberCoincidenceInner"
597+ when debugPropagate $ liftIO $ putStrLn $ "SubscriberCoincidenceInner" <> showNodeId subscribed
519598 liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) $ Just a
520599 scheduleClear $ coincidenceSubscribedOccurrence subscribed
521600 liftIO . writeIORef (coincidenceSubscribedSubscribers subscribed) =<< propagate a =<< liftIO (readIORef (coincidenceSubscribedSubscribers subscribed))
@@ -705,17 +784,17 @@ getRootSubscribed r = do
705784
706785-- When getPushSubscribed returns, the PushSubscribed returned will have a fully filled-in
707786getPushSubscribed :: Push a b -> EventM (PushSubscribed a b)
708−getPushSubscribed (Push compute parent subscribedRef) = do
709− mSubscribed <- liftIO $ readIORef subscribedRef
787+getPushSubscribed p = do
788+ mSubscribed <- liftIO $ readIORef $ pushSubscribed p
710789 case mSubscribed of
711790 Just subscribed -> return subscribed
712791 Nothing -> do -- Not yet subscribed
713− subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ liftM fromJust $ readIORef subscribedRef
714− let !s = SubscriberPush compute subscribedUnsafe
792+ subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ liftM fromJust $ readIORef $ pushSubscribed p
793+ let !s = SubscriberPush (pushCompute p) subscribedUnsafe
715794 ws <- liftIO $ mkWeakPtrWithDebug s "SubscriberPush"
716− subd <- subscribe parent $ WeakSubscriberSimple ws
795+ subd <- subscribe (pushParent p) $ WeakSubscriberSimple ws
717796 parentOcc <- liftIO $ getEventSubscribedOcc subd
718− occ <- liftM join $ mapM compute parentOcc
797+ occ <- liftM join $ mapM (pushCompute p) parentOcc
719798 occRef <- liftIO $ newIORef occ
720799 when (isJust occ) $ scheduleClear occRef
721800 subscribersRef <- liftIO $ newIORef []
@@ -725,8 +804,11 @@ getPushSubscribed (Push compute parent subscribedRef) = do
725804 , pushSubscribedSubscribers = subscribersRef
726805 , pushSubscribedSelf = unsafeCoerce s
727806 , pushSubscribedParent = subd
807+#ifdef DEBUG_NODEIDS
808+ , pushSubscribedNodeId = unsafeNodeId p
809+#endif
728810 }
729− liftIO $ writeIORef subscribedRef $ Just subscribed
811+ liftIO $ writeIORef (pushSubscribed p) $ Just subscribed
730812 return subscribed
731813
732814getMergeSubscribed :: forall k. GCompare k => Merge k -> EventM (MergeSubscribed k)
@@ -768,6 +850,9 @@ getMergeSubscribed m = {-# SCC "getMergeSubscribed.entire" #-} do
768850 , mergeSubscribedSubscribers = subsRef
769851 , mergeSubscribedSelf = unsafeCoerce $ map (\(x, _, _, _) -> x) subscribers --TODO: Does lack of strictness make this leak?
770852 , mergeSubscribedParents = DMap.fromDistinctAscList $ map (^._4) subscribers
853+#ifdef DEBUG_NODEIDS
854+ , mergeSubscribedNodeId = unsafeNodeId m
855+#endif
771856 }
772857 liftIO $ writeIORef subscribedRef subscribed
773858 return subscribed
@@ -782,6 +867,9 @@ getMergeSubscribed m = {-# SCC "getMergeSubscribed.entire" #-} do
782867 , mergeSubscribedSubscribers = subsRef --TODO: This will definitely leak
783868 , mergeSubscribedSelf = unsafeCoerce ()
784869 , mergeSubscribedParents = DMap.empty
870+#ifdef DEBUG_NODEIDS
871+ , mergeSubscribedNodeId = -1
872+#endif
785873 }
786874
787875getFanSubscribed :: GCompare k => Fan k -> EventM (FanSubscribed k)
@@ -799,6 +887,9 @@ getFanSubscribed f = do
799887 { fanSubscribedParent = subd
800888 , fanSubscribedSubscribers = subscribersRef
801889 , fanSubscribedSelf = sub
890+#ifdef DEBUG_NODEIDS
891+ , fanSubscribedNodeId = unsafeNodeId f
892+#endif
802893 }
803894 liftIO $ writeIORef (fanSubscribed f) $ Just subscribed
804895 return subscribed
@@ -837,6 +928,9 @@ getSwitchSubscribed s = do
837928 , switchSubscribedBehaviorParents = parentsRef
838929 , switchSubscribedParent = switchParent s
839930 , switchSubscribedCurrentParent = subdRef
931+#ifdef DEBUG_NODEIDS
932+ , switchSubscribedNodeId = unsafeNodeId s
933+#endif
840934 }
841935 liftIO $ writeIORef subscribedRef subscribed
842936 liftIO $ writeIORef (switchSubscribed s) $ Just subscribed
@@ -873,6 +967,9 @@ getCoincidenceSubscribed c = do
873967 , coincidenceSubscribedOuter = subOuter
874968 , coincidenceSubscribedOuterParent = outerSubd
875969 , coincidenceSubscribedInnerParent = innerSubdRef
970+#ifdef DEBUG_NODEIDS
971+ , coincidenceSubscribedNodeId = unsafeNodeId c
972+#endif
876973 }
877974 liftIO $ writeIORef subscribedRef subscribed
878975 liftIO $ writeIORef (coincidenceSubscribed c) $ Just subscribed
@@ -958,9 +1055,6 @@ runFrame a = do
9581055 mapM_ recalculateSubscriberHeight =<< readIORef (switchSubscribedSubscribers subscribed)
9591056 return result
9601057
961−debugInvalidateHeight :: Bool
962−debugInvalidateHeight = False
963−
9641058invalidHeight :: Int
9651059invalidHeight = -1000
9661060
@@ -971,31 +1065,37 @@ invalidateSubscriberHeight ws = do
9711065 Nothing -> return () --TODO: cleanup?
9721066 Just s -> case s of
9731067 SubscriberPush _ subscribed -> do
974− when debugInvalidateHeight $ putStrLn "invalidateSubscriberHeight: SubsciberPush"
1068+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberPush" <> showNodeId subscribed
9751069 mapM_ invalidateSubscriberHeight =<< readIORef (pushSubscribedSubscribers subscribed)
1070+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberPush" <> showNodeId subscribed <> " done"
9761071 SubscriberMerge _ subscribed -> do
977− when debugInvalidateHeight $ putStrLn "invalidateSubscriberHeight: SubsciberMerge"
1072+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberMerge" <> showNodeId subscribed
9781073 oldHeight <- readIORef $ mergeSubscribedHeight subscribed
9791074 when (oldHeight /= invalidHeight) $ do
9801075 writeIORef (mergeSubscribedHeight subscribed) $ invalidHeight
9811076 mapM_ invalidateSubscriberHeight =<< readIORef (mergeSubscribedSubscribers subscribed)
1077+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberMerge" <> showNodeId subscribed <> " done"
9821078 SubscriberFan subscribed -> do
983− when debugInvalidateHeight $ putStrLn "invalidateSubscriberHeight: SubsciberFan"
1079+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
9841080 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
9851081 forM_ (DMap.toList subscribers) $ ((\(FanSubscriberKey _ :=> v) -> mapM_ invalidateSubscriberHeight v) :: DSum (FanSubscriberKey k) -> IO ())
1082+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
9861083 SubscriberHold _ -> return ()
9871084 SubscriberSwitch subscribed -> do
988− when debugInvalidateHeight $ putStrLn "invalidateSubscriberHeight: SubsciberSwitch"
1085+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed
9891086 oldHeight <- readIORef $ switchSubscribedHeight subscribed
9901087 when (oldHeight /= invalidHeight) $ do
9911088 writeIORef (switchSubscribedHeight subscribed) $ invalidHeight
9921089 mapM_ invalidateSubscriberHeight =<< readIORef (switchSubscribedSubscribers subscribed)
1090+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed <> " done"
9931091 SubscriberCoincidenceOuter subscribed -> do
994− when debugInvalidateHeight $ putStrLn "invalidateSubscriberHeight: SubsciberCoincidenceOuter"
1092+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberCoincidenceOuter" <> showNodeId subscribed
9951093 invalidateCoincidenceHeight subscribed
1094+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberCoincidenceOuter" <> showNodeId subscribed <> " done"
9961095 SubscriberCoincidenceInner subscribed -> do
997− when debugInvalidateHeight $ putStrLn "invalidateSubscriberHeight: SubsciberCoincidenceInner"
1096+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed
9981097 invalidateCoincidenceHeight subscribed
1098+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed <> " done"
9991099
10001100invalidateCoincidenceHeight :: CoincidenceSubscribed a -> IO ()
10011101invalidateCoincidenceHeight subscribed = do
@@ -1013,27 +1113,42 @@ recalculateSubscriberHeight ws = do
10131113 Nothing -> return () --TODO: cleanup?
10141114 Just s -> case s of
10151115 SubscriberPush _ subscribed -> do
1116+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberPush" <> showNodeId subscribed
10161117 mapM_ recalculateSubscriberHeight =<< readIORef (pushSubscribedSubscribers subscribed)
1118+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberPush" <> showNodeId subscribed <> " done"
10171119 SubscriberMerge _ subscribed -> do
1120+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberMerge" <> showNodeId subscribed
10181121 oldHeight <- readIORef $ mergeSubscribedHeight subscribed
10191122 when (oldHeight == invalidHeight) $ do
10201123 height <- calculateMergeHeight subscribed
1124+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: height: " <> show height
10211125 when (height /= invalidHeight) $ do -- If height == invalidHeight, that means some of the prereqs have not yet been recomputed; when they do recompute, they'll catch this node again --TODO: this is O(n*m), where n is the number of children of this noe and m is the number that have been invalidated
10221126 writeIORef (mergeSubscribedHeight subscribed) height
10231127 mapM_ recalculateSubscriberHeight =<< readIORef (mergeSubscribedSubscribers subscribed)
1128+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberMerge" <> showNodeId subscribed <> " done"
10241129 SubscriberFan subscribed -> do
1130+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
10251131 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
10261132 forM_ (DMap.toList subscribers) $ ((\(FanSubscriberKey _ :=> v) -> mapM_ recalculateSubscriberHeight v) :: DSum (FanSubscriberKey k) -> IO ())
1133+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
10271134 SubscriberHold _ -> return ()
10281135 SubscriberSwitch subscribed -> do
1136+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed
10291137 oldHeight <- readIORef $ switchSubscribedHeight subscribed
10301138 when (oldHeight == invalidHeight) $ do
10311139 height <- calculateSwitchHeight subscribed
10321140 when (height /= invalidHeight) $ do
10331141 writeIORef (switchSubscribedHeight subscribed) height
10341142 mapM_ recalculateSubscriberHeight =<< readIORef (switchSubscribedSubscribers subscribed)
1035− SubscriberCoincidenceOuter subscribed -> void $ recalculateCoincidenceHeight subscribed
1036− SubscriberCoincidenceInner subscribed -> void $ recalculateCoincidenceHeight subscribed
1143+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed <> " done"
1144+ SubscriberCoincidenceOuter subscribed -> do
1145+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberCoincidenceOuter" <> showNodeId subscribed
1146+ void $ recalculateCoincidenceHeight subscribed
1147+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberCoincidenceOuter" <> showNodeId subscribed <> " done"
1148+ SubscriberCoincidenceInner subscribed -> do
1149+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed
1150+ void $ recalculateCoincidenceHeight subscribed
1151+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed <> " done"
10371152
10381153recalculateCoincidenceHeight :: CoincidenceSubscribed a -> IO ()
10391154recalculateCoincidenceHeight subscribed = do