on develop help sign in
Add maybeDyn and takeWhileE
commit28a943bc9308f1b865afc02ac3ed97fe379c77dc authorRyan Trinkle <ryan.trinkle@gmail.com> dateMon 29 May 2017, 21:14 (9 years ago) parent75426f7
2 files changed+36−4
src/Reflex/Class.hs+14 src/Reflex/Dynamic.hs+22−4
src/Reflex/Class.hs+14
@@ -88,6 +88,7 @@ module Reflex.Class
8888 , headE
8989 , tailE
9090 , headTailE
91+ , takeWhileE
9192 , switcher
9293 -- * Debugging functions
9394 , traceEvent
@@ -643,6 +644,19 @@ headTailE e = do
643644 be <- hold never $ fmap (const e) eHead
644645 return (eHead, switch be)
645646
647+-- | Starting at the current time, fire all the occurrences of the 'Event' for
648+-- which the given predicate returns 'True'. When 'False' is returned, do not
649+-- fire, and permanently stop firing, even if 'True' values are encountered
650+-- later.
651+takeWhileE :: forall t m a. (Reflex t, MonadFix m, MonadHold t m) => (a -> Bool) -> Event t a -> m (Event t a)
652+takeWhileE f e = do
653+ rec let (eFalse, eTrue) = fanEither $ ffor e' $ \a -> if f a
654+ then Right a
655+ else Left never
656+ be <- hold e eFalse
657+ let e' = switch be
658+ return eTrue
659+
646660-- | Split the supplied 'Event' into two individual 'Event's occuring at the
647661-- same time with the respective values from the tuple.
648662splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
src/Reflex/Dynamic.hs+22−4
@@ -33,6 +33,7 @@ module Reflex.Dynamic
3333 , attachPromptlyDyn
3434 , attachPromptlyDynWith
3535 , attachPromptlyDynWithMaybe
36+ , maybeDyn
3637 , scanDyn
3738 , scanDynMaybe
3839 , holdUniqDyn
@@ -85,21 +86,20 @@ module Reflex.Dynamic
8586 , uniqDynBy
8687 ) where
8788
88−import Prelude hiding (mapM, mapM_)
89−
9089import Data.Functor.Misc
9190import Reflex.Class
9291
9392import Control.Applicative ((<*>))
94−import Control.Monad hiding (forM, forM_, mapM, mapM_)
93+import Control.Monad
9594import Control.Monad.Fix
96−import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_)
95+import Control.Monad.Identity
9796import Data.Align
9897import Data.Dependent.Map (DMap)
9998import qualified Data.Dependent.Map as DMap
10099import Data.Dependent.Sum (DSum (..))
101100import Data.GADT.Compare ((:~:) (..), GCompare (..), GEq (..), GOrdering (..))
102101import Data.Map (Map)
102+import Data.Maybe
103103import Data.Monoid
104104import Data.These
105105
@@ -269,6 +269,24 @@ attachPromptlyDynWithMaybe f d e =
269269 These (_, b) a -> f a b -- Both events are firing, so use the newer value
270270 That _ -> Nothing -- The tagging event isn't firing, so don't fire
271271
272+-- | Factor a @Dynamic t (Maybe a)@ into a @Dynamic t (Maybe (Dynamic t a))@,
273+-- such that the outer 'Dynamic' is updated only when the 'Maybe''s constructor
274+-- chages from 'Nothing' to 'Just' or vice-versa. Whenever the constructor
275+-- becomes 'Just', an inner 'Dynamic' will be provided, whose value will track
276+-- the 'a' inside the 'Just'; when the constructor becomes 'Nothing', the
277+-- existing inner 'Dynamic' will become constant, and will not change when the
278+-- outer constructor changes back to 'Nothing'.
279+maybeDyn :: forall t a m. (Reflex t, MonadFix m, MonadHold t m) => Dynamic t (Maybe a) -> m (Dynamic t (Maybe (Dynamic t a)))
280+maybeDyn d = do
281+ ma <- sample $ current d
282+ let inner :: forall m'. (MonadFix m', MonadHold t m') => a -> m' (Dynamic t a)
283+ inner a = holdDyn a . fmapMaybe id =<< takeWhileE isJust (updated d)
284+ mInner0 :: Maybe (Dynamic t a) <- mapM inner ma
285+ rec result <- holdDyn mInner0 $ flip push (updated d) $ \new -> do
286+ old <- sample $ current d
287+ if isJust old == isJust new then return Nothing else Just <$> mapM inner new
288+ return result
289+
272290--------------------------------------------------------------------------------
273291-- Demux
274292--------------------------------------------------------------------------------