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