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#ifdef MIN_VERSION_semialign
177import Prelude hiding (zip, zipWith)
179#if MIN_VERSION_these(0,8,0)
180import Data.These.Combinators (justThese)
182#if MIN_VERSION_semialign(1,1,0)
183import Data.Zip (Zip (..))
187import Control.Applicative
188import Control.Monad.Identity
189import Control.Monad.Reader
190import Control.Monad.State.Strict
191import Control.Monad.Trans.Cont (ContT)
192import Control.Monad.Trans.Except (ExceptT)
193import Control.Monad.Trans.RWS (RWST)
194import Control.Monad.Trans.Writer (WriterT)
199import Data.Dependent.Map (DMap, DSum (..))
200import qualified Data.Dependent.Map as DMap
201import Data.Functor.Compose
202import Data.Functor.Product
203import Data.GADT.Compare (GEq (..), GCompare (..))
204import Data.FastMutableIntMap (PatchIntMap)
206import Data.Functor.Bind
207import Data.Functor.Misc
208import Data.Functor.Plus
209import Data.IntMap.Strict (IntMap)
210import qualified Data.IntMap.Strict as IntMap
211import Data.List.NonEmpty (NonEmpty (..))
213import Data.Semigroup (Semigroup (..))
214import Data.Some (Some(Some))
217import Data.Type.Coercion
218import Data.Type.Equality ((:~:) (..))
219import Data.Witherable (Filterable(..))
220import qualified Data.Witherable as W
221import Reflex.FunctorMaybe (FunctorMaybe)
222import qualified Reflex.FunctorMaybe
224import qualified Data.Patch.MapWithMove as PatchMapWithMove
226import Debug.Trace (trace)
228-- | The 'Reflex' class contains all the primitive functionality needed for
229-- Functional Reactive Programming (FRP). The @/t/@ type parameter indicates
230-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
231-- and the type of the timeline determines the FRP engine to be used. For most
232-- purposes, the 'Reflex.Spider' implementation is recommended.
233class ( MonadHold t (PushM t)
234 , MonadSample t (PullM t)
236 , Functor (Dynamic t)
237 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
240 -- | A container for a value that can change over time. 'Behavior's can be
241 -- sampled at will, but it is not possible to be notified when they change
242 data Behavior t :: * -> *
243 -- | A stream of occurrences. During any given frame, an 'Event' is either
244 -- occurring or not occurring; if it is occurring, it will contain a value of
245 -- the given type (its "occurrence type")
246 data Event t :: * -> *
247 -- | A container for a value that can change over time and allows
248 -- notifications on changes. Basically a combination of a 'Behavior' and an
249 -- 'Event', with a rule that the 'Behavior' will change if and only if the
251 data Dynamic t :: * -> *
252 -- | An 'Incremental' is a more general form of a 'Dynamic'.
253 -- Instead of always fully replacing the value, only parts of it can be patched.
254 -- This is only needed for performance critical code via `mergeIncremental` to make small
255 -- changes to large values.
256 data Incremental t :: * -> *
257 -- | A monad for doing complex push-based calculations efficiently
258 type PushM t :: * -> *
259 -- | A monad for doing complex pull-based calculations efficiently
260 type PullM t :: * -> *
261 -- | An 'Event' with no occurrences
263 -- | Create a 'Behavior' that always has the given value
264 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
265 -- | Create an 'Event' from another 'Event'; the provided function can sample
266 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
267 -- (Just) or non-occurring (Nothing) result
268 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
269 -- | 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.
270 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
271 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
272 -- recomputed whenever any of the read 'Behavior's changes
273 pull :: PullM t a -> Behavior t a
274 -- | Merge a collection of events; the resulting 'Event' will only occur if at
275 -- least one input event is occurring, and will contain all of the input keys
276 -- that are occurring simultaneously
278 --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
279 mergeG :: GCompare k => (forall a. q a -> Event t (v a))
280 -> DMap k q -> Event t (DMap k v)
282 -- | Efficiently fan-out an event to many destinations. You should save the
283 -- result in a @let@-binding, and then repeatedly 'selectG' on the result to
284 -- create child events
285 fanG :: GCompare k => Event t (DMap k v) -> EventSelectorG t k v
287 -- | Create an 'Event' that will occur whenever the currently-selected input
289 switch :: Behavior t (Event t a) -> Event t a
290 -- | Create an 'Event' that will occur whenever the input event is occurring -- and its occurrence value, another 'Event', is also occurring.
291 -- You maybe looking for '@switchHold@ @never@' instead.
292 coincidence :: Event t (Event t a) -> Event t a
293 -- | Extract the 'Behavior' of a 'Dynamic'.
294 current :: Dynamic t a -> Behavior t a
295 -- | Extract the 'Event' of the 'Dynamic'.
296 updated :: Dynamic t a -> Event t a
297 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
298 -- recent firing of the given 'Event', if any.
299 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
300 -- | Create a new 'Incremental'. The given "PullM"'s value must always change
301 -- in the same way that the accumulated application of patches would change
303 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
304 -- | Create a merge whose parents can change over time
305 mergeIncrementalG :: GCompare k
306 => (forall a. q a -> Event t (v a))
307 -> Incremental t (PatchDMap k q)
308 -> Event t (DMap k v)
309 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
310 mergeIncrementalWithMoveG :: GCompare k
311 => (forall a. q a -> Event t (v a))
312 -> Incremental t (PatchDMapWithMove k q) -> Event t (DMap k v)
313 -- | Extract the 'Behavior' component of an 'Incremental'
314 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
315 -- | Extract the 'Event' component of an 'Incremental'
316 updatedIncremental :: Patch p => Incremental t p -> Event t p
317 -- | Convert an 'Incremental' to a 'Dynamic'
318 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
319 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
321 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
322 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
324 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
325 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
327 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
328 -- | Construct a 'Coercion' for an 'Incremental' given 'Coercion's for its
329 -- patch target and patch types.
331 :: Coercion (PatchTarget a) (PatchTarget b) -> Coercion a b -> Coercion (Incremental t a) (Incremental t b)
332 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
333 fanInt :: Event t (IntMap a) -> EventSelectorInt t a
335-- | Efficiently fan-out an event to many destinations. You should save the
336-- result in a @let@-binding, and then repeatedly 'select' on the result to
337-- create child events
338fan :: forall t k. (Reflex t, GCompare k)
339 => Event t (DMap k Identity) -> EventSelector t k
340 --TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it
341fan e = EventSelector (fixup (selectG (fanG e) :: k a -> Event t (Identity a)) :: forall a. k a -> Event t a)
343 fixup :: forall a. (k a -> Event t (Identity a)) -> k a -> Event t a
344 fixup = case eventCoercion Coercion :: Coercion (Event t (Identity a)) (Event t a) of
347--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on
348-- | Constructs a single 'Event' out of a map of events. The output event may fire with multiple
349-- keys simultaneously.
350mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
351mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never
353-- | Coerce a 'Behavior' between representationally-equivalent value types
354coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
355coerceBehavior = coerceWith $ behaviorCoercion Coercion
357-- | Coerce an 'Event' between representationally-equivalent occurrence types
358coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
359coerceEvent = coerceWith $ eventCoercion Coercion
361-- | Coerce a 'Dynamic' between representationally-equivalent value types
362coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
363coerceDynamic = coerceWith $ dynamicCoercion Coercion
365-- | Coerce an 'Incremental' between representationally-equivalent value types
367 :: (Reflex t, Coercible a b, Coercible (PatchTarget a) (PatchTarget b))
368 => Incremental t a -> Incremental t b
369coerceIncremental = coerceWith $ incrementalCoercion Coercion Coercion
371-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
372-- __must__ change when and only when the 'Event' fires, such that the
373-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
374-- if this is not the case, the resulting 'Dynamic' will behave
375-- nondeterministically.
376unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
377unsafeDynamic = unsafeBuildDynamic . sample
379-- | Construct a 'Dynamic' value that never changes
380constDyn :: Reflex t => a -> Dynamic t a
383instance (Reflex t, Default a) => Default (Dynamic t a) where
386-- | 'MonadSample' designates monads that can read the current value of a
387-- 'Behavior'. This includes both 'PullM' and 'PushM'.
388class (Applicative m, Monad m) => MonadSample t m | m -> t where
389 -- | Get the current value in the 'Behavior'
390 sample :: Behavior t a -> m a
392-- | 'MonadHold' designates monads that can create new 'Behavior's based on
393-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
394-- is required to create any stateful computations with Reflex.
395class MonadSample t m => MonadHold t m where
396 -- | Create a new 'Behavior' whose value will initially be equal to the given
397 -- value and will be updated whenever the given 'Event' occurs. The update
398 -- takes effect immediately after the 'Event' occurs; if the occurrence that
399 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
400 -- the 'Behavior', it will see the __old__ value of the 'Behavior', not the new
402 hold :: a -> Event t a -> m (Behavior t a)
403 default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)
404 hold v0 = lift . hold v0
405 -- | Create a 'Dynamic' value using the given initial value that changes every
406 -- time the 'Event' occurs.
407 holdDyn :: a -> Event t a -> m (Dynamic t a)
408 default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)
409 holdDyn v0 = lift . holdDyn v0
410 -- | Create an 'Incremental' value using the given initial value that changes
411 -- every time the 'Event' occurs.
412 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
413 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
414 holdIncremental v0 = lift . holdIncremental v0
415 buildDynamic :: PushM t a -> Event t a -> m (Dynamic t a)
417 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
418 buildDynamic getV0 = lift . buildDynamic getV0
420 -- | Create a new 'Event' that only occurs only once, on the first occurrence of
421 -- the supplied 'Event'.
422 headE :: Event t a -> m (Event t a)
424-- | Accumulate an 'Incremental' with the supplied initial value and the firings of the provided 'Event',
425-- using the combining function to produce a patch.
427 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
428 => (PatchTarget p -> b -> p)
431 -> m (Incremental t p)
432accumIncremental f = accumMaybeIncremental $ \v o -> Just $ f v o
434-- | Similar to 'accumIncremental' but the combining function runs in 'PushM'
436 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
437 => (PatchTarget p -> b -> PushM t p)
440 -> m (Incremental t p)
441accumMIncremental f = accumMaybeMIncremental $ \v o -> Just <$> f v o
443-- | Similar to 'accumIncremental' but allows filtering of updates (by dropping updates when the
444-- combining function produces @Nothing@)
446 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
447 => (PatchTarget p -> b -> Maybe p)
450 -> m (Incremental t p)
451accumMaybeIncremental f = accumMaybeMIncremental $ \v o -> return $ f v o
453-- | Similar to 'accumMaybeMIncremental' but the combining function runs in 'PushM'
454accumMaybeMIncremental
455 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
456 => (PatchTarget p -> b -> PushM t (Maybe p))
459 -> m (Incremental t p)
460accumMaybeMIncremental f z e = do
461 rec let e' = flip push e $ \o -> do
462 v <- sample $ currentIncremental d'
464 d' <- holdIncremental z e'
467-- | Accumulate an 'Incremental' by folding occurrences of an 'Event'
468-- with a function that both accumulates and produces a value to fire
469-- as an 'Event'. Returns both the accumulated value and the constructed
472 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
473 => (PatchTarget p -> b -> (p, c))
476 -> m (Incremental t p, Event t c)
477mapAccumIncremental f = mapAccumMaybeIncremental $ \v o -> bimap Just Just $ f v o
479-- | Like 'mapAccumIncremental' but the combining function runs in 'PushM'
481 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
482 => (PatchTarget p -> b -> PushM t (p, c))
485 -> m (Incremental t p, Event t c)
486mapAccumMIncremental f = mapAccumMaybeMIncremental $ \v o -> bimap Just Just <$> f v o
488-- | Accumulate an 'Incremental' by folding occurrences of an 'Event' with
489-- a function that both optionally accumulates and optionally produces
490-- a value to fire as a separate output 'Event'.
491-- Note that because 'Nothing's are discarded in both cases, the output
492-- 'Event' may fire even though the output 'Incremental' has not changed, and
493-- the output 'Incremental' may update even when the output 'Event' is not firing.
494mapAccumMaybeIncremental
495 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
496 => (PatchTarget p -> b -> (Maybe p, Maybe c))
499 -> m (Incremental t p, Event t c)
500mapAccumMaybeIncremental f = mapAccumMaybeMIncremental $ \v o -> return $ f v o
502-- | Like 'mapAccumMaybeIncremental' but the combining function is a 'PushM' action
503mapAccumMaybeMIncremental
504 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
505 => (PatchTarget p -> b -> PushM t (Maybe p, Maybe c))
508 -> m (Incremental t p, Event t c)
509mapAccumMaybeMIncremental f z e = do
510 rec let e' = flip push e $ \o -> do
511 v <- sample $ currentIncremental d'
513 return $ case result of
514 (Nothing, Nothing) -> Nothing
516 d' <- holdIncremental z $ mapMaybe fst e'
517 return (d', mapMaybe snd e')
519-- | A somewhat slow implementation of 'headE'
520slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
522 rec be <- hold e $ fmapCheap (const never) e'
526-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
527-- key. This is much more efficient than filtering for each key with
529newtype EventSelector t k = EventSelector
530 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
531 -- determined by the type of the key, so this can be used to fan-out
532 -- 'Event's whose sub-'Event's have different types.
534 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
535 -- (but equivalent to) using 'mapMaybe' to select only the relevant
536 -- occurrences of an 'Event'.
537 select :: forall a. k a -> Event t a
540newtype EventSelectorG t k v = EventSelectorG
541 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
542 -- determined by the type of the key, so this can be used to fan-out
543 -- 'Event's whose sub-'Event's have different types.
545 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
546 -- (but equivalent to) using 'mapMaybe' to select only the relevant
547 -- occurrences of an 'Event'.
548 selectG :: forall a. k a -> Event t (v a)
551-- | Efficiently select an 'Event' keyed on 'Int'. This is more efficient than manually
553newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }
555--------------------------------------------------------------------------------
557--------------------------------------------------------------------------------
559instance MonadSample t m => MonadSample t (ReaderT r m) where
560 sample = lift . sample
562instance MonadHold t m => MonadHold t (ReaderT r m) where
563 hold a0 = lift . hold a0
564 holdDyn a0 = lift . holdDyn a0
565 holdIncremental a0 = lift . holdIncremental a0
566 buildDynamic a0 = lift . buildDynamic a0
569instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
570 sample = lift . sample
572instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
573 hold a0 = lift . hold a0
574 holdDyn a0 = lift . holdDyn a0
575 holdIncremental a0 = lift . holdIncremental a0
576 buildDynamic a0 = lift . buildDynamic a0
579instance MonadSample t m => MonadSample t (StateT s m) where
580 sample = lift . sample
582instance MonadHold t m => MonadHold t (StateT s m) where
583 hold a0 = lift . hold a0
584 holdDyn a0 = lift . holdDyn a0
585 holdIncremental a0 = lift . holdIncremental a0
586 buildDynamic a0 = lift . buildDynamic a0
589instance MonadSample t m => MonadSample t (ExceptT e m) where
590 sample = lift . sample
592instance MonadHold t m => MonadHold t (ExceptT e m) where
593 hold a0 = lift . hold a0
594 holdDyn a0 = lift . holdDyn a0
595 holdIncremental a0 = lift . holdIncremental a0
596 buildDynamic a0 = lift . buildDynamic a0
599instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
600 sample = lift . sample
602instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
603 hold a0 = lift . hold a0
604 holdDyn a0 = lift . holdDyn a0
605 holdIncremental a0 = lift . holdIncremental a0
606 buildDynamic a0 = lift . buildDynamic a0
609instance MonadSample t m => MonadSample t (ContT r m) where
610 sample = lift . sample
612instance MonadHold t m => MonadHold t (ContT r m) where
613 hold a0 = lift . hold a0
614 holdDyn a0 = lift . holdDyn a0
615 holdIncremental a0 = lift . holdIncremental a0
616 buildDynamic a0 = lift . buildDynamic a0
619--------------------------------------------------------------------------------
620-- Convenience functions
621--------------------------------------------------------------------------------
623-- | Create an 'Event' from another 'Event'. The provided function can sample
624-- 'Behavior's and hold 'Event's.
625pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
626pushAlways f = push (fmap Just . f)
628-- | Flipped version of 'fmap'.
629ffor :: Functor f => f a -> (a -> b) -> f b
632-- | Rotated version of 'liftA2'.
633ffor2 :: Applicative f => f a -> f b -> (a -> b -> c) -> f c
634ffor2 a b f = liftA2 f a b
636-- | Rotated version of 'liftA3'.
637ffor3 :: Applicative f => f a -> f b -> f c -> (a -> b -> c -> d) -> f d
638ffor3 a b c f = liftA3 f a b c
640instance Reflex t => Applicative (Behavior t) where
642 f <*> x = pull $ sample f `ap` sample x
646instance Reflex t => Apply (Behavior t) where
649instance Reflex t => Bind (Behavior t) where
652instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
654 fromRational = pure . fromRational
657instance Reflex t => Functor (Behavior t) where
658 fmap f = pull . fmap f . sample
660instance (Reflex t, IsString a) => IsString (Behavior t a) where
661 fromString = pure . fromString
663instance Reflex t => Monad (Behavior t) where
664 a >>= f = pull $ sample a >>= sample . f
665 -- 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.
667#if !MIN_VERSION_base(4,13,0)
668 fail = error "Monad (Behavior t) does not support fail"
671instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
672 mempty = constant mempty
673 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
674 mconcat = pull . fmap mconcat . mapM sample
676instance (Reflex t, Num a) => Num (Behavior t a) where
681 fromInteger = pure . fromInteger
685instance (Num a, Reflex t) => Num (Dynamic t a) where
690 fromInteger = pure . fromInteger
694instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
695 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
696 sconcat = pull . fmap sconcat . mapM sample
697 stimes n = fmap $ stimes n
699-- | Alias for 'mapMaybe'
700fmapMaybe :: Filterable f => (a -> Maybe b) -> f a -> f b
703-- | Flipped version of 'mapMaybe'.
704fforMaybe :: Filterable f => f a -> (a -> Maybe b) -> f b
705fforMaybe = flip mapMaybe
707-- | Filter 'f a' using the provided predicate.
708ffilter :: Filterable f => (a -> Bool) -> f a -> f a
711-- | Filter 'Left's from 'f (Either a b)' into 'a'.
712filterLeft :: Filterable f => f (Either a b) -> f a
713filterLeft = mapMaybe (either Just (const Nothing))
715-- | Filter 'Right's from 'f (Either a b)' into 'b'.
716filterRight :: Filterable f => f (Either a b) -> f b
717filterRight = mapMaybe (either (const Nothing) Just)
719-- | Left-biased event union (prefers left event on simultaneous
721instance Reflex t => Alt (Event t) where
722 ev1 <!> ev2 = leftmost [ev1, ev2]
724-- | 'Event' intersection. Only occurs when both events are co-incident.
725instance Reflex t => Apply (Event t) where
726 evf <.> evx = mapMaybe f (align evf evx) where
727 f (These g a) = Just (g a)
731-- | 'Event' intersection (convenient interface to 'coincidence').
732instance Reflex t => Bind (Event t) where
733 evx >>- f = coincidence (f <$> evx)
736instance Reflex t => Functor (Event t) where
738 fmap f = mapMaybe $ Just . f
740 x <$ e = fmapCheap (const x) e
742-- TODO Remove this instance
743instance Reflex t => FunctorMaybe (Event t) where
744 {-# INLINE fmapMaybe #-}
747instance Reflex t => Filterable (Event t) where
748 {-# INLINE mapMaybe #-}
749 mapMaybe f = push $ return . f
751-- | Never: @'zero' = 'never'@.
752instance Reflex t => Plus (Event t) where
755-- | Replace each occurrence value of the 'Event' with the value of the
756-- 'Behavior' at the time of that occurrence.
757tag :: Reflex t => Behavior t b -> Event t a -> Event t b
758tag b = pushAlways $ \_ -> sample b
760-- | Replace each occurrence value of the 'Event' with the value of the
761-- 'Behavior' at that time; if it is 'Just', fire with the contained value; if
762-- it is 'Nothing', drop the occurrence.
763tagMaybe :: Reflex t => Behavior t (Maybe b) -> Event t a -> Event t b
764tagMaybe b = push $ \_ -> sample b
766-- | Create a new 'Event' that combines occurrences of supplied 'Event' with the
767-- current value of the 'Behavior'.
768attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
769attach = attachWith (,)
771-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
772-- combining it with the current value of the 'Behavior'.
773attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
774attachWith f = attachWithMaybe $ \a b -> Just $ f a b
776-- | Create a new 'Event' by combining each occurrence with the current value of
777-- the 'Behavior'. The occurrence is discarded if the combining function returns
779attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
780attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
782-- | Create a new 'Event' that occurs on all but the first occurrence of the
784tailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a)
785tailE e = snd <$> headTailE e
787-- | Create a tuple of two 'Event's with the first one occurring only the first
788-- time the supplied 'Event' occurs and the second occurring on all but the first
790headTailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a, Event t a)
793 be <- hold never $ fmap (const e) eHead
794 return (eHead, switch be)
796-- | Take the streak of occurrences starting at the current time for which the
797-- event returns 'True'.
799-- Starting at the current time, fire all the occurrences of the 'Event' for
800-- which the given predicate returns 'True'. When first 'False' is returned,
801-- do not fire, and permanently stop firing, even if 'True' values would have
802-- been encountered later.
805 . (Reflex t, MonadFix m, MonadHold t m)
809takeWhileE f = takeWhileJustE $ \v -> guard (f v) $> v
811-- | Take the streak of occurrences starting at the current time for which the
812-- event returns 'Just b'.
814-- Starting at the current time, fire all the occurrences of the 'Event' for
815-- which the given predicate returns 'Just b'. When first 'Nothing' is returned,
816-- do not fire, and permanently stop firing, even if 'Just b' values would have
817-- been encountered later.
820 . (Reflex t, MonadFix m, MonadHold t m)
824takeWhileJustE f e = do
825 rec let (eBad, eTrue) = fanEither $ ffor e' $ \a -> case f a of
826 Nothing -> Left never
828 eFirstBad <- headE eBad
829 e' <- switchHold e eFirstBad
832-- | Drop the streak of occurrences starting at the current time for which the
833-- event returns 'True'.
835-- Starting at the current time, do not fire all the occurrences of the 'Event'
836-- for which the given predicate returns 'True'. When 'False' is first
837-- returned, do fire, and permanently continue firing, even if 'True' values
838-- would have been encountered later.
841 . (Reflex t, MonadFix m, MonadHold t m)
845dropWhileE f e = snd <$> takeDropWhileJustE (\v -> guard (f v) $> v) e
847-- | Both take and drop the streak of occurrences starting at the current time
848-- for which the event returns 'Just b'.
850-- For the left event, starting at the current time, fire all the occurrences
851-- of the 'Event' for which the given function returns 'Just b'. When
852-- 'Nothing' is returned, do not fire, and permanently stop firing, even if
853-- 'Just b' values would have been encountered later.
855-- For the right event, do not fire until the first occurrence where the given
856-- function returns 'Nothing', and fire that one and all subsequent
857-- occurrences. Even if the function would have again returned 'Just b', keep
861 . (Reflex t, MonadFix m, MonadHold t m)
864 -> m (Event t b, Event t a)
865takeDropWhileJustE f e = do
866 rec let (eBad, eGood) = fanEither $ ffor e' $ \a -> case f a of
869 eFirstBad <- headE eBad
870 e' <- switchHold e (never <$ eFirstBad)
871 eRest <- switchHoldPromptOnly never (e <$ eFirstBad)
872 return (eGood, eRest)
874-- | Split the supplied 'Event' into two individual 'Event's occurring at the
875-- same time with the respective values from the tuple.
876splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
877splitE e = (fmap fst e, fmap snd e)
879-- | Print the supplied 'String' and the value of the 'Event' on each
880-- occurrence. This should /only/ be used for debugging.
882-- Note: As with Debug.Trace.trace, the message will only be printed if the
883-- 'Event' is actually used.
884traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
885traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
887-- | Print the output of the supplied function on each occurrence of the
888-- 'Event'. This should /only/ be used for debugging.
890-- Note: As with Debug.Trace.trace, the message will only be printed if the
891-- 'Event' is actually used.
892traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
893traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
895instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
896 (<>) = alignWith (mergeThese (<>))
897 sconcat = fmap sconcat . mergeList . toList
898 stimes n = fmap $ stimes n
900instance (Semigroup a, Reflex t) => Monoid (Event t a) where
903 mconcat = fmap sconcat . mergeList
905-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
906-- list occurs. If multiple occur at the same time they are folded from the left
907-- with the given function.
908{-# INLINE mergeWith #-}
909mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
910mergeWith = mergeWith' id
912{-# INLINE mergeWith' #-}
913mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
914mergeWith' f g es = fmap (Prelude.foldl1 g . fmap f)
916 . IntMap.fromDistinctAscList
917 $ zip [0 :: Int ..] es
919-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
920-- list occurs. If multiple occur at the same time the value is the value of the
922{-# INLINE leftmost #-}
923leftmost :: Reflex t => [Event t a] -> Event t a
924leftmost = mergeWith const
926-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
927-- list occurs and has a list of the values of all 'Event's occurring at that
929mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
931mergeList es = mergeWithFoldCheap' id es
934 :: (Reflex t, Patch p, Patch p')
935 => (PatchTarget p -> PatchTarget p')
939unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
941-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
942-- occurs if at least one of them occurs and has a map of values of all 'Event's
943-- occurring at that time.
944mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
945mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
947-- | Like 'mergeMap' but for 'IntMap'.
948mergeIntMap :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
949mergeIntMap = fmap dmapToIntMap . merge . intMapWithFunctorToDMap
951-- | Create a merge whose parents can change over time
952mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
953mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
955-- | Create a merge whose parents can change over time
956mergeIntMapIncremental :: Reflex t => Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
957mergeIntMapIncremental = fmap dmapToIntMap . mergeIncremental . unsafeMapIncremental intMapWithFunctorToDMap (const2IntPatchDMapWith id)
959-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
960mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
961mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
963-- | Split the event into separate events for 'Left' and 'Right' values.
964fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
966 let justLeft = either Just (const Nothing)
967 justRight = either (const Nothing) Just
968 in (mapMaybe justLeft e, mapMaybe justRight e)
970-- | Split the event into separate events for 'This' and 'That' values,
971-- allowing them to fire simultaneously when the input value is 'These'.
972fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
974 let this (This x) = Just x
975 this (These x _) = Just x
977 that (That y) = Just y
978 that (These _ y) = Just y
980 in (mapMaybe this e, mapMaybe that e)
982-- | Split the event into an 'EventSelector' that allows efficient selection of
983-- the individual 'Event's.
984fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
985fanMap = fan . fmap mapToDMap
987-- | Switches to the new event whenever it receives one. Only the old event is
988-- considered the moment a new one is switched in; the output event will fire at
989-- that moment only if the old event does.
991-- Because the simultaneous firing case is irrelevant, this function imposes
992-- laxer "timing requirements" on the overall circuit, avoiding many potential
993-- cyclic dependency / metastability failures. It's also more performant. Use
994-- this rather than 'switchHoldPromptly' and 'switchHoldPromptOnly' unless you
995-- are absolutely sure you need to act on the new event in the coincidental
997switchHold :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
998switchHold ea0 eea = switch <$> hold ea0 eea
1000-- | Switches to the new event whenever it receives one. Whenever a new event is
1001-- provided, if it is firing, its value will be the resulting event's value; if
1002-- it is not firing, but the old one is, the old one's value will be used.
1004-- 'switchHold', by always forwarding the old event the moment it is switched
1005-- out, avoids many potential cyclic dependency problems / metastability
1006-- problems. It's also more performant. Use it instead unless you are sure you
1008switchHoldPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1009switchHoldPromptly ea0 eea = do
1011 let eLag = switch bea
1012 eCoincidences = coincidence eea
1013 return $ leftmost [eCoincidences, eLag]
1015-- | switches to a new event whenever it receives one. At the moment of
1016-- switching, the old event will be ignored if it fires, and the new one will be
1017-- used if it fires; this is the opposite of 'switch', which will use only the
1020-- 'switchHold', by always forwarding the old event the moment it is switched
1021-- out, avoids many potential cyclic dependency problems / metastability
1022-- problems. It's also more performant. Use it instead unless you are sure you
1024switchHoldPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1025switchHoldPromptOnly e0 e' = do
1026 eLag <- switch <$> hold e0 e'
1027 return $ coincidence $ leftmost [e', eLag <$ eLag]
1029-- | When the given outer event fires, condense the inner events into the contained patch. Non-firing inner events will be replaced with deletions.
1030coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)
1031coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ ffor e $ \(PatchMap m) -> mergeMap $ ffor m $ \case
1032 Nothing -> fmapCheap (const Nothing) e
1033 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
1035-- | See 'coincidencePatchMap'
1036coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)
1037coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ ffor e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case
1038 Nothing -> fmapCheap (const Nothing) e
1039 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
1041-- | See 'coincidencePatchMap'
1042coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)
1043coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ ffor e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
1044 PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->
1045 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1046 PatchMapWithMove.From_Move k -> fforCheap e $ \_ ->
1047 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }
1048 PatchMapWithMove.From_Insert ev -> leftmost
1049 [ fforCheap ev $ \v ->
1050 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }
1051 , fforCheap e $ \_ ->
1052 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1055-- | Given a 'PatchTarget' of events (e.g., a 'Map' with 'Event' values) and an event of 'Patch'es
1056-- (e.g., a 'PatchMap' with 'Event' values), produce an 'Event' of the 'PatchTarget' type that
1057-- fires with the patched value.
1058switchHoldPromptOnlyIncremental
1059 :: forall t m p pt w
1062 , Patch (p (Event t w))
1063 , PatchTarget (p (Event t w)) ~ pt (Event t w)
1065 , PatchTarget (p w) ~ pt w
1068 => (Incremental t (p (Event t w)) -> Event t (pt w))
1069 -> (Event t (p (Event t w)) -> Event t (p w))
1071 -> Event t (p (Event t w))
1072 -> m (Event t (pt w))
1073switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch e0 e' = do
1074 lag <- mergePatchIncremental <$> holdIncremental e0 e'
1075 pure $ ffor (align lag (coincidencePatch e')) $ \case
1077 That new -> new `applyAlways` mempty
1078 These old new -> new `applyAlways` old
1080instance Reflex t => Align (Event t) where
1082#if MIN_VERSION_these(0, 8, 0)
1083instance Reflex t => Semialign (Event t) where
1085 align = alignEventWithMaybe Just
1087#ifdef MIN_VERSION_semialign
1088#if MIN_VERSION_semialign(1,1,0)
1089instance Reflex t => Zip (Event t) where
1091 zip x y = mapMaybe justThese $ align x y
1095-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
1096-- the 'Behavior' is true at the time of occurrence.
1097gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
1098gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
1100-- | Create a new behavior given a starting behavior and switch to the behavior
1101-- carried by the event when it fires.
1102switcher :: (Reflex t, MonadHold t m)
1103 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
1104switcher b eb = pull . (sample <=< sample) <$> hold b eb
1106instance (Reflex t, IsString a) => IsString (Dynamic t a) where
1107 fromString = pure . fromString
1109-- | Combine two 'Dynamic's. The result will change whenever either (or both)
1110-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
1111zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
1112zipDyn = zipDynWith (,)
1114-- | Combine two 'Dynamic's with a combining function. The result will change
1115-- whenever either (or both) input 'Dynamic' changes.
1116-- More efficient than 'liftA2'.
1117zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
1119 let eab = align (updated da) (updated db)
1120 ec = flip push eab $ \o -> do
1123 b <- sample $ current db
1126 a <- sample $ current da
1128 These a b -> return (a, b)
1129 return $ Just $ f a b
1130 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
1132instance (Reflex t, Semigroup a) => Semigroup (Dynamic t a) where
1133 (<>) = zipDynWith (<>)
1134 stimes n = fmap $ stimes n
1136instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
1137 mconcat = distributeListOverDynWith mconcat
1138 mempty = constDyn mempty
1139 mappend = zipDynWith mappend
1141-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1142-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1143-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1144distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
1145distributeDMapOverDynPure = distributeDMapOverDynPureG coerceDynamic
1147-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1148-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1149-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1150distributeDMapOverDynPureG
1151 :: forall t k q v. (Reflex t, GCompare k)
1152 => (forall a. q a -> Dynamic t (v a))
1153 -> DMap k q -> Dynamic t (DMap k v)
1154distributeDMapOverDynPureG nt dm = case DMap.toList dm of
1155 [] -> constDyn DMap.empty
1156 [k :=> v] -> DMap.singleton k <$> nt v
1158 let getInitial = DMap.traverseWithKey (\_ -> sample . current . nt) dm
1159 edmPre = mergeG getCompose $ DMap.map (Compose . updated . nt) dm
1160 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
1161 olds <- sample $ current result
1162 return $ DMap.unionWithKey (\_ _ new -> new) olds news
1165-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
1166distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
1167distributeListOverDyn = distributeListOverDynWith id
1169-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
1170distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
1171distributeListOverDynWith f =
1172 fmap (f . map fromDSum . DMap.toAscList) .
1173 distributeDMapOverDynPure .
1174 DMap.fromDistinctAscList .
1175 zipWith toDSum [0..]
1177 toDSum :: Int -> Dynamic t a -> DSum (Const2 Int a) (Dynamic t)
1178 toDSum k v = Const2 k :=> v
1179 fromDSum :: DSum (Const2 Int a) Identity -> a
1180 fromDSum (Const2 _ :=> Identity v) = v
1182-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
1183-- unless the second supplied 'Event' occurs simultaneously.
1184difference :: Reflex t => Event t a -> Event t b -> Event t a
1185difference = alignEventWithMaybe $ \case
1189-- | Zips two values by taking the union of their shapes and combining with the provided function.
1190-- 'Nothing' values are dropped.
1191alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
1192alignEventWithMaybe f ea eb = mapMaybe (f <=< dmapToThese) $
1193 merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
1195-- | Produces an 'Event' that fires only when the input event fires with a 'DSum' key that
1196-- matches the provided key.
1198 :: forall t m k v a.
1205 -> Event t (DSum k v)
1206 -> m (Event t (v a))
1207filterEventKey k kv' = do
1208 let f :: DSum k v -> Maybe (v a)
1209 f (newK :=> newV) = case newK `geq` k of
1210 Just Refl -> Just newV
1212 takeWhileJustE f kv'
1214-- | "Factor" the input 'DSum' 'Event' to produce an 'Event' which
1215-- fires when the 'DSum' key changes and contains both the value of the
1216-- 'DSum' at switchover and an 'Event' of values produced by subsequent
1217-- firings of the input 'Event' that do not change the 'DSum' key.
1219 :: forall t m k v a.
1226 -> Event t (DSum k v)
1227 -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))
1228factorEvent k0 kv' = do
1229 key :: Behavior t (Some k) <- hold (Some k0) $ fmapCheap (\(k :=> _) -> Some k) kv'
1230 let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case
1231 Some oldKey -> case newKey `geq` oldKey of
1232 Just Refl -> return Nothing
1234 newInner <- filterEventKey newKey kv'
1235 return $ Just $ newKey :=> Pair newVal (Compose newInner)
1236 eInitial <- filterEventKey k0 kv'
1237 return (eInitial, update)
1239--------------------------------------------------------------------------------
1241--------------------------------------------------------------------------------
1243-- | An 'Accumulator' type can be built by accumulating occurrences of an
1245#if __GLASGOW_HASKELL__ < 802
1246{-# WARNING accum "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1247{-# WARNING accumM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1248{-# WARNING accumMaybe "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1249{-# WARNING accumMaybeM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1251class Reflex t => Accumulator t f | f -> t where
1252 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
1253 accum f = accumMaybe $ \v o -> Just $ f v o
1254 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
1255 accumM f = accumMaybeM $ \v o -> Just <$> f v o
1256 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
1257 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
1258 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
1259 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
1260 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
1261 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
1262 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
1263 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1264 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
1265 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1267-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1268-- with the provided function. See 'foldDyn'.
1270 :: (Reflex t, MonadHold t m, MonadFix m)
1275accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o
1277-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1278-- with the provided 'PushM' action.
1280 :: (Reflex t, MonadHold t m, MonadFix m)
1281 => (a -> b -> PushM t a)
1285accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o
1287-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1288-- with the provided function, discarding 'Nothing' results.
1290 :: (Reflex t, MonadHold t m, MonadFix m)
1291 => (a -> b -> Maybe a)
1295accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o
1297-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1298-- with the provided 'PushM' action, discarding 'Nothing' results.
1300 :: (Reflex t, MonadHold t m, MonadFix m)
1301 => (a -> b -> PushM t (Maybe a))
1305accumMaybeMDyn f z e = do
1306 rec let e' = flip push e $ \o -> do
1307 v <- sample $ current d'
1312-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1313-- with a function that both accumulates and produces a value to fire
1314-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1316 :: (Reflex t, MonadHold t m, MonadFix m)
1317 => (a -> b -> (a, c))
1320 -> m (Dynamic t a, Event t c)
1321mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o
1323-- | Similar to 'mapAccumDyn' except that the combining function is a
1326 :: (Reflex t, MonadHold t m, MonadFix m)
1327 => (a -> b -> PushM t (a, c))
1330 -> m (Dynamic t a, Event t c)
1331mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o
1333-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event' with
1334-- a function that both optionally accumulates and optionally produces
1335-- a value to fire as a separate output 'Event'.
1336-- Note that because 'Nothing's are discarded in both cases, the output
1337-- 'Event' may fire even though the output 'Dynamic' has not changed, and
1338-- the output 'Dynamic' may update even when the output 'Event' is not firing.
1340 :: (Reflex t, MonadHold t m, MonadFix m)
1341 => (a -> b -> (Maybe a, Maybe c))
1344 -> m (Dynamic t a, Event t c)
1345mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o
1347-- | Like 'mapAccumMaybeDyn' except that the combining function is a
1350 :: (Reflex t, MonadHold t m, MonadFix m)
1351 => (a -> b -> PushM t (Maybe a, Maybe c))
1354 -> m (Dynamic t a, Event t c)
1355mapAccumMaybeMDyn f z e = do
1356 rec let e' = flip push e $ \o -> do
1357 v <- sample $ current d'
1359 return $ case result of
1360 (Nothing, Nothing) -> Nothing
1362 d' <- holdDyn z $ mapMaybe fst e'
1363 return (d', mapMaybe snd e')
1365-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1366-- with the provided function.
1367{-# INLINE accumB #-}
1369 :: (Reflex t, MonadHold t m, MonadFix m)
1374accumB f = accumMaybeB $ \v o -> Just $ f v o
1376-- | Like 'accumB' except that the combining function is a 'PushM' action.
1377{-# INLINE accumMB #-}
1379 :: (Reflex t, MonadHold t m, MonadFix m)
1380 => (a -> b -> PushM t a)
1384accumMB f = accumMaybeMB $ \v o -> Just <$> f v o
1386-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1387-- with the provided function, discarding 'Nothing' results.
1388{-# INLINE accumMaybeB #-}
1390 :: (Reflex t, MonadHold t m, MonadFix m)
1391 => (a -> b -> Maybe a)
1395accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o
1397-- | Like 'accumMaybeB' except that the combining function is a 'PushM' action.
1398{-# INLINE accumMaybeMB #-}
1399accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)
1400accumMaybeMB f z e = do
1401 rec let e' = flip push e $ \o -> do
1407-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1408-- with a function that both accumulates and produces a value to fire
1409-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1410{-# INLINE mapAccumB #-}
1412 :: (Reflex t, MonadHold t m, MonadFix m)
1413 => (a -> b -> (a, c))
1416 -> m (Behavior t a, Event t c)
1417mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o
1419-- | Like 'mapAccumB' except that the combining function is a 'PushM' action.
1420{-# INLINE mapAccumMB #-}
1422 :: (Reflex t, MonadHold t m, MonadFix m)
1423 => (a -> b -> PushM t (a, c))
1426 -> m (Behavior t a, Event t c)
1427mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o
1429-- | Accumulate a 'Behavior' by folding occurrences of an 'Event' with
1430-- a function that both optionally accumulates and optionally produces
1431-- a value to fire as a separate output 'Event'. 'Nothing's are discarded.
1432{-# INLINE mapAccumMaybeB #-}
1434 :: (Reflex t, MonadHold t m, MonadFix m)
1435 => (a -> b -> (Maybe a, Maybe c))
1438 -> m (Behavior t a, Event t c)
1439mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o
1441-- | Like 'mapAccumMaybeB' except that the combining function is a 'PushM' action.
1442{-# INLINE mapAccumMaybeMB #-}
1443mapAccumMaybeMB :: (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)
1444mapAccumMaybeMB f z e = do
1445 rec let e' = flip push e $ \o -> do
1448 return $ case result of
1449 (Nothing, Nothing) -> Nothing
1451 d' <- hold z $ mapMaybe fst e'
1452 return (d', mapMaybe snd e')
1454-- | Accumulate occurrences of an 'Event', producing an output occurrence each
1455-- time. Discard the underlying 'Accumulator'.
1456{-# INLINE mapAccum_ #-}
1457mapAccum_ :: 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)
1459 (_, result) <- mapAccumB f z e
1462-- | Accumulate occurrences of an 'Event', possibly producing an output
1463-- occurrence each time. Discard the underlying 'Accumulator'.
1464{-# INLINE mapAccumMaybe_ #-}
1465mapAccumMaybe_ :: 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)
1466mapAccumMaybe_ f z e = do
1467 (_, result) <- mapAccumMaybeB f z e
1470-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
1471-- an output occurrence each time. Discard the underlying 'Accumulator'.
1472{-# INLINE mapAccumM_ #-}
1473mapAccumM_ :: 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)
1474mapAccumM_ f z e = do
1475 (_, result) <- mapAccumMB f z e
1478-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
1479-- producing an output occurrence each time. Discard the underlying
1481{-# INLINE mapAccumMaybeM_ #-}
1482mapAccumMaybeM_ :: 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)
1483mapAccumMaybeM_ f z e = do
1484 (_, result) <- mapAccumMaybeMB f z e
1487instance Reflex t => Accumulator t (Dynamic t) where
1488 accumMaybeM = accumMaybeMDyn
1489 mapAccumMaybeM = mapAccumMaybeMDyn
1491instance Reflex t => Accumulator t (Behavior t) where
1492 accumMaybeM = accumMaybeMB
1493 mapAccumMaybeM = mapAccumMaybeMB
1495instance Reflex t => Accumulator t (Event t) where
1496 accumMaybeM f z e = updated <$> accumMaybeM f z e
1497 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
1499-- | Create a new 'Event' by combining each occurrence with the next value of the
1500-- list using the supplied function. If the list runs out of items, all
1501-- subsequent 'Event' occurrences will be ignored.
1502zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
1503zipListWithEvent f l e = do
1504 let f' a b = case a of
1505 h:t -> (Just t, Just $ f h b)
1506 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
1507 mapAccumMaybe_ f' l e
1509-- | Assign a number to each occurrence of the given 'Event', starting from 0
1510{-# INLINE numberOccurrences #-}
1511numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
1512numberOccurrences = numberOccurrencesFrom 0
1514-- | Assign a number to each occurrence of the given 'Event'
1515{-# INLINE numberOccurrencesFrom #-}
1516numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
1517numberOccurrencesFrom = mapAccum_ (\n a -> let !next = n + 1 in (next, (n, a)))
1519-- | Assign a number to each occurrence of the given 'Event'; discard the occurrences' values
1520{-# INLINE numberOccurrencesFrom_ #-}
1521numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
1522numberOccurrencesFrom_ = mapAccum_ (\n _ -> let !next = n + 1 in (next, n))
1524-- | This is used to sample the value of a 'Behavior' using an 'Event'.
1526-- The '<@>' operator is intended to be used in conjunction with
1527-- the 'Applicative' instance for 'Behavior'.
1529-- This is useful when we want to combine the values of one 'Event' and
1530-- the value of several 'Behavior's at the time the 'Event' is firing.
1534-- > f :: a -> b -> c -> d
1535-- > b1 :: Behavior t a
1536-- > b2 :: Behavior t b
1541-- > f <$> b1 <*> b2 <@> e :: Event t d
1543-- in order to apply the function 'f' to the relevant values.
1545-- The alternative would be something like:
1547-- > attachWith (\(x1, x2) y -> f x1 x2 y) ((,) <$> b1 <*> b2) e :: Event t d
1549-- or a variation involing a custom data type to hold the combination of
1550-- 'Behavior's even when that combination might only ever be used by 'f'.
1552-- A more suggestive example might be:
1554-- > handleMouse <$> bPlayerState <*> bMousePosition <@> eMouseClick :: Event t (GameState -> GameState)
1556(<@>) :: Reflex t => Behavior t (a -> b) -> Event t a -> Event t b
1557(<@>) b = push $ \x -> do
1559 return . Just . f $ x
1562-- | An version of '<@>' that does not use the value of the 'Event'.
1564-- Alternatively, it is 'tag' in operator form.
1566-- This is useful when we want to combine the values of several
1567-- 'Behavior's at particular points in time using an 'Applicative'
1572-- > g :: a -> b -> d
1573-- > b1 :: Behavior t a
1574-- > b2 :: Behavior t b
1577-- where 'e' is firing at the points in time of interest.
1579-- Then we can use '<@':
1581-- > g <$> b1 <*> b2 <@ e :: Event t d
1583-- to combine the values of 'b1' and 'b2' at each of those points of time,
1584-- with the function 'g' being used to combine the values.
1586-- This is the same as '<@>' except that the 'Event' is being used only
1587-- to act as a trigger.
1588(<@) :: (Reflex t) => Behavior t b -> Event t a -> Event t b
1596-- | A "cheap" version of 'pushAlways'. See the performance note on 'pushCheap'.
1597{-# INLINE pushAlwaysCheap #-}
1598pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
1599pushAlwaysCheap f = pushCheap (fmap Just . f)
1601-- | A "cheap" version of 'mapMaybe'. See the performance note on 'pushCheap'.
1602{-# INLINE mapMaybeCheap #-}
1603mapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1604mapMaybeCheap f = pushCheap $ return . f
1606-- | An alias for 'mapMaybeCheap'
1607{-# INLINE fmapMaybeCheap #-}
1608fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1609fmapMaybeCheap = mapMaybeCheap
1612-- | A "cheap" version of 'fforMaybe'. See the performance note on 'pushCheap'.
1613{-# INLINE fforMaybeCheap #-}
1614fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
1615fforMaybeCheap = flip mapMaybeCheap
1617-- | A "cheap" version of 'ffor'. See the performance note on 'pushCheap'.
1618{-# INLINE fforCheap #-}
1619fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
1620fforCheap = flip fmapCheap
1622-- | A "cheap" version of 'fmap'. See the performance note on 'pushCheap'.
1623{-# INLINE fmapCheap #-}
1624fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
1625fmapCheap f = pushCheap $ return . Just . f
1627-- | A "cheap" version of 'tag'. See the performance note on 'pushCheap'.
1628{-# INLINE tagCheap #-}
1629tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
1630tagCheap b = pushAlwaysCheap $ \_ -> sample b
1632-- | Merge a collection of events; the resulting 'Event' will only occur if at
1633-- least one input event is occurring, and will contain all of the input keys
1634-- that are occurring simultaneously
1635merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)
1636merge = mergeG coerceEvent
1639-- | Create a merge whose parents can change over time
1640mergeIncremental :: (Reflex t, GCompare k)
1641 => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
1642mergeIncremental = mergeIncrementalG coerceEvent
1644-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
1645mergeIncrementalWithMove :: (Reflex t, GCompare k)
1646 => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
1647mergeIncrementalWithMove = mergeIncrementalWithMoveG coerceEvent
1649-- | A "cheap" version of 'mergeWithCheap'. See the performance note on 'pushCheap'.
1650{-# INLINE mergeWithCheap #-}
1651mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
1652mergeWithCheap = mergeWithCheap' id
1654-- | A "cheap" version of 'mergeWithCheap''. See the performance note on 'pushCheap'.
1655{-# INLINE mergeWithCheap' #-}
1656mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
1657mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
1659-- | A "cheap" version of 'mergeWithFoldCheap''. See the performance note on 'pushCheap'.
1660{-# INLINE mergeWithFoldCheap' #-}
1661mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
1662mergeWithFoldCheap' f es =
1663 fmapCheap (f . (\(h : t) -> h :| t) . IntMap.elems)
1665 . IntMap.fromDistinctAscList
1666 $ zip [0 :: Int ..] es
1668--------------------------------------------------------------------------------
1669-- Deprecated functions
1670--------------------------------------------------------------------------------
1672{-# 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'. " #-}
1673-- | See 'switchHoldPromptly'
1674switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1675switchPromptly = switchHoldPromptly
1676{-# 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'. " #-}
1677-- | See 'switchHoldPromptOnly'
1678switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1679switchPromptOnly = 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