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

Open
wants to merge 3 commits into
base: develop
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
10 changes: 5 additions & 5 deletions src/Reflex/DynamicWriter/Base.hs
Expand Up @@ -120,7 +120,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)
Expand Down Expand Up @@ -159,7 +159,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')
Expand All @@ -168,7 +168,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)
Expand All @@ -195,7 +195,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)
Expand All @@ -219,7 +219,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
Expand Down
17 changes: 8 additions & 9 deletions src/Reflex/Spider/Internal.hs
Expand Up @@ -251,7 +251,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
Expand All @@ -272,7 +272,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
Expand All @@ -286,7 +286,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
Expand All @@ -311,8 +311,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
Expand Down Expand Up @@ -551,14 +550,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
Expand Down Expand Up @@ -2052,7 +2051,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)

Expand Down Expand Up @@ -2611,7 +2610,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
Expand Down