From b60a473a5ba139dbd4205a1fbc5bffa1f343f2aa Mon Sep 17 00:00:00 2001 From: Alexandre Esteves Date: Mon, 29 Aug 2022 01:56:17 +0100 Subject: [PATCH 1/2] Remove redundant MonadFix constraint --- src/Reflex/DynamicWriter/Base.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Reflex/DynamicWriter/Base.hs b/src/Reflex/DynamicWriter/Base.hs index 6c2292af..4c3495d9 100644 --- a/src/Reflex/DynamicWriter/Base.hs +++ b/src/Reflex/DynamicWriter/Base.hs @@ -125,7 +125,7 @@ instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (DynamicWrit -- | Run a 'DynamicWriterT' action. The dynamic writer output will be provided -- along with the result of the action. -runDynamicWriterT :: (MonadFix m, Reflex t, Monoid w) => DynamicWriterT t w m a -> m (a, Dynamic t w) +runDynamicWriterT :: (Monad m, Reflex t, Monoid w) => DynamicWriterT t w m a -> m (a, Dynamic t w) runDynamicWriterT (DynamicWriterT a) = do (result, ws) <- runStateT a [] return (result, mconcat $ reverse ws) @@ -164,7 +164,7 @@ newtype DynamicWriterTLoweredResult t w v a = DynamicWriterTLoweredResult (v a, -- | When the execution of a 'DynamicWriterT' action is adjusted using -- 'Adjustable', the 'Dynamic' output of that action will also be updated to -- match. -instance (Adjustable t m, MonadFix m, Monoid w, MonadHold t m, Reflex t) => Adjustable t (DynamicWriterT t w m) where +instance (Adjustable t m, Monoid w, MonadHold t m, Reflex t) => Adjustable t (DynamicWriterT t w m) where runWithReplace a0 a' = do (result0, result') <- lift $ runWithReplace (runDynamicWriterT a0) $ runDynamicWriterT <$> a' tellDyn . join =<< holdDyn (snd result0) (snd <$> result') @@ -173,7 +173,7 @@ instance (Adjustable t m, MonadFix m, Monoid w, MonadHold t m, Reflex t) => Adju traverseDMapWithKeyWithAdjust = traverseDMapWithKeyWithAdjustImpl traverseDMapWithKeyWithAdjust mapPatchDMap weakenPatchDMapWith mergeDynIncremental traverseDMapWithKeyWithAdjustWithMove = traverseDMapWithKeyWithAdjustImpl traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove weakenPatchDMapWithMoveWith mergeDynIncrementalWithMove -traverseDMapWithKeyWithAdjustImpl :: forall t w k v' p p' v m. (PatchTarget (p' (Some k) (Dynamic t w)) ~ Map (Some k) (Dynamic t w), PatchTarget (p' (Some k) w) ~ Map (Some k) w, Patch (p' (Some k) w), Patch (p' (Some k) (Dynamic t w)), MonadFix m, Monoid w, Reflex t, MonadHold t m) +traverseDMapWithKeyWithAdjustImpl :: forall t w k v' p p' v m. (PatchTarget (p' (Some k) (Dynamic t w)) ~ Map (Some k) (Dynamic t w), PatchTarget (p' (Some k) w) ~ Map (Some k) w, Patch (p' (Some k) w), Patch (p' (Some k) (Dynamic t w)), Monoid w, Reflex t, MonadHold t m) => ( (forall a. k a -> v a -> m (DynamicWriterTLoweredResult t w v' a)) -> DMap k v -> Event t (p k v) @@ -200,7 +200,7 @@ traverseDMapWithKeyWithAdjustImpl base mapPatch weakenPatchWith mergeMyDynIncrem tellDyn $ fmap (mconcat . Map.elems) $ incrementalToDynamic $ mergeMyDynIncremental i return (liftedResult0, liftedResult') -traverseIntMapWithKeyWithAdjustImpl :: forall t w v' p p' v m. (PatchTarget (p' (Dynamic t w)) ~ IntMap (Dynamic t w), PatchTarget (p' w) ~ IntMap w, Patch (p' w), Patch (p' (Dynamic t w)), MonadFix m, Monoid w, Reflex t, MonadHold t m, Functor p, p ~ p') +traverseIntMapWithKeyWithAdjustImpl :: forall t w v' p p' v m. (PatchTarget (p' (Dynamic t w)) ~ IntMap (Dynamic t w), PatchTarget (p' w) ~ IntMap w, Patch (p' w), Patch (p' (Dynamic t w)), Monoid w, Reflex t, MonadHold t m, Functor p, p ~ p') => ( (IntMap.Key -> v -> m (v', Dynamic t w)) -> IntMap v -> Event t (p v) @@ -224,7 +224,7 @@ traverseIntMapWithKeyWithAdjustImpl base mergeMyDynIncremental f (dm0 :: IntMap return (liftedResult0, liftedResult') -- | Map a function over the output of a 'DynamicWriterT'. -withDynamicWriterT :: (Monoid w, Monoid w', Reflex t, MonadHold t m, MonadFix m) +withDynamicWriterT :: (Monoid w, Monoid w', Reflex t, MonadHold t m) => (w -> w') -> DynamicWriterT t w m a -> DynamicWriterT t w' m a From c9ccc2a3228621826eaeb7df20031ca9543a7997 Mon Sep 17 00:00:00 2001 From: Alexandre Esteves Date: Thu, 1 Sep 2022 02:06:07 +0100 Subject: [PATCH 2/2] Remove redundant HasSpiderTimeLine constraint --- src/Reflex/Spider/Internal.hs | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/Reflex/Spider/Internal.hs b/src/Reflex/Spider/Internal.hs index affeee9f..d562c41a 100644 --- a/src/Reflex/Spider/Internal.hs +++ b/src/Reflex/Spider/Internal.hs @@ -261,7 +261,7 @@ subscribeAndRead = unEvent -- caching; if the computation function is very cheap, this is (much) more -- efficient than 'push' {-# INLINE [1] pushCheap #-} -pushCheap :: HasSpiderTimeline x => (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b +pushCheap :: (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b pushCheap !f e = Event $ \sub -> do (subscription, occ) <- subscribeAndRead e $ debugSubscriber' "push" $ sub { subscriberPropagate = \a -> do @@ -282,7 +282,7 @@ terminalSubscriber p = Subscriber -- | Subscribe to an Event only for the duration of one occurrence {-# INLINE subscribeAndReadHead #-} -subscribeAndReadHead :: HasSpiderTimeline x => Event x a -> Subscriber x a -> EventM x (EventSubscription x, Maybe a) +subscribeAndReadHead :: Event x a -> Subscriber x a -> EventM x (EventSubscription x, Maybe a) subscribeAndReadHead e sub = do subscriptionRef <- liftIO $ newIORef $ error "subscribeAndReadHead: not initialized" (subscription, occ) <- subscribeAndRead e $ debugSubscriber' "head" $ sub @@ -296,7 +296,7 @@ subscribeAndReadHead e sub = do return (subscription, occ) --TODO: Make this lazy in its input event -headE :: (MonadIO m, Defer (SomeMergeInit x) m, HasSpiderTimeline x) => Event x a -> m (Event x a) +headE :: (MonadIO m, Defer (SomeMergeInit x) m) => Event x a -> m (Event x a) headE originalE = do parent <- liftIO $ newIORef $ Just originalE defer $ SomeMergeInit $ do --TODO: Rename SomeMergeInit appropriately @@ -321,8 +321,7 @@ nowSpiderEventM :: (HasSpiderTimeline x) => EventM x (R.Event (SpiderTimeline x) nowSpiderEventM = SpiderEvent <$> now -now :: (MonadIO m, Defer (Some Clear) m, HasSpiderTimeline x - ) => m (Event x ()) +now :: (MonadIO m, Defer (Some Clear) m) => m (Event x ()) now = do nowOrNot <- liftIO $ newIORef $ Just () scheduleClear nowOrNot @@ -561,14 +560,14 @@ recalculateSubscriberHeight :: Height -> Subscriber x a -> IO () recalculateSubscriberHeight = flip subscriberRecalculateHeight -- | Propagate everything at the current height -propagate :: forall x a. HasSpiderTimeline x => a -> WeakBag (Subscriber x a) -> EventM x () +propagate :: forall x a. a -> WeakBag (Subscriber x a) -> EventM x () propagate a subscribers = withIncreasedDepth (Proxy::Proxy x) $ -- 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 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work WeakBag.traverse_ subscribers $ \s -> subscriberPropagate s a -- | Propagate everything at the current height -propagateFast :: forall x a. HasSpiderTimeline x => a -> FastWeakBag (Subscriber x a) -> EventM x () +propagateFast :: forall x a. a -> FastWeakBag (Subscriber x a) -> EventM x () propagateFast a subscribers = withIncreasedDepth (Proxy::Proxy x) $ -- 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 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work @@ -2059,7 +2058,7 @@ scheduleMergeSelf m height = scheduleMerge' height (_merge_heightRef m) $ do --TODO: Assert that m is not empty subscriberPropagate (_merge_sub m) vals -checkCycle :: HasSpiderTimeline x => EventSubscribed x -> EventM x () +checkCycle :: EventSubscribed x -> EventM x () checkCycle subscribed = liftIO $ do height <- readIORef (eventSubscribedHeightRef subscribed) @@ -2614,7 +2613,7 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide headE e = runFrame . runSpiderHostFrame $ Reflex.Class.headE e {-# INLINABLE now #-} now = runFrame . runSpiderHostFrame $ Reflex.Class.now - + instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where sample = SpiderHostFrame . readBehaviorUntracked . unSpiderBehavior --TODO: This can cause problems with laziness, so we should get rid of it if we can