on develop help sign in
Add functions like `takeWhileE`

- `takeWhileJustE` - `dropWhileE` - `takeDropWhileE` `headE` is also added to `takeWhileE` as a performance optimization. Issue #199 tracking being able to easily write tests for things like this.

commit5b746aac2cf397816f91736ca1c8109a7706751c authorJohn Ericson <John.Ericson@Obsidian.Systems> dateTue 17 Jul 2018, 17:36 (8 years ago) parente52ce57
2 files changed+83−15
src/Reflex/Class.hs+79−11 src/Reflex/Dynamic.hs+4−4
src/Reflex/Class.hs+79−11
@@ -107,6 +107,9 @@ module Reflex.Class
107107 , tailE
108108 , headTailE
109109 , takeWhileE
110+ , takeWhileJustE
111+ , dropWhileE
112+ , takeDropWhileJustE
110113 , switcher
111114 -- * Debugging functions
112115 , traceEvent
@@ -566,19 +569,84 @@ headTailE e = do
566569 be <- hold never $ fmap (const e) eHead
567570 return (eHead, switch be)
568571
569−-- | Starting at the current time, fire all the occurrences of the 'Event' for
570−-- which the given predicate returns 'True'. When 'False' is returned, do not
571−-- fire, and permanently stop firing, even if 'True' values are encountered
572−-- later.
573−takeWhileE :: forall t m a. (Reflex t, MonadFix m, MonadHold t m) => (a -> Bool) -> Event t a -> m (Event t a)
574−takeWhileE f e = do
575− rec let (eFalse, eTrue) = fanEither $ ffor e' $ \a -> if f a
576− then Right a
577− else Left never
578− be <- hold e eFalse
579− let e' = switch be
572+-- | Take the streak of occurrences starting at the current time for which the
573+-- event returns 'True'.
574+--
575+-- Starting at the current time, fire all the occurrences of the 'Event' for
576+-- which the given predicate returns 'True'. When 'False' first is returned,
577+-- do not fire, and permanently stop firing, even if 'True' values would have
578+-- been encountered later.
579+takeWhileE
580+ :: forall t m a
581+ . (Reflex t, MonadFix m, MonadHold t m)
582+ => (a -> Bool)
583+ -> Event t a
584+ -> m (Event t a)
585+takeWhileE f e = takeWhileJustE (\v -> guard (f v) $> v) e
586+
587+-- | Take the streak of occurrences starting at the current time for which the
588+-- event returns 'Just b'.
589+--
590+-- Starting at the current time, fire all the occurrences of the 'Event' for
591+-- which the given predicate returns 'Just b'. When 'Nothing' first is returned,
592+-- do not fire, and permanently stop firing, even if 'Just b' values would have
593+-- been encountered later.
594+takeWhileJustE
595+ :: forall t m a b
596+ . (Reflex t, MonadFix m, MonadHold t m)
597+ => (a -> Maybe b)
598+ -> Event t a
599+ -> m (Event t b)
600+takeWhileJustE f e = do
601+ rec let (eBad, eTrue) = fanEither $ ffor e' $ \a -> case f a of
602+ Nothing -> Left never
603+ Just b -> Right b
604+ eFirstBad <- headE eBad
605+ e' <- switchHold e eFirstBad
580606 return eTrue
581607
608+-- | Drop the streak of occurrences starting at the current time for which the
609+-- event returns 'True'.
610+--
611+-- Starting at the current time, do not fire all the occurrences of the 'Event'
612+-- for which the given predicate returns 'True'. When 'False' is first
613+-- returned, do fire, and permanently continue firing, even if 'True' values
614+-- would have been encountered later.
615+dropWhileE
616+ :: forall t m a
617+ . (Reflex t, MonadFix m, MonadHold t m)
618+ => (a -> Bool)
619+ -> Event t a
620+ -> m (Event t a)
621+dropWhileE f e = snd <$> takeDropWhileJustE (\v -> guard (f v) $> v) e
622+
623+-- | Both take and drop the streak of occurrences starting at the current time
624+-- for which the event returns 'Just b'.
625+--
626+-- For the left event, starting at the current time, fire all the occurrences
627+-- of the 'Event' for which the given function returns 'Just b'. When
628+-- 'Nothing' is returned, do not fire, and permanently stop firing, even if
629+-- 'Just b' values would have been encountered later.
630+--
631+-- For the right event, do not fire until the first occurrence where the given
632+-- function returns 'Nothing', and fire that one and all subsequent
633+-- occurrences. Even if the function would have again returned 'Just b', keep
634+-- on firing.
635+takeDropWhileJustE
636+ :: forall t m a b
637+ . (Reflex t, MonadFix m, MonadHold t m)
638+ => (a -> Maybe b)
639+ -> Event t a
640+ -> m (Event t b, Event t a)
641+takeDropWhileJustE f e = do
642+ rec let (eBad, eGood) = fanEither $ ffor e' $ \a -> case f a of
643+ Nothing -> Left ()
644+ Just b -> Right b
645+ eFirstBad <- headE eBad
646+ e' <- switchHold e (never <$ eFirstBad)
647+ eRest <- switchHoldPromptOnly never (e <$ eFirstBad)
648+ return (eGood, eRest)
649+
582650-- | Split the supplied 'Event' into two individual 'Event's occurring at the
583651-- same time with the respective values from the tuple.
584652splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
src/Reflex/Dynamic.hs+4−4
@@ -327,10 +327,10 @@ eitherDyn = fmap (fmap unpack) . factorDyn . fmap eitherToDSum
327327factorDyn :: forall t m k v. (Reflex t, MonadFix m, MonadHold t m, GEq k) => Dynamic t (DSum k v) -> m (Dynamic t (DSum k (Compose (Dynamic t) v)))
328328factorDyn d = do
329329 let inner :: forall m' a. (MonadFix m', MonadHold t m') => k a -> v a -> m' (Dynamic t (v a))
330− inner k v0 = holdDyn v0 . fmapMaybe id =<< takeWhileE isJust newVal
331− where newVal = ffor (updated d) $ \(newK :=> newV) -> case newK `geq` k of
332− Just Refl -> Just newV
333− Nothing -> Nothing
330+ inner k v0 = (=<<) (holdDyn v0) $ flip takeWhileJustE (updated d) $
331+ \(newK :=> newV) -> case newK `geq` k of
332+ Just Refl -> Just newV
333+ Nothing -> Nothing
334334 getInitial = do
335335 k0 :=> (v0 :: v a) <- sample $ current d
336336 i0 <- inner k0 v0