on develop help sign in
Add maybeDyn and takeWhileE
28a943bRyan Trinkle
src/Reflex/Class.hs+14
@@ -88,6 +88,7 @@ module Reflex.Class
88 , headE
88 , headE
89 , tailE
89 , tailE
90 , headTailE
90 , headTailE
91+ , takeWhileE
91 , switcher
92 , switcher
92 -- * Debugging functions
93 -- * Debugging functions
93 , traceEvent
94 , traceEvent
@@ -643,6 +644,19 @@ headTailE e = do
643 be <- hold never $ fmap (const e) eHead
644 be <- hold never $ fmap (const e) eHead
644 return (eHead, switch be)
645 return (eHead, switch be)
645
646
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+
646-- | Split the supplied 'Event' into two individual 'Event's occuring at the
660-- | Split the supplied 'Event' into two individual 'Event's occuring at the
647-- same time with the respective values from the tuple.
661-- same time with the respective values from the tuple.
648splitE :: 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+22−4
@@ -33,6 +33,7 @@ module Reflex.Dynamic
33 , attachPromptlyDyn
33 , attachPromptlyDyn
34 , attachPromptlyDynWith
34 , attachPromptlyDynWith
35 , attachPromptlyDynWithMaybe
35 , attachPromptlyDynWithMaybe
36+ , maybeDyn
36 , scanDyn
37 , scanDyn
37 , scanDynMaybe
38 , scanDynMaybe
38 , holdUniqDyn
39 , holdUniqDyn
@@ -85,21 +86,20 @@ module Reflex.Dynamic
85 , uniqDynBy
86 , uniqDynBy
86 ) where
87 ) where
87
88
88−import Prelude hiding (mapM, mapM_)
89−
90import Data.Functor.Misc
89import Data.Functor.Misc
91import Reflex.Class
90import Reflex.Class
92
91
93import Control.Applicative ((<*>))
92import Control.Applicative ((<*>))
94−import Control.Monad hiding (forM, forM_, mapM, mapM_)
93+import Control.Monad
95import Control.Monad.Fix
94import Control.Monad.Fix
96−import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_)
95+import Control.Monad.Identity
97import Data.Align
96import Data.Align
98import Data.Dependent.Map (DMap)
97import Data.Dependent.Map (DMap)
99import qualified Data.Dependent.Map as DMap
98import qualified Data.Dependent.Map as DMap
100import Data.Dependent.Sum (DSum (..))
99import Data.Dependent.Sum (DSum (..))
101import Data.GADT.Compare ((:~:) (..), GCompare (..), GEq (..), GOrdering (..))
100import Data.GADT.Compare ((:~:) (..), GCompare (..), GEq (..), GOrdering (..))
102import Data.Map (Map)
101import Data.Map (Map)
102+import Data.Maybe
103import Data.Monoid
103import Data.Monoid
104import Data.These
104import Data.These
105
105
@@ -269,6 +269,24 @@ attachPromptlyDynWithMaybe f d e =
269 These (_, b) a -> f a b -- Both events are firing, so use the newer value
269 These (_, b) a -> f a b -- Both events are firing, so use the newer value
270 That _ -> Nothing -- The tagging event isn't firing, so don't fire
270 That _ -> Nothing -- The tagging event isn't firing, so don't fire
271
271
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+
272--------------------------------------------------------------------------------
290--------------------------------------------------------------------------------
273-- Demux
291-- Demux
274--------------------------------------------------------------------------------
292--------------------------------------------------------------------------------