@@ -884,10 +884,7 @@ instance Defer (SomeHoldInit x) (ComputeM x) where
884runComputeM :: Defer (SomeHoldInit x) m => ComputeM x a -> m a
884runComputeM :: Defer (SomeHoldInit x) m => ComputeM x a -> m a
885runComputeM (ComputeM a) = liftIO . runReaderT a =<< getDeferralQueue
885runComputeM (ComputeM a) = liftIO . runReaderT a =<< getDeferralQueue
887−data MergeSubscribedParent (x :: *) (k :: * -> *) a = MergeSubscribedParent !(EventSubscription x) !(Subscriber x a)
887+newtype MergeSubscribedParent x a = MergeSubscribedParent { unMergeSubscribedParent :: EventSubscription x }
889−mergeSubscribedParentSubscription :: MergeSubscribedParent x k a -> EventSubscription x
890−mergeSubscribedParentSubscription (MergeSubscribedParent es _) = es
892data HeightBag = HeightBag
889data HeightBag = HeightBag
893 { _heightBag_size :: {-# UNPACK #-} !Int
890 { _heightBag_size :: {-# UNPACK #-} !Int
@@ -1553,11 +1550,11 @@ merge d = cacheEvent $ Event $ \sub -> do
1553 modifyIORef' heightBagRef $ heightBagAdd new
1550 modifyIORef' heightBagRef $ heightBagAdd new
1554 revalidateMyHeight
1551 revalidateMyHeight
1556− subscribers :: [(Maybe (DSum k Identity), Height, DSum k (MergeSubscribedParent x k))] <- forM (DMap.toList initialParents) $ \(k :=> e) -> do
1553+ subscribers :: [(Maybe (DSum k Identity), Height, DSum k (MergeSubscribedParent x))] <- forM (DMap.toList initialParents) $ \(k :=> e) -> do
1557 let s = subscriber k
1554 let s = subscriber k
1558 (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead e s
1555 (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead e s
1559 height <- liftIO $ getEventSubscribedHeight parentSubd
1556 height <- liftIO $ getEventSubscribedHeight parentSubd
1560− return $ (fmap (\x -> k :=> Identity x) parentOcc, height, k :=> MergeSubscribedParent subscription s)
1557+ return $ (fmap (\x -> k :=> Identity x) parentOcc, height, k :=> MergeSubscribedParent subscription)
1561 let dm = DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers
1558 let dm = DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers
1562 heights = fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here
1559 heights = fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here
1563 myHeightBag = heightBagFromList $ filter (/= invalidHeight) heights
1560 myHeightBag = heightBagFromList $ filter (/= invalidHeight) heights
@@ -1586,13 +1583,13 @@ merge d = cacheEvent $ Event $ \sub -> do
1586 let s = subscriber k
1583 let s = subscriber k
1587 subscription@(EventSubscription _ subd) <- subscribe e s
1584 subscription@(EventSubscription _ subd) <- subscribe e s
1588 newParentHeight <- liftIO $ getEventSubscribedHeight subd
1585 newParentHeight <- liftIO $ getEventSubscribedHeight subd
1589− let newParent = MergeSubscribedParent subscription s
1586+ let newParent = MergeSubscribedParent subscription
1590 liftIO $ modifyIORef' heightBagRef $ heightBagAdd newParentHeight
1587 liftIO $ modifyIORef' heightBagRef $ heightBagAdd newParentHeight
1591 return $ DMap.insertLookupWithKey' (\_ new _ -> new) k newParent ps
1588 return $ DMap.insertLookupWithKey' (\_ new _ -> new) k newParent ps
1592 forM_ mOldSubd $ \oldSubd -> do
1589 forM_ mOldSubd $ \oldSubd -> do
1593− oldHeight <- liftIO $ getEventSubscribedHeight $ _eventSubscription_subscribed $ mergeSubscribedParentSubscription oldSubd
1590+ oldHeight <- liftIO $ getEventSubscribedHeight $ _eventSubscription_subscribed $ unMergeSubscribedParent oldSubd
1594 liftIO $ modifyIORef heightBagRef $ heightBagRemove oldHeight
1591 liftIO $ modifyIORef heightBagRef $ heightBagRemove oldHeight
1595− return (maybeToList (mergeSubscribedParentSubscription <$> mOldSubd) ++ subscriptionsToKill, newPs)
1592+ return (maybeToList (unMergeSubscribedParent <$> mOldSubd) ++ subscriptionsToKill, newPs)
1596 (subscriptionsToKill, newParents) <- foldM f ([], oldParents) $ DMap.toList p --TODO: I think this runEventM is OK, since no events are firing at this time, but it might not be
1593 (subscriptionsToKill, newParents) <- foldM f ([], oldParents) $ DMap.toList p --TODO: I think this runEventM is OK, since no events are firing at this time, but it might not be
1597 liftIO $ writeIORef parentsRef $! newParents
1594 liftIO $ writeIORef parentsRef $! newParents
1598 return subscriptionsToKill
1595 return subscriptionsToKill
@@ -1609,7 +1606,7 @@ merge d = cacheEvent $ Event $ \sub -> do
1609 liftIO $ writeIORef changeSubdRef (s, changeSubd)
1606 liftIO $ writeIORef changeSubdRef (s, changeSubd)
1610 let unsubscribeAll = do
1607 let unsubscribeAll = do
1611 parents <- readIORef parentsRef
1608 parents <- readIORef parentsRef
1612− forM_ (DMap.toList parents) $ \(_ :=> MergeSubscribedParent s _) -> unsubscribe s
1609+ forM_ (DMap.toList parents) $ \(_ :=> MergeSubscribedParent s) -> unsubscribe s
1613 return ( EventSubscription unsubscribeAll $ EventSubscribed heightRef $ toAny (parentsRef, changeSubdRef)
1610 return ( EventSubscription unsubscribeAll $ EventSubscribed heightRef $ toAny (parentsRef, changeSubdRef)