1{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE ConstraintKinds #-}
4{-# LANGUAGE DefaultSignatures #-}
5{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE FunctionalDependencies #-}
9{-# LANGUAGE LambdaCase #-}
10{-# LANGUAGE MultiParamTypeClasses #-}
11{-# LANGUAGE NoMonomorphismRestriction #-}
12{-# LANGUAGE PolyKinds #-}
13{-# LANGUAGE RankNTypes #-}
14{-# LANGUAGE RecursiveDo #-}
15{-# LANGUAGE RoleAnnotations #-}
16{-# LANGUAGE ScopedTypeVariables #-}
17{-# LANGUAGE TypeFamilies #-}
18{-# LANGUAGE TypeOperators #-}
19{-# LANGUAGE UndecidableInstances #-}
20#ifdef USE_REFLEX_OPTIMIZER
21{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
24-- | This module contains the Reflex interface, as well as a variety of
25-- convenience functions for working with 'Event's, 'Behavior's, and other
37 -- ** 'fan' related types
39 , EventSelectorInt (..)
40 -- * Convenience functions
43 -- ** Combining 'Event's
48 , mergeMapIncrementalWithMove
49 , mergeIntMapIncremental
51 , coincidencePatchMapWithMove
52 , coincidencePatchIntMap
57 -- ** Breaking up 'Event's
68 -- ** Collapsing 'Event . Event'
71 , switchHoldPromptOnly
72 , switchHoldPromptOnlyIncremental
73 -- ** Using 'Event's to sample 'Behavior's
79 -- ** Blocking an 'Event' based on a 'Behavior'
81 -- ** Combining 'Dynamic's
82 , distributeDMapOverDynPure
83 , distributeListOverDyn
84 , distributeListOverDynWith
87 -- ** Accumulating state
111 , accumMaybeIncremental
112 , accumMaybeMIncremental
113 , mapAccumIncremental
114 , mapAccumMIncremental
115 , mapAccumMaybeIncremental
116 , mapAccumMaybeMIncremental
119 , numberOccurrencesFrom
120 , numberOccurrencesFrom_
130 -- * Debugging functions
133 -- * Unsafe functions
135 , unsafeMapIncremental
142 -- * Miscellaneous convenience functions
146 -- * Deprecated functions
160 -- * Slow, but general, implementations
164import Control.Applicative
165import Control.Monad.Identity
166import Control.Monad.Reader
167import Control.Monad.State.Strict
168import Control.Monad.Trans.Cont (ContT)
169import Control.Monad.Trans.Except (ExceptT)
170import Control.Monad.Trans.RWS (RWST)
171import Control.Monad.Trans.Writer (WriterT)
176import Data.Dependent.Map (DMap, DSum (..))
177import qualified Data.Dependent.Map as DMap
178import Data.Functor.Compose
179import Data.Functor.Product
180import Data.GADT.Compare (GEq (..), GCompare (..), (:~:) (..))
181import Data.FastMutableIntMap (PatchIntMap)
183import Data.Functor.Bind
184import Data.Functor.Misc
185import Data.Functor.Plus
186import Data.IntMap.Strict (IntMap)
187import qualified Data.IntMap.Strict as IntMap
188import Data.List.NonEmpty (NonEmpty (..))
190import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
191import Data.Some (Some)
192import qualified Data.Some as Some
195import Data.Type.Coercion
196import Reflex.FunctorMaybe
198import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
200import Debug.Trace (trace)
202-- | The 'Reflex' class contains all the primitive functionality needed for
203-- Functional Reactive Programming (FRP). The @/t/@ type parameter indicates
204-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
205-- and the type of the timeline determines the FRP engine to be used. For most
206-- purposes, the 'Reflex.Spider' implementation is recommended.
207class ( MonadHold t (PushM t)
208 , MonadSample t (PullM t)
210 , Functor (Dynamic t)
211 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
214 -- | A container for a value that can change over time. 'Behavior's can be
215 -- sampled at will, but it is not possible to be notified when they change
216 data Behavior t :: * -> *
217 -- | A stream of occurrences. During any given frame, an 'Event' is either
218 -- occurring or not occurring; if it is occurring, it will contain a value of
219 -- the given type (its "occurrence type")
220 data Event t :: * -> *
221 -- | A container for a value that can change over time and allows
222 -- notifications on changes. Basically a combination of a 'Behavior' and an
223 -- 'Event', with a rule that the 'Behavior' will change if and only if the
225 data Dynamic t :: * -> *
226 -- | An 'Incremental' is a more general form of a 'Dynamic'.
227 -- Instead of always fully replacing the value, only parts of it can be patched.
228 -- This is only needed for performance critical code via `mergeIncremental` to make small
229 -- changes to large values.
230 data Incremental t :: * -> *
231 -- | A monad for doing complex push-based calculations efficiently
232 type PushM t :: * -> *
233 -- | A monad for doing complex pull-based calculations efficiently
234 type PullM t :: * -> *
235 -- | An 'Event' with no occurrences
237 -- | Create a 'Behavior' that always has the given value
238 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
239 -- | Create an 'Event' from another 'Event'; the provided function can sample
240 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
241 -- (Just) or non-occurring (Nothing) result
242 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
243 -- | 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.
244 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
245 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
246 -- recomputed whenever any of the read 'Behavior's changes
247 pull :: PullM t a -> Behavior t a
248 -- | Merge a collection of events; the resulting 'Event' will only occur if at
249 -- least one input event is occurring, and will contain all of the input keys
250 -- that are occurring simultaneously
251 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
252 -- | Efficiently fan-out an event to many destinations. This function should
253 -- be partially applied, and then the result applied repeatedly to create
255 fan :: GCompare k => Event t (DMap k Identity) -> EventSelector t k --TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it
256 -- | Create an 'Event' that will occur whenever the currently-selected input
258 switch :: Behavior t (Event t a) -> Event t a
259 -- | Create an 'Event' that will occur whenever the input event is occurring
260 -- and its occurrence value, another 'Event', is also occurring
261 coincidence :: Event t (Event t a) -> Event t a
262 -- | Extract the 'Behavior' of a 'Dynamic'.
263 current :: Dynamic t a -> Behavior t a
264 -- | Extract the 'Event' of the 'Dynamic'.
265 updated :: Dynamic t a -> Event t a
266 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
267 -- recent firing of the given 'Event', if any.
268 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
269 -- | Create a new 'Incremental'. The given "PullM"'s value must always change
270 -- in the same way that the accumulated application of patches would change
272 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
273 -- | Create a merge whose parents can change over time
274 mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
275 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
276 mergeIncrementalWithMove :: GCompare k => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
277 -- | Extract the 'Behavior' component of an 'Incremental'
278 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
279 -- | Extract the 'Event' component of an 'Incremental'
280 updatedIncremental :: Patch p => Incremental t p -> Event t p
281 -- | Convert an 'Incremental' to a 'Dynamic'
282 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
283 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
285 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
286 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
288 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
289 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
291 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
292 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
293 fanInt :: Event t (IntMap a) -> EventSelectorInt t a
295--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on
296mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
297mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never
299-- | Coerce a 'Behavior' between representationally-equivalent value types
300coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
301coerceBehavior = coerceWith $ behaviorCoercion Coercion
303-- | Coerce an 'Event' between representationally-equivalent occurrence types
304coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
305coerceEvent = coerceWith $ eventCoercion Coercion
307-- | Coerce a 'Dynamic' between representationally-equivalent value types
308coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
309coerceDynamic = coerceWith $ dynamicCoercion Coercion
311-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
312-- __must__ change when and only when the 'Event' fires, such that the
313-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
314-- if this is not the case, the resulting 'Dynamic' will behave
315-- nondeterministically.
316unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
317unsafeDynamic = unsafeBuildDynamic . sample
319-- | Construct a 'Dynamic' value that never changes
320constDyn :: Reflex t => a -> Dynamic t a
323instance (Reflex t, Default a) => Default (Dynamic t a) where
326-- | 'MonadSample' designates monads that can read the current value of a
327-- 'Behavior'. This includes both 'PullM' and 'PushM'.
328class (Applicative m, Monad m) => MonadSample t m | m -> t where
329 -- | Get the current value in the 'Behavior'
330 sample :: Behavior t a -> m a
332-- | 'MonadHold' designates monads that can create new 'Behavior's based on
333-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
334-- is required to create any stateful computations with Reflex.
335class MonadSample t m => MonadHold t m where
336 -- | Create a new 'Behavior' whose value will initially be equal to the given
337 -- value and will be updated whenever the given 'Event' occurs. The update
338 -- takes effect immediately after the 'Event' occurs; if the occurrence that
339 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
340 -- the 'Behavior', it will see the __old__ value of the 'Behavior', not the new
342 hold :: a -> Event t a -> m (Behavior t a)
343 default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)
344 hold v0 = lift . hold v0
345 -- | Create a 'Dynamic' value using the given initial value that changes every
346 -- time the 'Event' occurs.
347 holdDyn :: a -> Event t a -> m (Dynamic t a)
348 default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)
349 holdDyn v0 = lift . holdDyn v0
350 -- | Create an 'Incremental' value using the given initial value that changes
351 -- every time the 'Event' occurs.
352 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
353 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
354 holdIncremental v0 = lift . holdIncremental v0
355 buildDynamic :: PushM t a -> Event t a -> m (Dynamic t a)
357 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
358 buildDynamic getV0 = lift . buildDynamic getV0
360 -- | Create a new 'Event' that only occurs only once, on the first occurrence of
361 -- the supplied 'Event'.
362 headE :: Event t a -> m (Event t a)
364accumIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> p) -> PatchTarget p -> Event t b -> m (Incremental t p)
365accumIncremental f = accumMaybeIncremental $ \v o -> Just $ f v o
366accumMIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> PushM t p) -> PatchTarget p -> Event t b -> m (Incremental t p)
367accumMIncremental f = accumMaybeMIncremental $ \v o -> Just <$> f v o
368accumMaybeIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> Maybe p) -> PatchTarget p -> Event t b -> m (Incremental t p)
369accumMaybeIncremental f = accumMaybeMIncremental $ \v o -> return $ f v o
370accumMaybeMIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> PushM t (Maybe p)) -> PatchTarget p -> Event t b -> m (Incremental t p)
371accumMaybeMIncremental f z e = do
372 rec let e' = flip push e $ \o -> do
373 v <- sample $ currentIncremental d'
375 d' <- holdIncremental z e'
377mapAccumIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> (p, c)) -> PatchTarget p -> Event t b -> m (Incremental t p, Event t c)
378mapAccumIncremental f = mapAccumMaybeIncremental $ \v o -> bimap Just Just $ f v o
379mapAccumMIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> PushM t (p, c)) -> PatchTarget p -> Event t b -> m (Incremental t p, Event t c)
380mapAccumMIncremental f = mapAccumMaybeMIncremental $ \v o -> bimap Just Just <$> f v o
381mapAccumMaybeIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> (Maybe p, Maybe c)) -> PatchTarget p -> Event t b -> m (Incremental t p, Event t c)
382mapAccumMaybeIncremental f = mapAccumMaybeMIncremental $ \v o -> return $ f v o
383mapAccumMaybeMIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> PushM t (Maybe p, Maybe c)) -> PatchTarget p -> Event t b -> m (Incremental t p, Event t c)
384mapAccumMaybeMIncremental f z e = do
385 rec let e' = flip push e $ \o -> do
386 v <- sample $ currentIncremental d'
388 return $ case result of
389 (Nothing, Nothing) -> Nothing
391 d' <- holdIncremental z $ fmapMaybe fst e'
392 return (d', fmapMaybe snd e')
394slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
396 rec be <- hold e $ fmapCheap (const never) e'
400-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
401-- key. This is much more efficient than filtering for each key with
403newtype EventSelector t k = EventSelector
404 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
405 -- determined by the type of the key, so this can be used to fan-out
406 -- 'Event's whose sub-'Event's have different types.
408 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
409 -- (but equivalent to) using 'fmapMaybe' to select only the relevant
410 -- occurrences of an 'Event'.
411 select :: forall a. k a -> Event t a
414newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }
416--------------------------------------------------------------------------------
418--------------------------------------------------------------------------------
420instance MonadSample t m => MonadSample t (ReaderT r m) where
421 sample = lift . sample
423instance MonadHold t m => MonadHold t (ReaderT r m) where
424 hold a0 = lift . hold a0
425 holdDyn a0 = lift . holdDyn a0
426 holdIncremental a0 = lift . holdIncremental a0
427 buildDynamic a0 = lift . buildDynamic a0
430instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
431 sample = lift . sample
433instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
434 hold a0 = lift . hold a0
435 holdDyn a0 = lift . holdDyn a0
436 holdIncremental a0 = lift . holdIncremental a0
437 buildDynamic a0 = lift . buildDynamic a0
440instance MonadSample t m => MonadSample t (StateT s m) where
441 sample = lift . sample
443instance MonadHold t m => MonadHold t (StateT s m) where
444 hold a0 = lift . hold a0
445 holdDyn a0 = lift . holdDyn a0
446 holdIncremental a0 = lift . holdIncremental a0
447 buildDynamic a0 = lift . buildDynamic a0
450instance MonadSample t m => MonadSample t (ExceptT e m) where
451 sample = lift . sample
453instance MonadHold t m => MonadHold t (ExceptT e m) where
454 hold a0 = lift . hold a0
455 holdDyn a0 = lift . holdDyn a0
456 holdIncremental a0 = lift . holdIncremental a0
457 buildDynamic a0 = lift . buildDynamic a0
460instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
461 sample = lift . sample
463instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
464 hold a0 = lift . hold a0
465 holdDyn a0 = lift . holdDyn a0
466 holdIncremental a0 = lift . holdIncremental a0
467 buildDynamic a0 = lift . buildDynamic a0
470instance MonadSample t m => MonadSample t (ContT r m) where
471 sample = lift . sample
473instance MonadHold t m => MonadHold t (ContT r m) where
474 hold a0 = lift . hold a0
475 holdDyn a0 = lift . holdDyn a0
476 holdIncremental a0 = lift . holdIncremental a0
477 buildDynamic a0 = lift . buildDynamic a0
480--------------------------------------------------------------------------------
481-- Convenience functions
482--------------------------------------------------------------------------------
484-- | Create an 'Event' from another 'Event'. The provided function can sample
485-- 'Behavior's and hold 'Event's.
486pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
487pushAlways f = push (fmap Just . f)
489-- | Flipped version of 'fmap'.
490ffor :: Functor f => f a -> (a -> b) -> f b
493-- | Rotated version of 'liftA2'.
494ffor2 :: Applicative f => f a -> f b -> (a -> b -> c) -> f c
495ffor2 a b f = liftA2 f a b
497-- | Rotated version of 'liftA3'.
498ffor3 :: Applicative f => f a -> f b -> f c -> (a -> b -> c -> d) -> f d
499ffor3 a b c f = liftA3 f a b c
501instance Reflex t => Applicative (Behavior t) where
503 f <*> x = pull $ sample f `ap` sample x
507instance Reflex t => Apply (Behavior t) where
510instance Reflex t => Bind (Behavior t) where
513instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
515 fromRational = pure . fromRational
518instance Reflex t => Functor (Behavior t) where
519 fmap f = pull . fmap f . sample
521instance (Reflex t, IsString a) => IsString (Behavior t a) where
522 fromString = pure . fromString
524instance Reflex t => Monad (Behavior t) where
525 a >>= f = pull $ sample a >>= sample . f
526 -- 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.
528 fail = error "Monad (Behavior t) does not support fail"
530instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
531 mempty = constant mempty
532 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
533 mconcat = pull . fmap mconcat . mapM sample
535instance (Reflex t, Num a) => Num (Behavior t a) where
540 fromInteger = pure . fromInteger
544instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
545 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
546 sconcat = pull . fmap sconcat . mapM sample
547#if MIN_VERSION_semigroups(0,17,0)
548 stimes n = fmap $ stimes n
550 times1p n = fmap $ times1p n
553-- | Flipped version of 'fmapMaybe'.
554fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b
555fforMaybe = flip fmapMaybe
557-- | Filter 'f a' using the provided predicate.
558-- Relies on 'fforMaybe'.
559ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
560ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
562-- | Filter 'Left's from 'f (Either a b)' into 'a'.
563filterLeft :: FunctorMaybe f => f (Either a b) -> f a
564filterLeft = fmapMaybe (either Just (const Nothing))
566-- | Filter 'Right's from 'f (Either a b)' into 'b'.
567filterRight :: FunctorMaybe f => f (Either a b) -> f b
568filterRight = fmapMaybe (either (const Nothing) Just)
570-- | Left-biased event union (prefers left event on simultaneous
572instance Reflex t => Alt (Event t) where
573 ev1 <!> ev2 = leftmost [ev1, ev2]
575-- | 'Event' intersection (convenient interface to 'coincidence').
576instance Reflex t => Apply (Event t) where
577 evf <.> evx = coincidence (fmap (<$> evx) evf)
579-- | 'Event' intersection (convenient interface to 'coincidence').
580instance Reflex t => Bind (Event t) where
581 evx >>- f = coincidence (f <$> evx)
584instance Reflex t => Functor (Event t) where
586 fmap f = fmapMaybe $ Just . f
588 x <$ e = fmapCheap (const x) e
590instance Reflex t => FunctorMaybe (Event t) where
591 {-# INLINE fmapMaybe #-}
592 fmapMaybe f = push $ return . f
594-- | Never: @'zero' = 'never'@.
595instance Reflex t => Plus (Event t) where
598-- | Replace each occurrence value of the 'Event' with the value of the
599-- 'Behavior' at the time of that occurrence.
600tag :: Reflex t => Behavior t b -> Event t a -> Event t b
601tag b = pushAlways $ \_ -> sample b
603-- | Replace each occurrence value of the 'Event' with the value of the
604-- 'Behavior' at that time; if it is 'Just', fire with the contained value; if
605-- it is 'Nothing', drop the occurrence.
606tagMaybe :: Reflex t => Behavior t (Maybe b) -> Event t a -> Event t b
607tagMaybe b = push $ \_ -> sample b
609-- | Create a new 'Event' that combines occurrences of supplied 'Event' with the
610-- current value of the 'Behavior'.
611attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
612attach = attachWith (,)
614-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
615-- combining it with the current value of the 'Behavior'.
616attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
617attachWith f = attachWithMaybe $ \a b -> Just $ f a b
619-- | Create a new 'Event' by combining each occurrence with the current value of
620-- the 'Behavior'. The occurrence is discarded if the combining function returns
622attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
623attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
625-- | Create a new 'Event' that occurs on all but the first occurrence of the
627tailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a)
628tailE e = snd <$> headTailE e
630-- | Create a tuple of two 'Event's with the first one occurring only the first
631-- time the supplied 'Event' occurs and the second occurring on all but the first
633headTailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a, Event t a)
636 be <- hold never $ fmap (const e) eHead
637 return (eHead, switch be)
639-- | Take the streak of occurrences starting at the current time for which the
640-- event returns 'True'.
642-- Starting at the current time, fire all the occurrences of the 'Event' for
643-- which the given predicate returns 'True'. When first 'False' is returned,
644-- do not fire, and permanently stop firing, even if 'True' values would have
645-- been encountered later.
648 . (Reflex t, MonadFix m, MonadHold t m)
652takeWhileE f = takeWhileJustE $ \v -> guard (f v) $> v
654-- | Take the streak of occurrences starting at the current time for which the
655-- event returns 'Just b'.
657-- Starting at the current time, fire all the occurrences of the 'Event' for
658-- which the given predicate returns 'Just b'. When first 'Nothing' is returned,
659-- do not fire, and permanently stop firing, even if 'Just b' values would have
660-- been encountered later.
663 . (Reflex t, MonadFix m, MonadHold t m)
667takeWhileJustE f e = do
668 rec let (eBad, eTrue) = fanEither $ ffor e' $ \a -> case f a of
669 Nothing -> Left never
671 eFirstBad <- headE eBad
672 e' <- switchHold e eFirstBad
675-- | Drop the streak of occurrences starting at the current time for which the
676-- event returns 'True'.
678-- Starting at the current time, do not fire all the occurrences of the 'Event'
679-- for which the given predicate returns 'True'. When 'False' is first
680-- returned, do fire, and permanently continue firing, even if 'True' values
681-- would have been encountered later.
684 . (Reflex t, MonadFix m, MonadHold t m)
688dropWhileE f e = snd <$> takeDropWhileJustE (\v -> guard (f v) $> v) e
690-- | Both take and drop the streak of occurrences starting at the current time
691-- for which the event returns 'Just b'.
693-- For the left event, starting at the current time, fire all the occurrences
694-- of the 'Event' for which the given function returns 'Just b'. When
695-- 'Nothing' is returned, do not fire, and permanently stop firing, even if
696-- 'Just b' values would have been encountered later.
698-- For the right event, do not fire until the first occurrence where the given
699-- function returns 'Nothing', and fire that one and all subsequent
700-- occurrences. Even if the function would have again returned 'Just b', keep
704 . (Reflex t, MonadFix m, MonadHold t m)
707 -> m (Event t b, Event t a)
708takeDropWhileJustE f e = do
709 rec let (eBad, eGood) = fanEither $ ffor e' $ \a -> case f a of
712 eFirstBad <- headE eBad
713 e' <- switchHold e (never <$ eFirstBad)
714 eRest <- switchHoldPromptOnly never (e <$ eFirstBad)
715 return (eGood, eRest)
717-- | Split the supplied 'Event' into two individual 'Event's occurring at the
718-- same time with the respective values from the tuple.
719splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
720splitE e = (fmap fst e, fmap snd e)
722-- | Print the supplied 'String' and the value of the 'Event' on each
723-- occurrence. This should /only/ be used for debugging.
725-- Note: As with Debug.Trace.trace, the message will only be printed if the
726-- 'Event' is actually used.
727traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
728traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
730-- | Print the output of the supplied function on each occurrence of the
731-- 'Event'. This should /only/ be used for debugging.
733-- Note: As with Debug.Trace.trace, the message will only be printed if the
734-- 'Event' is actually used.
735traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
736traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
738instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
739 (<>) = alignWith (mergeThese (<>))
740 sconcat = fmap sconcat . mergeList . toList
741#if MIN_VERSION_semigroups(0,17,0)
742 stimes n = fmap $ stimes n
744 times1p n = fmap $ times1p n
747instance (Semigroup a, Reflex t) => Monoid (Event t a) where
750 mconcat = fmap sconcat . mergeList
752-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
753-- list occurs. If multiple occur at the same time they are folded from the left
754-- with the given function.
755{-# INLINE mergeWith #-}
756mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
757mergeWith = mergeWith' id
759{-# INLINE mergeWith' #-}
760mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
761mergeWith' f g es = fmap (Prelude.foldl1 g . fmap f)
763 . IntMap.fromDistinctAscList
764 $ zip [0 :: Int ..] es
766-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
767-- list occurs. If multiple occur at the same time the value is the value of the
769{-# INLINE leftmost #-}
770leftmost :: Reflex t => [Event t a] -> Event t a
771leftmost = mergeWith const
773-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
774-- list occurs and has a list of the values of all 'Event's occurring at that
776mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
778mergeList es = mergeWithFoldCheap' id es
780unsafeMapIncremental :: (Reflex t, Patch p, Patch p') => (PatchTarget p -> PatchTarget p') -> (p -> p') -> Incremental t p -> Incremental t p'
781unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
783-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
784-- occurs if at least one of them occurs and has a map of values of all 'Event's
785-- occurring at that time.
786mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
787mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
789-- | Like 'mergeMap' but for 'IntMap'.
790mergeIntMap :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
791mergeIntMap = fmap dmapToIntMap . merge . intMapWithFunctorToDMap
793-- | Create a merge whose parents can change over time
794mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
795mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
797-- | Create a merge whose parents can change over time
798mergeIntMapIncremental :: Reflex t => Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
799mergeIntMapIncremental = fmap dmapToIntMap . mergeIncremental . unsafeMapIncremental intMapWithFunctorToDMap (const2IntPatchDMapWith id)
801-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
802mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
803mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
805-- | Split the event into separate events for 'Left' and 'Right' values.
806fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
808 let justLeft = either Just (const Nothing)
809 justRight = either (const Nothing) Just
810 in (fmapMaybe justLeft e, fmapMaybe justRight e)
812-- | Split the event into separate events for 'This' and 'That' values,
813-- allowing them to fire simultaneously when the input value is 'These'.
814fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
816 let this (This x) = Just x
817 this (These x _) = Just x
819 that (That y) = Just y
820 that (These _ y) = Just y
822 in (fmapMaybe this e, fmapMaybe that e)
824-- | Split the event into an 'EventSelector' that allows efficient selection of
825-- the individual 'Event's.
826fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
827fanMap = fan . fmap mapToDMap
829-- | Switches to the new event whenever it receives one. Only the old event is
830-- considered the moment a new one is switched in; the output event will fire at
831-- that moment only if the old event does.
833-- Because the simultaneous firing case is irrelevant, this function imposes
834-- laxer "timing requirements" on the overall circuit, avoiding many potential
835-- cyclic dependency / metastability failures. It's also more performant. Use
836-- this rather than 'switchHoldPromptly' and 'switchHoldPromptOnly' unless you
837-- are absolutely sure you need to act on the new event in the coincidental
839switchHold :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
840switchHold ea0 eea = switch <$> hold ea0 eea
842-- | Switches to the new event whenever it receives one. Whenever a new event is
843-- provided, if it is firing, its value will be the resulting event's value; if
844-- it is not firing, but the old one is, the old one's value will be used.
846-- 'switchHold', by always forwarding the old event the moment it is switched
847-- out, avoids many potential cyclic dependency problems / metastability
848-- problems. It's also more performant. Use it instead unless you are sure you
850switchHoldPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
851switchHoldPromptly ea0 eea = do
853 let eLag = switch bea
854 eCoincidences = coincidence eea
855 return $ leftmost [eCoincidences, eLag]
857-- | switches to a new event whenever it receives one. At the moment of
858-- switching, the old event will be ignored if it fires, and the new one will be
859-- used if it fires; this is the opposite of 'switch', which will use only the
862-- 'switchHold', by always forwarding the old event the moment it is switched
863-- out, avoids many potential cyclic dependency problems / metastability
864-- problems. It's also more performant. Use it instead unless you are sure you
866switchHoldPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
867switchHoldPromptOnly e0 e' = do
868 eLag <- switch <$> hold e0 e'
869 return $ coincidence $ leftmost [e', eLag <$ eLag]
871-- | When the given outer event fires, condense the inner events into the contained patch. Non-firing inner events will be replaced with deletions.
872coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)
873coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ ffor e $ \(PatchMap m) -> mergeMap $ ffor m $ \case
874 Nothing -> fmapCheap (const Nothing) e
875 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
877-- | See 'coincidencePatchMap'
878coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)
879coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ ffor e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case
880 Nothing -> fmapCheap (const Nothing) e
881 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
883-- | See 'coincidencePatchMap'
884coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)
885coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ ffor e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
886 PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->
887 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
888 PatchMapWithMove.From_Move k -> fforCheap e $ \_ ->
889 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }
890 PatchMapWithMove.From_Insert ev -> leftmost
891 [ fforCheap ev $ \v ->
892 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }
893 , fforCheap e $ \_ ->
894 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
897switchHoldPromptOnlyIncremental
901 , Patch (p (Event t w))
902 , PatchTarget (p (Event t w)) ~ pt (Event t w)
904 , PatchTarget (p w) ~ pt w
907 => (Incremental t (p (Event t w)) -> Event t (pt w))
908 -> (Event t (p (Event t w)) -> Event t (p w))
910 -> Event t (p (Event t w))
911 -> m (Event t (pt w))
912switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch e0 e' = do
913 lag <- mergePatchIncremental <$> holdIncremental e0 e'
914 pure $ ffor (align lag (coincidencePatch e')) $ \case
916 That new -> new `applyAlways` mempty
917 These old new -> new `applyAlways` old
919instance Reflex t => Align (Event t) where
921 align = alignEventWithMaybe Just
923-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
924-- the 'Behavior' is true at the time of occurrence.
925gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
926gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
928-- | Create a new behavior given a starting behavior and switch to the behavior
929-- carried by the event when it fires.
930switcher :: (Reflex t, MonadHold t m)
931 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
932switcher b eb = pull . (sample <=< sample) <$> hold b eb
934instance (Reflex t, IsString a) => IsString (Dynamic t a) where
935 fromString = pure . fromString
937-- | Combine two 'Dynamic's. The result will change whenever either (or both)
938-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
939zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
940zipDyn = zipDynWith (,)
942-- | Combine two 'Dynamic's with a combining function. The result will change
943-- whenever either (or both) input 'Dynamic' changes.
944-- More efficient than 'liftA2'.
945zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
947 let eab = align (updated da) (updated db)
948 ec = flip push eab $ \o -> do
951 b <- sample $ current db
954 a <- sample $ current da
956 These a b -> return (a, b)
957 return $ Just $ f a b
958 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
960instance (Reflex t, Semigroup a) => Semigroup (Dynamic t a) where
961 (<>) = zipDynWith (<>)
962#if MIN_VERSION_semigroups(0,17,0)
963 stimes n = fmap $ stimes n
965 times1p n = fmap $ times1p n
968instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
969 mconcat = distributeListOverDynWith mconcat
970 mempty = constDyn mempty
971 mappend = zipDynWith mappend
973-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
974-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
975-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
976distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
977distributeDMapOverDynPure dm = case DMap.toList dm of
978 [] -> constDyn DMap.empty
979 [k :=> v] -> fmap (DMap.singleton k . Identity) v
981 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
982 edmPre = merge $ DMap.map updated dm
983 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
984 olds <- sample $ current result
985 return $ DMap.unionWithKey (\_ _ new -> new) olds news
988-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
989distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
990distributeListOverDyn = distributeListOverDynWith id
992-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
993distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
994distributeListOverDynWith f = fmap (f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]
996-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
997-- unless the second supplied 'Event' occurs simultaneously.
998difference :: Reflex t => Event t a -> Event t b -> Event t a
999difference = alignEventWithMaybe $ \case
1003alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
1004alignEventWithMaybe f ea eb =
1005 fmapMaybe (f <=< dmapToThese)
1007 $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
1010 :: forall t m k v a.
1017 -> Event t (DSum k v)
1018 -> m (Event t (v a))
1019filterEventKey k kv' = do
1020 let f :: DSum k v -> Maybe (v a)
1021 f (newK :=> newV) = case newK `geq` k of
1022 Just Refl -> Just newV
1024 takeWhileJustE f kv'
1028 :: forall t m k v a.
1035 -> Event t (DSum k v)
1036 -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))
1037factorEvent k0 kv' = do
1038 key :: Behavior t (Some k) <- hold (Some.This k0) $ fmapCheap (\(k :=> _) -> Some.This k) kv'
1039 let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case
1040 Some.This oldKey -> case newKey `geq` oldKey of
1041 Just Refl -> return Nothing
1043 newInner <- filterEventKey newKey kv'
1044 return $ Just $ newKey :=> Pair newVal (Compose newInner)
1045 eInitial <- filterEventKey k0 kv'
1046 return (eInitial, update)
1048--------------------------------------------------------------------------------
1050--------------------------------------------------------------------------------
1052-- | An 'Accumulator' type can be built by accumulating occurrences of an
1054#if __GLASGOW_HASKELL__ < 802
1055{-# WARNING accum "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1056{-# WARNING accumM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1057{-# WARNING accumMaybe "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1058{-# WARNING accumMaybeM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1060class Reflex t => Accumulator t f | f -> t where
1061 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
1062 accum f = accumMaybe $ \v o -> Just $ f v o
1063 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
1064 accumM f = accumMaybeM $ \v o -> Just <$> f v o
1065 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
1066 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
1067 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
1068 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
1069 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
1070 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
1071 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
1072 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1073 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
1074 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1076accumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Dynamic t a)
1077accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o
1078accumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Dynamic t a)
1079accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o
1080accumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Dynamic t a)
1081accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o
1082accumMaybeMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Dynamic t a)
1083accumMaybeMDyn f z e = do
1084 rec let e' = flip push e $ \o -> do
1085 v <- sample $ current d'
1089mapAccumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
1090mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o
1091mapAccumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
1092mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o
1093mapAccumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
1094mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o
1095mapAccumMaybeMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
1096mapAccumMaybeMDyn f z e = do
1097 rec let e' = flip push e $ \o -> do
1098 v <- sample $ current d'
1100 return $ case result of
1101 (Nothing, Nothing) -> Nothing
1103 d' <- holdDyn z $ fmapMaybe fst e'
1104 return (d', fmapMaybe snd e')
1106{-# INLINE accumB #-}
1107accumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Behavior t a)
1108accumB f = accumMaybeB $ \v o -> Just $ f v o
1109{-# INLINE accumMB #-}
1110accumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Behavior t a)
1111accumMB f = accumMaybeMB $ \v o -> Just <$> f v o
1112{-# INLINE accumMaybeB #-}
1113accumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Behavior t a)
1114accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o
1115{-# INLINE accumMaybeMB #-}
1116accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)
1117accumMaybeMB f z e = do
1118 rec let e' = flip push e $ \o -> do
1123{-# INLINE mapAccumB #-}
1124mapAccumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)
1125mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o
1126{-# INLINE mapAccumMB #-}
1127mapAccumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)
1128mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o
1129{-# INLINE mapAccumMaybeB #-}
1130mapAccumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)
1131mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o
1133{-# INLINE mapAccumMaybeMB #-}
1134mapAccumMaybeMB :: (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)
1135mapAccumMaybeMB f z e = do
1136 rec let e' = flip push e $ \o -> do
1139 return $ case result of
1140 (Nothing, Nothing) -> Nothing
1142 d' <- hold z $ fmapMaybe fst e'
1143 return (d', fmapMaybe snd e')
1145-- | Accumulate occurrences of an 'Event', producing an output occurrence each
1146-- time. Discard the underlying 'Accumulator'.
1147{-# INLINE mapAccum_ #-}
1148mapAccum_ :: 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)
1150 (_, result) <- mapAccumB f z e
1153-- | Accumulate occurrences of an 'Event', possibly producing an output
1154-- occurrence each time. Discard the underlying 'Accumulator'.
1155{-# INLINE mapAccumMaybe_ #-}
1156mapAccumMaybe_ :: 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)
1157mapAccumMaybe_ f z e = do
1158 (_, result) <- mapAccumMaybeB f z e
1161-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
1162-- an output occurrence each time. Discard the underlying 'Accumulator'.
1163{-# INLINE mapAccumM_ #-}
1164mapAccumM_ :: 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)
1165mapAccumM_ f z e = do
1166 (_, result) <- mapAccumMB f z e
1169-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
1170-- producing an output occurrence each time. Discard the underlying
1172{-# INLINE mapAccumMaybeM_ #-}
1173mapAccumMaybeM_ :: 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)
1174mapAccumMaybeM_ f z e = do
1175 (_, result) <- mapAccumMaybeMB f z e
1178instance Reflex t => Accumulator t (Dynamic t) where
1179 accumMaybeM = accumMaybeMDyn
1180 mapAccumMaybeM = mapAccumMaybeMDyn
1182instance Reflex t => Accumulator t (Behavior t) where
1183 accumMaybeM = accumMaybeMB
1184 mapAccumMaybeM = mapAccumMaybeMB
1186instance Reflex t => Accumulator t (Event t) where
1187 accumMaybeM f z e = updated <$> accumMaybeM f z e
1188 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
1190-- | Create a new 'Event' by combining each occurrence with the next value of the
1191-- list using the supplied function. If the list runs out of items, all
1192-- subsequent 'Event' occurrences will be ignored.
1193zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
1194zipListWithEvent f l e = do
1195 let f' a b = case a of
1196 h:t -> (Just t, Just $ f h b)
1197 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
1198 mapAccumMaybe_ f' l e
1200-- | Assign a number to each occurrence of the given 'Event', starting from 0
1201{-# INLINE numberOccurrences #-}
1202numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
1203numberOccurrences = numberOccurrencesFrom 0
1205-- | Assign a number to each occurrence of the given 'Event'
1206{-# INLINE numberOccurrencesFrom #-}
1207numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
1208numberOccurrencesFrom = mapAccum_ (\n a -> let !next = n + 1 in (next, (n, a)))
1210-- | Assign a number to each occurrence of the given 'Event'; discard the occurrences' values
1211{-# INLINE numberOccurrencesFrom_ #-}
1212numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
1213numberOccurrencesFrom_ = mapAccum_ (\n _ -> let !next = n + 1 in (next, n))
1215-- | This is used to sample the value of a 'Behavior' using an 'Event'.
1217-- The '<@>' operator is intended to be used in conjunction with
1218-- the 'Applicative' instance for 'Behavior'.
1220-- This is useful when we want to combine the values of one 'Event' and
1221-- the value of several 'Behavior's at the time the 'Event' is firing.
1225-- > f :: a -> b -> c -> d
1226-- > b1 :: Behavior t a
1227-- > b2 :: Behavior t b
1232-- > f <$> b1 <*> b2 <@> e :: Event t d
1234-- in order to apply the function 'f' to the relevant values.
1236-- The alternative would be something like:
1238-- > attachWith (\(x1, x2) y -> f x1 x2 y) ((,) <$> b1 <*> b2) e :: Event t d
1240-- or a variation involing a custom data type to hold the combination of
1241-- 'Behavior's even when that combination might only ever be used by 'f'.
1243-- A more suggestive example might be:
1245-- > handleMouse <$> bPlayerState <*> bMousePosition <@> eMouseClick :: Event t (GameState -> GameState)
1247(<@>) :: Reflex t => Behavior t (a -> b) -> Event t a -> Event t b
1248(<@>) b = push $ \x -> do
1250 return . Just . f $ x
1253-- | An version of '<@>' that does not use the value of the 'Event'.
1255-- Alternatively, it is 'tag' in operator form.
1257-- This is useful when we want to combine the values of several
1258-- 'Behavior's at particular points in time using an 'Applicative'
1263-- > g :: a -> b -> d
1264-- > b1 :: Behavior t a
1265-- > b2 :: Behavior t b
1268-- where 'e' is firing at the points in time of interest.
1270-- Then we can use '<@':
1272-- > g <$> b1 <*> b2 <@ e :: Event t d
1274-- to combine the values of 'b1' and 'b2' at each of those points of time,
1275-- with the function 'g' being used to combine the values.
1277-- This is the same as '<@>' except that the 'Event' is being used only
1278-- to act as a trigger.
1279(<@) :: (Reflex t) => Behavior t b -> Event t a -> Event t b
1287{-# INLINE pushAlwaysCheap #-}
1288pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
1289pushAlwaysCheap f = pushCheap (fmap Just . f)
1291{-# INLINE fmapMaybeCheap #-}
1292fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1293fmapMaybeCheap f = pushCheap $ return . f
1295{-# INLINE fforMaybeCheap #-}
1296fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
1297fforMaybeCheap = flip fmapMaybeCheap
1299{-# INLINE fforCheap #-}
1300fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
1301fforCheap = flip fmapCheap
1303{-# INLINE fmapCheap #-}
1304fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
1305fmapCheap f = pushCheap $ return . Just . f
1307{-# INLINE tagCheap #-}
1308tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
1309tagCheap b = pushAlwaysCheap $ \_ -> sample b
1311{-# INLINE mergeWithCheap #-}
1312mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
1313mergeWithCheap = mergeWithCheap' id
1315{-# INLINE mergeWithCheap' #-}
1316mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
1317mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
1319{-# INLINE mergeWithFoldCheap' #-}
1320mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
1321mergeWithFoldCheap' f es =
1322 fmapCheap (f . (\(h : t) -> h :| t) . IntMap.elems)
1324 . IntMap.fromDistinctAscList
1325 $ zip [0 :: Int ..] es
1327--------------------------------------------------------------------------------
1328-- Deprecated functions
1329--------------------------------------------------------------------------------
1331-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
1332-- occurs. If both occur at the same time they are combined using 'mappend'.
1333{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}
1334appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
1335appendEvents = alignWith $ mergeThese mappend
1337-- | Alias for 'headE'
1338{-# DEPRECATED onceE "Use 'headE' instead" #-}
1339onceE :: MonadHold t m => Event t a -> m (Event t a)
1342-- | Run both sides of a 'These' monadically, combining the results.
1343{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
1344#ifdef USE_TEMPLATE_HASKELL
1345{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
1347sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
1348sequenceThese t = case t of
1349 This ma -> fmap This ma
1350 These ma mb -> liftM2 These ma mb
1351 That mb -> fmap That mb
1353{-# 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'. " #-}
1354switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1355switchPromptly = switchHoldPromptly
1356{-# 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'. " #-}
1357switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1358switchPromptOnly = switchHoldPromptOnly
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list