2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FunctionalDependencies #-}
6{-# LANGUAGE LambdaCase #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE NoMonomorphismRestriction #-}
9{-# LANGUAGE RankNTypes #-}
10{-# LANGUAGE RecursiveDo #-}
11{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE TypeFamilies #-}
13{-# LANGUAGE TypeOperators #-}
14{-# LANGUAGE UndecidableInstances #-}
16-- | This module contains the Reflex interface, as well as a variety of
17-- convenience functions for working with 'Event's, 'Behavior's, and other
24 -- ** 'fan'-related types
26 -- ** 'Incremental'-related types
29 -- * Convenience functions
32 -- ** Combining 'Event's
37 -- ** Breaking up 'Event's
44 -- ** Switching between 'Event's
46 -- ** Using 'Event's to sample 'Behavior's
51 -- ** Blocking an 'Event' based on a 'Behavior'
53 -- ** Combining 'Dynamic's
54 , distributeDMapOverDynPure
57 -- ** Accumulating state
67 -- * Debugging functions
76 -- * Miscellaneous convenience functions
78 -- * Deprecated functions
84import Control.Applicative
85import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
86import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
87import Control.Monad.State.Strict hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
88import Control.Monad.Trans.Cont (ContT ())
89import Control.Monad.Trans.Except (ExceptT ())
90import Control.Monad.Trans.RWS (RWST ())
91import Control.Monad.Trans.Writer (WriterT ())
94import Data.Dependent.Map (DMap, DSum (..), GCompare (..), GOrdering (..))
95import qualified Data.Dependent.Map as DMap
96import Data.Dependent.Sum (ShowTag (..))
98import Data.Functor.Bind hiding (join)
99import qualified Data.Functor.Bind as Bind
100import Data.Functor.Compose
101import Data.Functor.Constant
102import Data.Functor.Misc
103import Data.Functor.Plus
104import Data.GADT.Compare ((:~:) (..), GEq (..))
105import Data.GADT.Show (GShow (..))
106import Data.List.NonEmpty (NonEmpty (..))
109import Data.Monoid hiding (Alt, (<>))
110import Data.Semigroup (Semigroup, sconcat, stimes, stimesIdempotentMonoid, (<>))
113import Data.Traversable
115-- Note: must come last to silence warnings due to AMP on GHC < 7.10
116import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)
118import Debug.Trace (trace)
120-- | The 'Reflex' class contains all the primitive functionality needed for
121-- Functional Reactive Programming (FRP). The @t@ type parameter indicates
122-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
123-- and the type of the timeline determines the FRP engine to be used. For most
124-- purposes, the 'Reflex.Spider' implementation is recommended.
125class ( MonadHold t (PushM t)
126 , MonadSample t (PullM t)
129 , Functor (Behavior t)
130 , Functor (Dynamic t)
131 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
134 -- | A container for a value that can change over time. 'Behavior's can be
135 -- sampled at will, but it is not possible to be notified when they change
136 data Behavior t :: * -> *
137 -- | A stream of occurrences. During any given frame, an 'Event' is either
138 -- occurring or not occurring; if it is occurring, it will contain a value of
139 -- the given type (its "occurrence type")
140 data Event t :: * -> *
141 -- | A container for a value that can change over time and allows
142 -- notifications on changes. Basically a combination of a 'Behavior' and an
143 -- 'Event', with a rule that the 'Behavior' will change if and only if the
145 data Dynamic t :: * -> *
146 -- | A container for a value that can change over time and allows
147 -- notifications on changes. Basically a combination of a 'Behavior' and an
148 -- 'Event', with a rule that the 'Behavior' will change if and only if the
150 data Incremental t :: (* -> *) -> * -> *
151 -- | An 'Event' with no occurrences
153 -- | Create a 'Behavior' that always has the given value
154 constant :: a -> Behavior t a --TODO: Refactor to use 'pure' from Applicative instead; however, we need to make sure that encouraging Applicative-style use of 'Behavior's doesn't have a negative performance impact
155 -- | Create an 'Event' from another 'Event'; the provided function can sample
156 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
157 -- (Just) or non-occurring (Nothing) result
158 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
159 -- | A monad for doing complex push-based calculations efficiently
160 type PushM t :: * -> *
161 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
162 -- recomputed whenever any of the read 'Behavior's changes
163 pull :: PullM t a -> Behavior t a
164 -- | A monad for doing complex pull-based calculations efficiently
165 type PullM t :: * -> *
166 -- | Merge a collection of events; the resulting 'Event' will only occur if at
167 -- least one input event is occuring, and will contain all of the input keys
168 -- that are occurring simultaneously
169 merge :: GCompare k => DMap k (Event t) -> Event t (DMap k Identity) --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
170 -- | Efficiently fan-out an event to many destinations. This function should
171 -- be partially applied, and then the result applied repeatedly to create
173 fan :: GCompare k => Event t (DMap k Identity) -> EventSelector t k --TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it
174 -- | Create an 'Event' that will occur whenever the currently-selected input
176 switch :: Behavior t (Event t a) -> Event t a
177 -- | Create an 'Event' that will occur whenever the input event is occurring
178 -- and its occurrence value, another 'Event', is also occurring
179 coincidence :: Event t (Event t a) -> Event t a
180 -- | Extract the 'Behavior' of a 'Dynamic'.
181 current :: Dynamic t a -> Behavior t a
182 -- | Extract the 'Event' of the 'Dynamic'.
183 updated :: Dynamic t a -> Event t a
184 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
185 -- recent firing of the given 'Event', if any.
186 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
187 -- | Create a new 'Incremental'. The given 'PullM''s value must always change
188 -- in the same way that the accumulated application of patches would change
190 unsafeBuildIncremental :: Patch p => PullM t a -> Event t (p a) -> Incremental t p a
191 -- | Create a merge whose parents can change over time
192 mergeIncremental :: GCompare k => Incremental t PatchDMap (DMap k (Event t)) -> Event t (DMap k Identity)
193 -- | Extract the 'Behavior' component of an 'Incremental'
194 currentIncremental :: Patch p => Incremental t p a -> Behavior t a
195 -- | Extract the 'Event' component of an 'Incremental'
196 updatedIncremental :: Patch p => Incremental t p a -> Event t (p a)
197 -- | Convert an 'Incremental' to a 'Dynamic'
198 incrementalToDynamic :: Patch p => Incremental t p a -> Dynamic t a
200-- | A 'Patch' type represents a kind of change made to a datastructure.
202 -- | Apply the patch @p a@ to the value @a@. If no change is needed, return
204 apply :: p a -> a -> Maybe a
206instance Patch Identity where
207 apply (Identity a) _ = Just a
209-- | A set of changes to a 'DMap'. Only DMap types are allowed for @a@.
210data PatchDMap a where
211 PatchDMap :: GCompare k => DMap k (Compose Maybe v) -> PatchDMap (DMap k v)
213instance GCompare k => Semigroup (PatchDMap (DMap k v)) where
214 PatchDMap a <> PatchDMap b = PatchDMap $ a `mappend` b --TODO: Add a semigroup instance for DMap
215 -- PatchDMap is idempotent, so stimes n is id for every n
216#if MIN_VERSION_semigroups(0,17,0)
217 stimes = stimesIdempotentMonoid
219 times1p n x = case compare n 0 of
220 LT -> error "stimesIdempotentMonoid: negative multiplier"
225instance GCompare k => Monoid (PatchDMap (DMap k v)) where
226 mempty = PatchDMap mempty
229instance Patch PatchDMap where
230 apply (PatchDMap diff) old = Just $! insertions `DMap.union` (old `DMap.difference` deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?
231 where insertions = DMap.mapMaybeWithKey (const $ getCompose) diff
232 deletions = DMap.mapMaybeWithKey (const $ nothingToJust . getCompose) diff
233 nothingToJust = \case
234 Nothing -> Just $ Constant ()
237-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
238-- _must_ change when and only when the 'Event' fires, such that the
239-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
240-- if this is not the case, the resulting 'Dynamic' will behave
241-- nondeterministically.
242unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
243unsafeDynamic = unsafeBuildDynamic . sample
245-- | Construct a 'Dynamic' value that never changes
246constDyn :: Reflex t => a -> Dynamic t a
249-- | 'MonadSample' designates monads that can read the current value of a
250-- 'Behavior'. This includes both 'PullM' and 'PushM'.
251class (Applicative m, Monad m) => MonadSample t m | m -> t where
252 -- | Get the current value in the 'Behavior'
253 sample :: Behavior t a -> m a
255-- | 'MonadHold' designates monads that can create new 'Behavior's based on
256-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
257-- is required to create any stateful computations with Reflex.
258class MonadSample t m => MonadHold t m where
259 -- | Create a new 'Behavior' whose value will initially be equal to the given
260 -- value and will be updated whenever the given 'Event' occurs. The update
261 -- takes effect immediately after the 'Event' occurs; if the occurrence that
262 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
263 -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new
265 hold :: a -> Event t a -> m (Behavior t a)
266 -- | Create a 'Dynamic' value using the given initial value that changes every
267 -- time the 'Event' occurs.
268 holdDyn :: a -> Event t a -> m (Dynamic t a)
269 -- | Create an 'Incremental' value using the given initial value that changes
270 -- every time the 'Event' occurs.
271 holdIncremental :: Patch p => a -> Event t (p a) -> m (Incremental t p a)
273-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
274-- key. This is much more efficient than filtering for each key with
276newtype EventSelector t k = EventSelector
277 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
278 -- determined by the type of the key, so this can be used to fan-out
279 -- 'Event's whose sub-'Event's have different types.
281 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
282 -- (but equivalent to) using 'fmapMaybe' to select only the relevant
283 -- occurrences of an 'Event'.
284 select :: forall a. k a -> Event t a
287--------------------------------------------------------------------------------
289--------------------------------------------------------------------------------
291instance MonadSample t m => MonadSample t (ReaderT r m) where
292 sample = lift . sample
294instance MonadHold t m => MonadHold t (ReaderT r m) where
295 hold a0 = lift . hold a0
296 holdDyn a0 = lift . holdDyn a0
297 holdIncremental a0 = lift . holdIncremental a0
299instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
300 sample = lift . sample
302instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
303 hold a0 = lift . hold a0
304 holdDyn a0 = lift . holdDyn a0
305 holdIncremental a0 = lift . holdIncremental a0
307instance MonadSample t m => MonadSample t (StateT s m) where
308 sample = lift . sample
310instance MonadHold t m => MonadHold t (StateT s m) where
311 hold a0 = lift . hold a0
312 holdDyn a0 = lift . holdDyn a0
313 holdIncremental a0 = lift . holdIncremental a0
315instance MonadSample t m => MonadSample t (ExceptT e m) where
316 sample = lift . sample
318instance MonadHold t m => MonadHold t (ExceptT e m) where
319 hold a0 = lift . hold a0
320 holdDyn a0 = lift . holdDyn a0
321 holdIncremental a0 = lift . holdIncremental a0
323instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
324 sample = lift . sample
326instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
327 hold a0 = lift . hold a0
328 holdDyn a0 = lift . holdDyn a0
329 holdIncremental a0 = lift . holdIncremental a0
331instance MonadSample t m => MonadSample t (ContT r m) where
332 sample = lift . sample
334instance MonadHold t m => MonadHold t (ContT r m) where
335 hold a0 = lift . hold a0
336 holdDyn a0 = lift . holdDyn a0
337 holdIncremental a0 = lift . holdIncremental a0
339--------------------------------------------------------------------------------
340-- Convenience functions
341--------------------------------------------------------------------------------
343-- | Create an 'Event' from another 'Event'. The provided function can sample
344-- 'Behavior's and hold 'Event's.
345pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
346pushAlways f = push (fmap Just . f)
348-- | Flipped version of 'fmap'.
349ffor :: Functor f => f a -> (a -> b) -> f b
352instance Reflex t => Applicative (Behavior t) where
354 f <*> x = pull $ sample f `ap` sample x
358instance Reflex t => Apply (Behavior t) where
361instance Reflex t => Bind (Behavior t) where
364instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
366 fromRational = pure . fromRational
369instance Reflex t => Functor (Behavior t) where
370 fmap f = pull . fmap f . sample
372instance (Reflex t, IsString a) => IsString (Behavior t a) where
373 fromString = pure . fromString
375instance Reflex t => Monad (Behavior t) where
376 a >>= f = pull $ sample a >>= sample . f
377 -- Note: it is tempting to write (_ >> b = b); however, this would result in (fail x >> return y) succeeding (returning y), which violates the law that (a >> b = a >>= \_ -> b), since the implementation of (>>=) above actually will fail. Since we can't examine 'Behavior's other than by using sample, I don't think it's possible to write (>>) to be more efficient than the (>>=) above.
379 fail = error "Monad (Behavior t) does not support fail"
381instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
382 mempty = constant mempty
383 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
384 mconcat = pull . fmap mconcat . mapM sample
386instance (Reflex t, Num a) => Num (Behavior t a) where
391 fromInteger = pure . fromInteger
395instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
396 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
397 sconcat = pull . fmap sconcat . mapM sample
398#if MIN_VERSION_semigroups(0,17,0)
399 stimes n = fmap $ stimes n
401 times1p n = fmap $ times1p n
404--TODO: See if there's a better class in the standard libraries already
405-- | A class for values that combines filtering and mapping using 'Maybe'.
406class FunctorMaybe f where
407 -- | Combined mapping and filtering function.
408 fmapMaybe :: (a -> Maybe b) -> f a -> f b
410instance FunctorMaybe [] where
411 fmapMaybe f = catMaybes . fmap f
413-- | Flipped version of 'fmapMaybe'.
414fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b
415fforMaybe = flip fmapMaybe
417-- | Filter 'f a' using the provided predicate.
418-- Relies on 'fforMaybe'.
419ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
420ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
422-- | Left-biased event union (prefers left event on simultaneous
424instance Reflex t => Alt (Event t) where
425 ev1 <!> ev2 = leftmost [ev1, ev2]
427-- | 'Event' intersection (convenient interface to 'coincidence').
428instance Reflex t => Apply (Event t) where
429 evf <.> evx = coincidence (fmap (<$> evx) evf)
431-- | 'Event' intersection (convenient interface to 'coincidence').
432instance Reflex t => Bind (Event t) where
433 evx >>- f = coincidence (f <$> evx)
436instance Reflex t => Functor (Event t) where
437 fmap f = fmapMaybe $ Just . f
439instance Reflex t => FunctorMaybe (Event t) where
440 fmapMaybe f = push $ return . f
442-- | Never: @'zero' = 'never'@.
443instance Reflex t => Plus (Event t) where
446-- | Replace each occurrence value of the 'Event' with the value of the
447-- 'Behavior' at the time of that occurrence.
448tag :: Reflex t => Behavior t b -> Event t a -> Event t b
449tag b = pushAlways $ \_ -> sample b
451-- | Create a new 'Event' that combines occurences of supplied 'Event' with the
452-- current value of the 'Behavior'.
453attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
454attach = attachWith (,)
456-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
457-- combining it with the current value of the 'Behavior'.
458attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
459attachWith f = attachWithMaybe $ \a b -> Just $ f a b
461-- | Create a new 'Event' by combining each occurence with the current value of
462-- the 'Behavior'. The occurrence is discarded if the combining function returns
464attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
465attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
467-- | Create a new 'Event' that only occurs only once, on the first occurence of
468-- the supplied 'Event'.
469headE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
471 rec be <- hold e $ fmap (const never) e'
476-- | Create a new 'Event' that occurs on all but the first occurence of the
478tailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
479tailE e = snd <$> headTailE e
481-- | Create a tuple of two 'Event's with the first one occuring only the first
482-- time the supplied 'Event' occurs and the second occuring on all but the first
484headTailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a, Event t a)
487 be <- hold never $ fmap (const e) eHead
488 return (eHead, switch be)
490-- | Split the supplied 'Event' into two individual 'Event's occuring at the
491-- same time with the respective values from the tuple.
492splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
493splitE e = (fmap fst e, fmap snd e)
495-- | Print the supplied 'String' and the value of the 'Event' on each
496-- occurence. This should /only/ be used for debugging.
498-- Note: As with Debug.Trace.trace, the message will only be printed if the
499-- 'Event' is actually used.
500traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
501traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
503-- | Print the output of the supplied function on each occurence of the
504-- 'Event'. This should /only/ be used for debugging.
506-- Note: As with Debug.Trace.trace, the message will only be printed if the
507-- 'Event' is actually used.
508traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
509traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
511-- | Tag type for 'Either' to use it as a 'DSum'.
512data EitherTag l r a where
513 LeftTag :: EitherTag l r l
514 RightTag :: EitherTag l r r
516instance GEq (EitherTag l r) where
517 geq a b = case (a, b) of
518 (LeftTag, LeftTag) -> Just Refl
519 (RightTag, RightTag) -> Just Refl
522instance GCompare (EitherTag l r) where
523 gcompare a b = case (a, b) of
524 (LeftTag, LeftTag) -> GEQ
525 (LeftTag, RightTag) -> GLT
526 (RightTag, LeftTag) -> GGT
527 (RightTag, RightTag) -> GEQ
529instance GShow (EitherTag l r) where
530 gshowsPrec _ a = case a of
531 LeftTag -> showString "LeftTag"
532 RightTag -> showString "RightTag"
534instance (Show l, Show r) => ShowTag (EitherTag l r) Identity where
535 showTaggedPrec t n (Identity a) = case t of
536 LeftTag -> showsPrec n a
537 RightTag -> showsPrec n a
539-- | Convert 'Either' to a 'DSum'. Inverse of 'dsumToEither'.
540eitherToDSum :: Either a b -> DSum (EitherTag a b) Identity
542 Left a -> (LeftTag :=> Identity a)
543 Right b -> (RightTag :=> Identity b)
545-- | Convert 'DSum' to 'Either'. Inverse of 'eitherToDSum'.
546dsumToEither :: DSum (EitherTag a b) Identity -> Either a b
548 (LeftTag :=> Identity a) -> Left a
549 (RightTag :=> Identity b) -> Right b
551-- | Extract the values of a 'DMap' of 'EitherTag's.
552dmapToThese :: DMap (EitherTag a b) Identity -> Maybe (These a b)
553dmapToThese m = case (DMap.lookup LeftTag m, DMap.lookup RightTag m) of
554 (Nothing, Nothing) -> Nothing
555 (Just (Identity a), Nothing) -> Just $ This a
556 (Nothing, Just (Identity b)) -> Just $ That b
557 (Just (Identity a), Just (Identity b)) -> Just $ These a b
559instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
560 (<>) = alignWith (mergeThese (<>))
561 sconcat = fmap sconcat . mergeList . toList
562#if MIN_VERSION_semigroups(0,17,0)
563 stimes n = fmap $ stimes n
565 times1p n = fmap $ times1p n
568instance (Semigroup a, Reflex t) => Monoid (Event t a) where
571 mconcat = fmap sconcat . mergeList
573-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
574-- list occurs. If multiple occur at the same time they are folded from the left
575-- with the given function.
576mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
577mergeWith f es = fmap (Prelude.foldl1 f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList)
579 . DMap.fromDistinctAscList
580 . map (\(k, v) -> Const2 k :=> v)
581 $ zip [0 :: Int ..] es
583-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
584-- list occurs. If multiple occur at the same time the value is the value of the
586leftmost :: Reflex t => [Event t a] -> Event t a
587leftmost = mergeWith const
589-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
590-- list occurs and has a list of the values of all 'Event's occuring at that
592mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
594mergeList es = mergeWith (<>) $ map (fmap (:|[])) es
596-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
597-- occurs if at least one of them occurs and has a map of values of all 'Event's
598-- occuring at that time.
599mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
600mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
602-- | Split the event into an 'EventSelector' that allows efficient selection of
603-- the individual 'Event's.
604fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
605fanMap = fan . fmap mapToDMap
607-- | Switches to the new event whenever it receives one; the new event is used
608-- immediately, on the same frame that it is switched to
609switchPromptly :: forall t m a. (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
610switchPromptly ea0 eea = do
612 let eLag = switch bea
613 eCoincidences = coincidence eea
614 return $ leftmost [eCoincidences, eLag]
616instance Reflex t => Align (Event t) where
618 align ea eb = fmapMaybe dmapToThese $ merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
620-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
621-- the 'Behavior' is true at the time of occurence.
622gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
623gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
625-- | Create a new behavior given a starting behavior and switch to a the behvior
626-- carried by the event when it fires.
627switcher :: (Reflex t, MonadHold t m)
628 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
629switcher b eb = pull . (sample <=< sample) <$> hold b eb
631-- | Combine two 'Dynamic's. The result will change whenever either (or both)
632-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
633zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
634zipDyn = zipDynWith (,)
636-- | Combine two 'Dynamic's with a combining function. The result will change
637-- whenever either (or both) input 'Dynamic' changes.
638zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
640 let eab = align (updated da) (updated db)
641 ec = flip push eab $ \o -> do
644 b <- sample $ current db
647 a <- sample $ current da
649 These a b -> return (a, b)
650 return $ Just $ f a b
651 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
653instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
654 mconcat = fmap (mconcat . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]
655 mempty = constDyn mempty
656 mappend = zipDynWith mappend
658-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
659-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
660-- through the use of multiple uses of 'zipWithDyn' or 'Applicative' operators.
661distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
662distributeDMapOverDynPure dm = case DMap.toList dm of
663 [] -> constDyn DMap.empty
664 [k :=> v] -> fmap (DMap.singleton k . Identity) v
666 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
667 edmPre = merge $ DMap.map updated dm
668 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
669 olds <- sample $ current result
670 return $ DMap.unionWithKey (\_ _ new -> new) olds news
673--------------------------------------------------------------------------------
675--------------------------------------------------------------------------------
677-- | An 'Accumulator' type can be built by accumulating occurrences of an
679class Reflex t => Accumulator t f | f -> t where
680 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
681 accum f = accumMaybe $ \v o -> Just $ f v o
682 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
683 accumM f = accumMaybeM $ \v o -> Just <$> f v o
684 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
685 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
686 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
687 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
688 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
689 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
690 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
691 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
692 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
693 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
695-- | Accumulate occurrences of an 'Event', producing an output occurrence each
696-- time. Discard the underlying 'Accumulator'.
697mapAccum_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Event t c)
699 (_ :: Behavior t a, result) <- mapAccum f z e
702-- | Accumulate occurrences of an 'Event', possibly producing an output
703-- occurrence each time. Discard the underlying 'Accumulator'.
704mapAccumMaybe_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
705mapAccumMaybe_ f z e = do
706 (_ :: Behavior t a, result) <- mapAccumMaybe f z e
709-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
710-- an output occurrence each time. Discard the underlying 'Accumulator'.
711mapAccumM_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Event t c)
713 (_ :: Behavior t a, result) <- mapAccumM f z e
716-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
717-- producing an output occurrence each time. Discard the underlying
719mapAccumMaybeM_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
720mapAccumMaybeM_ f z e = do
721 (_ :: Behavior t a, result) <- mapAccumMaybeM f z e
724instance Reflex t => Accumulator t (Dynamic t) where
725 accumMaybeM f z e = do
726 rec let e' = flip push e $ \o -> do
727 v <- sample $ current d'
731 mapAccumMaybeM f z e = do
732 rec let e' = flip push e $ \o -> do
733 v <- sample $ current d'
735 return $ case result of
736 (Nothing, Nothing) -> Nothing
738 d' <- holdDyn z $ fmapMaybe fst e'
739 return (d', fmapMaybe snd e')
741instance Reflex t => Accumulator t (Behavior t) where
742 accumMaybeM f z e = current <$> accumMaybeM f z e
743 mapAccumMaybeM f z e = first current <$> mapAccumMaybeM f z e
745instance Reflex t => Accumulator t (Event t) where
746 accumMaybeM f z e = updated <$> accumMaybeM f z e
747 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
749-- | Create a new 'Event' by combining each occurence with the next value of the
750-- list using the supplied function. If the list runs out of items, all
751-- subsequent 'Event' occurrences will be ignored.
752zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
753zipListWithEvent f l e = do
754 let f' a b = case a of
755 h:t -> (Just t, Just $ f h b)
756 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
757 mapAccumMaybe_ f' l e
759--------------------------------------------------------------------------------
760-- Deprecated functions
761--------------------------------------------------------------------------------
763-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
764-- occurs. If both occur at the same time they are combined using 'mappend'.
765{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}
766appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
767appendEvents = alignWith $ mergeThese mappend
769-- | Alias for 'headE'
770{-# DEPRECATED onceE "Use 'headE' instead" #-}
771onceE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
774{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
775{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
776sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
777sequenceThese t = case t of
778 This ma -> liftM This ma
779 These ma mb -> liftM2 These ma mb
780 That mb -> liftM That mb
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list