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
66 -- * Debugging functions
75 -- * Miscellaneous convenience functions
77 -- * Deprecated functions
83import Control.Applicative
84import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
85import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
86import Control.Monad.State.Strict hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
87import Control.Monad.Trans.Cont (ContT ())
88import Control.Monad.Trans.Except (ExceptT ())
89import Control.Monad.Trans.RWS (RWST ())
90import Control.Monad.Trans.Writer (WriterT ())
93import Data.Dependent.Map (DMap, DSum (..), GCompare (..), GOrdering (..))
94import qualified Data.Dependent.Map as DMap
95import Data.Dependent.Sum (ShowTag (..))
97import Data.Functor.Bind hiding (join)
98import qualified Data.Functor.Bind as Bind
99import Data.Functor.Compose
100import Data.Functor.Constant
101import Data.Functor.Misc
102import Data.Functor.Plus
103import Data.GADT.Compare ((:~:) (..), GEq (..))
104import Data.GADT.Show (GShow (..))
105import Data.List.NonEmpty (NonEmpty (..))
108import Data.Monoid hiding (Alt, (<>))
109import Data.Semigroup (Semigroup, sconcat, stimes, stimesIdempotentMonoid, (<>))
112import Data.Traversable
114-- Note: must come last to silence warnings due to AMP on GHC < 7.10
115import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)
117import Debug.Trace (trace)
119-- | The 'Reflex' class contains all the primitive functionality needed for
120-- Functional Reactive Programming (FRP). The @t@ type parameter indicates
121-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
122-- and the type of the timeline determines the FRP engine to be used. For most
123-- purposes, the 'Reflex.Spider' implementation is recommended.
124class ( MonadHold t (PushM t)
125 , MonadSample t (PullM t)
128 , Functor (Behavior t)
129 , Functor (Dynamic t)
130 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
133 -- | A container for a value that can change over time. 'Behavior's can be
134 -- sampled at will, but it is not possible to be notified when they change
135 data Behavior t :: * -> *
136 -- | A stream of occurrences. During any given frame, an 'Event' is either
137 -- occurring or not occurring; if it is occurring, it will contain a value of
138 -- the given type (its "occurrence type")
139 data Event t :: * -> *
140 -- | A container for a value that can change over time and allows
141 -- notifications on changes. Basically a combination of a 'Behavior' and an
142 -- 'Event', with a rule that the 'Behavior' will change if and only if the
144 data Dynamic t :: * -> *
145 -- | A container for a value that can change over time and allows
146 -- notifications on changes. Basically a combination of a 'Behavior' and an
147 -- 'Event', with a rule that the 'Behavior' will change if and only if the
149 data Incremental t :: (* -> *) -> * -> *
150 -- | An 'Event' with no occurrences
152 -- | Create a 'Behavior' that always has the given value
153 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
154 -- | Create an 'Event' from another 'Event'; the provided function can sample
155 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
156 -- (Just) or non-occurring (Nothing) result
157 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
158 -- | A monad for doing complex push-based calculations efficiently
159 type PushM t :: * -> *
160 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
161 -- recomputed whenever any of the read 'Behavior's changes
162 pull :: PullM t a -> Behavior t a
163 -- | A monad for doing complex pull-based calculations efficiently
164 type PullM t :: * -> *
165 -- | Merge a collection of events; the resulting 'Event' will only occur if at
166 -- least one input event is occuring, and will contain all of the input keys
167 -- that are occurring simultaneously
168 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
169 -- | Efficiently fan-out an event to many destinations. This function should
170 -- be partially applied, and then the result applied repeatedly to create
172 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
173 -- | Create an 'Event' that will occur whenever the currently-selected input
175 switch :: Behavior t (Event t a) -> Event t a
176 -- | Create an 'Event' that will occur whenever the input event is occurring
177 -- and its occurrence value, another 'Event', is also occurring
178 coincidence :: Event t (Event t a) -> Event t a
179 -- | Extract the 'Behavior' of a 'Dynamic'.
180 current :: Dynamic t a -> Behavior t a
181 -- | Extract the 'Event' of the 'Dynamic'.
182 updated :: Dynamic t a -> Event t a
183 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
184 -- recent firing of the given 'Event', if any.
185 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
186 -- | Create a new 'Incremental'. The given 'PullM''s value must always change
187 -- in the same way that the accumulated application of patches would change
189 unsafeBuildIncremental :: Patch p => PullM t a -> Event t (p a) -> Incremental t p a
190 -- | Create a merge whose parents can change over time
191 mergeIncremental :: GCompare k => Incremental t PatchDMap (DMap k (Event t)) -> Event t (DMap k Identity)
192 -- | Extract the 'Behavior' component of an 'Incremental'
193 currentIncremental :: Patch p => Incremental t p a -> Behavior t a
194 -- | Extract the 'Event' component of an 'Incremental'
195 updatedIncremental :: Patch p => Incremental t p a -> Event t (p a)
196 -- | Convert an 'Incremental' to a 'Dynamic'
197 incrementalToDynamic :: Patch p => Incremental t p a -> Dynamic t a
199-- | A 'Patch' type represents a kind of change made to a datastructure.
201 -- | Apply the patch @p a@ to the value @a@. If no change is needed, return
203 apply :: p a -> a -> Maybe a
205instance Patch Identity where
206 apply (Identity a) _ = Just a
208-- | A set of changes to a 'DMap'. Only DMap types are allowed for @a@.
209data PatchDMap a where
210 PatchDMap :: GCompare k => DMap k (Compose Maybe v) -> PatchDMap (DMap k v)
212instance GCompare k => Semigroup (PatchDMap (DMap k v)) where
213 PatchDMap a <> PatchDMap b = PatchDMap $ a `mappend` b --TODO: Add a semigroup instance for DMap
214 -- PatchDMap is idempotent, so stimes n is id for every n
215#if MIN_VERSION_semigroups(0,17,0)
216 stimes = stimesIdempotentMonoid
218 times1p n x = case compare n 0 of
219 LT -> error "stimesIdempotentMonoid: negative multiplier"
224instance GCompare k => Monoid (PatchDMap (DMap k v)) where
225 mempty = PatchDMap mempty
228instance Patch PatchDMap where
229 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?
230 where insertions = DMap.mapMaybeWithKey (const $ getCompose) diff
231 deletions = DMap.mapMaybeWithKey (const $ nothingToJust . getCompose) diff
232 nothingToJust = \case
233 Nothing -> Just $ Constant ()
236-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
237-- _must_ change when and only when the 'Event' fires, such that the
238-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
239-- if this is not the case, the resulting 'Dynamic' will behave
240-- nondeterministically.
241unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
242unsafeDynamic = unsafeBuildDynamic . sample
244-- | Construct a 'Dynamic' value that never changes
245constDyn :: Reflex t => a -> Dynamic t a
248-- | 'MonadSample' designates monads that can read the current value of a
249-- 'Behavior'. This includes both 'PullM' and 'PushM'.
250class (Applicative m, Monad m) => MonadSample t m | m -> t where
251 -- | Get the current value in the 'Behavior'
252 sample :: Behavior t a -> m a
254-- | 'MonadHold' designates monads that can create new 'Behavior's based on
255-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
256-- is required to create any stateful computations with Reflex.
257class MonadSample t m => MonadHold t m where
258 -- | Create a new 'Behavior' whose value will initially be equal to the given
259 -- value and will be updated whenever the given 'Event' occurs. The update
260 -- takes effect immediately after the 'Event' occurs; if the occurrence that
261 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
262 -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new
264 hold :: a -> Event t a -> m (Behavior t a)
265 -- | Create a 'Dynamic' value using the given initial value that changes every
266 -- time the 'Event' occurs.
267 holdDyn :: a -> Event t a -> m (Dynamic t a)
268 -- | Create an 'Incremental' value using the given initial value that changes
269 -- every time the 'Event' occurs.
270 holdIncremental :: Patch p => a -> Event t (p a) -> m (Incremental t p a)
272-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
273-- key. This is much more efficient than filtering for each key with
275newtype EventSelector t k = EventSelector
276 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
277 -- determined by the type of the key, so this can be used to fan-out
278 -- 'Event's whose sub-'Event's have different types.
280 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
281 -- (but equivalent to) using 'fmapMaybe' to select only the relevant
282 -- occurrences of an 'Event'.
283 select :: forall a. k a -> Event t a
286--------------------------------------------------------------------------------
288--------------------------------------------------------------------------------
290instance MonadSample t m => MonadSample t (ReaderT r m) where
291 sample = lift . sample
293instance MonadHold t m => MonadHold t (ReaderT r m) where
294 hold a0 = lift . hold a0
295 holdDyn a0 = lift . holdDyn a0
296 holdIncremental a0 = lift . holdIncremental a0
298instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
299 sample = lift . sample
301instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
302 hold a0 = lift . hold a0
303 holdDyn a0 = lift . holdDyn a0
304 holdIncremental a0 = lift . holdIncremental a0
306instance MonadSample t m => MonadSample t (StateT s m) where
307 sample = lift . sample
309instance MonadHold t m => MonadHold t (StateT s m) where
310 hold a0 = lift . hold a0
311 holdDyn a0 = lift . holdDyn a0
312 holdIncremental a0 = lift . holdIncremental a0
314instance MonadSample t m => MonadSample t (ExceptT e m) where
315 sample = lift . sample
317instance MonadHold t m => MonadHold t (ExceptT e m) where
318 hold a0 = lift . hold a0
319 holdDyn a0 = lift . holdDyn a0
320 holdIncremental a0 = lift . holdIncremental a0
322instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
323 sample = lift . sample
325instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
326 hold a0 = lift . hold a0
327 holdDyn a0 = lift . holdDyn a0
328 holdIncremental a0 = lift . holdIncremental a0
330instance MonadSample t m => MonadSample t (ContT r m) where
331 sample = lift . sample
333instance MonadHold t m => MonadHold t (ContT r m) where
334 hold a0 = lift . hold a0
335 holdDyn a0 = lift . holdDyn a0
336 holdIncremental a0 = lift . holdIncremental a0
338--------------------------------------------------------------------------------
339-- Convenience functions
340--------------------------------------------------------------------------------
342-- | Create an 'Event' from another 'Event'. The provided function can sample
343-- 'Behavior's and hold 'Event's.
344pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
345pushAlways f = push (fmap Just . f)
347-- | Flipped version of 'fmap'.
348ffor :: Functor f => f a -> (a -> b) -> f b
351instance Reflex t => Applicative (Behavior t) where
353 f <*> x = pull $ sample f `ap` sample x
357instance Reflex t => Apply (Behavior t) where
360instance Reflex t => Bind (Behavior t) where
363instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
365 fromRational = pure . fromRational
368instance Reflex t => Functor (Behavior t) where
369 fmap f = pull . fmap f . sample
371instance (Reflex t, IsString a) => IsString (Behavior t a) where
372 fromString = pure . fromString
374instance Reflex t => Monad (Behavior t) where
375 a >>= f = pull $ sample a >>= sample . f
376 -- 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.
378 fail = error "Monad (Behavior t) does not support fail"
380instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
381 mempty = constant mempty
382 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
383 mconcat = pull . fmap mconcat . mapM sample
385instance (Reflex t, Num a) => Num (Behavior t a) where
390 fromInteger = pure . fromInteger
394instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
395 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
396 sconcat = pull . fmap sconcat . mapM sample
397#if MIN_VERSION_semigroups(0,17,0)
398 stimes n = fmap $ stimes n
400 times1p n = fmap $ times1p n
403--TODO: See if there's a better class in the standard libraries already
404-- | A class for values that combines filtering and mapping using 'Maybe'.
405class FunctorMaybe f where
406 -- | Combined mapping and filtering function.
407 fmapMaybe :: (a -> Maybe b) -> f a -> f b
409instance FunctorMaybe [] where
410 fmapMaybe f = catMaybes . fmap f
412-- | Flipped version of 'fmapMaybe'.
413fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b
414fforMaybe = flip fmapMaybe
416-- | Filter 'f a' using the provided predicate.
417-- Relies on 'fforMaybe'.
418ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
419ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
421-- | Left-biased event union (prefers left event on simultaneous
423instance Reflex t => Alt (Event t) where
424 ev1 <!> ev2 = leftmost [ev1, ev2]
426-- | 'Event' intersection (convenient interface to 'coincidence').
427instance Reflex t => Apply (Event t) where
428 evf <.> evx = coincidence (fmap (<$> evx) evf)
430-- | 'Event' intersection (convenient interface to 'coincidence').
431instance Reflex t => Bind (Event t) where
432 evx >>- f = coincidence (f <$> evx)
435instance Reflex t => Functor (Event t) where
436 fmap f = fmapMaybe $ Just . f
438instance Reflex t => FunctorMaybe (Event t) where
439 fmapMaybe f = push $ return . f
441-- | Never: @'zero' = 'never'@.
442instance Reflex t => Plus (Event t) where
445-- | Replace each occurrence value of the 'Event' with the value of the
446-- 'Behavior' at the time of that occurrence.
447tag :: Reflex t => Behavior t b -> Event t a -> Event t b
448tag b = pushAlways $ \_ -> sample b
450-- | Create a new 'Event' that combines occurences of supplied 'Event' with the
451-- current value of the 'Behavior'.
452attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
453attach = attachWith (,)
455-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
456-- combining it with the current value of the 'Behavior'.
457attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
458attachWith f = attachWithMaybe $ \a b -> Just $ f a b
460-- | Create a new 'Event' by combining each occurence with the current value of
461-- the 'Behavior'. The occurrence is discarded if the combining function returns
463attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
464attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
466-- | Create a new 'Event' that only occurs only once, on the first occurence of
467-- the supplied 'Event'.
468headE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
470 rec be <- hold e $ fmap (const never) e'
475-- | Create a new 'Event' that occurs on all but the first occurence of the
477tailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
478tailE e = snd <$> headTailE e
480-- | Create a tuple of two 'Event's with the first one occuring only the first
481-- time the supplied 'Event' occurs and the second occuring on all but the first
483headTailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a, Event t a)
486 be <- hold never $ fmap (const e) eHead
487 return (eHead, switch be)
489-- | Split the supplied 'Event' into two individual 'Event's occuring at the
490-- same time with the respective values from the tuple.
491splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
492splitE e = (fmap fst e, fmap snd e)
494-- | Print the supplied 'String' and the value of the 'Event' on each
495-- occurence. This should /only/ be used for debugging.
497-- Note: As with Debug.Trace.trace, the message will only be printed if the
498-- 'Event' is actually used.
499traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
500traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
502-- | Print the output of the supplied function on each occurence of the
503-- 'Event'. This should /only/ be used for debugging.
505-- Note: As with Debug.Trace.trace, the message will only be printed if the
506-- 'Event' is actually used.
507traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
508traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
510-- | Tag type for 'Either' to use it as a 'DSum'.
511data EitherTag l r a where
512 LeftTag :: EitherTag l r l
513 RightTag :: EitherTag l r r
515instance GEq (EitherTag l r) where
516 geq a b = case (a, b) of
517 (LeftTag, LeftTag) -> Just Refl
518 (RightTag, RightTag) -> Just Refl
521instance GCompare (EitherTag l r) where
522 gcompare a b = case (a, b) of
523 (LeftTag, LeftTag) -> GEQ
524 (LeftTag, RightTag) -> GLT
525 (RightTag, LeftTag) -> GGT
526 (RightTag, RightTag) -> GEQ
528instance GShow (EitherTag l r) where
529 gshowsPrec _ a = case a of
530 LeftTag -> showString "LeftTag"
531 RightTag -> showString "RightTag"
533instance (Show l, Show r) => ShowTag (EitherTag l r) Identity where
534 showTaggedPrec t n (Identity a) = case t of
535 LeftTag -> showsPrec n a
536 RightTag -> showsPrec n a
538-- | Convert 'Either' to a 'DSum'. Inverse of 'dsumToEither'.
539eitherToDSum :: Either a b -> DSum (EitherTag a b) Identity
541 Left a -> (LeftTag :=> Identity a)
542 Right b -> (RightTag :=> Identity b)
544-- | Convert 'DSum' to 'Either'. Inverse of 'eitherToDSum'.
545dsumToEither :: DSum (EitherTag a b) Identity -> Either a b
547 (LeftTag :=> Identity a) -> Left a
548 (RightTag :=> Identity b) -> Right b
550-- | Extract the values of a 'DMap' of 'EitherTag's.
551dmapToThese :: DMap (EitherTag a b) Identity -> Maybe (These a b)
552dmapToThese m = case (DMap.lookup LeftTag m, DMap.lookup RightTag m) of
553 (Nothing, Nothing) -> Nothing
554 (Just (Identity a), Nothing) -> Just $ This a
555 (Nothing, Just (Identity b)) -> Just $ That b
556 (Just (Identity a), Just (Identity b)) -> Just $ These a b
558instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
559 (<>) = alignWith (mergeThese (<>))
560 sconcat = fmap sconcat . mergeList . toList
561#if MIN_VERSION_semigroups(0,17,0)
562 stimes n = fmap $ stimes n
564 times1p n = fmap $ times1p n
567instance (Semigroup a, Reflex t) => Monoid (Event t a) where
570 mconcat = fmap sconcat . mergeList
572-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
573-- list occurs. If multiple occur at the same time they are folded from the left
574-- with the given function.
575mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
576mergeWith f es = fmap (Prelude.foldl1 f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList)
578 . DMap.fromDistinctAscList
579 . map (\(k, v) -> Const2 k :=> v)
580 $ zip [0 :: Int ..] es
582-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
583-- list occurs. If multiple occur at the same time the value is the value of the
585leftmost :: Reflex t => [Event t a] -> Event t a
586leftmost = mergeWith const
588-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
589-- list occurs and has a list of the values of all 'Event's occuring at that
591mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
593mergeList es = mergeWith (<>) $ map (fmap (:|[])) es
595-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
596-- occurs if at least one of them occurs and has a map of values of all 'Event's
597-- occuring at that time.
598mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
599mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
601-- | Split the event into an 'EventSelector' that allows efficient selection of
602-- the individual 'Event's.
603fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
604fanMap = fan . fmap mapToDMap
606-- | Switches to the new event whenever it receives one; the new event is used
607-- immediately, on the same frame that it is switched to
608switchPromptly :: forall t m a. (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
609switchPromptly ea0 eea = do
611 let eLag = switch bea
612 eCoincidences = coincidence eea
613 return $ leftmost [eCoincidences, eLag]
615instance Reflex t => Align (Event t) where
617 align ea eb = fmapMaybe dmapToThese $ merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
619-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
620-- the 'Behavior' is true at the time of occurence.
621gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
622gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
624-- | Create a new behavior given a starting behavior and switch to a the behvior
625-- carried by the event when it fires.
626switcher :: (Reflex t, MonadHold t m)
627 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
628switcher b eb = pull . (sample <=< sample) <$> hold b eb
630-- | Combine two 'Dynamic's. The result will change whenever either (or both)
631-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
632zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
633zipDyn = zipDynWith (,)
635-- | Combine two 'Dynamic's with a combining function. The result will change
636-- whenever either (or both) input 'Dynamic' changes.
637zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
639 let eab = align (updated da) (updated db)
640 ec = flip push eab $ \o -> do
643 b <- sample $ current db
646 a <- sample $ current da
648 These a b -> return (a, b)
649 return $ Just $ f a b
650 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
652instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
653 mconcat = fmap (mconcat . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]
654 mempty = constDyn mempty
655 mappend = zipDynWith mappend
657-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
658-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
659-- through the use of multiple uses of 'zipWithDyn' or 'Applicative' operators.
660distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
661distributeDMapOverDynPure dm = case DMap.toList dm of
662 [] -> constDyn DMap.empty
663 [k :=> v] -> fmap (DMap.singleton k . Identity) v
665 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
666 edmPre = merge $ DMap.map updated dm
667 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
668 olds <- sample $ current result
669 return $ DMap.unionWithKey (\_ _ new -> new) olds news
672--------------------------------------------------------------------------------
674--------------------------------------------------------------------------------
676-- | An 'Accumulator' type can be built by accumulating occurrences of an
678class Reflex t => Accumulator t f | f -> t where
679 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
680 accum f = accumMaybe $ \v o -> Just $ f v o
681 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
682 accumM f = accumMaybeM $ \v o -> Just <$> f v o
683 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
684 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
685 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
686 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
687 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
688 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
689 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
690 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
691 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
692 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
694-- | Accumulate occurrences of an 'Event', producing an output occurrence each
695-- time. Discard the underlying 'Accumulator'.
696mapAccum_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Event t c)
698 (_ :: Behavior t a, result) <- mapAccum f z e
701-- | Accumulate occurrences of an 'Event', possibly producing an output
702-- occurrence each time. Discard the underlying 'Accumulator'.
703mapAccumMaybe_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
704mapAccumMaybe_ f z e = do
705 (_ :: Behavior t a, result) <- mapAccumMaybe f z e
708-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
709-- an output occurrence each time. Discard the underlying 'Accumulator'.
710mapAccumM_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Event t c)
712 (_ :: Behavior t a, result) <- mapAccumM f z e
715-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
716-- producing an output occurrence each time. Discard the underlying
718mapAccumMaybeM_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
719mapAccumMaybeM_ f z e = do
720 (_ :: Behavior t a, result) <- mapAccumMaybeM f z e
723instance Reflex t => Accumulator t (Dynamic t) where
724 accumMaybeM f z e = do
725 rec let e' = flip push e $ \o -> do
726 v <- sample $ current d'
730 mapAccumMaybeM f z e = do
731 rec let e' = flip push e $ \o -> do
732 v <- sample $ current d'
734 return $ case result of
735 (Nothing, Nothing) -> Nothing
737 d' <- holdDyn z $ fmapMaybe fst e'
738 return (d', fmapMaybe snd e')
740instance Reflex t => Accumulator t (Behavior t) where
741 accumMaybeM f z e = current <$> accumMaybeM f z e
742 mapAccumMaybeM f z e = first current <$> mapAccumMaybeM f z e
744instance Reflex t => Accumulator t (Event t) where
745 accumMaybeM f z e = updated <$> accumMaybeM f z e
746 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
748-- | Create a new 'Event' by combining each occurence with the next value of the
749-- list using the supplied function. If the list runs out of items, all
750-- subsequent 'Event' occurrences will be ignored.
751zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
752zipListWithEvent f l e = do
753 let f' a b = case a of
754 h:t -> (Just t, Just $ f h b)
755 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
756 mapAccumMaybe_ f' l e
758--------------------------------------------------------------------------------
759-- Deprecated functions
760--------------------------------------------------------------------------------
762-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
763-- occurs. If both occur at the same time they are combined using 'mappend'.
764{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}
765appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
766appendEvents = alignWith $ mergeThese mappend
768-- | Alias for 'headE'
769{-# DEPRECATED onceE "Use 'headE' instead" #-}
770onceE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
773{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
774{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
775sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
776sequenceThese t = case t of
777 This ma -> liftM This ma
778 These ma mb -> liftM2 These ma mb
779 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