1{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE ConstraintKinds #-}
4{-# LANGUAGE DefaultSignatures #-}
5{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE FunctionalDependencies #-}
9{-# LANGUAGE LambdaCase #-}
10{-# LANGUAGE MultiParamTypeClasses #-}
11{-# LANGUAGE NoMonomorphismRestriction #-}
12{-# LANGUAGE PolyKinds #-}
13{-# LANGUAGE RankNTypes #-}
14{-# LANGUAGE RecursiveDo #-}
15{-# LANGUAGE RoleAnnotations #-}
16{-# LANGUAGE ScopedTypeVariables #-}
17{-# LANGUAGE TypeFamilies #-}
18{-# LANGUAGE TypeOperators #-}
19{-# LANGUAGE UndecidableInstances #-}
20#ifdef USE_REFLEX_OPTIMIZER
21{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
24-- | This module contains the Reflex interface, as well as a variety of
25-- convenience functions for working with 'Event's, 'Behavior's, and other
37 -- ** 'fan'-related types
39 , EventSelectorInt (..)
40 -- ** 'Incremental'-related types
41 -- * Convenience functions
44 -- ** Combining 'Event's
48 , mergeMapIncrementalWithMove
49 , mergeIntMapIncremental
54 -- ** Breaking up 'Event's
64 -- ** Collapsing 'Event . Event'
67 , switchHoldPromptOnly
68 -- ** Using 'Event's to sample 'Behavior's
73 -- ** Blocking an 'Event' based on a 'Behavior'
75 -- ** Combining 'Dynamic's
76 , distributeDMapOverDynPure
77 , distributeListOverDyn
78 , distributeListOverDynWith
81 -- ** Accumulating state
105 , numberOccurrencesFrom
106 , numberOccurrencesFrom_
116 -- * Debugging functions
119 -- * Unsafe functions
121 , unsafeMapIncremental
128 -- * Miscellaneous convenience functions
132 -- * Deprecated functions
146 -- * Slow, but general, implementations
150import Control.Applicative
151import Control.Monad.Identity
152import Control.Monad.Reader
153import Control.Monad.State.Strict
154import Control.Monad.Trans.Cont (ContT)
155import Control.Monad.Trans.Except (ExceptT)
156import Control.Monad.Trans.RWS (RWST)
157import Control.Monad.Trans.Writer (WriterT)
162import Data.Dependent.Map (DMap, DSum (..))
163import qualified Data.Dependent.Map as DMap
164import Data.Functor.Compose
165import Data.Functor.Product
166import Data.GADT.Compare (GEq (..), GCompare (..), (:~:) (..))
167import Data.FastMutableIntMap (PatchIntMap)
169import Data.Functor.Bind
170import Data.Functor.Misc
171import Data.Functor.Plus
172import Data.IntMap.Strict (IntMap)
173import qualified Data.IntMap.Strict as IntMap
174import Data.List.NonEmpty (NonEmpty (..))
176import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
177import Data.Some (Some)
178import qualified Data.Some as Some
181import Data.Type.Coercion
182import Reflex.FunctorMaybe
185import Debug.Trace (trace)
187-- | The 'Reflex' class contains all the primitive functionality needed for
188-- Functional Reactive Programming (FRP). The @t@ type parameter indicates
189-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
190-- and the type of the timeline determines the FRP engine to be used. For most
191-- purposes, the 'Reflex.Spider' implementation is recommended.
192class ( MonadHold t (PushM t)
193 , MonadSample t (PullM t)
195 , Functor (Dynamic t)
196 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
199 -- | A container for a value that can change over time. 'Behavior's can be
200 -- sampled at will, but it is not possible to be notified when they change
201 data Behavior t :: * -> *
202 -- | A stream of occurrences. During any given frame, an 'Event' is either
203 -- occurring or not occurring; if it is occurring, it will contain a value of
204 -- the given type (its "occurrence type")
205 data Event t :: * -> *
206 -- | A container for a value that can change over time and allows
207 -- notifications on changes. Basically a combination of a 'Behavior' and an
208 -- 'Event', with a rule that the 'Behavior' will change if and only if the
210 data Dynamic t :: * -> *
211 -- | An 'Incremental' is a more general form of a 'Dynamic'.
212 -- Instead of always fully replacing the value, only parts of it can be patched.
213 -- This is only needed for performance critical code via `mergeIncremental` to make small
214 -- changes to large values.
215 data Incremental t :: * -> *
216 -- | A monad for doing complex push-based calculations efficiently
217 type PushM t :: * -> *
218 -- | A monad for doing complex pull-based calculations efficiently
219 type PullM t :: * -> *
220 -- | An 'Event' with no occurrences
222 -- | Create a 'Behavior' that always has the given value
223 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
224 -- | Create an 'Event' from another 'Event'; the provided function can sample
225 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
226 -- (Just) or non-occurring (Nothing) result
227 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
228 -- | Like 'push' but intended for functions that the implementation can consider cheap to compute for performance considerations. WARNING: The function passed to 'pushCheap' may be run multiple times without any caching.
229 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
230 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
231 -- recomputed whenever any of the read 'Behavior's changes
232 pull :: PullM t a -> Behavior t a
233 -- | Merge a collection of events; the resulting 'Event' will only occur if at
234 -- least one input event is occurring, and will contain all of the input keys
235 -- that are occurring simultaneously
236 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
237 -- | Efficiently fan-out an event to many destinations. This function should
238 -- be partially applied, and then the result applied repeatedly to create
240 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
241 -- | Create an 'Event' that will occur whenever the currently-selected input
243 switch :: Behavior t (Event t a) -> Event t a
244 -- | Create an 'Event' that will occur whenever the input event is occurring
245 -- and its occurrence value, another 'Event', is also occurring
246 coincidence :: Event t (Event t a) -> Event t a
247 -- | Extract the 'Behavior' of a 'Dynamic'.
248 current :: Dynamic t a -> Behavior t a
249 -- | Extract the 'Event' of the 'Dynamic'.
250 updated :: Dynamic t a -> Event t a
251 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
252 -- recent firing of the given 'Event', if any.
253 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
254 -- | Create a new 'Incremental'. The given 'PullM''s value must always change
255 -- in the same way that the accumulated application of patches would change
257 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
258 -- | Create a merge whose parents can change over time
259 mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
260 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
261 mergeIncrementalWithMove :: GCompare k => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
262 -- | Extract the 'Behavior' component of an 'Incremental'
263 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
264 -- | Extract the 'Event' component of an 'Incremental'
265 updatedIncremental :: Patch p => Incremental t p -> Event t p
266 -- | Convert an 'Incremental' to a 'Dynamic'
267 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
268 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
270 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
271 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
273 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
274 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
276 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
277 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
278 fanInt :: Event t (IntMap a) -> EventSelectorInt t a
280--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on
281mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
282mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never
284-- | Coerce a 'Behavior' between representationally-equivalent value types
285coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
286coerceBehavior = coerceWith $ behaviorCoercion Coercion
288-- | Coerce an 'Event' between representationally-equivalent occurrence types
289coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
290coerceEvent = coerceWith $ eventCoercion Coercion
292-- | Coerce a 'Dynamic' between representationally-equivalent value types
293coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
294coerceDynamic = coerceWith $ dynamicCoercion Coercion
296-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
297-- _must_ change when and only when the 'Event' fires, such that the
298-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
299-- if this is not the case, the resulting 'Dynamic' will behave
300-- nondeterministically.
301unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
302unsafeDynamic = unsafeBuildDynamic . sample
304-- | Construct a 'Dynamic' value that never changes
305constDyn :: Reflex t => a -> Dynamic t a
308instance (Reflex t, Default a) => Default (Dynamic t a) where
311-- | 'MonadSample' designates monads that can read the current value of a
312-- 'Behavior'. This includes both 'PullM' and 'PushM'.
313class (Applicative m, Monad m) => MonadSample t m | m -> t where
314 -- | Get the current value in the 'Behavior'
315 sample :: Behavior t a -> m a
317-- | 'MonadHold' designates monads that can create new 'Behavior's based on
318-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
319-- is required to create any stateful computations with Reflex.
320class MonadSample t m => MonadHold t m where
321 -- | Create a new 'Behavior' whose value will initially be equal to the given
322 -- value and will be updated whenever the given 'Event' occurs. The update
323 -- takes effect immediately after the 'Event' occurs; if the occurrence that
324 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
325 -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new
327 hold :: a -> Event t a -> m (Behavior t a)
328 default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)
329 hold v0 = lift . hold v0
330 -- | Create a 'Dynamic' value using the given initial value that changes every
331 -- time the 'Event' occurs.
332 holdDyn :: a -> Event t a -> m (Dynamic t a)
333 default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)
334 holdDyn v0 = lift . holdDyn v0
335 -- | Create an 'Incremental' value using the given initial value that changes
336 -- every time the 'Event' occurs.
337 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
338 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
339 holdIncremental v0 = lift . holdIncremental v0
340 buildDynamic :: PullM t a -> Event t a -> m (Dynamic t a)
342 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
343 buildDynamic getV0 = lift . buildDynamic getV0
345 -- | Create a new 'Event' that only occurs only once, on the first occurrence of
346 -- the supplied 'Event'.
347 headE :: Event t a -> m (Event t a)
350slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
352 rec be <- hold e $ fmapCheap (const never) e'
356-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
357-- key. This is much more efficient than filtering for each key with
359newtype EventSelector t k = EventSelector
360 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
361 -- determined by the type of the key, so this can be used to fan-out
362 -- 'Event's whose sub-'Event's have different types.
364 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
365 -- (but equivalent to) using 'fmapMaybe' to select only the relevant
366 -- occurrences of an 'Event'.
367 select :: forall a. k a -> Event t a
370newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }
372--------------------------------------------------------------------------------
374--------------------------------------------------------------------------------
376instance MonadSample t m => MonadSample t (ReaderT r m) where
377 sample = lift . sample
379instance MonadHold t m => MonadHold t (ReaderT r m) where
380 hold a0 = lift . hold a0
381 holdDyn a0 = lift . holdDyn a0
382 holdIncremental a0 = lift . holdIncremental a0
383 buildDynamic a0 = lift . buildDynamic a0
386instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
387 sample = lift . sample
389instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
390 hold a0 = lift . hold a0
391 holdDyn a0 = lift . holdDyn a0
392 holdIncremental a0 = lift . holdIncremental a0
393 buildDynamic a0 = lift . buildDynamic a0
396instance MonadSample t m => MonadSample t (StateT s m) where
397 sample = lift . sample
399instance MonadHold t m => MonadHold t (StateT s m) where
400 hold a0 = lift . hold a0
401 holdDyn a0 = lift . holdDyn a0
402 holdIncremental a0 = lift . holdIncremental a0
403 buildDynamic a0 = lift . buildDynamic a0
406instance MonadSample t m => MonadSample t (ExceptT e m) where
407 sample = lift . sample
409instance MonadHold t m => MonadHold t (ExceptT e m) where
410 hold a0 = lift . hold a0
411 holdDyn a0 = lift . holdDyn a0
412 holdIncremental a0 = lift . holdIncremental a0
413 buildDynamic a0 = lift . buildDynamic a0
416instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
417 sample = lift . sample
419instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
420 hold a0 = lift . hold a0
421 holdDyn a0 = lift . holdDyn a0
422 holdIncremental a0 = lift . holdIncremental a0
423 buildDynamic a0 = lift . buildDynamic a0
426instance MonadSample t m => MonadSample t (ContT r m) where
427 sample = lift . sample
429instance MonadHold t m => MonadHold t (ContT r m) where
430 hold a0 = lift . hold a0
431 holdDyn a0 = lift . holdDyn a0
432 holdIncremental a0 = lift . holdIncremental a0
433 buildDynamic a0 = lift . buildDynamic a0
436--------------------------------------------------------------------------------
437-- Convenience functions
438--------------------------------------------------------------------------------
440-- | Create an 'Event' from another 'Event'. The provided function can sample
441-- 'Behavior's and hold 'Event's.
442pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
443pushAlways f = push (fmap Just . f)
445-- | Flipped version of 'fmap'.
446ffor :: Functor f => f a -> (a -> b) -> f b
449-- | Rotated version of 'liftA2'.
450ffor2 :: Applicative f => f a -> f b -> (a -> b -> c) -> f c
451ffor2 a b f = liftA2 f a b
453-- | Rotated version of 'liftA3'.
454ffor3 :: Applicative f => f a -> f b -> f c -> (a -> b -> c -> d) -> f d
455ffor3 a b c f = liftA3 f a b c
457instance Reflex t => Applicative (Behavior t) where
459 f <*> x = pull $ sample f `ap` sample x
463instance Reflex t => Apply (Behavior t) where
466instance Reflex t => Bind (Behavior t) where
469instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
471 fromRational = pure . fromRational
474instance Reflex t => Functor (Behavior t) where
475 fmap f = pull . fmap f . sample
477instance (Reflex t, IsString a) => IsString (Behavior t a) where
478 fromString = pure . fromString
480instance Reflex t => Monad (Behavior t) where
481 a >>= f = pull $ sample a >>= sample . f
482 -- 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.
484 fail = error "Monad (Behavior t) does not support fail"
486instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
487 mempty = constant mempty
488 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
489 mconcat = pull . fmap mconcat . mapM sample
491instance (Reflex t, Num a) => Num (Behavior t a) where
496 fromInteger = pure . fromInteger
500instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
501 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
502 sconcat = pull . fmap sconcat . mapM sample
503#if MIN_VERSION_semigroups(0,17,0)
504 stimes n = fmap $ stimes n
506 times1p n = fmap $ times1p n
509-- | Flipped version of 'fmapMaybe'.
510fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b
511fforMaybe = flip fmapMaybe
513-- | Filter 'f a' using the provided predicate.
514-- Relies on 'fforMaybe'.
515ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
516ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
518-- | Filter 'Left's from 'f (Either a b)' into 'a'.
519filterLeft :: FunctorMaybe f => f (Either a b) -> f a
520filterLeft = fmapMaybe (either Just (const Nothing))
522-- | Filter 'Right's from 'f (Either a b)' into 'b'.
523filterRight :: FunctorMaybe f => f (Either a b) -> f b
524filterRight = fmapMaybe (either (const Nothing) Just)
526-- | Left-biased event union (prefers left event on simultaneous
528instance Reflex t => Alt (Event t) where
529 ev1 <!> ev2 = leftmost [ev1, ev2]
531-- | 'Event' intersection (convenient interface to 'coincidence').
532instance Reflex t => Apply (Event t) where
533 evf <.> evx = coincidence (fmap (<$> evx) evf)
535-- | 'Event' intersection (convenient interface to 'coincidence').
536instance Reflex t => Bind (Event t) where
537 evx >>- f = coincidence (f <$> evx)
540instance Reflex t => Functor (Event t) where
542 fmap f = fmapMaybe $ Just . f
544 x <$ e = fmapCheap (const x) e
546instance Reflex t => FunctorMaybe (Event t) where
547 {-# INLINE fmapMaybe #-}
548 fmapMaybe f = push $ return . f
550-- | Never: @'zero' = 'never'@.
551instance Reflex t => Plus (Event t) where
554-- | Replace each occurrence value of the 'Event' with the value of the
555-- 'Behavior' at the time of that occurrence.
556tag :: Reflex t => Behavior t b -> Event t a -> Event t b
557tag b = pushAlways $ \_ -> sample b
559-- | Create a new 'Event' that combines occurrences of supplied 'Event' with the
560-- current value of the 'Behavior'.
561attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
562attach = attachWith (,)
564-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
565-- combining it with the current value of the 'Behavior'.
566attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
567attachWith f = attachWithMaybe $ \a b -> Just $ f a b
569-- | Create a new 'Event' by combining each occurrence with the current value of
570-- the 'Behavior'. The occurrence is discarded if the combining function returns
572attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
573attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
575-- | Create a new 'Event' that occurs on all but the first occurrence of the
577tailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a)
578tailE e = snd <$> headTailE e
580-- | Create a tuple of two 'Event's with the first one occurring only the first
581-- time the supplied 'Event' occurs and the second occurring on all but the first
583headTailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a, Event t a)
586 be <- hold never $ fmap (const e) eHead
587 return (eHead, switch be)
589-- | Take the streak of occurrences starting at the current time for which the
590-- event returns 'True'.
592-- Starting at the current time, fire all the occurrences of the 'Event' for
593-- which the given predicate returns 'True'. When 'False' first is returned,
594-- do not fire, and permanently stop firing, even if 'True' values would have
595-- been encountered later.
598 . (Reflex t, MonadFix m, MonadHold t m)
602takeWhileE f = takeWhileJustE $ \v -> guard (f v) $> v
604-- | Take the streak of occurrences starting at the current time for which the
605-- event returns 'Just b'.
607-- Starting at the current time, fire all the occurrences of the 'Event' for
608-- which the given predicate returns 'Just b'. When 'Nothing' first is returned,
609-- do not fire, and permanently stop firing, even if 'Just b' values would have
610-- been encountered later.
613 . (Reflex t, MonadFix m, MonadHold t m)
617takeWhileJustE f e = do
618 rec let (eBad, eTrue) = fanEither $ ffor e' $ \a -> case f a of
619 Nothing -> Left never
621 eFirstBad <- headE eBad
622 e' <- switchHold e eFirstBad
625-- | Drop the streak of occurrences starting at the current time for which the
626-- event returns 'True'.
628-- Starting at the current time, do not fire all the occurrences of the 'Event'
629-- for which the given predicate returns 'True'. When 'False' is first
630-- returned, do fire, and permanently continue firing, even if 'True' values
631-- would have been encountered later.
634 . (Reflex t, MonadFix m, MonadHold t m)
638dropWhileE f e = snd <$> takeDropWhileJustE (\v -> guard (f v) $> v) e
640-- | Both take and drop the streak of occurrences starting at the current time
641-- for which the event returns 'Just b'.
643-- For the left event, starting at the current time, fire all the occurrences
644-- of the 'Event' for which the given function returns 'Just b'. When
645-- 'Nothing' is returned, do not fire, and permanently stop firing, even if
646-- 'Just b' values would have been encountered later.
648-- For the right event, do not fire until the first occurrence where the given
649-- function returns 'Nothing', and fire that one and all subsequent
650-- occurrences. Even if the function would have again returned 'Just b', keep
654 . (Reflex t, MonadFix m, MonadHold t m)
657 -> m (Event t b, Event t a)
658takeDropWhileJustE f e = do
659 rec let (eBad, eGood) = fanEither $ ffor e' $ \a -> case f a of
662 eFirstBad <- headE eBad
663 e' <- switchHold e (never <$ eFirstBad)
664 eRest <- switchHoldPromptOnly never (e <$ eFirstBad)
665 return (eGood, eRest)
667-- | Split the supplied 'Event' into two individual 'Event's occurring at the
668-- same time with the respective values from the tuple.
669splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
670splitE e = (fmap fst e, fmap snd e)
672-- | Print the supplied 'String' and the value of the 'Event' on each
673-- occurrence. This should /only/ be used for debugging.
675-- Note: As with Debug.Trace.trace, the message will only be printed if the
676-- 'Event' is actually used.
677traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
678traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
680-- | Print the output of the supplied function on each occurrence of the
681-- 'Event'. This should /only/ be used for debugging.
683-- Note: As with Debug.Trace.trace, the message will only be printed if the
684-- 'Event' is actually used.
685traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
686traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
688instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
689 (<>) = alignWith (mergeThese (<>))
690 sconcat = fmap sconcat . mergeList . toList
691#if MIN_VERSION_semigroups(0,17,0)
692 stimes n = fmap $ stimes n
694 times1p n = fmap $ times1p n
697instance (Semigroup a, Reflex t) => Monoid (Event t a) where
700 mconcat = fmap sconcat . mergeList
702-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
703-- list occurs. If multiple occur at the same time they are folded from the left
704-- with the given function.
705{-# INLINE mergeWith #-}
706mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
707mergeWith = mergeWith' id
709{-# INLINE mergeWith' #-}
710mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
711mergeWith' f g es = fmap (Prelude.foldl1 g . fmap f)
713 . IntMap.fromDistinctAscList
714 $ zip [0 :: Int ..] es
716-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
717-- list occurs. If multiple occur at the same time the value is the value of the
719{-# INLINE leftmost #-}
720leftmost :: Reflex t => [Event t a] -> Event t a
721leftmost = mergeWith const
723-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
724-- list occurs and has a list of the values of all 'Event's occurring at that
726mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
728mergeList es = mergeWithFoldCheap' id es
730unsafeMapIncremental :: (Reflex t, Patch p, Patch p') => (PatchTarget p -> PatchTarget p') -> (p -> p') -> Incremental t p -> Incremental t p'
731unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
733-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
734-- occurs if at least one of them occurs and has a map of values of all 'Event's
735-- occurring at that time.
736mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
737mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
739-- | Create a merge whose parents can change over time
740mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
741mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
743-- | Create a merge whose parents can change over time
744mergeIntMapIncremental :: Reflex t => Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
745mergeIntMapIncremental = fmap dmapToIntMap . mergeIncremental . unsafeMapIncremental intMapWithFunctorToDMap (const2IntPatchDMapWith id)
747-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
748mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
749mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
751-- | Split the event into separate events for 'Left' and 'Right' values.
752fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
754 let justLeft = either Just (const Nothing)
755 justRight = either (const Nothing) Just
756 in (fmapMaybe justLeft e, fmapMaybe justRight e)
758-- | Split the event into separate events for 'This' and 'That' values,
759-- allowing them to fire simultaneously when the input value is 'These'.
760fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
762 let this (This x) = Just x
763 this (These x _) = Just x
765 that (That y) = Just y
766 that (These _ y) = Just y
768 in (fmapMaybe this e, fmapMaybe that e)
770-- | Split the event into an 'EventSelector' that allows efficient selection of
771-- the individual 'Event's.
772fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
773fanMap = fan . fmap mapToDMap
775-- | Switches to the new event whenever it receives one. Only the old event is
776-- considered the moment a new one is switched in; the output event will fire at
777-- that moment if only if the old event does.
779-- Because the simultaneous firing case is irrelevant, this function imposes
780-- laxer "timing requirements" on the overall circuit, avoiding many potential
781-- cyclic dependency / metastability failures. It's also more performant. Use
782-- this rather than 'switchHoldPromptly' and 'switchHoldPromptOnly' unless you
783-- are absolutely sure you need to act on the new event in the coincidental
785switchHold :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
786switchHold ea0 eea = switch <$> hold ea0 eea
788-- | Switches to the new event whenever it receives one. Whenever a new event is
789-- provided, if it is firing, its value will be the resulting event's value; if
790-- it is not firing, but the old one is, the old one's value will be used.
792-- 'switchHold', by always forwarding the old event the moment it is switched
793-- out, avoids many potential cyclic dependency problems / metastability
794-- problems. It's also more performant. Use it instead unless you are sure you
796switchHoldPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
797switchHoldPromptly ea0 eea = do
799 let eLag = switch bea
800 eCoincidences = coincidence eea
801 return $ leftmost [eCoincidences, eLag]
803-- | switches to a new event whenever it receives one. At the moment of
804-- switching, the old event will be ignored if it fires, and the new one will be
805-- used if it fires; this is the opposite of 'switch', which will use only the
808-- 'switchHold', by always forwarding the old event the moment it is switched
809-- out, avoids many potential cyclic dependency problems / metastability
810-- problems. It's also more performant. Use it instead unless you are sure you
812switchHoldPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
813switchHoldPromptOnly e0 e' = do
814 eLag <- switch <$> hold e0 e'
815 return $ coincidence $ leftmost [e', eLag <$ eLag]
817instance Reflex t => Align (Event t) where
819 align = alignEventWithMaybe Just
821-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
822-- the 'Behavior' is true at the time of occurrence.
823gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
824gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
826-- | Create a new behavior given a starting behavior and switch to a the behvior
827-- carried by the event when it fires.
828switcher :: (Reflex t, MonadHold t m)
829 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
830switcher b eb = pull . (sample <=< sample) <$> hold b eb
832instance (Reflex t, IsString a) => IsString (Dynamic t a) where
833 fromString = pure . fromString
835-- | Combine two 'Dynamic's. The result will change whenever either (or both)
836-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
837zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
838zipDyn = zipDynWith (,)
840-- | Combine two 'Dynamic's with a combining function. The result will change
841-- whenever either (or both) input 'Dynamic' changes.
842-- More efficient than liftA2.
843zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
845 let eab = align (updated da) (updated db)
846 ec = flip push eab $ \o -> do
849 b <- sample $ current db
852 a <- sample $ current da
854 These a b -> return (a, b)
855 return $ Just $ f a b
856 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
858instance (Reflex t, Semigroup a) => Semigroup (Dynamic t a) where
859 (<>) = zipDynWith (<>)
860#if MIN_VERSION_semigroups(0,17,0)
861 stimes n = fmap $ stimes n
863 times1p n = fmap $ times1p n
866instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
867 mconcat = distributeListOverDynWith mconcat
868 mempty = constDyn mempty
869 mappend = zipDynWith mappend
871-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
872-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
873-- through the use of multiple uses of 'zipWithDyn' or 'Applicative' operators.
874distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
875distributeDMapOverDynPure dm = case DMap.toList dm of
876 [] -> constDyn DMap.empty
877 [k :=> v] -> fmap (DMap.singleton k . Identity) v
879 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
880 edmPre = merge $ DMap.map updated dm
881 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
882 olds <- sample $ current result
883 return $ DMap.unionWithKey (\_ _ new -> new) olds news
886-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
887distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
888distributeListOverDyn = distributeListOverDynWith id
890-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
891distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
892distributeListOverDynWith f = fmap (f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]
894-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
895-- unless the second supplied 'Event' occurs simultaneously.
896difference :: Reflex t => Event t a -> Event t b -> Event t a
897difference = alignEventWithMaybe $ \case
901alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
902alignEventWithMaybe f ea eb =
903 fmapMaybe (f <=< dmapToThese)
905 $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
915 -> Event t (DSum k v)
916 -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))
917factorEvent k0 kv' = do
918 key :: Behavior t (Some k) <- hold (Some.This k0) $ fmapCheap (\(k :=> _) -> Some.This k) kv'
919 let inner :: forall m' b. (MonadFix m', MonadHold t m') => k b -> m' (Event t (v b))
921 let f :: DSum k v -> Maybe (v b)
922 f (newK :=> newV) = case newK `geq` k of
923 Just Refl -> Just newV
926 update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case
927 Some.This oldKey -> case newKey `geq` oldKey of
928 Just Refl -> return Nothing
930 newInner <- inner newKey
931 return $ Just $ newKey :=> Pair newVal (Compose newInner)
933 return (eInitial, update)
935--------------------------------------------------------------------------------
937--------------------------------------------------------------------------------
939-- | An 'Accumulator' type can be built by accumulating occurrences of an
941#if __GLASGOW_HASKELL__ < 802
942{-# WARNING accum "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
943{-# WARNING accumM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
944{-# WARNING accumMaybe "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
945{-# WARNING accumMaybeM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
947class Reflex t => Accumulator t f | f -> t where
948 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
949 accum f = accumMaybe $ \v o -> Just $ f v o
950 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
951 accumM f = accumMaybeM $ \v o -> Just <$> f v o
952 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
953 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
954 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
955 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
956 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
957 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
958 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
959 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
960 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
961 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
963accumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Dynamic t a)
964accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o
965accumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Dynamic t a)
966accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o
967accumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Dynamic t a)
968accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o
969accumMaybeMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Dynamic t a)
970accumMaybeMDyn f z e = do
971 rec let e' = flip push e $ \o -> do
972 v <- sample $ current d'
976mapAccumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
977mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o
978mapAccumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
979mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o
980mapAccumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
981mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o
982mapAccumMaybeMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
983mapAccumMaybeMDyn f z e = do
984 rec let e' = flip push e $ \o -> do
985 v <- sample $ current d'
987 return $ case result of
988 (Nothing, Nothing) -> Nothing
990 d' <- holdDyn z $ fmapMaybe fst e'
991 return (d', fmapMaybe snd e')
994accumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Behavior t a)
995accumB f = accumMaybeB $ \v o -> Just $ f v o
996{-# INLINE accumMB #-}
997accumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Behavior t a)
998accumMB f = accumMaybeMB $ \v o -> Just <$> f v o
999{-# INLINE accumMaybeB #-}
1000accumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Behavior t a)
1001accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o
1002{-# INLINE accumMaybeMB #-}
1003accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)
1004accumMaybeMB f z e = do
1005 rec let e' = flip push e $ \o -> do
1010{-# INLINE mapAccumB #-}
1011mapAccumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)
1012mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o
1013{-# INLINE mapAccumMB #-}
1014mapAccumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)
1015mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o
1016{-# INLINE mapAccumMaybeB #-}
1017mapAccumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)
1018mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o
1020{-# INLINE mapAccumMaybeMB #-}
1021mapAccumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)
1022mapAccumMaybeMB f z e = do
1023 rec let e' = flip push e $ \o -> do
1026 return $ case result of
1027 (Nothing, Nothing) -> Nothing
1029 d' <- hold z $ fmapMaybe fst e'
1030 return (d', fmapMaybe snd e')
1032-- | Accumulate occurrences of an 'Event', producing an output occurrence each
1033-- time. Discard the underlying 'Accumulator'.
1034{-# INLINE mapAccum_ #-}
1035mapAccum_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Event t c)
1037 (_, result) <- mapAccumB f z e
1040-- | Accumulate occurrences of an 'Event', possibly producing an output
1041-- occurrence each time. Discard the underlying 'Accumulator'.
1042{-# INLINE mapAccumMaybe_ #-}
1043mapAccumMaybe_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
1044mapAccumMaybe_ f z e = do
1045 (_, result) <- mapAccumMaybeB f z e
1048-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
1049-- an output occurrence each time. Discard the underlying 'Accumulator'.
1050{-# INLINE mapAccumM_ #-}
1051mapAccumM_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Event t c)
1052mapAccumM_ f z e = do
1053 (_, result) <- mapAccumMB f z e
1056-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
1057-- producing an output occurrence each time. Discard the underlying
1059{-# INLINE mapAccumMaybeM_ #-}
1060mapAccumMaybeM_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
1061mapAccumMaybeM_ f z e = do
1062 (_, result) <- mapAccumMaybeMB f z e
1065instance Reflex t => Accumulator t (Dynamic t) where
1066 accumMaybeM = accumMaybeMDyn
1067 mapAccumMaybeM = mapAccumMaybeMDyn
1069instance Reflex t => Accumulator t (Behavior t) where
1070 accumMaybeM = accumMaybeMB
1071 mapAccumMaybeM = mapAccumMaybeMB
1073instance Reflex t => Accumulator t (Event t) where
1074 accumMaybeM f z e = updated <$> accumMaybeM f z e
1075 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
1077-- | Create a new 'Event' by combining each occurrence with the next value of the
1078-- list using the supplied function. If the list runs out of items, all
1079-- subsequent 'Event' occurrences will be ignored.
1080zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
1081zipListWithEvent f l e = do
1082 let f' a b = case a of
1083 h:t -> (Just t, Just $ f h b)
1084 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
1085 mapAccumMaybe_ f' l e
1087-- | Assign a number to each occurrence of the given 'Event', starting from 0
1088{-# INLINE numberOccurrences #-}
1089numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
1090numberOccurrences = numberOccurrencesFrom 0
1092-- | Assign a number to each occurrence of the given 'Event'
1093{-# INLINE numberOccurrencesFrom #-}
1094numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
1095numberOccurrencesFrom = mapAccum_ (\n a -> let !next = n + 1 in (next, (n, a)))
1097-- | Assign a number to each occurrence of the given 'Event'; discard the occurrences' values
1098{-# INLINE numberOccurrencesFrom_ #-}
1099numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
1100numberOccurrencesFrom_ = mapAccum_ (\n _ -> let !next = n + 1 in (next, n))
1102-- | This is used to sample the value of a 'Behavior' using an 'Event'.
1104-- The '<@>' operator is intended to be used in conjunction with
1105-- the 'Applicative' instance for 'Behavior'.
1107-- This is useful when we want to combine the values of one 'Event' and
1108-- the value of several 'Behavior's at the time the 'Event' is firing.
1112-- > f :: a -> b -> c -> d
1113-- > b1 :: Behavior t a
1114-- > b2 :: Behavior t b
1119-- > f <$> b1 <*> b2 <@> e :: Event t d
1121-- in order to apply the function 'f' to the relevant values.
1123-- The alternative would be something like:
1125-- > attachWith (\(x1, x2) y -> f x1 x2 y) ((,) <$> b1 <*> b2) e :: Event t d
1127-- or a variation involing a custom data type to hold the combination of
1128-- 'Behavior's even when that combination might only ever be used by 'f'.
1130-- A more suggestive example might be:
1132-- > handleMouse <$> bPlayerState <*> bMousePosition <@> eMouseClick :: Event t (GameState -> GameState)
1134(<@>) :: Reflex t => Behavior t (a -> b) -> Event t a -> Event t b
1135(<@>) b = push $ \x -> do
1137 return . Just . f $ x
1140-- | An version of '<@>' that does not use the value of the 'Event'.
1142-- Alternatively, it is 'tag' in operator form.
1144-- This is useful when we want to combine the values of several
1145-- 'Behavior's at particular points in time using an 'Applicative'
1150-- > g :: a -> b -> d
1151-- > b1 :: Behavior t a
1152-- > b2 :: Behavior t b
1155-- where 'e' is firing at the points in time of interest.
1157-- Then we can use '<@':
1159-- > g <$> b1 <*> b2 <@ e :: Event t d
1161-- to combine the values of 'b1' and 'b2' at each of those points of time,
1162-- with the function 'g' being used to combine the values.
1164-- This is the same as '<@>' except that the 'Event' is being used only
1165-- to act as a trigger.
1166(<@) :: (Reflex t) => Behavior t b -> Event t a -> Event t b
1174{-# INLINE pushAlwaysCheap #-}
1175pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
1176pushAlwaysCheap f = pushCheap (fmap Just . f)
1178{-# INLINE fmapMaybeCheap #-}
1179fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1180fmapMaybeCheap f = pushCheap $ return . f
1182{-# INLINE fforMaybeCheap #-}
1183fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
1184fforMaybeCheap = flip fmapMaybeCheap
1186{-# INLINE fforCheap #-}
1187fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
1188fforCheap = flip fmapCheap
1190{-# INLINE fmapCheap #-}
1191fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
1192fmapCheap f = pushCheap $ return . Just . f
1194{-# INLINE tagCheap #-}
1195tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
1196tagCheap b = pushAlwaysCheap $ \_ -> sample b
1198{-# INLINE mergeWithCheap #-}
1199mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
1200mergeWithCheap = mergeWithCheap' id
1202{-# INLINE mergeWithCheap' #-}
1203mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
1204mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
1206{-# INLINE mergeWithFoldCheap' #-}
1207mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
1208mergeWithFoldCheap' f es =
1209 fmapCheap (f . (\(h : t) -> h :| t) . IntMap.elems)
1211 . IntMap.fromDistinctAscList
1212 $ zip [0 :: Int ..] es
1214--------------------------------------------------------------------------------
1215-- Deprecated functions
1216--------------------------------------------------------------------------------
1218-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
1219-- occurs. If both occur at the same time they are combined using 'mappend'.
1220{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}
1221appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
1222appendEvents = alignWith $ mergeThese mappend
1224-- | Alias for 'headE'
1225{-# DEPRECATED onceE "Use 'headE' instead" #-}
1226onceE :: MonadHold t m => Event t a -> m (Event t a)
1229-- | Run both sides of a 'These' monadically, combining the results.
1230{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
1231#ifdef USE_TEMPLATE_HASKELL
1232{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
1234sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
1235sequenceThese t = case t of
1236 This ma -> fmap This ma
1237 These ma mb -> liftM2 These ma mb
1238 That mb -> fmap That mb
1240{-# DEPRECATED switchPromptly "Use 'switchHoldPromptly' instead. The 'switchHold*' naming convention was chosen because those functions are more closely related to each other than they are to 'switch'. " #-}
1241switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1242switchPromptly = switchHoldPromptly
1243{-# DEPRECATED switchPromptOnly "Use 'switchHoldPromptOnly' instead. The 'switchHold*' naming convention was chosen because those functions are more closely related to each other than they are to 'switch'. " #-}
1244switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1245switchPromptOnly = switchHoldPromptOnly
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