propagate :: a -> [WeakSubscriber a] -> EventM [WeakSubscriber a]
propagate a subscribers = do
  traverseAndCleanWeakList_ (liftIO . deRefWeakSubscriber) subscribers $ \s -> case s of
    SubscriberPush compute subscribed -> do
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberPush" <> showNodeId subscribed
      occ <- compute a
      case occ of
        Nothing -> return () -- No need to write a Nothing back into the Ref
        Just o -> do
          liftIO $ writeIORef (pushSubscribedOccurrence subscribed) occ
          scheduleClear $ pushSubscribedOccurrence subscribed
          liftIO . writeIORef (pushSubscribedSubscribers subscribed) =<< propagate o =<< liftIO (readIORef (pushSubscribedSubscribers subscribed))
    SubscriberMerge k subscribed -> do
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberMerge" <> showNodeId subscribed
      oldM <- liftIO $ readIORef $ mergeSubscribedAccum subscribed
      liftIO $ writeIORef (mergeSubscribedAccum subscribed) $ DMap.insertWith (error "Same key fired multiple times for") k a oldM
      when (DMap.null oldM) $ do -- Only schedule the firing once
        height <- liftIO $ readIORef $ mergeSubscribedHeight subscribed
        --TODO: assertions about height
        currentHeight <- getCurrentHeight
        when (height <= currentHeight) $ error $ "Height (" ++ show height ++ ") is not greater than current height (" ++ show currentHeight ++ ")"
        scheduleMerge height subscribed
    SubscriberFan subscribed -> do
      subs <- liftIO $ readIORef $ fanSubscribedSubscribers subscribed
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberFan" <> showNodeId subscribed <> ": " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"
      --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
      forM_ (DMap.toList a) $ \(k :=> v) -> case DMap.lookup (FanSubscriberKey k) subs of
        Nothing -> do
          when debugPropagate $ liftIO $ putStrLn "No subscriber for key"
          return ()
        Just subsubs -> do
          _ <- propagate v subsubs --TODO: use the value of this
          return ()
      --TODO: The following is way too slow to do all the time
      subs' <- liftIO $ forM (DMap.toList subs) $ ((\(FanSubscriberKey k :=> subsubs) -> do
        subsubs' <- traverseAndCleanWeakList_ (liftIO . deRefWeakSubscriber) subsubs (const $ return ())
        return $ if null subsubs' then Nothing else Just $ FanSubscriberKey k :=> subsubs') :: DSum (FanSubscriberKey k) -> IO (Maybe (DSum (FanSubscriberKey k))))
      liftIO $ writeIORef (fanSubscribedSubscribers subscribed) $ DMap.fromDistinctAscList $ catMaybes subs'
    SubscriberHold h -> do
      invalidators <- liftIO $ readIORef $ holdInvalidators h
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberHold" <> showNodeId h <> ": " ++ show (length invalidators)
      toAssignRef <- askToAssignRef
      liftIO $ modifyIORef' toAssignRef (SomeAssignment h a :)
    SubscriberSwitch subscribed -> do
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberSwitch" <> showNodeId subscribed
      liftIO $ writeIORef (switchSubscribedOccurrence subscribed) $ Just a
      scheduleClear $ switchSubscribedOccurrence subscribed
      subs <- liftIO $ readIORef $ switchSubscribedSubscribers subscribed
      liftIO . writeIORef (switchSubscribedSubscribers subscribed) =<< propagate a subs
    SubscriberCoincidenceOuter subscribed -> do
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberCoincidenceOuter" <> showNodeId subscribed
      outerHeight <- liftIO $ readIORef $ coincidenceSubscribedHeight subscribed
      when debugPropagate $ liftIO $ putStrLn $ "  outerHeight = " <> show outerHeight
      (occ, innerHeight, innerSubd) <- subscribeCoincidenceInner a outerHeight subscribed
      when debugPropagate $ liftIO $ putStrLn $ "  isJust occ = " <> show (isJust occ)
      when debugPropagate $ liftIO $ putStrLn $ "  innerHeight = " <> show innerHeight
      liftIO $ writeIORef (coincidenceSubscribedInnerParent subscribed) $ Just innerSubd
      scheduleClear $ coincidenceSubscribedInnerParent subscribed
      case occ of
        Nothing -> do
          when (innerHeight > outerHeight) $ liftIO $ do -- If the event fires, it will fire at a later height
            writeIORef (coincidenceSubscribedHeight subscribed) innerHeight
            mapM_ invalidateSubscriberHeight =<< readIORef (coincidenceSubscribedSubscribers subscribed)
            mapM_ recalculateSubscriberHeight =<< readIORef (coincidenceSubscribedSubscribers subscribed)
        Just o -> do -- Since it's already firing, no need to adjust height
          liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) occ
          scheduleClear $ coincidenceSubscribedOccurrence subscribed
          liftIO . writeIORef (coincidenceSubscribedSubscribers subscribed) =<< propagate o =<< liftIO (readIORef (coincidenceSubscribedSubscribers subscribed))
    SubscriberCoincidenceInner subscribed -> do
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberCoincidenceInner" <> showNodeId subscribed
      liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) $ Just a
      scheduleClear $ coincidenceSubscribedOccurrence subscribed
      liftIO . writeIORef (coincidenceSubscribedSubscribers subscribed) =<< propagate a =<< liftIO (readIORef (coincidenceSubscribedSubscribers subscribed))
propagate :: a -> [WeakSubscriber a] -> EventM [WeakSubscriber a]
propagate a subscribers = do
  traverseAndCleanWeakList_ (liftIO . deRefWeakSubscriber) subscribers $ \s -> case s of
    SubscriberPush compute subscribed -> do
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberPush" <> showNodeId subscribed
      occ <- compute a
      case occ of
        Nothing -> return () -- No need to write a Nothing back into the Ref
        Just o -> do
          liftIO $ writeIORef (pushSubscribedOccurrence subscribed) occ
          scheduleClear $ pushSubscribedOccurrence subscribed
          liftIO . writeIORef (pushSubscribedSubscribers subscribed) =<< propagate o =<< liftIO (readIORef (pushSubscribedSubscribers subscribed))
    SubscriberMerge k subscribed -> do
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberMerge" <> showNodeId subscribed
      oldM <- liftIO $ readIORef $ mergeSubscribedAccum subscribed
      liftIO $ writeIORef (mergeSubscribedAccum subscribed) $ DMap.insertWith (error "Same key fired multiple times for") k a oldM
      when (DMap.null oldM) $ do -- Only schedule the firing once
        height <- liftIO $ readIORef $ mergeSubscribedHeight subscribed
        --TODO: assertions about height
        currentHeight <- getCurrentHeight
        when (height <= currentHeight) $ error $ "Height (" ++ show height ++ ") is not greater than current height (" ++ show currentHeight ++ ")"
        scheduleMerge height subscribed
    SubscriberFan subscribed -> do
      subs <- liftIO $ readIORef $ fanSubscribedSubscribers subscribed
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberFan" <> showNodeId subscribed <> ": " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"
      --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
      forM_ (DMap.toList a) $ \(k :=> v) -> case DMap.lookup (FanSubscriberKey k) subs of
        Nothing -> do
          when debugPropagate $ liftIO $ putStrLn "No subscriber for key"
          return ()
        Just subsubs -> do
          _ <- propagate v subsubs --TODO: use the value of this
          return ()
      --TODO: The following is way too slow to do all the time
      subs' <- liftIO $ forM (DMap.toList subs) $ ((\(FanSubscriberKey k :=> subsubs) -> do
        subsubs' <- traverseAndCleanWeakList_ (liftIO . deRefWeakSubscriber) subsubs (const $ return ())
        return $ if null subsubs' then Nothing else Just $ FanSubscriberKey k :=> subsubs') :: DSum (FanSubscriberKey k) -> IO (Maybe (DSum (FanSubscriberKey k))))
      liftIO $ writeIORef (fanSubscribedSubscribers subscribed) $ DMap.fromDistinctAscList $ catMaybes subs'
    SubscriberHold h -> do
      invalidators <- liftIO $ readIORef $ holdInvalidators h
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberHold" <> showNodeId h <> ": " ++ show (length invalidators)
      toAssignRef <- askToAssignRef
      liftIO $ modifyIORef' toAssignRef (SomeAssignment h a :)
    SubscriberSwitch subscribed -> do
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberSwitch" <> showNodeId subscribed
      liftIO $ writeIORef (switchSubscribedOccurrence subscribed) $ Just a
      scheduleClear $ switchSubscribedOccurrence subscribed
      subs <- liftIO $ readIORef $ switchSubscribedSubscribers subscribed
      liftIO . writeIORef (switchSubscribedSubscribers subscribed) =<< propagate a subs
    SubscriberCoincidenceOuter subscribed -> do
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberCoincidenceOuter" <> showNodeId subscribed
      outerHeight <- liftIO $ readIORef $ coincidenceSubscribedHeight subscribed
      when debugPropagate $ liftIO $ putStrLn $ "  outerHeight = " <> show outerHeight
      (occ, innerHeight, innerSubd) <- subscribeCoincidenceInner a outerHeight subscribed
      when debugPropagate $ liftIO $ putStrLn $ "  isJust occ = " <> show (isJust occ)
      when debugPropagate $ liftIO $ putStrLn $ "  innerHeight = " <> show innerHeight
      liftIO $ writeIORef (coincidenceSubscribedInnerParent subscribed) $ Just innerSubd
      scheduleClear $ coincidenceSubscribedInnerParent subscribed
      case occ of
        Nothing -> do
          when (innerHeight > outerHeight) $ liftIO $ do -- If the event fires, it will fire at a later height
            writeIORef (coincidenceSubscribedHeight subscribed) innerHeight
            mapM_ invalidateSubscriberHeight =<< readIORef (coincidenceSubscribedSubscribers subscribed)
            mapM_ recalculateSubscriberHeight =<< readIORef (coincidenceSubscribedSubscribers subscribed)
        Just o -> do -- Since it's already firing, no need to adjust height
          liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) occ
          scheduleClear $ coincidenceSubscribedOccurrence subscribed
          liftIO . writeIORef (coincidenceSubscribedSubscribers subscribed) =<< propagate o =<< liftIO (readIORef (coincidenceSubscribedSubscribers subscribed))
    SubscriberCoincidenceInner subscribed -> do
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberCoincidenceInner" <> showNodeId subscribed
      liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) $ Just a
      scheduleClear $ coincidenceSubscribedOccurrence subscribed
      liftIO . writeIORef (coincidenceSubscribedSubscribers subscribed) =<< propagate a =<< liftIO (readIORef (coincidenceSubscribedSubscribers subscribed))
propagate a subscribers = do
  traverseAndCleanWeakList_ (liftIO . deRefWeakSubscriber) subscribers $ \s -> case s of
    SubscriberPush compute subscribed -> do
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberPush" <> showNodeId subscribed
      occ <- compute a
      case occ of
        Nothing -> return () -- No need to write a Nothing back into the Ref
        Just o -> do
          liftIO $ writeIORef (pushSubscribedOccurrence subscribed) occ
          scheduleClear $ pushSubscribedOccurrence subscribed
          liftIO . writeIORef (pushSubscribedSubscribers subscribed) =<< propagate o =<< liftIO (readIORef (pushSubscribedSubscribers subscribed))
    SubscriberMerge k subscribed -> do
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberMerge" <> showNodeId subscribed
      oldM <- liftIO $ readIORef $ mergeSubscribedAccum subscribed
      liftIO $ writeIORef (mergeSubscribedAccum subscribed) $ DMap.insertWith (error "Same key fired multiple times for") k a oldM
      when (DMap.null oldM) $ do -- Only schedule the firing once
        height <- liftIO $ readIORef $ mergeSubscribedHeight subscribed
        --TODO: assertions about height
        currentHeight <- getCurrentHeight
        when (height <= currentHeight) $ error $ "Height (" ++ show height ++ ") is not greater than current height (" ++ show currentHeight ++ ")"
        scheduleMerge height subscribed
    SubscriberFan subscribed -> do
      subs <- liftIO $ readIORef $ fanSubscribedSubscribers subscribed
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberFan" <> showNodeId subscribed <> ": " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"
      --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
      forM_ (DMap.toList a) $ \(k :=> v) -> case DMap.lookup (FanSubscriberKey k) subs of
        Nothing -> do
          when debugPropagate $ liftIO $ putStrLn "No subscriber for key"
          return ()
        Just subsubs -> do
          _ <- propagate v subsubs --TODO: use the value of this
          return ()
      --TODO: The following is way too slow to do all the time
      subs' <- liftIO $ forM (DMap.toList subs) $ ((\(FanSubscriberKey k :=> subsubs) -> do
        subsubs' <- traverseAndCleanWeakList_ (liftIO . deRefWeakSubscriber) subsubs (const $ return ())
        return $ if null subsubs' then Nothing else Just $ FanSubscriberKey k :=> subsubs') :: DSum (FanSubscriberKey k) -> IO (Maybe (DSum (FanSubscriberKey k))))
      liftIO $ writeIORef (fanSubscribedSubscribers subscribed) $ DMap.fromDistinctAscList $ catMaybes subs'
    SubscriberHold h -> do
      invalidators <- liftIO $ readIORef $ holdInvalidators h
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberHold" <> showNodeId h <> ": " ++ show (length invalidators)
      toAssignRef <- askToAssignRef
      liftIO $ modifyIORef' toAssignRef (SomeAssignment h a :)
    SubscriberSwitch subscribed -> do
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberSwitch" <> showNodeId subscribed
      liftIO $ writeIORef (switchSubscribedOccurrence subscribed) $ Just a
      scheduleClear $ switchSubscribedOccurrence subscribed
      subs <- liftIO $ readIORef $ switchSubscribedSubscribers subscribed
      liftIO . writeIORef (switchSubscribedSubscribers subscribed) =<< propagate a subs
    SubscriberCoincidenceOuter subscribed -> do
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberCoincidenceOuter" <> showNodeId subscribed
      outerHeight <- liftIO $ readIORef $ coincidenceSubscribedHeight subscribed
      when debugPropagate $ liftIO $ putStrLn $ "  outerHeight = " <> show outerHeight
      (occ, innerHeight, innerSubd) <- subscribeCoincidenceInner a outerHeight subscribed
      when debugPropagate $ liftIO $ putStrLn $ "  isJust occ = " <> show (isJust occ)
      when debugPropagate $ liftIO $ putStrLn $ "  innerHeight = " <> show innerHeight
      liftIO $ writeIORef (coincidenceSubscribedInnerParent subscribed) $ Just innerSubd
      scheduleClear $ coincidenceSubscribedInnerParent subscribed
      case occ of
        Nothing -> do
          when (innerHeight > outerHeight) $ liftIO $ do -- If the event fires, it will fire at a later height
            writeIORef (coincidenceSubscribedHeight subscribed) innerHeight
            mapM_ invalidateSubscriberHeight =<< readIORef (coincidenceSubscribedSubscribers subscribed)
            mapM_ recalculateSubscriberHeight =<< readIORef (coincidenceSubscribedSubscribers subscribed)
        Just o -> do -- Since it's already firing, no need to adjust height
          liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) occ
          scheduleClear $ coincidenceSubscribedOccurrence subscribed
          liftIO . writeIORef (coincidenceSubscribedSubscribers subscribed) =<< propagate o =<< liftIO (readIORef (coincidenceSubscribedSubscribers subscribed))
    SubscriberCoincidenceInner subscribed -> do
      when debugPropagate $ liftIO $ putStrLn $ "SubscriberCoincidenceInner" <> showNodeId subscribed
      liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) $ Just a
      scheduleClear $ coincidenceSubscribedOccurrence subscribed
      liftIO . writeIORef (coincidenceSubscribedSubscribers subscribed) =<< propagate a =<< liftIO (readIORef (coincidenceSubscribedSubscribers subscribed))