Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Remove redundant constraints #481

Merged
merged 2 commits into from
Nov 9, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 5 additions & 5 deletions src/Reflex/DynamicWriter/Base.hs
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@
import Control.Monad.Catch (MonadMask, MonadThrow, MonadCatch)
import Control.Monad.Exception
import Control.Monad.Fix
import Control.Monad.Identity

Check warning on line 26 in src/Reflex/DynamicWriter/Base.hs

View workflow job for this annotation

GitHub Actions / GHC 8.6.5 on ubuntu-latest

The import of ‘Control.Monad.Identity’ is redundant

Check warning on line 26 in src/Reflex/DynamicWriter/Base.hs

View workflow job for this annotation

GitHub Actions / GHC 8.6.5 on ubuntu-latest

The import of ‘Control.Monad.Identity’ is redundant

Check warning on line 26 in src/Reflex/DynamicWriter/Base.hs

View workflow job for this annotation

GitHub Actions / GHC 8.6.5 on macos-latest

The import of ‘Control.Monad.Identity’ is redundant

Check warning on line 26 in src/Reflex/DynamicWriter/Base.hs

View workflow job for this annotation

GitHub Actions / GHC 8.6.5 on macos-latest

The import of ‘Control.Monad.Identity’ is redundant

Check warning on line 26 in src/Reflex/DynamicWriter/Base.hs

View workflow job for this annotation

GitHub Actions / GHC 8.8.4 on ubuntu-latest

The import of ‘Control.Monad.Identity’ is redundant

Check warning on line 26 in src/Reflex/DynamicWriter/Base.hs

View workflow job for this annotation

GitHub Actions / GHC 8.8.4 on ubuntu-latest

The import of ‘Control.Monad.Identity’ is redundant

Check warning on line 26 in src/Reflex/DynamicWriter/Base.hs

View workflow job for this annotation

GitHub Actions / GHC 8.8.4 on macos-latest

The import of ‘Control.Monad.Identity’ is redundant

Check warning on line 26 in src/Reflex/DynamicWriter/Base.hs

View workflow job for this annotation

GitHub Actions / GHC 8.8.4 on macos-latest

The import of ‘Control.Monad.Identity’ is redundant

Check warning on line 26 in src/Reflex/DynamicWriter/Base.hs

View workflow job for this annotation

GitHub Actions / GHC 8.10.7 on ubuntu-latest

The import of ‘Control.Monad.Identity’ is redundant

Check warning on line 26 in src/Reflex/DynamicWriter/Base.hs

View workflow job for this annotation

GitHub Actions / GHC 8.10.7 on ubuntu-latest

The import of ‘Control.Monad.Identity’ is redundant

Check warning on line 26 in src/Reflex/DynamicWriter/Base.hs

View workflow job for this annotation

GitHub Actions / GHC 8.10.7 on macos-latest

The import of ‘Control.Monad.Identity’ is redundant

Check warning on line 26 in src/Reflex/DynamicWriter/Base.hs

View workflow job for this annotation

GitHub Actions / GHC 8.10.7 on macos-latest

The import of ‘Control.Monad.Identity’ is redundant

Check warning on line 26 in src/Reflex/DynamicWriter/Base.hs

View workflow job for this annotation

GitHub Actions / GHC 9.0.2 on ubuntu-latest

The import of ‘Control.Monad.Identity’ is redundant

Check warning on line 26 in src/Reflex/DynamicWriter/Base.hs

View workflow job for this annotation

GitHub Actions / GHC 9.0.2 on macos-latest

The import of ‘Control.Monad.Identity’ is redundant
import Control.Monad.IO.Class
import Control.Monad.Morph
import Control.Monad.Primitive
Expand Down Expand Up @@ -125,7 +125,7 @@

-- | 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)
Expand Down Expand Up @@ -164,7 +164,7 @@
-- | 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')
Expand All @@ -173,7 +173,7 @@
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)
Expand All @@ -200,7 +200,7 @@
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)
Expand All @@ -224,7 +224,7 @@
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
Expand Down
17 changes: 8 additions & 9 deletions src/Reflex/Spider/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -261,7 +261,7 @@
-- 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
Expand All @@ -282,7 +282,7 @@

-- | 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
Expand All @@ -296,7 +296,7 @@
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
Expand All @@ -321,8 +321,7 @@
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
Expand Down Expand Up @@ -561,14 +560,14 @@
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
Expand Down Expand Up @@ -2059,7 +2058,7 @@
--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)

Expand Down Expand Up @@ -2113,7 +2112,7 @@
{-# INLINE mergeGCheap' #-}
mergeGCheap' :: forall k v x p s q. (HasSpiderTimeline x, GCompare k, PatchTarget p ~ DMap k q)
=> MergeGetSubscription x s -> MergeInitFunc k v q x s -> MergeUpdateFunc k v x p s -> MergeDestroyFunc k s -> DynamicS x p -> Event x (DMap k v)
mergeGCheap' getParent getInitialSubscribers updateFunc destroy d = Event $ \sub -> do

Check warning on line 2115 in src/Reflex/Spider/Internal.hs

View workflow job for this annotation

GitHub Actions / GHC 8.6.5 on ubuntu-latest

Defined but not used: ‘getParent’

Check warning on line 2115 in src/Reflex/Spider/Internal.hs

View workflow job for this annotation

GitHub Actions / GHC 8.6.5 on macos-latest

Defined but not used: ‘getParent’

Check warning on line 2115 in src/Reflex/Spider/Internal.hs

View workflow job for this annotation

GitHub Actions / GHC 8.8.4 on ubuntu-latest

Defined but not used: ‘getParent’

Check warning on line 2115 in src/Reflex/Spider/Internal.hs

View workflow job for this annotation

GitHub Actions / GHC 8.8.4 on macos-latest

Defined but not used: ‘getParent’

Check warning on line 2115 in src/Reflex/Spider/Internal.hs

View workflow job for this annotation

GitHub Actions / GHC 8.10.7 on ubuntu-latest

Defined but not used: ‘getParent’

Check warning on line 2115 in src/Reflex/Spider/Internal.hs

View workflow job for this annotation

GitHub Actions / GHC 8.10.7 on macos-latest

Defined but not used: ‘getParent’
initialParents <- readBehaviorUntracked $ dynamicCurrent d
accumRef <- liftIO $ newIORef $ error "merge: accumRef not yet initialized"
heightRef <- liftIO $ newIORef $ error "merge: heightRef not yet initialized"
Expand Down Expand Up @@ -2614,7 +2613,7 @@
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
Expand Down
Loading