1{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE ConstraintKinds #-}
4{-# LANGUAGE DefaultSignatures #-}
5{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE FunctionalDependencies #-}
9{-# LANGUAGE LambdaCase #-}
10{-# LANGUAGE NoMonomorphismRestriction #-}
11{-# LANGUAGE PolyKinds #-}
12{-# LANGUAGE RankNTypes #-}
13{-# LANGUAGE RecursiveDo #-}
14{-# LANGUAGE RoleAnnotations #-}
15{-# LANGUAGE ScopedTypeVariables #-}
16{-# LANGUAGE TypeFamilies #-}
17{-# LANGUAGE TypeOperators #-}
18{-# LANGUAGE UndecidableInstances #-}
19{-# LANGUAGE Trustworthy #-}
20#ifdef USE_REFLEX_OPTIMIZER
21{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
28-- This module contains the Reflex interface, as well as a variety of
29-- convenience functions for working with 'Event's, 'Behavior's, and other
42 -- ** 'fan' related types
45 , EventSelectorInt (..)
46 -- * Convenience functions
49 -- ** Combining 'Event's
53 , mergeIncrementalWithMove
57 , mergeMapIncrementalWithMove
58 , mergeIntMapIncremental
60 , coincidencePatchMapWithMove
61 , coincidencePatchIntMap
66 -- ** Breaking up 'Event's
78 -- ** Collapsing 'Event . Event'
81 , switchHoldPromptOnly
82 , switchHoldPromptOnlyIncremental
83 -- ** Using 'Event's to sample 'Behavior's
89 -- ** Blocking an 'Event' based on a 'Behavior'
91 -- ** Combining 'Dynamic's
92 , distributeDMapOverDynPure
93 , distributeDMapOverDynPureG
94 , distributeListOverDyn
95 , distributeListOverDynWith
98 -- ** Accumulating state
122 , accumMaybeIncremental
123 , accumMaybeMIncremental
124 , mapAccumIncremental
125 , mapAccumMIncremental
126 , mapAccumMaybeIncremental
127 , mapAccumMaybeMIncremental
130 , numberOccurrencesFrom
131 , numberOccurrencesFrom_
141 -- * Debugging functions
144 -- * Unsafe functions
146 , unsafeMapIncremental
147 -- * 'Filterable' convenience functions
148 , FunctorMaybe -- fmapMaybe is purposely not exported from deprecated 'FunctorMaybe' and the new alias is exported instead
149 , mapMaybe -- Re-exported for convenience
155 -- * Miscellaneous convenience functions
159 -- * Deprecated functions
162 -- * "Cheap" functions
172 -- * Slow, but general, implementations
176#if defined(MIN_VERSION_semialign)
177import Prelude hiding (zip, zipWith)
179#if MIN_VERSION_these(0,8,0)
180import Data.These.Combinators (justThese)
184import Control.Applicative
185import Control.Monad.Identity
186import Control.Monad.Reader
187import Control.Monad.State.Strict
188import Control.Monad.Trans.Cont (ContT)
189import Control.Monad.Trans.Except (ExceptT)
190import Control.Monad.Trans.RWS (RWST)
191import Control.Monad.Trans.Writer (WriterT)
196import Data.Dependent.Map (DMap, DSum (..))
197import qualified Data.Dependent.Map as DMap
198import Data.Functor.Compose
199import Data.Functor.Product
200import Data.GADT.Compare (GEq (..), GCompare (..), (:~:) (..))
201import Data.FastMutableIntMap (PatchIntMap)
203import Data.Functor.Bind
204import Data.Functor.Misc
205import Data.Functor.Plus
206import Data.IntMap.Strict (IntMap)
207import qualified Data.IntMap.Strict as IntMap
208import Data.List.NonEmpty (NonEmpty (..))
210import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
211import Data.Some (Some(Some))
214import Data.Type.Coercion
215import Data.Witherable (Filterable(..))
216import qualified Data.Witherable as W
217import Reflex.FunctorMaybe (FunctorMaybe)
218import qualified Reflex.FunctorMaybe
220import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
222import Debug.Trace (trace)
224-- | The 'Reflex' class contains all the primitive functionality needed for
225-- Functional Reactive Programming (FRP). The @/t/@ type parameter indicates
226-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
227-- and the type of the timeline determines the FRP engine to be used. For most
228-- purposes, the 'Reflex.Spider' implementation is recommended.
229class ( MonadHold t (PushM t)
230 , MonadSample t (PullM t)
232 , Functor (Dynamic t)
233 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
236 -- | A container for a value that can change over time. 'Behavior's can be
237 -- sampled at will, but it is not possible to be notified when they change
238 data Behavior t :: * -> *
239 -- | A stream of occurrences. During any given frame, an 'Event' is either
240 -- occurring or not occurring; if it is occurring, it will contain a value of
241 -- the given type (its "occurrence type")
242 data Event t :: * -> *
243 -- | A container for a value that can change over time and allows
244 -- notifications on changes. Basically a combination of a 'Behavior' and an
245 -- 'Event', with a rule that the 'Behavior' will change if and only if the
247 data Dynamic t :: * -> *
248 -- | An 'Incremental' is a more general form of a 'Dynamic'.
249 -- Instead of always fully replacing the value, only parts of it can be patched.
250 -- This is only needed for performance critical code via `mergeIncremental` to make small
251 -- changes to large values.
252 data Incremental t :: * -> *
253 -- | A monad for doing complex push-based calculations efficiently
254 type PushM t :: * -> *
255 -- | A monad for doing complex pull-based calculations efficiently
256 type PullM t :: * -> *
257 -- | An 'Event' with no occurrences
259 -- | Create a 'Behavior' that always has the given value
260 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
261 -- | Create an 'Event' from another 'Event'; the provided function can sample
262 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
263 -- (Just) or non-occurring (Nothing) result
264 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
265 -- | 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.
266 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
267 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
268 -- recomputed whenever any of the read 'Behavior's changes
269 pull :: PullM t a -> Behavior t a
270 -- | Merge a collection of events; the resulting 'Event' will only occur if at
271 -- least one input event is occurring, and will contain all of the input keys
272 -- that are occurring simultaneously
274 --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
275 mergeG :: GCompare k => (forall a. q a -> Event t (v a))
276 -> DMap k q -> Event t (DMap k v)
278 -- | Efficiently fan-out an event to many destinations. You should save the
279 -- result in a @let@-binding, and then repeatedly 'selectG' on the result to
280 -- create child events
281 fanG :: GCompare k => Event t (DMap k v) -> EventSelectorG t k v
283 -- | Create an 'Event' that will occur whenever the currently-selected input
285 switch :: Behavior t (Event t a) -> Event t a
286 -- | Create an 'Event' that will occur whenever the input event is occurring -- and its occurrence value, another 'Event', is also occurring
287 coincidence :: Event t (Event t a) -> Event t a
288 -- | Extract the 'Behavior' of a 'Dynamic'.
289 current :: Dynamic t a -> Behavior t a
290 -- | Extract the 'Event' of the 'Dynamic'.
291 updated :: Dynamic t a -> Event t a
292 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
293 -- recent firing of the given 'Event', if any.
294 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
295 -- | Create a new 'Incremental'. The given "PullM"'s value must always change
296 -- in the same way that the accumulated application of patches would change
298 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
299 -- | Create a merge whose parents can change over time
300 mergeIncrementalG :: GCompare k
301 => (forall a. q a -> Event t (v a))
302 -> Incremental t (PatchDMap k q)
303 -> Event t (DMap k v)
304 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
305 mergeIncrementalWithMoveG :: GCompare k
306 => (forall a. q a -> Event t (v a))
307 -> Incremental t (PatchDMapWithMove k q) -> Event t (DMap k v)
308 -- | Extract the 'Behavior' component of an 'Incremental'
309 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
310 -- | Extract the 'Event' component of an 'Incremental'
311 updatedIncremental :: Patch p => Incremental t p -> Event t p
312 -- | Convert an 'Incremental' to a 'Dynamic'
313 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
314 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
316 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
317 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
319 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
320 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
322 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
323 -- | Construct a 'Coercion' for an 'Incremental' given 'Coercion's for its
324 -- patch target and patch types.
326 :: Coercion (PatchTarget a) (PatchTarget b) -> Coercion a b -> Coercion (Incremental t a) (Incremental t b)
327 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
328 fanInt :: Event t (IntMap a) -> EventSelectorInt t a
330-- | Efficiently fan-out an event to many destinations. You should save the
331-- result in a @let@-binding, and then repeatedly 'select' on the result to
332-- create child events
333fan :: forall t k. (Reflex t, GCompare k)
334 => Event t (DMap k Identity) -> EventSelector t k
335 --TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it
336fan e = EventSelector (fixup (selectG (fanG e) :: k a -> Event t (Identity a)) :: forall a. k a -> Event t a)
338 fixup :: forall a. (k a -> Event t (Identity a)) -> k a -> Event t a
339 fixup = case eventCoercion Coercion :: Coercion (Event t (Identity a)) (Event t a) of
342--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on
343-- | Constructs a single 'Event' out of a map of events. The output event may fire with multiple
344-- keys simultaneously.
345mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
346mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never
348-- | Coerce a 'Behavior' between representationally-equivalent value types
349coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
350coerceBehavior = coerceWith $ behaviorCoercion Coercion
352-- | Coerce an 'Event' between representationally-equivalent occurrence types
353coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
354coerceEvent = coerceWith $ eventCoercion Coercion
356-- | Coerce a 'Dynamic' between representationally-equivalent value types
357coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
358coerceDynamic = coerceWith $ dynamicCoercion Coercion
360-- | Coerce an 'Incremental' between representationally-equivalent value types
362 :: (Reflex t, Coercible a b, Coercible (PatchTarget a) (PatchTarget b))
363 => Incremental t a -> Incremental t b
364coerceIncremental = coerceWith $ incrementalCoercion Coercion Coercion
366-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
367-- __must__ change when and only when the 'Event' fires, such that the
368-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
369-- if this is not the case, the resulting 'Dynamic' will behave
370-- nondeterministically.
371unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
372unsafeDynamic = unsafeBuildDynamic . sample
374-- | Construct a 'Dynamic' value that never changes
375constDyn :: Reflex t => a -> Dynamic t a
378instance (Reflex t, Default a) => Default (Dynamic t a) where
381-- | 'MonadSample' designates monads that can read the current value of a
382-- 'Behavior'. This includes both 'PullM' and 'PushM'.
383class (Applicative m, Monad m) => MonadSample t m | m -> t where
384 -- | Get the current value in the 'Behavior'
385 sample :: Behavior t a -> m a
387-- | 'MonadHold' designates monads that can create new 'Behavior's based on
388-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
389-- is required to create any stateful computations with Reflex.
390class MonadSample t m => MonadHold t m where
391 -- | Create a new 'Behavior' whose value will initially be equal to the given
392 -- value and will be updated whenever the given 'Event' occurs. The update
393 -- takes effect immediately after the 'Event' occurs; if the occurrence that
394 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
395 -- the 'Behavior', it will see the __old__ value of the 'Behavior', not the new
397 hold :: a -> Event t a -> m (Behavior t a)
398 default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)
399 hold v0 = lift . hold v0
400 -- | Create a 'Dynamic' value using the given initial value that changes every
401 -- time the 'Event' occurs.
402 holdDyn :: a -> Event t a -> m (Dynamic t a)
403 default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)
404 holdDyn v0 = lift . holdDyn v0
405 -- | Create an 'Incremental' value using the given initial value that changes
406 -- every time the 'Event' occurs.
407 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
408 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
409 holdIncremental v0 = lift . holdIncremental v0
410 buildDynamic :: PushM t a -> Event t a -> m (Dynamic t a)
412 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
413 buildDynamic getV0 = lift . buildDynamic getV0
415 -- | Create a new 'Event' that only occurs only once, on the first occurrence of
416 -- the supplied 'Event'.
417 headE :: Event t a -> m (Event t a)
419-- | Accumulate an 'Incremental' with the supplied initial value and the firings of the provided 'Event',
420-- using the combining function to produce a patch.
422 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
423 => (PatchTarget p -> b -> p)
426 -> m (Incremental t p)
427accumIncremental f = accumMaybeIncremental $ \v o -> Just $ f v o
429-- | Similar to 'accumIncremental' but the combining function runs in 'PushM'
431 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
432 => (PatchTarget p -> b -> PushM t p)
435 -> m (Incremental t p)
436accumMIncremental f = accumMaybeMIncremental $ \v o -> Just <$> f v o
438-- | Similar to 'accumIncremental' but allows filtering of updates (by dropping updates when the
439-- combining function produces @Nothing@)
441 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
442 => (PatchTarget p -> b -> Maybe p)
445 -> m (Incremental t p)
446accumMaybeIncremental f = accumMaybeMIncremental $ \v o -> return $ f v o
448-- | Similar to 'accumMaybeMIncremental' but the combining function runs in 'PushM'
449accumMaybeMIncremental
450 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
451 => (PatchTarget p -> b -> PushM t (Maybe p))
454 -> m (Incremental t p)
455accumMaybeMIncremental f z e = do
456 rec let e' = flip push e $ \o -> do
457 v <- sample $ currentIncremental d'
459 d' <- holdIncremental z e'
462-- | Accumulate an 'Incremental' by folding occurrences of an 'Event'
463-- with a function that both accumulates and produces a value to fire
464-- as an 'Event'. Returns both the accumulated value and the constructed
467 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
468 => (PatchTarget p -> b -> (p, c))
471 -> m (Incremental t p, Event t c)
472mapAccumIncremental f = mapAccumMaybeIncremental $ \v o -> bimap Just Just $ f v o
474-- | Like 'mapAccumIncremental' but the combining function runs in 'PushM'
476 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
477 => (PatchTarget p -> b -> PushM t (p, c))
480 -> m (Incremental t p, Event t c)
481mapAccumMIncremental f = mapAccumMaybeMIncremental $ \v o -> bimap Just Just <$> f v o
483-- | Accumulate an 'Incremental' by folding occurrences of an 'Event' with
484-- a function that both optionally accumulates and optionally produces
485-- a value to fire as a separate output 'Event'.
486-- Note that because 'Nothing's are discarded in both cases, the output
487-- 'Event' may fire even though the output 'Incremental' has not changed, and
488-- the output 'Incremental' may update even when the output 'Event' is not firing.
489mapAccumMaybeIncremental
490 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
491 => (PatchTarget p -> b -> (Maybe p, Maybe c))
494 -> m (Incremental t p, Event t c)
495mapAccumMaybeIncremental f = mapAccumMaybeMIncremental $ \v o -> return $ f v o
497-- | Like 'mapAccumMaybeIncremental' but the combining function is a 'PushM' action
498mapAccumMaybeMIncremental
499 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
500 => (PatchTarget p -> b -> PushM t (Maybe p, Maybe c))
503 -> m (Incremental t p, Event t c)
504mapAccumMaybeMIncremental f z e = do
505 rec let e' = flip push e $ \o -> do
506 v <- sample $ currentIncremental d'
508 return $ case result of
509 (Nothing, Nothing) -> Nothing
511 d' <- holdIncremental z $ mapMaybe fst e'
512 return (d', mapMaybe snd e')
514-- | A somewhat slow implementation of 'headE'
515slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
517 rec be <- hold e $ fmapCheap (const never) e'
521-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
522-- key. This is much more efficient than filtering for each key with
524newtype EventSelector t k = EventSelector
525 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
526 -- determined by the type of the key, so this can be used to fan-out
527 -- 'Event's whose sub-'Event's have different types.
529 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
530 -- (but equivalent to) using 'mapMaybe' to select only the relevant
531 -- occurrences of an 'Event'.
532 select :: forall a. k a -> Event t a
535newtype EventSelectorG t k v = EventSelectorG
536 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
537 -- determined by the type of the key, so this can be used to fan-out
538 -- 'Event's whose sub-'Event's have different types.
540 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
541 -- (but equivalent to) using 'mapMaybe' to select only the relevant
542 -- occurrences of an 'Event'.
543 selectG :: forall a. k a -> Event t (v a)
546-- | Efficiently select an 'Event' keyed on 'Int'. This is more efficient than manually
548newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }
550--------------------------------------------------------------------------------
552--------------------------------------------------------------------------------
554instance MonadSample t m => MonadSample t (ReaderT r m) where
555 sample = lift . sample
557instance MonadHold t m => MonadHold t (ReaderT r m) where
558 hold a0 = lift . hold a0
559 holdDyn a0 = lift . holdDyn a0
560 holdIncremental a0 = lift . holdIncremental a0
561 buildDynamic a0 = lift . buildDynamic a0
564instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
565 sample = lift . sample
567instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
568 hold a0 = lift . hold a0
569 holdDyn a0 = lift . holdDyn a0
570 holdIncremental a0 = lift . holdIncremental a0
571 buildDynamic a0 = lift . buildDynamic a0
574instance MonadSample t m => MonadSample t (StateT s m) where
575 sample = lift . sample
577instance MonadHold t m => MonadHold t (StateT s m) where
578 hold a0 = lift . hold a0
579 holdDyn a0 = lift . holdDyn a0
580 holdIncremental a0 = lift . holdIncremental a0
581 buildDynamic a0 = lift . buildDynamic a0
584instance MonadSample t m => MonadSample t (ExceptT e m) where
585 sample = lift . sample
587instance MonadHold t m => MonadHold t (ExceptT e m) where
588 hold a0 = lift . hold a0
589 holdDyn a0 = lift . holdDyn a0
590 holdIncremental a0 = lift . holdIncremental a0
591 buildDynamic a0 = lift . buildDynamic a0
594instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
595 sample = lift . sample
597instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
598 hold a0 = lift . hold a0
599 holdDyn a0 = lift . holdDyn a0
600 holdIncremental a0 = lift . holdIncremental a0
601 buildDynamic a0 = lift . buildDynamic a0
604instance MonadSample t m => MonadSample t (ContT r m) where
605 sample = lift . sample
607instance MonadHold t m => MonadHold t (ContT r m) where
608 hold a0 = lift . hold a0
609 holdDyn a0 = lift . holdDyn a0
610 holdIncremental a0 = lift . holdIncremental a0
611 buildDynamic a0 = lift . buildDynamic a0
614--------------------------------------------------------------------------------
615-- Convenience functions
616--------------------------------------------------------------------------------
618-- | Create an 'Event' from another 'Event'. The provided function can sample
619-- 'Behavior's and hold 'Event's.
620pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
621pushAlways f = push (fmap Just . f)
623-- | Flipped version of 'fmap'.
624ffor :: Functor f => f a -> (a -> b) -> f b
627-- | Rotated version of 'liftA2'.
628ffor2 :: Applicative f => f a -> f b -> (a -> b -> c) -> f c
629ffor2 a b f = liftA2 f a b
631-- | Rotated version of 'liftA3'.
632ffor3 :: Applicative f => f a -> f b -> f c -> (a -> b -> c -> d) -> f d
633ffor3 a b c f = liftA3 f a b c
635instance Reflex t => Applicative (Behavior t) where
637 f <*> x = pull $ sample f `ap` sample x
641instance Reflex t => Apply (Behavior t) where
644instance Reflex t => Bind (Behavior t) where
647instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
649 fromRational = pure . fromRational
652instance Reflex t => Functor (Behavior t) where
653 fmap f = pull . fmap f . sample
655instance (Reflex t, IsString a) => IsString (Behavior t a) where
656 fromString = pure . fromString
658instance Reflex t => Monad (Behavior t) where
659 a >>= f = pull $ sample a >>= sample . f
660 -- 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.
662 fail = error "Monad (Behavior t) does not support fail"
664instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
665 mempty = constant mempty
666 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
667 mconcat = pull . fmap mconcat . mapM sample
669instance (Reflex t, Num a) => Num (Behavior t a) where
674 fromInteger = pure . fromInteger
678instance (Num a, Reflex t) => Num (Dynamic t a) where
683 fromInteger = pure . fromInteger
687instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
688 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
689 sconcat = pull . fmap sconcat . mapM sample
690 stimes n = fmap $ stimes n
692-- | Alias for 'mapMaybe'
693fmapMaybe :: Filterable f => (a -> Maybe b) -> f a -> f b
696-- | Flipped version of 'mapMaybe'.
697fforMaybe :: Filterable f => f a -> (a -> Maybe b) -> f b
698fforMaybe = flip mapMaybe
700-- | Filter 'f a' using the provided predicate.
701ffilter :: Filterable f => (a -> Bool) -> f a -> f a
704-- | Filter 'Left's from 'f (Either a b)' into 'a'.
705filterLeft :: Filterable f => f (Either a b) -> f a
706filterLeft = mapMaybe (either Just (const Nothing))
708-- | Filter 'Right's from 'f (Either a b)' into 'b'.
709filterRight :: Filterable f => f (Either a b) -> f b
710filterRight = mapMaybe (either (const Nothing) Just)
712-- | Left-biased event union (prefers left event on simultaneous
714instance Reflex t => Alt (Event t) where
715 ev1 <!> ev2 = leftmost [ev1, ev2]
717-- | 'Event' intersection. Only occurs when both events are co-incident.
718instance Reflex t => Apply (Event t) where
719 evf <.> evx = mapMaybe f (align evf evx) where
720 f (These g a) = Just (g a)
724-- | 'Event' intersection (convenient interface to 'coincidence').
725instance Reflex t => Bind (Event t) where
726 evx >>- f = coincidence (f <$> evx)
729instance Reflex t => Functor (Event t) where
731 fmap f = mapMaybe $ Just . f
733 x <$ e = fmapCheap (const x) e
735-- TODO Remove this instance
736instance Reflex t => FunctorMaybe (Event t) where
737 {-# INLINE fmapMaybe #-}
740instance Reflex t => Filterable (Event t) where
741 {-# INLINE mapMaybe #-}
742 mapMaybe f = push $ return . f
744-- | Never: @'zero' = 'never'@.
745instance Reflex t => Plus (Event t) where
748-- | Replace each occurrence value of the 'Event' with the value of the
749-- 'Behavior' at the time of that occurrence.
750tag :: Reflex t => Behavior t b -> Event t a -> Event t b
751tag b = pushAlways $ \_ -> sample b
753-- | Replace each occurrence value of the 'Event' with the value of the
754-- 'Behavior' at that time; if it is 'Just', fire with the contained value; if
755-- it is 'Nothing', drop the occurrence.
756tagMaybe :: Reflex t => Behavior t (Maybe b) -> Event t a -> Event t b
757tagMaybe b = push $ \_ -> sample b
759-- | Create a new 'Event' that combines occurrences of supplied 'Event' with the
760-- current value of the 'Behavior'.
761attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
762attach = attachWith (,)
764-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
765-- combining it with the current value of the 'Behavior'.
766attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
767attachWith f = attachWithMaybe $ \a b -> Just $ f a b
769-- | Create a new 'Event' by combining each occurrence with the current value of
770-- the 'Behavior'. The occurrence is discarded if the combining function returns
772attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
773attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
775-- | Create a new 'Event' that occurs on all but the first occurrence of the
777tailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a)
778tailE e = snd <$> headTailE e
780-- | Create a tuple of two 'Event's with the first one occurring only the first
781-- time the supplied 'Event' occurs and the second occurring on all but the first
783headTailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a, Event t a)
786 be <- hold never $ fmap (const e) eHead
787 return (eHead, switch be)
789-- | Take the streak of occurrences starting at the current time for which the
790-- event returns 'True'.
792-- Starting at the current time, fire all the occurrences of the 'Event' for
793-- which the given predicate returns 'True'. When first 'False' is returned,
794-- do not fire, and permanently stop firing, even if 'True' values would have
795-- been encountered later.
798 . (Reflex t, MonadFix m, MonadHold t m)
802takeWhileE f = takeWhileJustE $ \v -> guard (f v) $> v
804-- | Take the streak of occurrences starting at the current time for which the
805-- event returns 'Just b'.
807-- Starting at the current time, fire all the occurrences of the 'Event' for
808-- which the given predicate returns 'Just b'. When first 'Nothing' is returned,
809-- do not fire, and permanently stop firing, even if 'Just b' values would have
810-- been encountered later.
813 . (Reflex t, MonadFix m, MonadHold t m)
817takeWhileJustE f e = do
818 rec let (eBad, eTrue) = fanEither $ ffor e' $ \a -> case f a of
819 Nothing -> Left never
821 eFirstBad <- headE eBad
822 e' <- switchHold e eFirstBad
825-- | Drop the streak of occurrences starting at the current time for which the
826-- event returns 'True'.
828-- Starting at the current time, do not fire all the occurrences of the 'Event'
829-- for which the given predicate returns 'True'. When 'False' is first
830-- returned, do fire, and permanently continue firing, even if 'True' values
831-- would have been encountered later.
834 . (Reflex t, MonadFix m, MonadHold t m)
838dropWhileE f e = snd <$> takeDropWhileJustE (\v -> guard (f v) $> v) e
840-- | Both take and drop the streak of occurrences starting at the current time
841-- for which the event returns 'Just b'.
843-- For the left event, starting at the current time, fire all the occurrences
844-- of the 'Event' for which the given function returns 'Just b'. When
845-- 'Nothing' is returned, do not fire, and permanently stop firing, even if
846-- 'Just b' values would have been encountered later.
848-- For the right event, do not fire until the first occurrence where the given
849-- function returns 'Nothing', and fire that one and all subsequent
850-- occurrences. Even if the function would have again returned 'Just b', keep
854 . (Reflex t, MonadFix m, MonadHold t m)
857 -> m (Event t b, Event t a)
858takeDropWhileJustE f e = do
859 rec let (eBad, eGood) = fanEither $ ffor e' $ \a -> case f a of
862 eFirstBad <- headE eBad
863 e' <- switchHold e (never <$ eFirstBad)
864 eRest <- switchHoldPromptOnly never (e <$ eFirstBad)
865 return (eGood, eRest)
867-- | Split the supplied 'Event' into two individual 'Event's occurring at the
868-- same time with the respective values from the tuple.
869splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
870splitE e = (fmap fst e, fmap snd e)
872-- | Print the supplied 'String' and the value of the 'Event' on each
873-- occurrence. This should /only/ be used for debugging.
875-- Note: As with Debug.Trace.trace, the message will only be printed if the
876-- 'Event' is actually used.
877traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
878traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
880-- | Print the output of the supplied function on each occurrence of the
881-- 'Event'. This should /only/ be used for debugging.
883-- Note: As with Debug.Trace.trace, the message will only be printed if the
884-- 'Event' is actually used.
885traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
886traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
888instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
889 (<>) = alignWith (mergeThese (<>))
890 sconcat = fmap sconcat . mergeList . toList
891 stimes n = fmap $ stimes n
893instance (Semigroup a, Reflex t) => Monoid (Event t a) where
896 mconcat = fmap sconcat . mergeList
898-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
899-- list occurs. If multiple occur at the same time they are folded from the left
900-- with the given function.
901{-# INLINE mergeWith #-}
902mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
903mergeWith = mergeWith' id
905{-# INLINE mergeWith' #-}
906mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
907mergeWith' f g es = fmap (Prelude.foldl1 g . fmap f)
909 . IntMap.fromDistinctAscList
910 $ zip [0 :: Int ..] es
912-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
913-- list occurs. If multiple occur at the same time the value is the value of the
915{-# INLINE leftmost #-}
916leftmost :: Reflex t => [Event t a] -> Event t a
917leftmost = mergeWith const
919-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
920-- list occurs and has a list of the values of all 'Event's occurring at that
922mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
924mergeList es = mergeWithFoldCheap' id es
927 :: (Reflex t, Patch p, Patch p')
928 => (PatchTarget p -> PatchTarget p')
932unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
934-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
935-- occurs if at least one of them occurs and has a map of values of all 'Event's
936-- occurring at that time.
937mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
938mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
940-- | Like 'mergeMap' but for 'IntMap'.
941mergeIntMap :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
942mergeIntMap = fmap dmapToIntMap . merge . intMapWithFunctorToDMap
944-- | Create a merge whose parents can change over time
945mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
946mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
948-- | Create a merge whose parents can change over time
949mergeIntMapIncremental :: Reflex t => Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
950mergeIntMapIncremental = fmap dmapToIntMap . mergeIncremental . unsafeMapIncremental intMapWithFunctorToDMap (const2IntPatchDMapWith id)
952-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
953mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
954mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
956-- | Split the event into separate events for 'Left' and 'Right' values.
957fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
959 let justLeft = either Just (const Nothing)
960 justRight = either (const Nothing) Just
961 in (mapMaybe justLeft e, mapMaybe justRight e)
963-- | Split the event into separate events for 'This' and 'That' values,
964-- allowing them to fire simultaneously when the input value is 'These'.
965fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
967 let this (This x) = Just x
968 this (These x _) = Just x
970 that (That y) = Just y
971 that (These _ y) = Just y
973 in (mapMaybe this e, mapMaybe that e)
975-- | Split the event into an 'EventSelector' that allows efficient selection of
976-- the individual 'Event's.
977fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
978fanMap = fan . fmap mapToDMap
980-- | Switches to the new event whenever it receives one. Only the old event is
981-- considered the moment a new one is switched in; the output event will fire at
982-- that moment only if the old event does.
984-- Because the simultaneous firing case is irrelevant, this function imposes
985-- laxer "timing requirements" on the overall circuit, avoiding many potential
986-- cyclic dependency / metastability failures. It's also more performant. Use
987-- this rather than 'switchHoldPromptly' and 'switchHoldPromptOnly' unless you
988-- are absolutely sure you need to act on the new event in the coincidental
990switchHold :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
991switchHold ea0 eea = switch <$> hold ea0 eea
993-- | Switches to the new event whenever it receives one. Whenever a new event is
994-- provided, if it is firing, its value will be the resulting event's value; if
995-- it is not firing, but the old one is, the old one's value will be used.
997-- 'switchHold', by always forwarding the old event the moment it is switched
998-- out, avoids many potential cyclic dependency problems / metastability
999-- problems. It's also more performant. Use it instead unless you are sure you
1001switchHoldPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1002switchHoldPromptly ea0 eea = do
1004 let eLag = switch bea
1005 eCoincidences = coincidence eea
1006 return $ leftmost [eCoincidences, eLag]
1008-- | switches to a new event whenever it receives one. At the moment of
1009-- switching, the old event will be ignored if it fires, and the new one will be
1010-- used if it fires; this is the opposite of 'switch', which will use only the
1013-- 'switchHold', by always forwarding the old event the moment it is switched
1014-- out, avoids many potential cyclic dependency problems / metastability
1015-- problems. It's also more performant. Use it instead unless you are sure you
1017switchHoldPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1018switchHoldPromptOnly e0 e' = do
1019 eLag <- switch <$> hold e0 e'
1020 return $ coincidence $ leftmost [e', eLag <$ eLag]
1022-- | When the given outer event fires, condense the inner events into the contained patch. Non-firing inner events will be replaced with deletions.
1023coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)
1024coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ ffor e $ \(PatchMap m) -> mergeMap $ ffor m $ \case
1025 Nothing -> fmapCheap (const Nothing) e
1026 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
1028-- | See 'coincidencePatchMap'
1029coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)
1030coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ ffor e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case
1031 Nothing -> fmapCheap (const Nothing) e
1032 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
1034-- | See 'coincidencePatchMap'
1035coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)
1036coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ ffor e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
1037 PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->
1038 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1039 PatchMapWithMove.From_Move k -> fforCheap e $ \_ ->
1040 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }
1041 PatchMapWithMove.From_Insert ev -> leftmost
1042 [ fforCheap ev $ \v ->
1043 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }
1044 , fforCheap e $ \_ ->
1045 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1048-- | Given a 'PatchTarget' of events (e.g., a 'Map' with 'Event' values) and an event of 'Patch'es
1049-- (e.g., a 'PatchMap' with 'Event' values), produce an 'Event' of the 'PatchTarget' type that
1050-- fires with the patched value.
1051switchHoldPromptOnlyIncremental
1052 :: forall t m p pt w
1055 , Patch (p (Event t w))
1056 , PatchTarget (p (Event t w)) ~ pt (Event t w)
1058 , PatchTarget (p w) ~ pt w
1061 => (Incremental t (p (Event t w)) -> Event t (pt w))
1062 -> (Event t (p (Event t w)) -> Event t (p w))
1064 -> Event t (p (Event t w))
1065 -> m (Event t (pt w))
1066switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch e0 e' = do
1067 lag <- mergePatchIncremental <$> holdIncremental e0 e'
1068 pure $ ffor (align lag (coincidencePatch e')) $ \case
1070 That new -> new `applyAlways` mempty
1071 These old new -> new `applyAlways` old
1073instance Reflex t => Align (Event t) where
1075#if MIN_VERSION_these(0, 8, 0)
1076instance Reflex t => Semialign (Event t) where
1078 align = alignEventWithMaybe Just
1080#if defined(MIN_VERSION_semialign)
1081 zip x y = mapMaybe justThese $ align x y
1085-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
1086-- the 'Behavior' is true at the time of occurrence.
1087gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
1088gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
1090-- | Create a new behavior given a starting behavior and switch to the behavior
1091-- carried by the event when it fires.
1092switcher :: (Reflex t, MonadHold t m)
1093 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
1094switcher b eb = pull . (sample <=< sample) <$> hold b eb
1096instance (Reflex t, IsString a) => IsString (Dynamic t a) where
1097 fromString = pure . fromString
1099-- | Combine two 'Dynamic's. The result will change whenever either (or both)
1100-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
1101zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
1102zipDyn = zipDynWith (,)
1104-- | Combine two 'Dynamic's with a combining function. The result will change
1105-- whenever either (or both) input 'Dynamic' changes.
1106-- More efficient than 'liftA2'.
1107zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
1109 let eab = align (updated da) (updated db)
1110 ec = flip push eab $ \o -> do
1113 b <- sample $ current db
1116 a <- sample $ current da
1118 These a b -> return (a, b)
1119 return $ Just $ f a b
1120 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
1122instance (Reflex t, Semigroup a) => Semigroup (Dynamic t a) where
1123 (<>) = zipDynWith (<>)
1124 stimes n = fmap $ stimes n
1126instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
1127 mconcat = distributeListOverDynWith mconcat
1128 mempty = constDyn mempty
1129 mappend = zipDynWith mappend
1131-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1132-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1133-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1134distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
1135distributeDMapOverDynPure = distributeDMapOverDynPureG coerceDynamic
1137-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1138-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1139-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1140distributeDMapOverDynPureG
1141 :: forall t k q v. (Reflex t, GCompare k)
1142 => (forall a. q a -> Dynamic t (v a))
1143 -> DMap k q -> Dynamic t (DMap k v)
1144distributeDMapOverDynPureG nt dm = case DMap.toList dm of
1145 [] -> constDyn DMap.empty
1146 [k :=> v] -> DMap.singleton k <$> nt v
1148 let getInitial = DMap.traverseWithKey (\_ -> sample . current . nt) dm
1149 edmPre = mergeG getCompose $ DMap.map (Compose . updated . nt) dm
1150 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
1151 olds <- sample $ current result
1152 return $ DMap.unionWithKey (\_ _ new -> new) olds news
1155-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
1156distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
1157distributeListOverDyn = distributeListOverDynWith id
1159-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
1160distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
1161distributeListOverDynWith f =
1162 fmap (f . map fromDSum . DMap.toAscList) .
1163 distributeDMapOverDynPure .
1164 DMap.fromDistinctAscList .
1165 zipWith toDSum [0..]
1167 toDSum :: Int -> Dynamic t a -> DSum (Const2 Int a) (Dynamic t)
1168 toDSum k v = Const2 k :=> v
1169 fromDSum :: DSum (Const2 Int a) Identity -> a
1170 fromDSum (Const2 _ :=> Identity v) = v
1172-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
1173-- unless the second supplied 'Event' occurs simultaneously.
1174difference :: Reflex t => Event t a -> Event t b -> Event t a
1175difference = alignEventWithMaybe $ \case
1179-- | Zips two values by taking the union of their shapes and combining with the provided function.
1180-- 'Nothing' values are dropped.
1181alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
1182alignEventWithMaybe f ea eb = mapMaybe (f <=< dmapToThese) $
1183 merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
1185-- | Produces an 'Event' that fires only when the input event fires with a 'DSum' key that
1186-- matches the provided key.
1188 :: forall t m k v a.
1195 -> Event t (DSum k v)
1196 -> m (Event t (v a))
1197filterEventKey k kv' = do
1198 let f :: DSum k v -> Maybe (v a)
1199 f (newK :=> newV) = case newK `geq` k of
1200 Just Refl -> Just newV
1202 takeWhileJustE f kv'
1204-- | "Factor" the input 'DSum' 'Event' to produce an 'Event' which
1205-- fires when the 'DSum' key changes and contains both the value of the
1206-- 'DSum' at switchover and an 'Event' of values produced by subsequent
1207-- firings of the input 'Event' that do not change the 'DSum' key.
1209 :: forall t m k v a.
1216 -> Event t (DSum k v)
1217 -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))
1218factorEvent k0 kv' = do
1219 key :: Behavior t (Some k) <- hold (Some k0) $ fmapCheap (\(k :=> _) -> Some k) kv'
1220 let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case
1221 Some oldKey -> case newKey `geq` oldKey of
1222 Just Refl -> return Nothing
1224 newInner <- filterEventKey newKey kv'
1225 return $ Just $ newKey :=> Pair newVal (Compose newInner)
1226 eInitial <- filterEventKey k0 kv'
1227 return (eInitial, update)
1229--------------------------------------------------------------------------------
1231--------------------------------------------------------------------------------
1233-- | An 'Accumulator' type can be built by accumulating occurrences of an
1235#if __GLASGOW_HASKELL__ < 802
1236{-# WARNING accum "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1237{-# WARNING accumM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1238{-# WARNING accumMaybe "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1239{-# WARNING accumMaybeM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1241class Reflex t => Accumulator t f | f -> t where
1242 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
1243 accum f = accumMaybe $ \v o -> Just $ f v o
1244 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
1245 accumM f = accumMaybeM $ \v o -> Just <$> f v o
1246 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
1247 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
1248 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
1249 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
1250 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
1251 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
1252 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
1253 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1254 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
1255 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1257-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1258-- with the provided function. See 'foldDyn'.
1260 :: (Reflex t, MonadHold t m, MonadFix m)
1265accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o
1267-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1268-- with the provided 'PushM' action.
1270 :: (Reflex t, MonadHold t m, MonadFix m)
1271 => (a -> b -> PushM t a)
1275accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o
1277-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1278-- with the provided function, discarding 'Nothing' results.
1280 :: (Reflex t, MonadHold t m, MonadFix m)
1281 => (a -> b -> Maybe a)
1285accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o
1287-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1288-- with the provided 'PushM' action, discarding 'Nothing' results.
1290 :: (Reflex t, MonadHold t m, MonadFix m)
1291 => (a -> b -> PushM t (Maybe a))
1295accumMaybeMDyn f z e = do
1296 rec let e' = flip push e $ \o -> do
1297 v <- sample $ current d'
1302-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1303-- with a function that both accumulates and produces a value to fire
1304-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1306 :: (Reflex t, MonadHold t m, MonadFix m)
1307 => (a -> b -> (a, c))
1310 -> m (Dynamic t a, Event t c)
1311mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o
1313-- | Similar to 'mapAccumDyn' except that the combining function is a
1316 :: (Reflex t, MonadHold t m, MonadFix m)
1317 => (a -> b -> PushM t (a, c))
1320 -> m (Dynamic t a, Event t c)
1321mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o
1323-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event' with
1324-- a function that both optionally accumulates and optionally produces
1325-- a value to fire as a separate output 'Event'.
1326-- Note that because 'Nothing's are discarded in both cases, the output
1327-- 'Event' may fire even though the output 'Dynamic' has not changed, and
1328-- the output 'Dynamic' may update even when the output 'Event' is not firing.
1330 :: (Reflex t, MonadHold t m, MonadFix m)
1331 => (a -> b -> (Maybe a, Maybe c))
1334 -> m (Dynamic t a, Event t c)
1335mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o
1337-- | Like 'mapAccumMaybeDyn' except that the combining function is a
1340 :: (Reflex t, MonadHold t m, MonadFix m)
1341 => (a -> b -> PushM t (Maybe a, Maybe c))
1344 -> m (Dynamic t a, Event t c)
1345mapAccumMaybeMDyn f z e = do
1346 rec let e' = flip push e $ \o -> do
1347 v <- sample $ current d'
1349 return $ case result of
1350 (Nothing, Nothing) -> Nothing
1352 d' <- holdDyn z $ mapMaybe fst e'
1353 return (d', mapMaybe snd e')
1355-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1356-- with the provided function.
1357{-# INLINE accumB #-}
1359 :: (Reflex t, MonadHold t m, MonadFix m)
1364accumB f = accumMaybeB $ \v o -> Just $ f v o
1366-- | Like 'accumB' except that the combining function is a 'PushM' action.
1367{-# INLINE accumMB #-}
1369 :: (Reflex t, MonadHold t m, MonadFix m)
1370 => (a -> b -> PushM t a)
1374accumMB f = accumMaybeMB $ \v o -> Just <$> f v o
1376-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1377-- with the provided function, discarding 'Nothing' results.
1378{-# INLINE accumMaybeB #-}
1380 :: (Reflex t, MonadHold t m, MonadFix m)
1381 => (a -> b -> Maybe a)
1385accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o
1387-- | Like 'accumMaybeB' except that the combining function is a 'PushM' action.
1388{-# INLINE accumMaybeMB #-}
1389accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)
1390accumMaybeMB f z e = do
1391 rec let e' = flip push e $ \o -> do
1397-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1398-- with a function that both accumulates and produces a value to fire
1399-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1400{-# INLINE mapAccumB #-}
1402 :: (Reflex t, MonadHold t m, MonadFix m)
1403 => (a -> b -> (a, c))
1406 -> m (Behavior t a, Event t c)
1407mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o
1409-- | Like 'mapAccumB' except that the combining function is a 'PushM' action.
1410{-# INLINE mapAccumMB #-}
1412 :: (Reflex t, MonadHold t m, MonadFix m)
1413 => (a -> b -> PushM t (a, c))
1416 -> m (Behavior t a, Event t c)
1417mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o
1419-- | Accumulate a 'Behavior' by folding occurrences of an 'Event' with
1420-- a function that both optionally accumulates and optionally produces
1421-- a value to fire as a separate output 'Event'. 'Nothing's are discarded.
1422{-# INLINE mapAccumMaybeB #-}
1424 :: (Reflex t, MonadHold t m, MonadFix m)
1425 => (a -> b -> (Maybe a, Maybe c))
1428 -> m (Behavior t a, Event t c)
1429mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o
1431-- | Like 'mapAccumMaybeB' except that the combining function is a 'PushM' action.
1432{-# INLINE mapAccumMaybeMB #-}
1433mapAccumMaybeMB :: (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)
1434mapAccumMaybeMB f z e = do
1435 rec let e' = flip push e $ \o -> do
1438 return $ case result of
1439 (Nothing, Nothing) -> Nothing
1441 d' <- hold z $ mapMaybe fst e'
1442 return (d', mapMaybe snd e')
1444-- | Accumulate occurrences of an 'Event', producing an output occurrence each
1445-- time. Discard the underlying 'Accumulator'.
1446{-# INLINE mapAccum_ #-}
1447mapAccum_ :: 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)
1449 (_, result) <- mapAccumB f z e
1452-- | Accumulate occurrences of an 'Event', possibly producing an output
1453-- occurrence each time. Discard the underlying 'Accumulator'.
1454{-# INLINE mapAccumMaybe_ #-}
1455mapAccumMaybe_ :: 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)
1456mapAccumMaybe_ f z e = do
1457 (_, result) <- mapAccumMaybeB f z e
1460-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
1461-- an output occurrence each time. Discard the underlying 'Accumulator'.
1462{-# INLINE mapAccumM_ #-}
1463mapAccumM_ :: 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)
1464mapAccumM_ f z e = do
1465 (_, result) <- mapAccumMB f z e
1468-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
1469-- producing an output occurrence each time. Discard the underlying
1471{-# INLINE mapAccumMaybeM_ #-}
1472mapAccumMaybeM_ :: 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)
1473mapAccumMaybeM_ f z e = do
1474 (_, result) <- mapAccumMaybeMB f z e
1477instance Reflex t => Accumulator t (Dynamic t) where
1478 accumMaybeM = accumMaybeMDyn
1479 mapAccumMaybeM = mapAccumMaybeMDyn
1481instance Reflex t => Accumulator t (Behavior t) where
1482 accumMaybeM = accumMaybeMB
1483 mapAccumMaybeM = mapAccumMaybeMB
1485instance Reflex t => Accumulator t (Event t) where
1486 accumMaybeM f z e = updated <$> accumMaybeM f z e
1487 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
1489-- | Create a new 'Event' by combining each occurrence with the next value of the
1490-- list using the supplied function. If the list runs out of items, all
1491-- subsequent 'Event' occurrences will be ignored.
1492zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
1493zipListWithEvent f l e = do
1494 let f' a b = case a of
1495 h:t -> (Just t, Just $ f h b)
1496 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
1497 mapAccumMaybe_ f' l e
1499-- | Assign a number to each occurrence of the given 'Event', starting from 0
1500{-# INLINE numberOccurrences #-}
1501numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
1502numberOccurrences = numberOccurrencesFrom 0
1504-- | Assign a number to each occurrence of the given 'Event'
1505{-# INLINE numberOccurrencesFrom #-}
1506numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
1507numberOccurrencesFrom = mapAccum_ (\n a -> let !next = n + 1 in (next, (n, a)))
1509-- | Assign a number to each occurrence of the given 'Event'; discard the occurrences' values
1510{-# INLINE numberOccurrencesFrom_ #-}
1511numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
1512numberOccurrencesFrom_ = mapAccum_ (\n _ -> let !next = n + 1 in (next, n))
1514-- | This is used to sample the value of a 'Behavior' using an 'Event'.
1516-- The '<@>' operator is intended to be used in conjunction with
1517-- the 'Applicative' instance for 'Behavior'.
1519-- This is useful when we want to combine the values of one 'Event' and
1520-- the value of several 'Behavior's at the time the 'Event' is firing.
1524-- > f :: a -> b -> c -> d
1525-- > b1 :: Behavior t a
1526-- > b2 :: Behavior t b
1531-- > f <$> b1 <*> b2 <@> e :: Event t d
1533-- in order to apply the function 'f' to the relevant values.
1535-- The alternative would be something like:
1537-- > attachWith (\(x1, x2) y -> f x1 x2 y) ((,) <$> b1 <*> b2) e :: Event t d
1539-- or a variation involing a custom data type to hold the combination of
1540-- 'Behavior's even when that combination might only ever be used by 'f'.
1542-- A more suggestive example might be:
1544-- > handleMouse <$> bPlayerState <*> bMousePosition <@> eMouseClick :: Event t (GameState -> GameState)
1546(<@>) :: Reflex t => Behavior t (a -> b) -> Event t a -> Event t b
1547(<@>) b = push $ \x -> do
1549 return . Just . f $ x
1552-- | An version of '<@>' that does not use the value of the 'Event'.
1554-- Alternatively, it is 'tag' in operator form.
1556-- This is useful when we want to combine the values of several
1557-- 'Behavior's at particular points in time using an 'Applicative'
1562-- > g :: a -> b -> d
1563-- > b1 :: Behavior t a
1564-- > b2 :: Behavior t b
1567-- where 'e' is firing at the points in time of interest.
1569-- Then we can use '<@':
1571-- > g <$> b1 <*> b2 <@ e :: Event t d
1573-- to combine the values of 'b1' and 'b2' at each of those points of time,
1574-- with the function 'g' being used to combine the values.
1576-- This is the same as '<@>' except that the 'Event' is being used only
1577-- to act as a trigger.
1578(<@) :: (Reflex t) => Behavior t b -> Event t a -> Event t b
1586-- | A "cheap" version of 'pushAlways'. See the performance note on 'pushCheap'.
1587{-# INLINE pushAlwaysCheap #-}
1588pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
1589pushAlwaysCheap f = pushCheap (fmap Just . f)
1591-- | A "cheap" version of 'mapMaybe'. See the performance note on 'pushCheap'.
1592{-# INLINE mapMaybeCheap #-}
1593mapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1594mapMaybeCheap f = pushCheap $ return . f
1596-- | An alias for 'mapMaybeCheap'
1597{-# INLINE fmapMaybeCheap #-}
1598fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1599fmapMaybeCheap = mapMaybeCheap
1602-- | A "cheap" version of 'fforMaybe'. See the performance note on 'pushCheap'.
1603{-# INLINE fforMaybeCheap #-}
1604fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
1605fforMaybeCheap = flip mapMaybeCheap
1607-- | A "cheap" version of 'ffor'. See the performance note on 'pushCheap'.
1608{-# INLINE fforCheap #-}
1609fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
1610fforCheap = flip fmapCheap
1612-- | A "cheap" version of 'fmap'. See the performance note on 'pushCheap'.
1613{-# INLINE fmapCheap #-}
1614fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
1615fmapCheap f = pushCheap $ return . Just . f
1617-- | A "cheap" version of 'tag'. See the performance note on 'pushCheap'.
1618{-# INLINE tagCheap #-}
1619tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
1620tagCheap b = pushAlwaysCheap $ \_ -> sample b
1622-- | Merge a collection of events; the resulting 'Event' will only occur if at
1623-- least one input event is occurring, and will contain all of the input keys
1624-- that are occurring simultaneously
1625merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)
1626merge = mergeG coerceEvent
1629-- | Create a merge whose parents can change over time
1630mergeIncremental :: (Reflex t, GCompare k)
1631 => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
1632mergeIncremental = mergeIncrementalG coerceEvent
1634-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
1635mergeIncrementalWithMove :: (Reflex t, GCompare k)
1636 => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
1637mergeIncrementalWithMove = mergeIncrementalWithMoveG coerceEvent
1639-- | A "cheap" version of 'mergeWithCheap'. See the performance note on 'pushCheap'.
1640{-# INLINE mergeWithCheap #-}
1641mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
1642mergeWithCheap = mergeWithCheap' id
1644-- | A "cheap" version of 'mergeWithCheap''. See the performance note on 'pushCheap'.
1645{-# INLINE mergeWithCheap' #-}
1646mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
1647mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
1649-- | A "cheap" version of 'mergeWithFoldCheap''. See the performance note on 'pushCheap'.
1650{-# INLINE mergeWithFoldCheap' #-}
1651mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
1652mergeWithFoldCheap' f es =
1653 fmapCheap (f . (\(h : t) -> h :| t) . IntMap.elems)
1655 . IntMap.fromDistinctAscList
1656 $ zip [0 :: Int ..] es
1658--------------------------------------------------------------------------------
1659-- Deprecated functions
1660--------------------------------------------------------------------------------
1662{-# 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'. " #-}
1663-- | See 'switchHoldPromptly'
1664switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1665switchPromptly = switchHoldPromptly
1666{-# 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'. " #-}
1667-- | See 'switchHoldPromptOnly'
1668switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1669switchPromptOnly = 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