on mb@revert-profiled-changes help sign in
reflex/src/Reflex/Class.hs
1598 lines 64 kB history raw
1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE CPP #-}
3{-# LANGUAGE ConstraintKinds #-}
4{-# LANGUAGE DefaultSignatures #-}
5{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE FunctionalDependencies #-}
8{-# LANGUAGE GADTs #-}
9{-# LANGUAGE LambdaCase #-}
10{-# LANGUAGE NoMonomorphismRestriction #-}
11{-# LANGUAGE PolyKinds #-}
12{-# LANGUAGE RankNTypes #-}
13{-# LANGUAGE RecursiveDo #-}
14{-# LANGUAGE RoleAnnotations #-}
15{-# LANGUAGE ScopedTypeVariables #-}
16{-# LANGUAGE TypeFamilies #-}
17{-# LANGUAGE TypeOperators #-}
18{-# LANGUAGE UndecidableInstances #-}
19#ifdef USE_REFLEX_OPTIMIZER
20{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
21#endif
23-- |
24-- Module:
25-- Reflex.Class
26-- Description:
27-- This module contains the Reflex interface, as well as a variety of
28-- convenience functions for working with 'Event's, 'Behavior's, and other
29-- signals.
30module Reflex.Class
31 ( module Reflex.Patch
32 -- * Primitives
33 , Reflex (..)
34 , mergeInt
35 , coerceBehavior
36 , coerceEvent
37 , coerceDynamic
38 , MonadSample (..)
39 , MonadHold (..)
40 -- ** 'fan' related types
41 , EventSelector (..)
42 , EventSelectorInt (..)
43 -- * Convenience functions
44 , constDyn
45 , pushAlways
46 -- ** Combining 'Event's
47 , leftmost
48 , mergeMap
49 , mergeIntMap
50 , mergeMapIncremental
51 , mergeMapIncrementalWithMove
52 , mergeIntMapIncremental
53 , coincidencePatchMap
54 , coincidencePatchMapWithMove
55 , coincidencePatchIntMap
56 , mergeList
57 , mergeWith
58 , difference
59 , alignEventWithMaybe
60 -- ** Breaking up 'Event's
61 , splitE
62 , fanEither
63 , fanThese
64 , fanMap
65 , dmapToThese
66 , EitherTag (..)
67 , eitherToDSum
68 , dsumToEither
69 , factorEvent
70 , filterEventKey
71 -- ** Collapsing 'Event . Event'
72 , switchHold
73 , switchHoldPromptly
74 , switchHoldPromptOnly
75 , switchHoldPromptOnlyIncremental
76 -- ** Using 'Event's to sample 'Behavior's
77 , tag
78 , tagMaybe
79 , attach
80 , attachWith
81 , attachWithMaybe
82 -- ** Blocking an 'Event' based on a 'Behavior'
83 , gate
84 -- ** Combining 'Dynamic's
85 , distributeDMapOverDynPure
86 , distributeListOverDyn
87 , distributeListOverDynWith
88 , zipDyn
89 , zipDynWith
90 -- ** Accumulating state
91 , Accumulator (..)
92 , accumDyn
93 , accumMDyn
94 , accumMaybeDyn
95 , accumMaybeMDyn
96 , mapAccumDyn
97 , mapAccumMDyn
98 , mapAccumMaybeDyn
99 , mapAccumMaybeMDyn
100 , accumB
101 , accumMB
102 , accumMaybeB
103 , accumMaybeMB
104 , mapAccumB
105 , mapAccumMB
106 , mapAccumMaybeB
107 , mapAccumMaybeMB
108 , mapAccum_
109 , mapAccumM_
110 , mapAccumMaybe_
111 , mapAccumMaybeM_
112 , accumIncremental
113 , accumMIncremental
114 , accumMaybeIncremental
115 , accumMaybeMIncremental
116 , mapAccumIncremental
117 , mapAccumMIncremental
118 , mapAccumMaybeIncremental
119 , mapAccumMaybeMIncremental
120 , zipListWithEvent
121 , numberOccurrences
122 , numberOccurrencesFrom
123 , numberOccurrencesFrom_
124 , (<@>)
125 , (<@)
126 , tailE
127 , headTailE
128 , takeWhileE
129 , takeWhileJustE
130 , dropWhileE
131 , takeDropWhileJustE
132 , switcher
133 -- * Debugging functions
134 , traceEvent
135 , traceEventWith
136 -- * Unsafe functions
137 , unsafeDynamic
138 , unsafeMapIncremental
139 -- * 'Filterable' convenience functions
140 , FunctorMaybe -- fmapMaybe is purposely not exported from deprecated 'FunctorMaybe' and the new alias is exported instead
141 , mapMaybe -- Re-exported for convenience
142 , fmapMaybe
143 , fforMaybe
144 , ffilter
145 , filterLeft
146 , filterRight
147 -- * Miscellaneous convenience functions
148 , ffor
149 , ffor2
150 , ffor3
151 -- * Deprecated functions
152 , switchPromptly
153 , switchPromptOnly
154 -- * "Cheap" functions
155 , fmapMaybeCheap
156 , mapMaybeCheap
157 , fmapCheap
158 , fforCheap
159 , fforMaybeCheap
160 , pushAlwaysCheap
161 , tagCheap
162 , mergeWithCheap
163 , mergeWithCheap'
164 -- * Slow, but general, implementations
165 , slowHeadE
166 ) where
168#ifdef MIN_VERSION_semialign
169import Prelude hiding (zip, zipWith)
171#if MIN_VERSION_these(0,8,0)
172import Data.These.Combinators (justThese)
173#endif
174#if MIN_VERSION_semialign(1,1,0)
175import Data.Zip (Zip (..))
176#endif
177#endif
179import Control.Applicative
180import Control.Monad.Identity
181import Control.Monad.Reader
182import Control.Monad.State.Strict
183import Control.Monad.Trans.Cont (ContT)
184import Control.Monad.Trans.Except (ExceptT)
185import Control.Monad.Trans.RWS (RWST)
186import Control.Monad.Trans.Writer (WriterT)
187import Data.Align
188import Data.Bifunctor
189import Data.Coerce
190import Data.Default
191import Data.Dependent.Map (DMap, DSum (..))
192import qualified Data.Dependent.Map as DMap
193import Data.Functor.Compose
194import Data.Functor.Product
195import Data.GADT.Compare (GEq (..), GCompare (..), (:~:) (..))
196import Data.FastMutableIntMap (PatchIntMap)
197import Data.Foldable
198import Data.Functor.Bind
199import Data.Functor.Misc
200import Data.Functor.Plus
201import Data.IntMap.Strict (IntMap)
202import qualified Data.IntMap.Strict as IntMap
203import Data.List.NonEmpty (NonEmpty (..))
204import Data.Map (Map)
205import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
206import Data.Some (Some(Some))
207import Data.String
208import Data.These
209import Data.Type.Coercion
210import Data.Witherable (Filterable(..))
211import qualified Data.Witherable as W
212import Reflex.FunctorMaybe (FunctorMaybe)
213import qualified Reflex.FunctorMaybe
214import Reflex.Patch
215import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
217import Debug.Trace (trace)
219-- | The 'Reflex' class contains all the primitive functionality needed for
220-- Functional Reactive Programming (FRP). The @/t/@ type parameter indicates
221-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
222-- and the type of the timeline determines the FRP engine to be used. For most
223-- purposes, the 'Reflex.Spider' implementation is recommended.
224class ( MonadHold t (PushM t)
225 , MonadSample t (PullM t)
226 , MonadFix (PushM t)
227 , Functor (Dynamic t)
228 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
229 , Monad (Dynamic t)
230 ) => Reflex t where
231 -- | A container for a value that can change over time. 'Behavior's can be
232 -- sampled at will, but it is not possible to be notified when they change
233 data Behavior t :: * -> *
234 -- | A stream of occurrences. During any given frame, an 'Event' is either
235 -- occurring or not occurring; if it is occurring, it will contain a value of
236 -- the given type (its "occurrence type")
237 data Event t :: * -> *
238 -- | A container for a value that can change over time and allows
239 -- notifications on changes. Basically a combination of a 'Behavior' and an
240 -- 'Event', with a rule that the 'Behavior' will change if and only if the
241 -- 'Event' fires.
242 data Dynamic t :: * -> *
243 -- | An 'Incremental' is a more general form of a 'Dynamic'.
244 -- Instead of always fully replacing the value, only parts of it can be patched.
245 -- This is only needed for performance critical code via `mergeIncremental` to make small
246 -- changes to large values.
247 data Incremental t :: * -> *
248 -- | A monad for doing complex push-based calculations efficiently
249 type PushM t :: * -> *
250 -- | A monad for doing complex pull-based calculations efficiently
251 type PullM t :: * -> *
252 -- | An 'Event' with no occurrences
253 never :: Event t a
254 -- | Create a 'Behavior' that always has the given value
255 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
256 -- | Create an 'Event' from another 'Event'; the provided function can sample
257 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
258 -- (Just) or non-occurring (Nothing) result
259 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
260 -- | 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.
261 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
262 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
263 -- recomputed whenever any of the read 'Behavior's changes
264 pull :: PullM t a -> Behavior t a
265 -- | Merge a collection of events; the resulting 'Event' will only occur if at
266 -- least one input event is occurring, and will contain all of the input keys
267 -- that are occurring simultaneously
268 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
269 -- | Efficiently fan-out an event to many destinations. You should save the
270 -- result in a @let@-binding, and then repeatedly 'select' on the result to
271 -- create child events
272 fan :: GCompare k => Event t (DMap k Identity) -> EventSelector t k
273 -- | Create an 'Event' that will occur whenever the currently-selected input
274 -- 'Event' occurs
275 switch :: Behavior t (Event t a) -> Event t a
276 -- | Create an 'Event' that will occur whenever the input event is occurring -- and its occurrence value, another 'Event', is also occurring
277 coincidence :: Event t (Event t a) -> Event t a
278 -- | Extract the 'Behavior' of a 'Dynamic'.
279 current :: Dynamic t a -> Behavior t a
280 -- | Extract the 'Event' of the 'Dynamic'.
281 updated :: Dynamic t a -> Event t a
282 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
283 -- recent firing of the given 'Event', if any.
284 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
285 -- | Create a new 'Incremental'. The given "PullM"'s value must always change
286 -- in the same way that the accumulated application of patches would change
287 -- that value.
288 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
289 -- | Create a merge whose parents can change over time
290 mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
291 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
292 mergeIncrementalWithMove :: GCompare k => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
293 -- | Extract the 'Behavior' component of an 'Incremental'
294 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
295 -- | Extract the 'Event' component of an 'Incremental'
296 updatedIncremental :: Patch p => Incremental t p -> Event t p
297 -- | Convert an 'Incremental' to a 'Dynamic'
298 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
299 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
300 -- occurrence type
301 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
302 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
303 -- occurrence type
304 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
305 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
306 -- occurrence type
307 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
308 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
309 fanInt :: Event t (IntMap a) -> EventSelectorInt t a
311--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on
312-- | Constructs a single 'Event' out of a map of events. The output event may fire with multiple
313-- keys simultaneously.
314mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
315mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never
317-- | Coerce a 'Behavior' between representationally-equivalent value types
318coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
319coerceBehavior = coerceWith $ behaviorCoercion Coercion
321-- | Coerce an 'Event' between representationally-equivalent occurrence types
322coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
323coerceEvent = coerceWith $ eventCoercion Coercion
325-- | Coerce a 'Dynamic' between representationally-equivalent value types
326coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
327coerceDynamic = coerceWith $ dynamicCoercion Coercion
329-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
330-- __must__ change when and only when the 'Event' fires, such that the
331-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
332-- if this is not the case, the resulting 'Dynamic' will behave
333-- nondeterministically.
334unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
335unsafeDynamic = unsafeBuildDynamic . sample
337-- | Construct a 'Dynamic' value that never changes
338constDyn :: Reflex t => a -> Dynamic t a
339constDyn = pure
341instance (Reflex t, Default a) => Default (Dynamic t a) where
342 def = pure def
344-- | 'MonadSample' designates monads that can read the current value of a
345-- 'Behavior'. This includes both 'PullM' and 'PushM'.
346class (Applicative m, Monad m) => MonadSample t m | m -> t where
347 -- | Get the current value in the 'Behavior'
348 sample :: Behavior t a -> m a
350-- | 'MonadHold' designates monads that can create new 'Behavior's based on
351-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
352-- is required to create any stateful computations with Reflex.
353class MonadSample t m => MonadHold t m where
354 -- | Create a new 'Behavior' whose value will initially be equal to the given
355 -- value and will be updated whenever the given 'Event' occurs. The update
356 -- takes effect immediately after the 'Event' occurs; if the occurrence that
357 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
358 -- the 'Behavior', it will see the __old__ value of the 'Behavior', not the new
359 -- one.
360 hold :: a -> Event t a -> m (Behavior t a)
361 default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)
362 hold v0 = lift . hold v0
363 -- | Create a 'Dynamic' value using the given initial value that changes every
364 -- time the 'Event' occurs.
365 holdDyn :: a -> Event t a -> m (Dynamic t a)
366 default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)
367 holdDyn v0 = lift . holdDyn v0
368 -- | Create an 'Incremental' value using the given initial value that changes
369 -- every time the 'Event' occurs.
370 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
371 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
372 holdIncremental v0 = lift . holdIncremental v0
373 buildDynamic :: PushM t a -> Event t a -> m (Dynamic t a)
374 {-
375 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
376 buildDynamic getV0 = lift . buildDynamic getV0
377 -}
378 -- | Create a new 'Event' that only occurs only once, on the first occurrence of
379 -- the supplied 'Event'.
380 headE :: Event t a -> m (Event t a)
382-- | Accumulate an 'Incremental' with the supplied initial value and the firings of the provided 'Event',
383-- using the combining function to produce a patch.
384accumIncremental
385 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
386 => (PatchTarget p -> b -> p)
387 -> PatchTarget p
388 -> Event t b
389 -> m (Incremental t p)
390accumIncremental f = accumMaybeIncremental $ \v o -> Just $ f v o
392-- | Similar to 'accumIncremental' but the combining function runs in 'PushM'
393accumMIncremental
394 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
395 => (PatchTarget p -> b -> PushM t p)
396 -> PatchTarget p
397 -> Event t b
398 -> m (Incremental t p)
399accumMIncremental f = accumMaybeMIncremental $ \v o -> Just <$> f v o
401-- | Similar to 'accumIncremental' but allows filtering of updates (by dropping updates when the
402-- combining function produces @Nothing@)
403accumMaybeIncremental
404 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
405 => (PatchTarget p -> b -> Maybe p)
406 -> PatchTarget p
407 -> Event t b
408 -> m (Incremental t p)
409accumMaybeIncremental f = accumMaybeMIncremental $ \v o -> return $ f v o
411-- | Similar to 'accumMaybeMIncremental' but the combining function runs in 'PushM'
412accumMaybeMIncremental
413 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
414 => (PatchTarget p -> b -> PushM t (Maybe p))
415 -> PatchTarget p
416 -> Event t b
417 -> m (Incremental t p)
418accumMaybeMIncremental f z e = do
419 rec let e' = flip push e $ \o -> do
420 v <- sample $ currentIncremental d'
421 f v o
422 d' <- holdIncremental z e'
423 return d'
425-- | Accumulate an 'Incremental' by folding occurrences of an 'Event'
426-- with a function that both accumulates and produces a value to fire
427-- as an 'Event'. Returns both the accumulated value and the constructed
428-- 'Event'.
429mapAccumIncremental
430 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
431 => (PatchTarget p -> b -> (p, c))
432 -> PatchTarget p
433 -> Event t b
434 -> m (Incremental t p, Event t c)
435mapAccumIncremental f = mapAccumMaybeIncremental $ \v o -> bimap Just Just $ f v o
437-- | Like 'mapAccumIncremental' but the combining function runs in 'PushM'
438mapAccumMIncremental
439 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
440 => (PatchTarget p -> b -> PushM t (p, c))
441 -> PatchTarget p
442 -> Event t b
443 -> m (Incremental t p, Event t c)
444mapAccumMIncremental f = mapAccumMaybeMIncremental $ \v o -> bimap Just Just <$> f v o
446-- | Accumulate an 'Incremental' by folding occurrences of an 'Event' with
447-- a function that both optionally accumulates and optionally produces
448-- a value to fire as a separate output 'Event'.
449-- Note that because 'Nothing's are discarded in both cases, the output
450-- 'Event' may fire even though the output 'Incremental' has not changed, and
451-- the output 'Incremental' may update even when the output 'Event' is not firing.
452mapAccumMaybeIncremental
453 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
454 => (PatchTarget p -> b -> (Maybe p, Maybe c))
455 -> PatchTarget p
456 -> Event t b
457 -> m (Incremental t p, Event t c)
458mapAccumMaybeIncremental f = mapAccumMaybeMIncremental $ \v o -> return $ f v o
460-- | Like 'mapAccumMaybeIncremental' but the combining function is a 'PushM' action
461mapAccumMaybeMIncremental
462 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
463 => (PatchTarget p -> b -> PushM t (Maybe p, Maybe c))
464 -> PatchTarget p
465 -> Event t b
466 -> m (Incremental t p, Event t c)
467mapAccumMaybeMIncremental f z e = do
468 rec let e' = flip push e $ \o -> do
469 v <- sample $ currentIncremental d'
470 result <- f v o
471 return $ case result of
472 (Nothing, Nothing) -> Nothing
473 _ -> Just result
474 d' <- holdIncremental z $ mapMaybe fst e'
475 return (d', mapMaybe snd e')
477-- | A somewhat slow implementation of 'headE'
478slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
479slowHeadE e = do
480 rec be <- hold e $ fmapCheap (const never) e'
481 let e' = switch be
482 return e'
484-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
485-- key. This is much more efficient than filtering for each key with
486-- 'mapMaybe'.
487newtype EventSelector t k = EventSelector
488 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
489 -- determined by the type of the key, so this can be used to fan-out
490 -- 'Event's whose sub-'Event's have different types.
491 --
492 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
493 -- (but equivalent to) using 'mapMaybe' to select only the relevant
494 -- occurrences of an 'Event'.
495 select :: forall a. k a -> Event t a
496 }
498-- | Efficiently select an 'Event' keyed on 'Int'. This is more efficient than manually
499-- filtering by key.
500newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }
502--------------------------------------------------------------------------------
503-- Instances
504--------------------------------------------------------------------------------
506instance MonadSample t m => MonadSample t (ReaderT r m) where
507 sample = lift . sample
509instance MonadHold t m => MonadHold t (ReaderT r m) where
510 hold a0 = lift . hold a0
511 holdDyn a0 = lift . holdDyn a0
512 holdIncremental a0 = lift . holdIncremental a0
513 buildDynamic a0 = lift . buildDynamic a0
514 headE = lift . headE
516instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
517 sample = lift . sample
519instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
520 hold a0 = lift . hold a0
521 holdDyn a0 = lift . holdDyn a0
522 holdIncremental a0 = lift . holdIncremental a0
523 buildDynamic a0 = lift . buildDynamic a0
524 headE = lift . headE
526instance MonadSample t m => MonadSample t (StateT s m) where
527 sample = lift . sample
529instance MonadHold t m => MonadHold t (StateT s m) where
530 hold a0 = lift . hold a0
531 holdDyn a0 = lift . holdDyn a0
532 holdIncremental a0 = lift . holdIncremental a0
533 buildDynamic a0 = lift . buildDynamic a0
534 headE = lift . headE
536instance MonadSample t m => MonadSample t (ExceptT e m) where
537 sample = lift . sample
539instance MonadHold t m => MonadHold t (ExceptT e m) where
540 hold a0 = lift . hold a0
541 holdDyn a0 = lift . holdDyn a0
542 holdIncremental a0 = lift . holdIncremental a0
543 buildDynamic a0 = lift . buildDynamic a0
544 headE = lift . headE
546instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
547 sample = lift . sample
549instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
550 hold a0 = lift . hold a0
551 holdDyn a0 = lift . holdDyn a0
552 holdIncremental a0 = lift . holdIncremental a0
553 buildDynamic a0 = lift . buildDynamic a0
554 headE = lift . headE
556instance MonadSample t m => MonadSample t (ContT r m) where
557 sample = lift . sample
559instance MonadHold t m => MonadHold t (ContT r m) where
560 hold a0 = lift . hold a0
561 holdDyn a0 = lift . holdDyn a0
562 holdIncremental a0 = lift . holdIncremental a0
563 buildDynamic a0 = lift . buildDynamic a0
564 headE = lift . headE
566--------------------------------------------------------------------------------
567-- Convenience functions
568--------------------------------------------------------------------------------
570-- | Create an 'Event' from another 'Event'. The provided function can sample
571-- 'Behavior's and hold 'Event's.
572pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
573pushAlways f = push (fmap Just . f)
575-- | Flipped version of 'fmap'.
576ffor :: Functor f => f a -> (a -> b) -> f b
577ffor = flip fmap
579-- | Rotated version of 'liftA2'.
580ffor2 :: Applicative f => f a -> f b -> (a -> b -> c) -> f c
581ffor2 a b f = liftA2 f a b
583-- | Rotated version of 'liftA3'.
584ffor3 :: Applicative f => f a -> f b -> f c -> (a -> b -> c -> d) -> f d
585ffor3 a b c f = liftA3 f a b c
587instance Reflex t => Applicative (Behavior t) where
588 pure = constant
589 f <*> x = pull $ sample f `ap` sample x
590 _ *> b = b
591 a <* _ = a
593instance Reflex t => Apply (Behavior t) where
594 (<.>) = (<*>)
596instance Reflex t => Bind (Behavior t) where
597 (>>-) = (>>=)
599instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
600 (/) = liftA2 (/)
601 fromRational = pure . fromRational
602 recip = fmap recip
604instance Reflex t => Functor (Behavior t) where
605 fmap f = pull . fmap f . sample
607instance (Reflex t, IsString a) => IsString (Behavior t a) where
608 fromString = pure . fromString
610instance Reflex t => Monad (Behavior t) where
611 a >>= f = pull $ sample a >>= sample . f
612 -- 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.
613 return = constant
614 fail = error "Monad (Behavior t) does not support fail"
616instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
617 mempty = constant mempty
618 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
619 mconcat = pull . fmap mconcat . mapM sample
621instance (Reflex t, Num a) => Num (Behavior t a) where
622 (+) = liftA2 (+)
623 (-) = liftA2 (-)
624 (*) = liftA2 (*)
625 abs = fmap abs
626 fromInteger = pure . fromInteger
627 negate = fmap negate
628 signum = fmap signum
630instance (Num a, Reflex t) => Num (Dynamic t a) where
631 (+) = liftA2 (+)
632 (*) = liftA2 (*)
633 abs = fmap abs
634 signum = fmap signum
635 fromInteger = pure . fromInteger
636 negate = fmap negate
637 (-) = liftA2 (-)
639instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
640 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
641 sconcat = pull . fmap sconcat . mapM sample
642 stimes n = fmap $ stimes n
644-- | Alias for 'mapMaybe'
645fmapMaybe :: Filterable f => (a -> Maybe b) -> f a -> f b
646fmapMaybe = mapMaybe
648-- | Flipped version of 'mapMaybe'.
649fforMaybe :: Filterable f => f a -> (a -> Maybe b) -> f b
650fforMaybe = flip mapMaybe
652-- | Filter 'f a' using the provided predicate.
653ffilter :: Filterable f => (a -> Bool) -> f a -> f a
654ffilter = W.filter
656-- | Filter 'Left's from 'f (Either a b)' into 'a'.
657filterLeft :: Filterable f => f (Either a b) -> f a
658filterLeft = mapMaybe (either Just (const Nothing))
660-- | Filter 'Right's from 'f (Either a b)' into 'b'.
661filterRight :: Filterable f => f (Either a b) -> f b
662filterRight = mapMaybe (either (const Nothing) Just)
664-- | Left-biased event union (prefers left event on simultaneous
665-- occurrence).
666instance Reflex t => Alt (Event t) where
667 ev1 <!> ev2 = leftmost [ev1, ev2]
669-- | 'Event' intersection. Only occurs when both events are co-incident.
670instance Reflex t => Apply (Event t) where
671 evf <.> evx = mapMaybe f (align evf evx) where
672 f (These g a) = Just (g a)
673 f _ = Nothing
676-- | 'Event' intersection (convenient interface to 'coincidence').
677instance Reflex t => Bind (Event t) where
678 evx >>- f = coincidence (f <$> evx)
679 join = coincidence
681instance Reflex t => Functor (Event t) where
682 {-# INLINE fmap #-}
683 fmap f = mapMaybe $ Just . f
684 {-# INLINE (<$) #-}
685 x <$ e = fmapCheap (const x) e
687-- TODO Remove this instance
688instance Reflex t => FunctorMaybe (Event t) where
689 {-# INLINE fmapMaybe #-}
690 fmapMaybe = mapMaybe
692instance Reflex t => Filterable (Event t) where
693 {-# INLINE mapMaybe #-}
694 mapMaybe f = push $ return . f
696-- | Never: @'zero' = 'never'@.
697instance Reflex t => Plus (Event t) where
698 zero = never
700-- | Replace each occurrence value of the 'Event' with the value of the
701-- 'Behavior' at the time of that occurrence.
702tag :: Reflex t => Behavior t b -> Event t a -> Event t b
703tag b = pushAlways $ \_ -> sample b
705-- | Replace each occurrence value of the 'Event' with the value of the
706-- 'Behavior' at that time; if it is 'Just', fire with the contained value; if
707-- it is 'Nothing', drop the occurrence.
708tagMaybe :: Reflex t => Behavior t (Maybe b) -> Event t a -> Event t b
709tagMaybe b = push $ \_ -> sample b
711-- | Create a new 'Event' that combines occurrences of supplied 'Event' with the
712-- current value of the 'Behavior'.
713attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
714attach = attachWith (,)
716-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
717-- combining it with the current value of the 'Behavior'.
718attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
719attachWith f = attachWithMaybe $ \a b -> Just $ f a b
721-- | Create a new 'Event' by combining each occurrence with the current value of
722-- the 'Behavior'. The occurrence is discarded if the combining function returns
723-- Nothing
724attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
725attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
727-- | Create a new 'Event' that occurs on all but the first occurrence of the
728-- supplied 'Event'.
729tailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a)
730tailE e = snd <$> headTailE e
732-- | Create a tuple of two 'Event's with the first one occurring only the first
733-- time the supplied 'Event' occurs and the second occurring on all but the first
734-- occurrence.
735headTailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a, Event t a)
736headTailE e = do
737 eHead <- headE e
738 be <- hold never $ fmap (const e) eHead
739 return (eHead, switch be)
741-- | Take the streak of occurrences starting at the current time for which the
742-- event returns 'True'.
743--
744-- Starting at the current time, fire all the occurrences of the 'Event' for
745-- which the given predicate returns 'True'. When first 'False' is returned,
746-- do not fire, and permanently stop firing, even if 'True' values would have
747-- been encountered later.
748takeWhileE
749 :: forall t m a
750 . (Reflex t, MonadFix m, MonadHold t m)
751 => (a -> Bool)
752 -> Event t a
753 -> m (Event t a)
754takeWhileE f = takeWhileJustE $ \v -> guard (f v) $> v
756-- | Take the streak of occurrences starting at the current time for which the
757-- event returns 'Just b'.
758--
759-- Starting at the current time, fire all the occurrences of the 'Event' for
760-- which the given predicate returns 'Just b'. When first 'Nothing' is returned,
761-- do not fire, and permanently stop firing, even if 'Just b' values would have
762-- been encountered later.
763takeWhileJustE
764 :: forall t m a b
765 . (Reflex t, MonadFix m, MonadHold t m)
766 => (a -> Maybe b)
767 -> Event t a
768 -> m (Event t b)
769takeWhileJustE f e = do
770 rec let (eBad, eTrue) = fanEither $ ffor e' $ \a -> case f a of
771 Nothing -> Left never
772 Just b -> Right b
773 eFirstBad <- headE eBad
774 e' <- switchHold e eFirstBad
775 return eTrue
777-- | Drop the streak of occurrences starting at the current time for which the
778-- event returns 'True'.
779--
780-- Starting at the current time, do not fire all the occurrences of the 'Event'
781-- for which the given predicate returns 'True'. When 'False' is first
782-- returned, do fire, and permanently continue firing, even if 'True' values
783-- would have been encountered later.
784dropWhileE
785 :: forall t m a
786 . (Reflex t, MonadFix m, MonadHold t m)
787 => (a -> Bool)
788 -> Event t a
789 -> m (Event t a)
790dropWhileE f e = snd <$> takeDropWhileJustE (\v -> guard (f v) $> v) e
792-- | Both take and drop the streak of occurrences starting at the current time
793-- for which the event returns 'Just b'.
794--
795-- For the left event, starting at the current time, fire all the occurrences
796-- of the 'Event' for which the given function returns 'Just b'. When
797-- 'Nothing' is returned, do not fire, and permanently stop firing, even if
798-- 'Just b' values would have been encountered later.
799--
800-- For the right event, do not fire until the first occurrence where the given
801-- function returns 'Nothing', and fire that one and all subsequent
802-- occurrences. Even if the function would have again returned 'Just b', keep
803-- on firing.
804takeDropWhileJustE
805 :: forall t m a b
806 . (Reflex t, MonadFix m, MonadHold t m)
807 => (a -> Maybe b)
808 -> Event t a
809 -> m (Event t b, Event t a)
810takeDropWhileJustE f e = do
811 rec let (eBad, eGood) = fanEither $ ffor e' $ \a -> case f a of
812 Nothing -> Left ()
813 Just b -> Right b
814 eFirstBad <- headE eBad
815 e' <- switchHold e (never <$ eFirstBad)
816 eRest <- switchHoldPromptOnly never (e <$ eFirstBad)
817 return (eGood, eRest)
819-- | Split the supplied 'Event' into two individual 'Event's occurring at the
820-- same time with the respective values from the tuple.
821splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
822splitE e = (fmap fst e, fmap snd e)
824-- | Print the supplied 'String' and the value of the 'Event' on each
825-- occurrence. This should /only/ be used for debugging.
826--
827-- Note: As with Debug.Trace.trace, the message will only be printed if the
828-- 'Event' is actually used.
829traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
830traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
832-- | Print the output of the supplied function on each occurrence of the
833-- 'Event'. This should /only/ be used for debugging.
834--
835-- Note: As with Debug.Trace.trace, the message will only be printed if the
836-- 'Event' is actually used.
837traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
838traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
840instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
841 (<>) = alignWith (mergeThese (<>))
842 sconcat = fmap sconcat . mergeList . toList
843 stimes n = fmap $ stimes n
845instance (Semigroup a, Reflex t) => Monoid (Event t a) where
846 mempty = never
847 mappend = (<>)
848 mconcat = fmap sconcat . mergeList
850-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
851-- list occurs. If multiple occur at the same time they are folded from the left
852-- with the given function.
853{-# INLINE mergeWith #-}
854mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
855mergeWith = mergeWith' id
857{-# INLINE mergeWith' #-}
858mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
859mergeWith' f g es = fmap (Prelude.foldl1 g . fmap f)
860 . mergeInt
861 . IntMap.fromDistinctAscList
862 $ zip [0 :: Int ..] es
864-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
865-- list occurs. If multiple occur at the same time the value is the value of the
866-- leftmost event.
867{-# INLINE leftmost #-}
868leftmost :: Reflex t => [Event t a] -> Event t a
869leftmost = mergeWith const
871-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
872-- list occurs and has a list of the values of all 'Event's occurring at that
873-- time.
874mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
875mergeList [] = never
876mergeList es = mergeWithFoldCheap' id es
878unsafeMapIncremental
879 :: (Reflex t, Patch p, Patch p')
880 => (PatchTarget p -> PatchTarget p')
881 -> (p -> p')
882 -> Incremental t p
883 -> Incremental t p'
884unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
886-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
887-- occurs if at least one of them occurs and has a map of values of all 'Event's
888-- occurring at that time.
889mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
890mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
892-- | Like 'mergeMap' but for 'IntMap'.
893mergeIntMap :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
894mergeIntMap = fmap dmapToIntMap . merge . intMapWithFunctorToDMap
896-- | Create a merge whose parents can change over time
897mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
898mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
900-- | Create a merge whose parents can change over time
901mergeIntMapIncremental :: Reflex t => Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
902mergeIntMapIncremental = fmap dmapToIntMap . mergeIncremental . unsafeMapIncremental intMapWithFunctorToDMap (const2IntPatchDMapWith id)
904-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
905mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
906mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
908-- | Split the event into separate events for 'Left' and 'Right' values.
909fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
910fanEither e =
911 let justLeft = either Just (const Nothing)
912 justRight = either (const Nothing) Just
913 in (mapMaybe justLeft e, mapMaybe justRight e)
915-- | Split the event into separate events for 'This' and 'That' values,
916-- allowing them to fire simultaneously when the input value is 'These'.
917fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
918fanThese e =
919 let this (This x) = Just x
920 this (These x _) = Just x
921 this _ = Nothing
922 that (That y) = Just y
923 that (These _ y) = Just y
924 that _ = Nothing
925 in (mapMaybe this e, mapMaybe that e)
927-- | Split the event into an 'EventSelector' that allows efficient selection of
928-- the individual 'Event's.
929fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
930fanMap = fan . fmap mapToDMap
932-- | Switches to the new event whenever it receives one. Only the old event is
933-- considered the moment a new one is switched in; the output event will fire at
934-- that moment only if the old event does.
935--
936-- Because the simultaneous firing case is irrelevant, this function imposes
937-- laxer "timing requirements" on the overall circuit, avoiding many potential
938-- cyclic dependency / metastability failures. It's also more performant. Use
939-- this rather than 'switchHoldPromptly' and 'switchHoldPromptOnly' unless you
940-- are absolutely sure you need to act on the new event in the coincidental
941-- case.
942switchHold :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
943switchHold ea0 eea = switch <$> hold ea0 eea
945-- | Switches to the new event whenever it receives one. Whenever a new event is
946-- provided, if it is firing, its value will be the resulting event's value; if
947-- it is not firing, but the old one is, the old one's value will be used.
948--
949-- 'switchHold', by always forwarding the old event the moment it is switched
950-- out, avoids many potential cyclic dependency problems / metastability
951-- problems. It's also more performant. Use it instead unless you are sure you
952-- cannot.
953switchHoldPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
954switchHoldPromptly ea0 eea = do
955 bea <- hold ea0 eea
956 let eLag = switch bea
957 eCoincidences = coincidence eea
958 return $ leftmost [eCoincidences, eLag]
960-- | switches to a new event whenever it receives one. At the moment of
961-- switching, the old event will be ignored if it fires, and the new one will be
962-- used if it fires; this is the opposite of 'switch', which will use only the
963-- old value.
964--
965-- 'switchHold', by always forwarding the old event the moment it is switched
966-- out, avoids many potential cyclic dependency problems / metastability
967-- problems. It's also more performant. Use it instead unless you are sure you
968-- cannot.
969switchHoldPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
970switchHoldPromptOnly e0 e' = do
971 eLag <- switch <$> hold e0 e'
972 return $ coincidence $ leftmost [e', eLag <$ eLag]
974-- | When the given outer event fires, condense the inner events into the contained patch. Non-firing inner events will be replaced with deletions.
975coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)
976coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ ffor e $ \(PatchMap m) -> mergeMap $ ffor m $ \case
977 Nothing -> fmapCheap (const Nothing) e
978 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
980-- | See 'coincidencePatchMap'
981coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)
982coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ ffor e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case
983 Nothing -> fmapCheap (const Nothing) e
984 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
986-- | See 'coincidencePatchMap'
987coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)
988coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ ffor e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
989 PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->
990 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
991 PatchMapWithMove.From_Move k -> fforCheap e $ \_ ->
992 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }
993 PatchMapWithMove.From_Insert ev -> leftmost
994 [ fforCheap ev $ \v ->
995 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }
996 , fforCheap e $ \_ ->
997 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
998 ]
1000-- | Given a 'PatchTarget' of events (e.g., a 'Map' with 'Event' values) and an event of 'Patch'es
1001-- (e.g., a 'PatchMap' with 'Event' values), produce an 'Event' of the 'PatchTarget' type that
1002-- fires with the patched value.
1003switchHoldPromptOnlyIncremental
1004 :: forall t m p pt w
1005 . ( Reflex t
1006 , MonadHold t m
1007 , Patch (p (Event t w))
1008 , PatchTarget (p (Event t w)) ~ pt (Event t w)
1009 , Patch (p w)
1010 , PatchTarget (p w) ~ pt w
1011 , Monoid (pt w)
1013 => (Incremental t (p (Event t w)) -> Event t (pt w))
1014 -> (Event t (p (Event t w)) -> Event t (p w))
1015 -> pt (Event t w)
1016 -> Event t (p (Event t w))
1017 -> m (Event t (pt w))
1018switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch e0 e' = do
1019 lag <- mergePatchIncremental <$> holdIncremental e0 e'
1020 pure $ ffor (align lag (coincidencePatch e')) $ \case
1021 This old -> old
1022 That new -> new `applyAlways` mempty
1023 These old new -> new `applyAlways` old
1025instance Reflex t => Align (Event t) where
1026 nil = never
1027#if MIN_VERSION_these(0, 8, 0)
1028instance Reflex t => Semialign (Event t) where
1029#endif
1030 align = alignEventWithMaybe Just
1032#ifdef MIN_VERSION_semialign
1033#if MIN_VERSION_semialign(1,1,0)
1034instance Reflex t => Zip (Event t) where
1035#endif
1036 zip x y = mapMaybe justThese $ align x y
1037#endif
1040-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
1041-- the 'Behavior' is true at the time of occurrence.
1042gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
1043gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
1045-- | Create a new behavior given a starting behavior and switch to the behavior
1046-- carried by the event when it fires.
1047switcher :: (Reflex t, MonadHold t m)
1048 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
1049switcher b eb = pull . (sample <=< sample) <$> hold b eb
1051instance (Reflex t, IsString a) => IsString (Dynamic t a) where
1052 fromString = pure . fromString
1054-- | Combine two 'Dynamic's. The result will change whenever either (or both)
1055-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
1056zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
1057zipDyn = zipDynWith (,)
1059-- | Combine two 'Dynamic's with a combining function. The result will change
1060-- whenever either (or both) input 'Dynamic' changes.
1061-- More efficient than 'liftA2'.
1062zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
1063zipDynWith f da db =
1064 let eab = align (updated da) (updated db)
1065 ec = flip push eab $ \o -> do
1066 (a, b) <- case o of
1067 This a -> do
1068 b <- sample $ current db
1069 return (a, b)
1070 That b -> do
1071 a <- sample $ current da
1072 return (a, b)
1073 These a b -> return (a, b)
1074 return $ Just $ f a b
1075 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
1077instance (Reflex t, Semigroup a) => Semigroup (Dynamic t a) where
1078 (<>) = zipDynWith (<>)
1079 stimes n = fmap $ stimes n
1081instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
1082 mconcat = distributeListOverDynWith mconcat
1083 mempty = constDyn mempty
1084 mappend = zipDynWith mappend
1086-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1087-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1088-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1089distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
1090distributeDMapOverDynPure dm = case DMap.toList dm of
1091 [] -> constDyn DMap.empty
1092 [k :=> v] -> fmap (DMap.singleton k . Identity) v
1093 _ ->
1094 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
1095 edmPre = merge $ DMap.map updated dm
1096 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
1097 olds <- sample $ current result
1098 return $ DMap.unionWithKey (\_ _ new -> new) olds news
1099 in result
1101-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
1102distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
1103distributeListOverDyn = distributeListOverDynWith id
1105-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
1106distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
1107distributeListOverDynWith f =
1108 fmap (f . map fromDSum . DMap.toAscList) .
1109 distributeDMapOverDynPure .
1110 DMap.fromDistinctAscList .
1111 zipWith toDSum [0..]
1112 where
1113 toDSum :: Int -> Dynamic t a -> DSum (Const2 Int a) (Dynamic t)
1114 toDSum k v = Const2 k :=> v
1115 fromDSum :: DSum (Const2 Int a) Identity -> a
1116 fromDSum (Const2 _ :=> Identity v) = v
1118-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
1119-- unless the second supplied 'Event' occurs simultaneously.
1120difference :: Reflex t => Event t a -> Event t b -> Event t a
1121difference = alignEventWithMaybe $ \case
1122 This a -> Just a
1123 _ -> Nothing
1125-- | Zips two values by taking the union of their shapes and combining with the provided function.
1126-- 'Nothing' values are dropped.
1127alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
1128alignEventWithMaybe f ea eb = mapMaybe (f <=< dmapToThese) $
1129 merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
1131-- | Produces an 'Event' that fires only when the input event fires with a 'DSum' key that
1132-- matches the provided key.
1133filterEventKey
1134 :: forall t m k v a.
1135 ( Reflex t
1136 , MonadFix m
1137 , MonadHold t m
1138 , GEq k
1140 => k a
1141 -> Event t (DSum k v)
1142 -> m (Event t (v a))
1143filterEventKey k kv' = do
1144 let f :: DSum k v -> Maybe (v a)
1145 f (newK :=> newV) = case newK `geq` k of
1146 Just Refl -> Just newV
1147 Nothing -> Nothing
1148 takeWhileJustE f kv'
1150-- | "Factor" the input 'DSum' 'Event' to produce an 'Event' which
1151-- fires when the 'DSum' key changes and contains both the value of the
1152-- 'DSum' at switchover and an 'Event' of values produced by subsequent
1153-- firings of the input 'Event' that do not change the 'DSum' key.
1154factorEvent
1155 :: forall t m k v a.
1156 ( Reflex t
1157 , MonadFix m
1158 , MonadHold t m
1159 , GEq k
1161 => k a
1162 -> Event t (DSum k v)
1163 -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))
1164factorEvent k0 kv' = do
1165 key :: Behavior t (Some k) <- hold (Some k0) $ fmapCheap (\(k :=> _) -> Some k) kv'
1166 let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case
1167 Some oldKey -> case newKey `geq` oldKey of
1168 Just Refl -> return Nothing
1169 Nothing -> do
1170 newInner <- filterEventKey newKey kv'
1171 return $ Just $ newKey :=> Pair newVal (Compose newInner)
1172 eInitial <- filterEventKey k0 kv'
1173 return (eInitial, update)
1175--------------------------------------------------------------------------------
1176-- Accumulator
1177--------------------------------------------------------------------------------
1179-- | An 'Accumulator' type can be built by accumulating occurrences of an
1180-- 'Event'.
1181#if __GLASGOW_HASKELL__ < 802
1182{-# WARNING accum "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1183{-# WARNING accumM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1184{-# WARNING accumMaybe "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1185{-# WARNING accumMaybeM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1186#endif
1187class Reflex t => Accumulator t f | f -> t where
1188 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
1189 accum f = accumMaybe $ \v o -> Just $ f v o
1190 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
1191 accumM f = accumMaybeM $ \v o -> Just <$> f v o
1192 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
1193 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
1194 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
1195 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
1196 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
1197 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
1198 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
1199 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1200 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
1201 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1203-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1204-- with the provided function. See 'foldDyn'.
1205accumDyn
1206 :: (Reflex t, MonadHold t m, MonadFix m)
1207 => (a -> b -> a)
1208 -> a
1209 -> Event t b
1210 -> m (Dynamic t a)
1211accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o
1213-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1214-- with the provided 'PushM' action.
1215accumMDyn
1216 :: (Reflex t, MonadHold t m, MonadFix m)
1217 => (a -> b -> PushM t a)
1218 -> a
1219 -> Event t b
1220 -> m (Dynamic t a)
1221accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o
1223-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1224-- with the provided function, discarding 'Nothing' results.
1225accumMaybeDyn
1226 :: (Reflex t, MonadHold t m, MonadFix m)
1227 => (a -> b -> Maybe a)
1228 -> a
1229 -> Event t b
1230 -> m (Dynamic t a)
1231accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o
1233-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1234-- with the provided 'PushM' action, discarding 'Nothing' results.
1235accumMaybeMDyn
1236 :: (Reflex t, MonadHold t m, MonadFix m)
1237 => (a -> b -> PushM t (Maybe a))
1238 -> a
1239 -> Event t b
1240 -> m (Dynamic t a)
1241accumMaybeMDyn f z e = do
1242 rec let e' = flip push e $ \o -> do
1243 v <- sample $ current d'
1244 f v o
1245 d' <- holdDyn z e'
1246 return d'
1248-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1249-- with a function that both accumulates and produces a value to fire
1250-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1251mapAccumDyn
1252 :: (Reflex t, MonadHold t m, MonadFix m)
1253 => (a -> b -> (a, c))
1254 -> a
1255 -> Event t b
1256 -> m (Dynamic t a, Event t c)
1257mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o
1259-- | Similar to 'mapAccumDyn' except that the combining function is a
1260-- 'PushM' action.
1261mapAccumMDyn
1262 :: (Reflex t, MonadHold t m, MonadFix m)
1263 => (a -> b -> PushM t (a, c))
1264 -> a
1265 -> Event t b
1266 -> m (Dynamic t a, Event t c)
1267mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o
1269-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event' with
1270-- a function that both optionally accumulates and optionally produces
1271-- a value to fire as a separate output 'Event'.
1272-- Note that because 'Nothing's are discarded in both cases, the output
1273-- 'Event' may fire even though the output 'Dynamic' has not changed, and
1274-- the output 'Dynamic' may update even when the output 'Event' is not firing.
1275mapAccumMaybeDyn
1276 :: (Reflex t, MonadHold t m, MonadFix m)
1277 => (a -> b -> (Maybe a, Maybe c))
1278 -> a
1279 -> Event t b
1280 -> m (Dynamic t a, Event t c)
1281mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o
1283-- | Like 'mapAccumMaybeDyn' except that the combining function is a
1284-- 'PushM' action.
1285mapAccumMaybeMDyn
1286 :: (Reflex t, MonadHold t m, MonadFix m)
1287 => (a -> b -> PushM t (Maybe a, Maybe c))
1288 -> a
1289 -> Event t b
1290 -> m (Dynamic t a, Event t c)
1291mapAccumMaybeMDyn f z e = do
1292 rec let e' = flip push e $ \o -> do
1293 v <- sample $ current d'
1294 result <- f v o
1295 return $ case result of
1296 (Nothing, Nothing) -> Nothing
1297 _ -> Just result
1298 d' <- holdDyn z $ mapMaybe fst e'
1299 return (d', mapMaybe snd e')
1301-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1302-- with the provided function.
1303{-# INLINE accumB #-}
1304accumB
1305 :: (Reflex t, MonadHold t m, MonadFix m)
1306 => (a -> b -> a)
1307 -> a
1308 -> Event t b
1309 -> m (Behavior t a)
1310accumB f = accumMaybeB $ \v o -> Just $ f v o
1312-- | Like 'accumB' except that the combining function is a 'PushM' action.
1313{-# INLINE accumMB #-}
1314accumMB
1315 :: (Reflex t, MonadHold t m, MonadFix m)
1316 => (a -> b -> PushM t a)
1317 -> a
1318 -> Event t b
1319 -> m (Behavior t a)
1320accumMB f = accumMaybeMB $ \v o -> Just <$> f v o
1322-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1323-- with the provided function, discarding 'Nothing' results.
1324{-# INLINE accumMaybeB #-}
1325accumMaybeB
1326 :: (Reflex t, MonadHold t m, MonadFix m)
1327 => (a -> b -> Maybe a)
1328 -> a
1329 -> Event t b
1330 -> m (Behavior t a)
1331accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o
1333-- | Like 'accumMaybeB' except that the combining function is a 'PushM' action.
1334{-# INLINE accumMaybeMB #-}
1335accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)
1336accumMaybeMB f z e = do
1337 rec let e' = flip push e $ \o -> do
1338 v <- sample d'
1339 f v o
1340 d' <- hold z e'
1341 return d'
1343-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1344-- with a function that both accumulates and produces a value to fire
1345-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1346{-# INLINE mapAccumB #-}
1347mapAccumB
1348 :: (Reflex t, MonadHold t m, MonadFix m)
1349 => (a -> b -> (a, c))
1350 -> a
1351 -> Event t b
1352 -> m (Behavior t a, Event t c)
1353mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o
1355-- | Like 'mapAccumB' except that the combining function is a 'PushM' action.
1356{-# INLINE mapAccumMB #-}
1357mapAccumMB
1358 :: (Reflex t, MonadHold t m, MonadFix m)
1359 => (a -> b -> PushM t (a, c))
1360 -> a
1361 -> Event t b
1362 -> m (Behavior t a, Event t c)
1363mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o
1365-- | Accumulate a 'Behavior' by folding occurrences of an 'Event' with
1366-- a function that both optionally accumulates and optionally produces
1367-- a value to fire as a separate output 'Event'. 'Nothing's are discarded.
1368{-# INLINE mapAccumMaybeB #-}
1369mapAccumMaybeB
1370 :: (Reflex t, MonadHold t m, MonadFix m)
1371 => (a -> b -> (Maybe a, Maybe c))
1372 -> a
1373 -> Event t b
1374 -> m (Behavior t a, Event t c)
1375mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o
1377-- | Like 'mapAccumMaybeB' except that the combining function is a 'PushM' action.
1378{-# INLINE mapAccumMaybeMB #-}
1379mapAccumMaybeMB :: (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)
1380mapAccumMaybeMB f z e = do
1381 rec let e' = flip push e $ \o -> do
1382 v <- sample d'
1383 result <- f v o
1384 return $ case result of
1385 (Nothing, Nothing) -> Nothing
1386 _ -> Just result
1387 d' <- hold z $ mapMaybe fst e'
1388 return (d', mapMaybe snd e')
1390-- | Accumulate occurrences of an 'Event', producing an output occurrence each
1391-- time. Discard the underlying 'Accumulator'.
1392{-# INLINE mapAccum_ #-}
1393mapAccum_ :: 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)
1394mapAccum_ f z e = do
1395 (_, result) <- mapAccumB f z e
1396 return result
1398-- | Accumulate occurrences of an 'Event', possibly producing an output
1399-- occurrence each time. Discard the underlying 'Accumulator'.
1400{-# INLINE mapAccumMaybe_ #-}
1401mapAccumMaybe_ :: 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)
1402mapAccumMaybe_ f z e = do
1403 (_, result) <- mapAccumMaybeB f z e
1404 return result
1406-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
1407-- an output occurrence each time. Discard the underlying 'Accumulator'.
1408{-# INLINE mapAccumM_ #-}
1409mapAccumM_ :: 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)
1410mapAccumM_ f z e = do
1411 (_, result) <- mapAccumMB f z e
1412 return result
1414-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
1415-- producing an output occurrence each time. Discard the underlying
1416-- 'Accumulator'.
1417{-# INLINE mapAccumMaybeM_ #-}
1418mapAccumMaybeM_ :: 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)
1419mapAccumMaybeM_ f z e = do
1420 (_, result) <- mapAccumMaybeMB f z e
1421 return result
1423instance Reflex t => Accumulator t (Dynamic t) where
1424 accumMaybeM = accumMaybeMDyn
1425 mapAccumMaybeM = mapAccumMaybeMDyn
1427instance Reflex t => Accumulator t (Behavior t) where
1428 accumMaybeM = accumMaybeMB
1429 mapAccumMaybeM = mapAccumMaybeMB
1431instance Reflex t => Accumulator t (Event t) where
1432 accumMaybeM f z e = updated <$> accumMaybeM f z e
1433 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
1435-- | Create a new 'Event' by combining each occurrence with the next value of the
1436-- list using the supplied function. If the list runs out of items, all
1437-- subsequent 'Event' occurrences will be ignored.
1438zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
1439zipListWithEvent f l e = do
1440 let f' a b = case a of
1441 h:t -> (Just t, Just $ f h b)
1442 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
1443 mapAccumMaybe_ f' l e
1445-- | Assign a number to each occurrence of the given 'Event', starting from 0
1446{-# INLINE numberOccurrences #-}
1447numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
1448numberOccurrences = numberOccurrencesFrom 0
1450-- | Assign a number to each occurrence of the given 'Event'
1451{-# INLINE numberOccurrencesFrom #-}
1452numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
1453numberOccurrencesFrom = mapAccum_ (\n a -> let !next = n + 1 in (next, (n, a)))
1455-- | Assign a number to each occurrence of the given 'Event'; discard the occurrences' values
1456{-# INLINE numberOccurrencesFrom_ #-}
1457numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
1458numberOccurrencesFrom_ = mapAccum_ (\n _ -> let !next = n + 1 in (next, n))
1460-- | This is used to sample the value of a 'Behavior' using an 'Event'.
1462-- The '<@>' operator is intended to be used in conjunction with
1463-- the 'Applicative' instance for 'Behavior'.
1465-- This is useful when we want to combine the values of one 'Event' and
1466-- the value of several 'Behavior's at the time the 'Event' is firing.
1468-- If we have:
1470-- > f :: a -> b -> c -> d
1471-- > b1 :: Behavior t a
1472-- > b2 :: Behavior t b
1473-- > e :: Event t c
1475-- then we can do:
1477-- > f <$> b1 <*> b2 <@> e :: Event t d
1479-- in order to apply the function 'f' to the relevant values.
1481-- The alternative would be something like:
1483-- > attachWith (\(x1, x2) y -> f x1 x2 y) ((,) <$> b1 <*> b2) e :: Event t d
1485-- or a variation involing a custom data type to hold the combination of
1486-- 'Behavior's even when that combination might only ever be used by 'f'.
1488-- A more suggestive example might be:
1490-- > handleMouse <$> bPlayerState <*> bMousePosition <@> eMouseClick :: Event t (GameState -> GameState)
1492(<@>) :: Reflex t => Behavior t (a -> b) -> Event t a -> Event t b
1493(<@>) b = push $ \x -> do
1494 f <- sample b
1495 return . Just . f $ x
1496infixl 4 <@>
1498-- | An version of '<@>' that does not use the value of the 'Event'.
1500-- Alternatively, it is 'tag' in operator form.
1502-- This is useful when we want to combine the values of several
1503-- 'Behavior's at particular points in time using an 'Applicative'
1504-- style syntax.
1506-- If we have:
1508-- > g :: a -> b -> d
1509-- > b1 :: Behavior t a
1510-- > b2 :: Behavior t b
1511-- > e :: Event t c
1513-- where 'e' is firing at the points in time of interest.
1515-- Then we can use '<@':
1517-- > g <$> b1 <*> b2 <@ e :: Event t d
1519-- to combine the values of 'b1' and 'b2' at each of those points of time,
1520-- with the function 'g' being used to combine the values.
1522-- This is the same as '<@>' except that the 'Event' is being used only
1523-- to act as a trigger.
1524(<@) :: (Reflex t) => Behavior t b -> Event t a -> Event t b
1525(<@) = tag
1526infixl 4 <@
1528------------------
1529-- Cheap Functions
1530------------------
1532-- | A "cheap" version of 'pushAlways'. See the performance note on 'pushCheap'.
1533{-# INLINE pushAlwaysCheap #-}
1534pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
1535pushAlwaysCheap f = pushCheap (fmap Just . f)
1537-- | A "cheap" version of 'mapMaybe'. See the performance note on 'pushCheap'.
1538{-# INLINE mapMaybeCheap #-}
1539mapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1540mapMaybeCheap f = pushCheap $ return . f
1542-- | An alias for 'mapMaybeCheap'
1543{-# INLINE fmapMaybeCheap #-}
1544fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1545fmapMaybeCheap = mapMaybeCheap
1548-- | A "cheap" version of 'fforMaybe'. See the performance note on 'pushCheap'.
1549{-# INLINE fforMaybeCheap #-}
1550fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
1551fforMaybeCheap = flip mapMaybeCheap
1553-- | A "cheap" version of 'ffor'. See the performance note on 'pushCheap'.
1554{-# INLINE fforCheap #-}
1555fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
1556fforCheap = flip fmapCheap
1558-- | A "cheap" version of 'fmap'. See the performance note on 'pushCheap'.
1559{-# INLINE fmapCheap #-}
1560fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
1561fmapCheap f = pushCheap $ return . Just . f
1563-- | A "cheap" version of 'tag'. See the performance note on 'pushCheap'.
1564{-# INLINE tagCheap #-}
1565tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
1566tagCheap b = pushAlwaysCheap $ \_ -> sample b
1568-- | A "cheap" version of 'mergeWithCheap'. See the performance note on 'pushCheap'.
1569{-# INLINE mergeWithCheap #-}
1570mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
1571mergeWithCheap = mergeWithCheap' id
1573-- | A "cheap" version of 'mergeWithCheap''. See the performance note on 'pushCheap'.
1574{-# INLINE mergeWithCheap' #-}
1575mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
1576mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
1578-- | A "cheap" version of 'mergeWithFoldCheap''. See the performance note on 'pushCheap'.
1579{-# INLINE mergeWithFoldCheap' #-}
1580mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
1581mergeWithFoldCheap' f es =
1582 fmapCheap (f . (\(h : t) -> h :| t) . IntMap.elems)
1583 . mergeInt
1584 . IntMap.fromDistinctAscList
1585 $ zip [0 :: Int ..] es
1587--------------------------------------------------------------------------------
1588-- Deprecated functions
1589--------------------------------------------------------------------------------
1591{-# 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'. " #-}
1592-- | See 'switchHoldPromptly'
1593switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1594switchPromptly = switchHoldPromptly
1595{-# 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'. " #-}
1596-- | See 'switchHoldPromptOnly'
1597switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1598switchPromptOnly = switchHoldPromptOnly