on develop help sign in
Merge pull request #200 from reflex-frp/take-drop
b95bf51Ryan Trinkle
src/Reflex/Class.hs+79−11
@@ -107,6 +107,9 @@ module Reflex.Class
107 , tailE
107 , tailE
108 , headTailE
108 , headTailE
109 , takeWhileE
109 , takeWhileE
110+ , takeWhileJustE
111+ , dropWhileE
112+ , takeDropWhileJustE
110 , switcher
113 , switcher
111 -- * Debugging functions
114 -- * Debugging functions
112 , traceEvent
115 , traceEvent
@@ -576,19 +579,84 @@ headTailE e = do
576 be <- hold never $ fmap (const e) eHead
579 be <- hold never $ fmap (const e) eHead
577 return (eHead, switch be)
580 return (eHead, switch be)
578
581
582+-- | Take the streak of occurrences starting at the current time for which the
583+-- event returns 'True'.
584+--
579−-- | Starting at the current time, fire all the occurrences of the 'Event' for
585+-- Starting at the current time, fire all the occurrences of the 'Event' for
580−-- which the given predicate returns 'True'. When 'False' is returned, do not
586+-- which the given predicate returns 'True'. When 'False' first is returned,
581−-- fire, and permanently stop firing, even if 'True' values are encountered
587+-- do not fire, and permanently stop firing, even if 'True' values would have
582−-- later.
588+-- been encountered later.
589+takeWhileE
590+ :: forall t m a
583−takeWhileE :: forall t m a. (Reflex t, MonadFix m, MonadHold t m) => (a -> Bool) -> Event t a -> m (Event t a)
591+ . (Reflex t, MonadFix m, MonadHold t m)
584−takeWhileE f e = do
592+ => (a -> Bool)
593+ -> Event t a
594+ -> m (Event t a)
595+takeWhileE f e = takeWhileJustE (\v -> guard (f v) $> v) e
596+
597+-- | Take the streak of occurrences starting at the current time for which the
598+-- event returns 'Just b'.
599+--
600+-- Starting at the current time, fire all the occurrences of the 'Event' for
601+-- which the given predicate returns 'Just b'. When 'Nothing' first is returned,
602+-- do not fire, and permanently stop firing, even if 'Just b' values would have
603+-- been encountered later.
604+takeWhileJustE
605+ :: forall t m a b
606+ . (Reflex t, MonadFix m, MonadHold t m)
607+ => (a -> Maybe b)
608+ -> Event t a
609+ -> m (Event t b)
610+takeWhileJustE f e = do
585− rec let (eFalse, eTrue) = fanEither $ ffor e' $ \a -> if f a
611+ rec let (eBad, eTrue) = fanEither $ ffor e' $ \a -> case f a of
586− then Right a
587− else Left never
612+ Nothing -> Left never
588− be <- hold e eFalse
613+ Just b -> Right b
589− let e' = switch be
614+ eFirstBad <- headE eBad
615+ e' <- switchHold e eFirstBad
590 return eTrue
616 return eTrue
591
617
618+-- | Drop the streak of occurrences starting at the current time for which the
619+-- event returns 'True'.
620+--
621+-- Starting at the current time, do not fire all the occurrences of the 'Event'
622+-- for which the given predicate returns 'True'. When 'False' is first
623+-- returned, do fire, and permanently continue firing, even if 'True' values
624+-- would have been encountered later.
625+dropWhileE
626+ :: forall t m a
627+ . (Reflex t, MonadFix m, MonadHold t m)
628+ => (a -> Bool)
629+ -> Event t a
630+ -> m (Event t a)
631+dropWhileE f e = snd <$> takeDropWhileJustE (\v -> guard (f v) $> v) e
632+
633+-- | Both take and drop the streak of occurrences starting at the current time
634+-- for which the event returns 'Just b'.
635+--
636+-- For the left event, starting at the current time, fire all the occurrences
637+-- of the 'Event' for which the given function returns 'Just b'. When
638+-- 'Nothing' is returned, do not fire, and permanently stop firing, even if
639+-- 'Just b' values would have been encountered later.
640+--
641+-- For the right event, do not fire until the first occurrence where the given
642+-- function returns 'Nothing', and fire that one and all subsequent
643+-- occurrences. Even if the function would have again returned 'Just b', keep
644+-- on firing.
645+takeDropWhileJustE
646+ :: forall t m a b
647+ . (Reflex t, MonadFix m, MonadHold t m)
648+ => (a -> Maybe b)
649+ -> Event t a
650+ -> m (Event t b, Event t a)
651+takeDropWhileJustE f e = do
652+ rec let (eBad, eGood) = fanEither $ ffor e' $ \a -> case f a of
653+ Nothing -> Left ()
654+ Just b -> Right b
655+ eFirstBad <- headE eBad
656+ e' <- switchHold e (never <$ eFirstBad)
657+ eRest <- switchHoldPromptOnly never (e <$ eFirstBad)
658+ return (eGood, eRest)
659+
592-- | Split the supplied 'Event' into two individual 'Event's occurring at the
660-- | Split the supplied 'Event' into two individual 'Event's occurring at the
593-- same time with the respective values from the tuple.
661-- same time with the respective values from the tuple.
594splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
662splitE :: 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
327factorDyn :: 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)))
327factorDyn :: 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)))
328factorDyn d = do
328factorDyn d = do
329 let inner :: forall m' a. (MonadFix m', MonadHold t m') => k a -> v a -> m' (Dynamic t (v a))
329 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
330+ inner k v0 = (=<<) (holdDyn v0) $ flip takeWhileJustE (updated d) $
331− where newVal = ffor (updated d) $ \(newK :=> newV) -> case newK `geq` k of
331+ \(newK :=> newV) -> case newK `geq` k of
332− Just Refl -> Just newV
332+ Just Refl -> Just newV
333− Nothing -> Nothing
333+ Nothing -> Nothing
334 getInitial = do
334 getInitial = do
335 k0 :=> (v0 :: v a) <- sample $ current d
335 k0 :=> (v0 :: v a) <- sample $ current d
336 i0 <- inner k0 v0
336 i0 <- inner k0 v0