1{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE ConstraintKinds #-}
4{-# LANGUAGE DefaultSignatures #-}
5{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE FunctionalDependencies #-}
9{-# LANGUAGE LambdaCase #-}
10{-# LANGUAGE MultiParamTypeClasses #-}
11{-# LANGUAGE NoMonomorphismRestriction #-}
12{-# LANGUAGE PolyKinds #-}
13{-# LANGUAGE RankNTypes #-}
14{-# LANGUAGE RecursiveDo #-}
15{-# LANGUAGE RoleAnnotations #-}
16{-# LANGUAGE ScopedTypeVariables #-}
17{-# LANGUAGE TypeFamilies #-}
18{-# LANGUAGE TypeOperators #-}
19{-# LANGUAGE UndecidableInstances #-}
20#ifdef USE_REFLEX_OPTIMIZER
21{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
24-- | This module contains the Reflex interface, as well as a variety of
25-- convenience functions for working with 'Event's, 'Behavior's, and other
37 -- ** 'fan'-related types
39 , EventSelectorInt (..)
40 -- ** 'Incremental'-related types
41 -- * Convenience functions
44 -- ** Combining 'Event's
48 , mergeMapIncrementalWithMove
49 , mergeIntMapIncremental
54 -- ** Breaking up 'Event's
65 -- ** Collapsing 'Event . Event'
68 , switchHoldPromptOnly
69 -- ** Using 'Event's to sample 'Behavior's
75 -- ** Blocking an 'Event' based on a 'Behavior'
77 -- ** Combining 'Dynamic's
78 , distributeDMapOverDynPure
79 , distributeListOverDyn
80 , distributeListOverDynWith
83 -- ** Accumulating state
107 , accumMaybeIncremental
108 , accumMaybeMIncremental
109 , mapAccumIncremental
110 , mapAccumMIncremental
111 , mapAccumMaybeIncremental
112 , mapAccumMaybeMIncremental
115 , numberOccurrencesFrom
116 , numberOccurrencesFrom_
126 -- * Debugging functions
129 -- * Unsafe functions
131 , unsafeMapIncremental
138 -- * Miscellaneous convenience functions
142 -- * Deprecated functions
156 -- * Slow, but general, implementations
160import Control.Applicative
161import Control.Monad.Identity
162import Control.Monad.Reader
163import Control.Monad.State.Strict
164import Control.Monad.Trans.Cont (ContT)
165import Control.Monad.Trans.Except (ExceptT)
166import Control.Monad.Trans.RWS (RWST)
167import Control.Monad.Trans.Writer (WriterT)
172import Data.Dependent.Map (DMap, DSum (..))
173import qualified Data.Dependent.Map as DMap
174import Data.Functor.Compose
175import Data.Functor.Product
176import Data.GADT.Compare (GEq (..), GCompare (..), (:~:) (..))
177import Data.FastMutableIntMap (PatchIntMap)
179import Data.Functor.Bind
180import Data.Functor.Misc
181import Data.Functor.Plus
182import Data.IntMap.Strict (IntMap)
183import qualified Data.IntMap.Strict as IntMap
184import Data.List.NonEmpty (NonEmpty (..))
186import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
187import Data.Some (Some)
188import qualified Data.Some as Some
191import Data.Type.Coercion
192import Reflex.FunctorMaybe
195import Debug.Trace (trace)
197-- | The 'Reflex' class contains all the primitive functionality needed for
198-- Functional Reactive Programming (FRP). The @t@ type parameter indicates
199-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
200-- and the type of the timeline determines the FRP engine to be used. For most
201-- purposes, the 'Reflex.Spider' implementation is recommended.
202class ( MonadHold t (PushM t)
203 , MonadSample t (PullM t)
205 , Functor (Dynamic t)
206 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
209 -- | A container for a value that can change over time. 'Behavior's can be
210 -- sampled at will, but it is not possible to be notified when they change
211 data Behavior t :: * -> *
212 -- | A stream of occurrences. During any given frame, an 'Event' is either
213 -- occurring or not occurring; if it is occurring, it will contain a value of
214 -- the given type (its "occurrence type")
215 data Event t :: * -> *
216 -- | A container for a value that can change over time and allows
217 -- notifications on changes. Basically a combination of a 'Behavior' and an
218 -- 'Event', with a rule that the 'Behavior' will change if and only if the
220 data Dynamic t :: * -> *
221 -- | An 'Incremental' is a more general form of a 'Dynamic'.
222 -- Instead of always fully replacing the value, only parts of it can be patched.
223 -- This is only needed for performance critical code via `mergeIncremental` to make small
224 -- changes to large values.
225 data Incremental t :: * -> *
226 -- | A monad for doing complex push-based calculations efficiently
227 type PushM t :: * -> *
228 -- | A monad for doing complex pull-based calculations efficiently
229 type PullM t :: * -> *
230 -- | An 'Event' with no occurrences
232 -- | Create a 'Behavior' that always has the given value
233 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
234 -- | Create an 'Event' from another 'Event'; the provided function can sample
235 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
236 -- (Just) or non-occurring (Nothing) result
237 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
238 -- | 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.
239 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
240 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
241 -- recomputed whenever any of the read 'Behavior's changes
242 pull :: PullM t a -> Behavior t a
243 -- | Merge a collection of events; the resulting 'Event' will only occur if at
244 -- least one input event is occurring, and will contain all of the input keys
245 -- that are occurring simultaneously
246 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
247 -- | Efficiently fan-out an event to many destinations. This function should
248 -- be partially applied, and then the result applied repeatedly to create
250 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
251 -- | Create an 'Event' that will occur whenever the currently-selected input
253 switch :: Behavior t (Event t a) -> Event t a
254 -- | Create an 'Event' that will occur whenever the input event is occurring
255 -- and its occurrence value, another 'Event', is also occurring
256 coincidence :: Event t (Event t a) -> Event t a
257 -- | Extract the 'Behavior' of a 'Dynamic'.
258 current :: Dynamic t a -> Behavior t a
259 -- | Extract the 'Event' of the 'Dynamic'.
260 updated :: Dynamic t a -> Event t a
261 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
262 -- recent firing of the given 'Event', if any.
263 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
264 -- | Create a new 'Incremental'. The given 'PullM''s value must always change
265 -- in the same way that the accumulated application of patches would change
267 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
268 -- | Create a merge whose parents can change over time
269 mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
270 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
271 mergeIncrementalWithMove :: GCompare k => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
272 -- | Extract the 'Behavior' component of an 'Incremental'
273 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
274 -- | Extract the 'Event' component of an 'Incremental'
275 updatedIncremental :: Patch p => Incremental t p -> Event t p
276 -- | Convert an 'Incremental' to a 'Dynamic'
277 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
278 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
280 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
281 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
283 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
284 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
286 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
287 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
288 fanInt :: Event t (IntMap a) -> EventSelectorInt t a
290--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on
291mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
292mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never
294-- | Coerce a 'Behavior' between representationally-equivalent value types
295coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
296coerceBehavior = coerceWith $ behaviorCoercion Coercion
298-- | Coerce an 'Event' between representationally-equivalent occurrence types
299coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
300coerceEvent = coerceWith $ eventCoercion Coercion
302-- | Coerce a 'Dynamic' between representationally-equivalent value types
303coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
304coerceDynamic = coerceWith $ dynamicCoercion Coercion
306-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
307-- _must_ change when and only when the 'Event' fires, such that the
308-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
309-- if this is not the case, the resulting 'Dynamic' will behave
310-- nondeterministically.
311unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
312unsafeDynamic = unsafeBuildDynamic . sample
314-- | Construct a 'Dynamic' value that never changes
315constDyn :: Reflex t => a -> Dynamic t a
318instance (Reflex t, Default a) => Default (Dynamic t a) where
321-- | 'MonadSample' designates monads that can read the current value of a
322-- 'Behavior'. This includes both 'PullM' and 'PushM'.
323class (Applicative m, Monad m) => MonadSample t m | m -> t where
324 -- | Get the current value in the 'Behavior'
325 sample :: Behavior t a -> m a
327-- | 'MonadHold' designates monads that can create new 'Behavior's based on
328-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
329-- is required to create any stateful computations with Reflex.
330class MonadSample t m => MonadHold t m where
331 -- | Create a new 'Behavior' whose value will initially be equal to the given
332 -- value and will be updated whenever the given 'Event' occurs. The update
333 -- takes effect immediately after the 'Event' occurs; if the occurrence that
334 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
335 -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new
337 hold :: a -> Event t a -> m (Behavior t a)
338 default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)
339 hold v0 = lift . hold v0
340 -- | Create a 'Dynamic' value using the given initial value that changes every
341 -- time the 'Event' occurs.
342 holdDyn :: a -> Event t a -> m (Dynamic t a)
343 default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)
344 holdDyn v0 = lift . holdDyn v0
345 -- | Create an 'Incremental' value using the given initial value that changes
346 -- every time the 'Event' occurs.
347 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
348 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
349 holdIncremental v0 = lift . holdIncremental v0
350 buildDynamic :: PushM t a -> Event t a -> m (Dynamic t a)
352 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
353 buildDynamic getV0 = lift . buildDynamic getV0
355 -- | Create a new 'Event' that only occurs only once, on the first occurrence of
356 -- the supplied 'Event'.
357 headE :: Event t a -> m (Event t a)
359accumIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> p) -> PatchTarget p -> Event t b -> m (Incremental t p)
360accumIncremental f = accumMaybeIncremental $ \v o -> Just $ f v o
361accumMIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> PushM t p) -> PatchTarget p -> Event t b -> m (Incremental t p)
362accumMIncremental f = accumMaybeMIncremental $ \v o -> Just <$> f v o
363accumMaybeIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> Maybe p) -> PatchTarget p -> Event t b -> m (Incremental t p)
364accumMaybeIncremental f = accumMaybeMIncremental $ \v o -> return $ f v o
365accumMaybeMIncremental :: (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)
366accumMaybeMIncremental f z e = do
367 rec let e' = flip push e $ \o -> do
368 v <- sample $ currentIncremental d'
370 d' <- holdIncremental z e'
372mapAccumIncremental :: (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)
373mapAccumIncremental f = mapAccumMaybeIncremental $ \v o -> bimap Just Just $ f v o
374mapAccumMIncremental :: (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)
375mapAccumMIncremental f = mapAccumMaybeMIncremental $ \v o -> bimap Just Just <$> f v o
376mapAccumMaybeIncremental :: (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)
377mapAccumMaybeIncremental f = mapAccumMaybeMIncremental $ \v o -> return $ f v o
378mapAccumMaybeMIncremental :: (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)
379mapAccumMaybeMIncremental f z e = do
380 rec let e' = flip push e $ \o -> do
381 v <- sample $ currentIncremental d'
383 return $ case result of
384 (Nothing, Nothing) -> Nothing
386 d' <- holdIncremental z $ fmapMaybe fst e'
387 return (d', fmapMaybe snd e')
389slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
391 rec be <- hold e $ fmapCheap (const never) e'
395-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
396-- key. This is much more efficient than filtering for each key with
398newtype EventSelector t k = EventSelector
399 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
400 -- determined by the type of the key, so this can be used to fan-out
401 -- 'Event's whose sub-'Event's have different types.
403 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
404 -- (but equivalent to) using 'fmapMaybe' to select only the relevant
405 -- occurrences of an 'Event'.
406 select :: forall a. k a -> Event t a
409newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }
411--------------------------------------------------------------------------------
413--------------------------------------------------------------------------------
415instance MonadSample t m => MonadSample t (ReaderT r m) where
416 sample = lift . sample
418instance MonadHold t m => MonadHold t (ReaderT r m) where
419 hold a0 = lift . hold a0
420 holdDyn a0 = lift . holdDyn a0
421 holdIncremental a0 = lift . holdIncremental a0
422 buildDynamic a0 = lift . buildDynamic a0
425instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
426 sample = lift . sample
428instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
429 hold a0 = lift . hold a0
430 holdDyn a0 = lift . holdDyn a0
431 holdIncremental a0 = lift . holdIncremental a0
432 buildDynamic a0 = lift . buildDynamic a0
435instance MonadSample t m => MonadSample t (StateT s m) where
436 sample = lift . sample
438instance MonadHold t m => MonadHold t (StateT s m) where
439 hold a0 = lift . hold a0
440 holdDyn a0 = lift . holdDyn a0
441 holdIncremental a0 = lift . holdIncremental a0
442 buildDynamic a0 = lift . buildDynamic a0
445instance MonadSample t m => MonadSample t (ExceptT e m) where
446 sample = lift . sample
448instance MonadHold t m => MonadHold t (ExceptT e m) where
449 hold a0 = lift . hold a0
450 holdDyn a0 = lift . holdDyn a0
451 holdIncremental a0 = lift . holdIncremental a0
452 buildDynamic a0 = lift . buildDynamic a0
455instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
456 sample = lift . sample
458instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
459 hold a0 = lift . hold a0
460 holdDyn a0 = lift . holdDyn a0
461 holdIncremental a0 = lift . holdIncremental a0
462 buildDynamic a0 = lift . buildDynamic a0
465instance MonadSample t m => MonadSample t (ContT r m) where
466 sample = lift . sample
468instance MonadHold t m => MonadHold t (ContT r m) where
469 hold a0 = lift . hold a0
470 holdDyn a0 = lift . holdDyn a0
471 holdIncremental a0 = lift . holdIncremental a0
472 buildDynamic a0 = lift . buildDynamic a0
475--------------------------------------------------------------------------------
476-- Convenience functions
477--------------------------------------------------------------------------------
479-- | Create an 'Event' from another 'Event'. The provided function can sample
480-- 'Behavior's and hold 'Event's.
481pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
482pushAlways f = push (fmap Just . f)
484-- | Flipped version of 'fmap'.
485ffor :: Functor f => f a -> (a -> b) -> f b
488-- | Rotated version of 'liftA2'.
489ffor2 :: Applicative f => f a -> f b -> (a -> b -> c) -> f c
490ffor2 a b f = liftA2 f a b
492-- | Rotated version of 'liftA3'.
493ffor3 :: Applicative f => f a -> f b -> f c -> (a -> b -> c -> d) -> f d
494ffor3 a b c f = liftA3 f a b c
496instance Reflex t => Applicative (Behavior t) where
498 f <*> x = pull $ sample f `ap` sample x
502instance Reflex t => Apply (Behavior t) where
505instance Reflex t => Bind (Behavior t) where
508instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
510 fromRational = pure . fromRational
513instance Reflex t => Functor (Behavior t) where
514 fmap f = pull . fmap f . sample
516instance (Reflex t, IsString a) => IsString (Behavior t a) where
517 fromString = pure . fromString
519instance Reflex t => Monad (Behavior t) where
520 a >>= f = pull $ sample a >>= sample . f
521 -- 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.
523 fail = error "Monad (Behavior t) does not support fail"
525instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
526 mempty = constant mempty
527 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
528 mconcat = pull . fmap mconcat . mapM sample
530instance (Reflex t, Num a) => Num (Behavior t a) where
535 fromInteger = pure . fromInteger
539instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
540 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
541 sconcat = pull . fmap sconcat . mapM sample
542#if MIN_VERSION_semigroups(0,17,0)
543 stimes n = fmap $ stimes n
545 times1p n = fmap $ times1p n
548-- | Flipped version of 'fmapMaybe'.
549fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b
550fforMaybe = flip fmapMaybe
552-- | Filter 'f a' using the provided predicate.
553-- Relies on 'fforMaybe'.
554ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
555ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
557-- | Filter 'Left's from 'f (Either a b)' into 'a'.
558filterLeft :: FunctorMaybe f => f (Either a b) -> f a
559filterLeft = fmapMaybe (either Just (const Nothing))
561-- | Filter 'Right's from 'f (Either a b)' into 'b'.
562filterRight :: FunctorMaybe f => f (Either a b) -> f b
563filterRight = fmapMaybe (either (const Nothing) Just)
565-- | Left-biased event union (prefers left event on simultaneous
567instance Reflex t => Alt (Event t) where
568 ev1 <!> ev2 = leftmost [ev1, ev2]
570-- | 'Event' intersection (convenient interface to 'coincidence').
571instance Reflex t => Apply (Event t) where
572 evf <.> evx = coincidence (fmap (<$> evx) evf)
574-- | 'Event' intersection (convenient interface to 'coincidence').
575instance Reflex t => Bind (Event t) where
576 evx >>- f = coincidence (f <$> evx)
579instance Reflex t => Functor (Event t) where
581 fmap f = fmapMaybe $ Just . f
583 x <$ e = fmapCheap (const x) e
585instance Reflex t => FunctorMaybe (Event t) where
586 {-# INLINE fmapMaybe #-}
587 fmapMaybe f = push $ return . f
589-- | Never: @'zero' = 'never'@.
590instance Reflex t => Plus (Event t) where
593-- | Replace each occurrence value of the 'Event' with the value of the
594-- 'Behavior' at the time of that occurrence.
595tag :: Reflex t => Behavior t b -> Event t a -> Event t b
596tag b = pushAlways $ \_ -> sample b
598-- | Replace each occurrence value of the 'Event' with the value of the
599-- 'Behavior' at that time; if it is 'Just', fire with the contained value; if
600-- it is 'Nothing', drop the occurrence.
601tagMaybe :: Reflex t => Behavior t (Maybe b) -> Event t a -> Event t b
602tagMaybe b = push $ \_ -> sample b
604-- | Create a new 'Event' that combines occurrences of supplied 'Event' with the
605-- current value of the 'Behavior'.
606attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
607attach = attachWith (,)
609-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
610-- combining it with the current value of the 'Behavior'.
611attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
612attachWith f = attachWithMaybe $ \a b -> Just $ f a b
614-- | Create a new 'Event' by combining each occurrence with the current value of
615-- the 'Behavior'. The occurrence is discarded if the combining function returns
617attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
618attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
620-- | Create a new 'Event' that occurs on all but the first occurrence of the
622tailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a)
623tailE e = snd <$> headTailE e
625-- | Create a tuple of two 'Event's with the first one occurring only the first
626-- time the supplied 'Event' occurs and the second occurring on all but the first
628headTailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a, Event t a)
631 be <- hold never $ fmap (const e) eHead
632 return (eHead, switch be)
634-- | Take the streak of occurrences starting at the current time for which the
635-- event returns 'True'.
637-- Starting at the current time, fire all the occurrences of the 'Event' for
638-- which the given predicate returns 'True'. When 'False' first is returned,
639-- do not fire, and permanently stop firing, even if 'True' values would have
640-- been encountered later.
643 . (Reflex t, MonadFix m, MonadHold t m)
647takeWhileE f = takeWhileJustE $ \v -> guard (f v) $> v
649-- | Take the streak of occurrences starting at the current time for which the
650-- event returns 'Just b'.
652-- Starting at the current time, fire all the occurrences of the 'Event' for
653-- which the given predicate returns 'Just b'. When 'Nothing' first is returned,
654-- do not fire, and permanently stop firing, even if 'Just b' values would have
655-- been encountered later.
658 . (Reflex t, MonadFix m, MonadHold t m)
662takeWhileJustE f e = do
663 rec let (eBad, eTrue) = fanEither $ ffor e' $ \a -> case f a of
664 Nothing -> Left never
666 eFirstBad <- headE eBad
667 e' <- switchHold e eFirstBad
670-- | Drop the streak of occurrences starting at the current time for which the
671-- event returns 'True'.
673-- Starting at the current time, do not fire all the occurrences of the 'Event'
674-- for which the given predicate returns 'True'. When 'False' is first
675-- returned, do fire, and permanently continue firing, even if 'True' values
676-- would have been encountered later.
679 . (Reflex t, MonadFix m, MonadHold t m)
683dropWhileE f e = snd <$> takeDropWhileJustE (\v -> guard (f v) $> v) e
685-- | Both take and drop the streak of occurrences starting at the current time
686-- for which the event returns 'Just b'.
688-- For the left event, starting at the current time, fire all the occurrences
689-- of the 'Event' for which the given function returns 'Just b'. When
690-- 'Nothing' is returned, do not fire, and permanently stop firing, even if
691-- 'Just b' values would have been encountered later.
693-- For the right event, do not fire until the first occurrence where the given
694-- function returns 'Nothing', and fire that one and all subsequent
695-- occurrences. Even if the function would have again returned 'Just b', keep
699 . (Reflex t, MonadFix m, MonadHold t m)
702 -> m (Event t b, Event t a)
703takeDropWhileJustE f e = do
704 rec let (eBad, eGood) = fanEither $ ffor e' $ \a -> case f a of
707 eFirstBad <- headE eBad
708 e' <- switchHold e (never <$ eFirstBad)
709 eRest <- switchHoldPromptOnly never (e <$ eFirstBad)
710 return (eGood, eRest)
712-- | Split the supplied 'Event' into two individual 'Event's occurring at the
713-- same time with the respective values from the tuple.
714splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
715splitE e = (fmap fst e, fmap snd e)
717-- | Print the supplied 'String' and the value of the 'Event' on each
718-- occurrence. This should /only/ be used for debugging.
720-- Note: As with Debug.Trace.trace, the message will only be printed if the
721-- 'Event' is actually used.
722traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
723traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
725-- | Print the output of the supplied function on each occurrence of the
726-- 'Event'. This should /only/ be used for debugging.
728-- Note: As with Debug.Trace.trace, the message will only be printed if the
729-- 'Event' is actually used.
730traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
731traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
733instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
734 (<>) = alignWith (mergeThese (<>))
735 sconcat = fmap sconcat . mergeList . toList
736#if MIN_VERSION_semigroups(0,17,0)
737 stimes n = fmap $ stimes n
739 times1p n = fmap $ times1p n
742instance (Semigroup a, Reflex t) => Monoid (Event t a) where
745 mconcat = fmap sconcat . mergeList
747-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
748-- list occurs. If multiple occur at the same time they are folded from the left
749-- with the given function.
750{-# INLINE mergeWith #-}
751mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
752mergeWith = mergeWith' id
754{-# INLINE mergeWith' #-}
755mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
756mergeWith' f g es = fmap (Prelude.foldl1 g . fmap f)
758 . IntMap.fromDistinctAscList
759 $ zip [0 :: Int ..] es
761-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
762-- list occurs. If multiple occur at the same time the value is the value of the
764{-# INLINE leftmost #-}
765leftmost :: Reflex t => [Event t a] -> Event t a
766leftmost = mergeWith const
768-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
769-- list occurs and has a list of the values of all 'Event's occurring at that
771mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
773mergeList es = mergeWithFoldCheap' id es
775unsafeMapIncremental :: (Reflex t, Patch p, Patch p') => (PatchTarget p -> PatchTarget p') -> (p -> p') -> Incremental t p -> Incremental t p'
776unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
778-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
779-- occurs if at least one of them occurs and has a map of values of all 'Event's
780-- occurring at that time.
781mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
782mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
784-- | Create a merge whose parents can change over time
785mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
786mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
788-- | Create a merge whose parents can change over time
789mergeIntMapIncremental :: Reflex t => Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
790mergeIntMapIncremental = fmap dmapToIntMap . mergeIncremental . unsafeMapIncremental intMapWithFunctorToDMap (const2IntPatchDMapWith id)
792-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
793mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
794mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
796-- | Split the event into separate events for 'Left' and 'Right' values.
797fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
799 let justLeft = either Just (const Nothing)
800 justRight = either (const Nothing) Just
801 in (fmapMaybe justLeft e, fmapMaybe justRight e)
803-- | Split the event into separate events for 'This' and 'That' values,
804-- allowing them to fire simultaneously when the input value is 'These'.
805fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
807 let this (This x) = Just x
808 this (These x _) = Just x
810 that (That y) = Just y
811 that (These _ y) = Just y
813 in (fmapMaybe this e, fmapMaybe that e)
815-- | Split the event into an 'EventSelector' that allows efficient selection of
816-- the individual 'Event's.
817fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
818fanMap = fan . fmap mapToDMap
820-- | Switches to the new event whenever it receives one. Only the old event is
821-- considered the moment a new one is switched in; the output event will fire at
822-- that moment if only if the old event does.
824-- Because the simultaneous firing case is irrelevant, this function imposes
825-- laxer "timing requirements" on the overall circuit, avoiding many potential
826-- cyclic dependency / metastability failures. It's also more performant. Use
827-- this rather than 'switchHoldPromptly' and 'switchHoldPromptOnly' unless you
828-- are absolutely sure you need to act on the new event in the coincidental
830switchHold :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
831switchHold ea0 eea = switch <$> hold ea0 eea
833-- | Switches to the new event whenever it receives one. Whenever a new event is
834-- provided, if it is firing, its value will be the resulting event's value; if
835-- it is not firing, but the old one is, the old one's value will be used.
837-- 'switchHold', by always forwarding the old event the moment it is switched
838-- out, avoids many potential cyclic dependency problems / metastability
839-- problems. It's also more performant. Use it instead unless you are sure you
841switchHoldPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
842switchHoldPromptly ea0 eea = do
844 let eLag = switch bea
845 eCoincidences = coincidence eea
846 return $ leftmost [eCoincidences, eLag]
848-- | switches to a new event whenever it receives one. At the moment of
849-- switching, the old event will be ignored if it fires, and the new one will be
850-- used if it fires; this is the opposite of 'switch', which will use only the
853-- 'switchHold', by always forwarding the old event the moment it is switched
854-- out, avoids many potential cyclic dependency problems / metastability
855-- problems. It's also more performant. Use it instead unless you are sure you
857switchHoldPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
858switchHoldPromptOnly e0 e' = do
859 eLag <- switch <$> hold e0 e'
860 return $ coincidence $ leftmost [e', eLag <$ eLag]
862instance Reflex t => Align (Event t) where
864 align = alignEventWithMaybe Just
866-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
867-- the 'Behavior' is true at the time of occurrence.
868gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
869gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
871-- | Create a new behavior given a starting behavior and switch to a the behvior
872-- carried by the event when it fires.
873switcher :: (Reflex t, MonadHold t m)
874 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
875switcher b eb = pull . (sample <=< sample) <$> hold b eb
877instance (Reflex t, IsString a) => IsString (Dynamic t a) where
878 fromString = pure . fromString
880-- | Combine two 'Dynamic's. The result will change whenever either (or both)
881-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
882zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
883zipDyn = zipDynWith (,)
885-- | Combine two 'Dynamic's with a combining function. The result will change
886-- whenever either (or both) input 'Dynamic' changes.
887-- More efficient than liftA2.
888zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
890 let eab = align (updated da) (updated db)
891 ec = flip push eab $ \o -> do
894 b <- sample $ current db
897 a <- sample $ current da
899 These a b -> return (a, b)
900 return $ Just $ f a b
901 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
903instance (Reflex t, Semigroup a) => Semigroup (Dynamic t a) where
904 (<>) = zipDynWith (<>)
905#if MIN_VERSION_semigroups(0,17,0)
906 stimes n = fmap $ stimes n
908 times1p n = fmap $ times1p n
911instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
912 mconcat = distributeListOverDynWith mconcat
913 mempty = constDyn mempty
914 mappend = zipDynWith mappend
916-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
917-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
918-- through the use of multiple uses of 'zipWithDyn' or 'Applicative' operators.
919distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
920distributeDMapOverDynPure dm = case DMap.toList dm of
921 [] -> constDyn DMap.empty
922 [k :=> v] -> fmap (DMap.singleton k . Identity) v
924 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
925 edmPre = merge $ DMap.map updated dm
926 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
927 olds <- sample $ current result
928 return $ DMap.unionWithKey (\_ _ new -> new) olds news
931-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
932distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
933distributeListOverDyn = distributeListOverDynWith id
935-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
936distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
937distributeListOverDynWith f = fmap (f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]
939-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
940-- unless the second supplied 'Event' occurs simultaneously.
941difference :: Reflex t => Event t a -> Event t b -> Event t a
942difference = alignEventWithMaybe $ \case
946alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
947alignEventWithMaybe f ea eb =
948 fmapMaybe (f <=< dmapToThese)
950 $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
960 -> Event t (DSum k v)
962filterEventKey k kv' = do
963 let f :: DSum k v -> Maybe (v a)
964 f (newK :=> newV) = case newK `geq` k of
965 Just Refl -> Just newV
978 -> Event t (DSum k v)
979 -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))
980factorEvent k0 kv' = do
981 key :: Behavior t (Some k) <- hold (Some.This k0) $ fmapCheap (\(k :=> _) -> Some.This k) kv'
982 let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case
983 Some.This oldKey -> case newKey `geq` oldKey of
984 Just Refl -> return Nothing
986 newInner <- filterEventKey newKey kv'
987 return $ Just $ newKey :=> Pair newVal (Compose newInner)
988 eInitial <- filterEventKey k0 kv'
989 return (eInitial, update)
991--------------------------------------------------------------------------------
993--------------------------------------------------------------------------------
995-- | An 'Accumulator' type can be built by accumulating occurrences of an
997#if __GLASGOW_HASKELL__ < 802
998{-# WARNING accum "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
999{-# WARNING accumM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1000{-# WARNING accumMaybe "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1001{-# WARNING accumMaybeM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1003class Reflex t => Accumulator t f | f -> t where
1004 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
1005 accum f = accumMaybe $ \v o -> Just $ f v o
1006 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
1007 accumM f = accumMaybeM $ \v o -> Just <$> f v o
1008 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
1009 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
1010 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
1011 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
1012 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
1013 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
1014 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
1015 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1016 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
1017 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1019accumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Dynamic t a)
1020accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o
1021accumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Dynamic t a)
1022accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o
1023accumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Dynamic t a)
1024accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o
1025accumMaybeMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Dynamic t a)
1026accumMaybeMDyn f z e = do
1027 rec let e' = flip push e $ \o -> do
1028 v <- sample $ current d'
1032mapAccumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
1033mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o
1034mapAccumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
1035mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o
1036mapAccumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
1037mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o
1038mapAccumMaybeMDyn :: (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)
1039mapAccumMaybeMDyn f z e = do
1040 rec let e' = flip push e $ \o -> do
1041 v <- sample $ current d'
1043 return $ case result of
1044 (Nothing, Nothing) -> Nothing
1046 d' <- holdDyn z $ fmapMaybe fst e'
1047 return (d', fmapMaybe snd e')
1049{-# INLINE accumB #-}
1050accumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Behavior t a)
1051accumB f = accumMaybeB $ \v o -> Just $ f v o
1052{-# INLINE accumMB #-}
1053accumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Behavior t a)
1054accumMB f = accumMaybeMB $ \v o -> Just <$> f v o
1055{-# INLINE accumMaybeB #-}
1056accumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Behavior t a)
1057accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o
1058{-# INLINE accumMaybeMB #-}
1059accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)
1060accumMaybeMB f z e = do
1061 rec let e' = flip push e $ \o -> do
1066{-# INLINE mapAccumB #-}
1067mapAccumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)
1068mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o
1069{-# INLINE mapAccumMB #-}
1070mapAccumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)
1071mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o
1072{-# INLINE mapAccumMaybeB #-}
1073mapAccumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)
1074mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o
1076{-# INLINE mapAccumMaybeMB #-}
1077mapAccumMaybeMB :: (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)
1078mapAccumMaybeMB f z e = do
1079 rec let e' = flip push e $ \o -> do
1082 return $ case result of
1083 (Nothing, Nothing) -> Nothing
1085 d' <- hold z $ fmapMaybe fst e'
1086 return (d', fmapMaybe snd e')
1088-- | Accumulate occurrences of an 'Event', producing an output occurrence each
1089-- time. Discard the underlying 'Accumulator'.
1090{-# INLINE mapAccum_ #-}
1091mapAccum_ :: 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)
1093 (_, result) <- mapAccumB f z e
1096-- | Accumulate occurrences of an 'Event', possibly producing an output
1097-- occurrence each time. Discard the underlying 'Accumulator'.
1098{-# INLINE mapAccumMaybe_ #-}
1099mapAccumMaybe_ :: 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)
1100mapAccumMaybe_ f z e = do
1101 (_, result) <- mapAccumMaybeB f z e
1104-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
1105-- an output occurrence each time. Discard the underlying 'Accumulator'.
1106{-# INLINE mapAccumM_ #-}
1107mapAccumM_ :: 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)
1108mapAccumM_ f z e = do
1109 (_, result) <- mapAccumMB f z e
1112-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
1113-- producing an output occurrence each time. Discard the underlying
1115{-# INLINE mapAccumMaybeM_ #-}
1116mapAccumMaybeM_ :: 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)
1117mapAccumMaybeM_ f z e = do
1118 (_, result) <- mapAccumMaybeMB f z e
1121instance Reflex t => Accumulator t (Dynamic t) where
1122 accumMaybeM = accumMaybeMDyn
1123 mapAccumMaybeM = mapAccumMaybeMDyn
1125instance Reflex t => Accumulator t (Behavior t) where
1126 accumMaybeM = accumMaybeMB
1127 mapAccumMaybeM = mapAccumMaybeMB
1129instance Reflex t => Accumulator t (Event t) where
1130 accumMaybeM f z e = updated <$> accumMaybeM f z e
1131 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
1133-- | Create a new 'Event' by combining each occurrence with the next value of the
1134-- list using the supplied function. If the list runs out of items, all
1135-- subsequent 'Event' occurrences will be ignored.
1136zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
1137zipListWithEvent f l e = do
1138 let f' a b = case a of
1139 h:t -> (Just t, Just $ f h b)
1140 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
1141 mapAccumMaybe_ f' l e
1143-- | Assign a number to each occurrence of the given 'Event', starting from 0
1144{-# INLINE numberOccurrences #-}
1145numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
1146numberOccurrences = numberOccurrencesFrom 0
1148-- | Assign a number to each occurrence of the given 'Event'
1149{-# INLINE numberOccurrencesFrom #-}
1150numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
1151numberOccurrencesFrom = mapAccum_ (\n a -> let !next = n + 1 in (next, (n, a)))
1153-- | Assign a number to each occurrence of the given 'Event'; discard the occurrences' values
1154{-# INLINE numberOccurrencesFrom_ #-}
1155numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
1156numberOccurrencesFrom_ = mapAccum_ (\n _ -> let !next = n + 1 in (next, n))
1158-- | This is used to sample the value of a 'Behavior' using an 'Event'.
1160-- The '<@>' operator is intended to be used in conjunction with
1161-- the 'Applicative' instance for 'Behavior'.
1163-- This is useful when we want to combine the values of one 'Event' and
1164-- the value of several 'Behavior's at the time the 'Event' is firing.
1168-- > f :: a -> b -> c -> d
1169-- > b1 :: Behavior t a
1170-- > b2 :: Behavior t b
1175-- > f <$> b1 <*> b2 <@> e :: Event t d
1177-- in order to apply the function 'f' to the relevant values.
1179-- The alternative would be something like:
1181-- > attachWith (\(x1, x2) y -> f x1 x2 y) ((,) <$> b1 <*> b2) e :: Event t d
1183-- or a variation involing a custom data type to hold the combination of
1184-- 'Behavior's even when that combination might only ever be used by 'f'.
1186-- A more suggestive example might be:
1188-- > handleMouse <$> bPlayerState <*> bMousePosition <@> eMouseClick :: Event t (GameState -> GameState)
1190(<@>) :: Reflex t => Behavior t (a -> b) -> Event t a -> Event t b
1191(<@>) b = push $ \x -> do
1193 return . Just . f $ x
1196-- | An version of '<@>' that does not use the value of the 'Event'.
1198-- Alternatively, it is 'tag' in operator form.
1200-- This is useful when we want to combine the values of several
1201-- 'Behavior's at particular points in time using an 'Applicative'
1206-- > g :: a -> b -> d
1207-- > b1 :: Behavior t a
1208-- > b2 :: Behavior t b
1211-- where 'e' is firing at the points in time of interest.
1213-- Then we can use '<@':
1215-- > g <$> b1 <*> b2 <@ e :: Event t d
1217-- to combine the values of 'b1' and 'b2' at each of those points of time,
1218-- with the function 'g' being used to combine the values.
1220-- This is the same as '<@>' except that the 'Event' is being used only
1221-- to act as a trigger.
1222(<@) :: (Reflex t) => Behavior t b -> Event t a -> Event t b
1230{-# INLINE pushAlwaysCheap #-}
1231pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
1232pushAlwaysCheap f = pushCheap (fmap Just . f)
1234{-# INLINE fmapMaybeCheap #-}
1235fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1236fmapMaybeCheap f = pushCheap $ return . f
1238{-# INLINE fforMaybeCheap #-}
1239fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
1240fforMaybeCheap = flip fmapMaybeCheap
1242{-# INLINE fforCheap #-}
1243fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
1244fforCheap = flip fmapCheap
1246{-# INLINE fmapCheap #-}
1247fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
1248fmapCheap f = pushCheap $ return . Just . f
1250{-# INLINE tagCheap #-}
1251tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
1252tagCheap b = pushAlwaysCheap $ \_ -> sample b
1254{-# INLINE mergeWithCheap #-}
1255mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
1256mergeWithCheap = mergeWithCheap' id
1258{-# INLINE mergeWithCheap' #-}
1259mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
1260mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
1262{-# INLINE mergeWithFoldCheap' #-}
1263mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
1264mergeWithFoldCheap' f es =
1265 fmapCheap (f . (\(h : t) -> h :| t) . IntMap.elems)
1267 . IntMap.fromDistinctAscList
1268 $ zip [0 :: Int ..] es
1270--------------------------------------------------------------------------------
1271-- Deprecated functions
1272--------------------------------------------------------------------------------
1274-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
1275-- occurs. If both occur at the same time they are combined using 'mappend'.
1276{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}
1277appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
1278appendEvents = alignWith $ mergeThese mappend
1280-- | Alias for 'headE'
1281{-# DEPRECATED onceE "Use 'headE' instead" #-}
1282onceE :: MonadHold t m => Event t a -> m (Event t a)
1285-- | Run both sides of a 'These' monadically, combining the results.
1286{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
1287#ifdef USE_TEMPLATE_HASKELL
1288{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
1290sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
1291sequenceThese t = case t of
1292 This ma -> fmap This ma
1293 These ma mb -> liftM2 These ma mb
1294 That mb -> fmap That mb
1296{-# 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'. " #-}
1297switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1298switchPromptly = switchHoldPromptly
1299{-# 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'. " #-}
1300switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1301switchPromptOnly = 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