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 (..), Unzip (..))
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)
423 -- | An event which only occurs at the current moment in time, such that:
425 -- > coincidence (pushAlways (\a -> (a <$) <$> now) e) = e
427 now :: m (Event t ())
428 default now :: (m ~ f m', MonadTrans f, MonadHold t m') => m (Event t ())
431-- | Accumulate an 'Incremental' with the supplied initial value and the firings of the provided 'Event',
432-- using the combining function to produce a patch.
434 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
435 => (PatchTarget p -> b -> p)
438 -> m (Incremental t p)
439accumIncremental f = accumMaybeIncremental $ \v o -> Just $ f v o
441-- | Similar to 'accumIncremental' but the combining function runs in 'PushM'
443 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
444 => (PatchTarget p -> b -> PushM t p)
447 -> m (Incremental t p)
448accumMIncremental f = accumMaybeMIncremental $ \v o -> Just <$> f v o
450-- | Similar to 'accumIncremental' but allows filtering of updates (by dropping updates when the
451-- combining function produces @Nothing@)
453 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
454 => (PatchTarget p -> b -> Maybe p)
457 -> m (Incremental t p)
458accumMaybeIncremental f = accumMaybeMIncremental $ \v o -> return $ f v o
460-- | Similar to 'accumMaybeMIncremental' but the combining function runs in 'PushM'
461accumMaybeMIncremental
462 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
463 => (PatchTarget p -> b -> PushM t (Maybe p))
466 -> m (Incremental t p)
467accumMaybeMIncremental f z e = do
468 rec let e' = flip push e $ \o -> do
469 v <- sample $ currentIncremental d'
471 d' <- holdIncremental z e'
474-- | Accumulate an 'Incremental' by folding occurrences of an 'Event'
475-- with a function that both accumulates and produces a value to fire
476-- as an 'Event'. Returns both the accumulated value and the constructed
479 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
480 => (PatchTarget p -> b -> (p, c))
483 -> m (Incremental t p, Event t c)
484mapAccumIncremental f = mapAccumMaybeIncremental $ \v o -> bimap Just Just $ f v o
486-- | Like 'mapAccumIncremental' but the combining function runs in 'PushM'
488 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
489 => (PatchTarget p -> b -> PushM t (p, c))
492 -> m (Incremental t p, Event t c)
493mapAccumMIncremental f = mapAccumMaybeMIncremental $ \v o -> bimap Just Just <$> f v o
495-- | Accumulate an 'Incremental' by folding occurrences of an 'Event' with
496-- a function that both optionally accumulates and optionally produces
497-- a value to fire as a separate output 'Event'.
498-- Note that because 'Nothing's are discarded in both cases, the output
499-- 'Event' may fire even though the output 'Incremental' has not changed, and
500-- the output 'Incremental' may update even when the output 'Event' is not firing.
501mapAccumMaybeIncremental
502 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
503 => (PatchTarget p -> b -> (Maybe p, Maybe c))
506 -> m (Incremental t p, Event t c)
507mapAccumMaybeIncremental f = mapAccumMaybeMIncremental $ \v o -> return $ f v o
509-- | Like 'mapAccumMaybeIncremental' but the combining function is a 'PushM' action
510mapAccumMaybeMIncremental
511 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
512 => (PatchTarget p -> b -> PushM t (Maybe p, Maybe c))
515 -> m (Incremental t p, Event t c)
516mapAccumMaybeMIncremental f z e = do
517 rec let e' = flip push e $ \o -> do
518 v <- sample $ currentIncremental d'
520 return $ case result of
521 (Nothing, Nothing) -> Nothing
523 d' <- holdIncremental z $ mapMaybe fst e'
524 return (d', mapMaybe snd e')
526-- | A somewhat slow implementation of 'headE'
527slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
529 rec be <- hold e $ fmapCheap (const never) e'
533-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
534-- key. This is much more efficient than filtering for each key with
536newtype EventSelector t k = EventSelector
537 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
538 -- determined by the type of the key, so this can be used to fan-out
539 -- 'Event's whose sub-'Event's have different types.
541 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
542 -- (but equivalent to) using 'mapMaybe' to select only the relevant
543 -- occurrences of an 'Event'.
544 select :: forall a. k a -> Event t a
547newtype EventSelectorG t k v = EventSelectorG
548 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
549 -- determined by the type of the key, so this can be used to fan-out
550 -- 'Event's whose sub-'Event's have different types.
552 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
553 -- (but equivalent to) using 'mapMaybe' to select only the relevant
554 -- occurrences of an 'Event'.
555 selectG :: forall a. k a -> Event t (v a)
558-- | Efficiently select an 'Event' keyed on 'Int'. This is more efficient than manually
560newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }
562--------------------------------------------------------------------------------
564--------------------------------------------------------------------------------
566instance MonadSample t m => MonadSample t (ReaderT r m) where
567 sample = lift . sample
569instance MonadHold t m => MonadHold t (ReaderT r m) where
570 hold a0 = lift . hold a0
571 holdDyn a0 = lift . holdDyn a0
572 holdIncremental a0 = lift . holdIncremental a0
573 buildDynamic a0 = lift . buildDynamic a0
577instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
578 sample = lift . sample
580instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
581 hold a0 = lift . hold a0
582 holdDyn a0 = lift . holdDyn a0
583 holdIncremental a0 = lift . holdIncremental a0
584 buildDynamic a0 = lift . buildDynamic a0
588instance MonadSample t m => MonadSample t (StateT s m) where
589 sample = lift . sample
591instance MonadHold t m => MonadHold t (StateT s m) where
592 hold a0 = lift . hold a0
593 holdDyn a0 = lift . holdDyn a0
594 holdIncremental a0 = lift . holdIncremental a0
595 buildDynamic a0 = lift . buildDynamic a0
599instance MonadSample t m => MonadSample t (ExceptT e m) where
600 sample = lift . sample
602instance MonadHold t m => MonadHold t (ExceptT e 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
610instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
611 sample = lift . sample
613instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
614 hold a0 = lift . hold a0
615 holdDyn a0 = lift . holdDyn a0
616 holdIncremental a0 = lift . holdIncremental a0
617 buildDynamic a0 = lift . buildDynamic a0
621instance MonadSample t m => MonadSample t (ContT r m) where
622 sample = lift . sample
624instance MonadHold t m => MonadHold t (ContT r m) where
625 hold a0 = lift . hold a0
626 holdDyn a0 = lift . holdDyn a0
627 holdIncremental a0 = lift . holdIncremental a0
628 buildDynamic a0 = lift . buildDynamic a0
632--------------------------------------------------------------------------------
633-- Convenience functions
634--------------------------------------------------------------------------------
636-- | Create an 'Event' from another 'Event'. The provided function can sample
637-- 'Behavior's and hold 'Event's.
638pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
639pushAlways f = push (fmap Just . f)
641-- | Flipped version of 'fmap'.
642ffor :: Functor f => f a -> (a -> b) -> f b
645-- | Rotated version of 'liftA2'.
646ffor2 :: Applicative f => f a -> f b -> (a -> b -> c) -> f c
647ffor2 a b f = liftA2 f a b
649-- | Rotated version of 'liftA3'.
650ffor3 :: Applicative f => f a -> f b -> f c -> (a -> b -> c -> d) -> f d
651ffor3 a b c f = liftA3 f a b c
653instance Reflex t => Applicative (Behavior t) where
655 f <*> x = pull $ sample f `ap` sample x
659instance Reflex t => Apply (Behavior t) where
662instance Reflex t => Bind (Behavior t) where
665instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
667 fromRational = pure . fromRational
670instance Reflex t => Functor (Behavior t) where
671 fmap f = pull . fmap f . sample
673instance (Reflex t, IsString a) => IsString (Behavior t a) where
674 fromString = pure . fromString
676instance Reflex t => Monad (Behavior t) where
677 a >>= f = pull $ sample a >>= sample . f
678 -- 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.
680#if !MIN_VERSION_base(4,13,0)
681 fail = error "Monad (Behavior t) does not support fail"
684instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
685 mempty = constant mempty
686 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
687 mconcat = pull . fmap mconcat . mapM sample
689instance (Reflex t, Num a) => Num (Behavior t a) where
694 fromInteger = pure . fromInteger
698instance (Num a, Reflex t) => Num (Dynamic t a) where
703 fromInteger = pure . fromInteger
707instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
708 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
709 sconcat = pull . fmap sconcat . mapM sample
710 stimes n = fmap $ stimes n
712-- | Alias for 'mapMaybe'
713fmapMaybe :: Filterable f => (a -> Maybe b) -> f a -> f b
716-- | Flipped version of 'mapMaybe'.
717fforMaybe :: Filterable f => f a -> (a -> Maybe b) -> f b
718fforMaybe = flip mapMaybe
720-- | Filter 'f a' using the provided predicate.
721ffilter :: Filterable f => (a -> Bool) -> f a -> f a
724-- | Filter 'Left's from 'f (Either a b)' into 'a'.
725filterLeft :: Filterable f => f (Either a b) -> f a
726filterLeft = mapMaybe (either Just (const Nothing))
728-- | Filter 'Right's from 'f (Either a b)' into 'b'.
729filterRight :: Filterable f => f (Either a b) -> f b
730filterRight = mapMaybe (either (const Nothing) Just)
732-- | Left-biased event union (prefers left event on simultaneous
734instance Reflex t => Alt (Event t) where
735 ev1 <!> ev2 = leftmost [ev1, ev2]
737-- | 'Event' intersection. Only occurs when both events are co-incident.
738instance Reflex t => Apply (Event t) where
739 evf <.> evx = mapMaybe f (align evf evx) where
740 f (These g a) = Just (g a)
744-- | 'Event' intersection (convenient interface to 'coincidence').
745instance Reflex t => Bind (Event t) where
746 evx >>- f = coincidence (f <$> evx)
749instance Reflex t => Functor (Event t) where
751 fmap f = mapMaybe $ Just . f
753 x <$ e = fmapCheap (const x) e
755-- TODO Remove this instance
756instance Reflex t => FunctorMaybe (Event t) where
757 {-# INLINE fmapMaybe #-}
760instance Reflex t => Filterable (Event t) where
761 {-# INLINE mapMaybe #-}
762 mapMaybe f = push $ return . f
764-- | Never: @'zero' = 'never'@.
765instance Reflex t => Plus (Event t) where
768-- | Replace each occurrence value of the 'Event' with the value of the
769-- 'Behavior' at the time of that occurrence.
770tag :: Reflex t => Behavior t b -> Event t a -> Event t b
771tag b = pushAlways $ \_ -> sample b
773-- | Replace each occurrence value of the 'Event' with the value of the
774-- 'Behavior' at that time; if it is 'Just', fire with the contained value; if
775-- it is 'Nothing', drop the occurrence.
776tagMaybe :: Reflex t => Behavior t (Maybe b) -> Event t a -> Event t b
777tagMaybe b = push $ \_ -> sample b
779-- | Create a new 'Event' that combines occurrences of supplied 'Event' with the
780-- current value of the 'Behavior'.
781attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
782attach = attachWith (,)
784-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
785-- combining it with the current value of the 'Behavior'.
786attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
787attachWith f = attachWithMaybe $ \a b -> Just $ f a b
789-- | Create a new 'Event' by combining each occurrence with the current value of
790-- the 'Behavior'. The occurrence is discarded if the combining function returns
792attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
793attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
795-- | Create a new 'Event' that occurs on all but the first occurrence of the
797tailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a)
798tailE e = snd <$> headTailE e
800-- | Create a tuple of two 'Event's with the first one occurring only the first
801-- time the supplied 'Event' occurs and the second occurring on all but the first
803headTailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a, Event t a)
806 be <- hold never $ fmap (const e) eHead
807 return (eHead, switch be)
809-- | Take the streak of occurrences starting at the current time for which the
810-- event returns 'True'.
812-- Starting at the current time, fire all the occurrences of the 'Event' for
813-- which the given predicate returns 'True'. When first 'False' is returned,
814-- do not fire, and permanently stop firing, even if 'True' values would have
815-- been encountered later.
818 . (Reflex t, MonadFix m, MonadHold t m)
822takeWhileE f = takeWhileJustE $ \v -> guard (f v) $> v
824-- | Take the streak of occurrences starting at the current time for which the
825-- event returns 'Just b'.
827-- Starting at the current time, fire all the occurrences of the 'Event' for
828-- which the given predicate returns 'Just b'. When first 'Nothing' is returned,
829-- do not fire, and permanently stop firing, even if 'Just b' values would have
830-- been encountered later.
833 . (Reflex t, MonadFix m, MonadHold t m)
837takeWhileJustE f e = do
838 rec let (eBad, eTrue) = fanEither $ ffor e' $ \a -> case f a of
839 Nothing -> Left never
841 eFirstBad <- headE eBad
842 e' <- switchHold e eFirstBad
845-- | Drop the streak of occurrences starting at the current time for which the
846-- event returns 'True'.
848-- Starting at the current time, do not fire all the occurrences of the 'Event'
849-- for which the given predicate returns 'True'. When 'False' is first
850-- returned, do fire, and permanently continue firing, even if 'True' values
851-- would have been encountered later.
854 . (Reflex t, MonadFix m, MonadHold t m)
858dropWhileE f e = snd <$> takeDropWhileJustE (\v -> guard (f v) $> v) e
860-- | Both take and drop the streak of occurrences starting at the current time
861-- for which the event returns 'Just b'.
863-- For the left event, starting at the current time, fire all the occurrences
864-- of the 'Event' for which the given function returns 'Just b'. When
865-- 'Nothing' is returned, do not fire, and permanently stop firing, even if
866-- 'Just b' values would have been encountered later.
868-- For the right event, do not fire until the first occurrence where the given
869-- function returns 'Nothing', and fire that one and all subsequent
870-- occurrences. Even if the function would have again returned 'Just b', keep
874 . (Reflex t, MonadFix m, MonadHold t m)
877 -> m (Event t b, Event t a)
878takeDropWhileJustE f e = do
879 rec let (eBad, eGood) = fanEither $ ffor e' $ \a -> case f a of
882 eFirstBad <- headE eBad
883 e' <- switchHold e (never <$ eFirstBad)
884 eRest <- switchHoldPromptOnly never (e <$ eFirstBad)
885 return (eGood, eRest)
887-- | Split the supplied 'Event' into two individual 'Event's occurring at the
888-- same time with the respective values from the tuple.
889splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
890splitE e = (fmap fst e, fmap snd e)
892-- | Print the supplied 'String' and the value of the 'Event' on each
893-- occurrence. This should /only/ be used for debugging.
895-- Note: As with Debug.Trace.trace, the message will only be printed if the
896-- 'Event' is actually used.
897traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
898traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
900-- | Print the output of the supplied function on each occurrence of the
901-- 'Event'. This should /only/ be used for debugging.
903-- Note: As with Debug.Trace.trace, the message will only be printed if the
904-- 'Event' is actually used.
905traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
906traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
908instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
909 (<>) = alignWith (mergeThese (<>))
910 sconcat = fmap sconcat . mergeList . toList
911 stimes n = fmap $ stimes n
913instance (Semigroup a, Reflex t) => Monoid (Event t a) where
916 mconcat = fmap sconcat . mergeList
918-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
919-- list occurs. If multiple occur at the same time they are folded from the left
920-- with the given function.
921{-# INLINE mergeWith #-}
922mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
923mergeWith = mergeWith' id
925{-# INLINE mergeWith' #-}
926mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
927mergeWith' f g es = fmap (Prelude.foldl1 g . fmap f)
929 . IntMap.fromDistinctAscList
930 $ zip [0 :: Int ..] es
932-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
933-- list occurs. If multiple occur at the same time the value is the value of the
935{-# INLINE leftmost #-}
936leftmost :: Reflex t => [Event t a] -> Event t a
937leftmost = mergeWith const
939-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
940-- list occurs and has a list of the values of all 'Event's occurring at that
942mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
944mergeList es = mergeWithFoldCheap' id es
947 :: (Reflex t, Patch p, Patch p')
948 => (PatchTarget p -> PatchTarget p')
952unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
954-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
955-- occurs if at least one of them occurs and has a map of values of all 'Event's
956-- occurring at that time.
957mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
958mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
960-- | Like 'mergeMap' but for 'IntMap'.
961mergeIntMap :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
962mergeIntMap = fmap dmapToIntMap . merge . intMapWithFunctorToDMap
964-- | Create a merge whose parents can change over time
965mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
966mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
968-- | Create a merge whose parents can change over time
969mergeIntMapIncremental :: Reflex t => Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
970mergeIntMapIncremental = fmap dmapToIntMap . mergeIncremental . unsafeMapIncremental intMapWithFunctorToDMap (const2IntPatchDMapWith id)
972-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
973mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
974mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
976-- | Split the event into separate events for 'Left' and 'Right' values.
977fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
979 let justLeft = either Just (const Nothing)
980 justRight = either (const Nothing) Just
981 in (mapMaybe justLeft e, mapMaybe justRight e)
983-- | Split the event into separate events for 'This' and 'That' values,
984-- allowing them to fire simultaneously when the input value is 'These'.
985fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
987 let this (This x) = Just x
988 this (These x _) = Just x
990 that (That y) = Just y
991 that (These _ y) = Just y
993 in (mapMaybe this e, mapMaybe that e)
995-- | Split the event into an 'EventSelector' that allows efficient selection of
996-- the individual 'Event's.
997fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
998fanMap = fan . fmap mapToDMap
1000-- | Switches to the new event whenever it receives one. Only the old event is
1001-- considered the moment a new one is switched in; the output event will fire at
1002-- that moment only if the old event does.
1004-- Because the simultaneous firing case is irrelevant, this function imposes
1005-- laxer "timing requirements" on the overall circuit, avoiding many potential
1006-- cyclic dependency / metastability failures. It's also more performant. Use
1007-- this rather than 'switchHoldPromptly' and 'switchHoldPromptOnly' unless you
1008-- are absolutely sure you need to act on the new event in the coincidental
1010switchHold :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1011switchHold ea0 eea = switch <$> hold ea0 eea
1013-- | Switches to the new event whenever it receives one. Whenever a new event is
1014-- provided, if it is firing, its value will be the resulting event's value; if
1015-- it is not firing, but the old one is, the old one's value will be used.
1017-- 'switchHold', by always forwarding the old event the moment it is switched
1018-- out, avoids many potential cyclic dependency problems / metastability
1019-- problems. It's also more performant. Use it instead unless you are sure you
1021switchHoldPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1022switchHoldPromptly ea0 eea = do
1024 let eLag = switch bea
1025 eCoincidences = coincidence eea
1026 return $ leftmost [eCoincidences, eLag]
1028-- | switches to a new event whenever it receives one. At the moment of
1029-- switching, the old event will be ignored if it fires, and the new one will be
1030-- used if it fires; this is the opposite of 'switch', which will use only the
1033-- 'switchHold', by always forwarding the old event the moment it is switched
1034-- out, avoids many potential cyclic dependency problems / metastability
1035-- problems. It's also more performant. Use it instead unless you are sure you
1037switchHoldPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1038switchHoldPromptOnly e0 e' = do
1039 eLag <- switch <$> hold e0 e'
1040 return $ coincidence $ leftmost [e', eLag <$ eLag]
1042-- | When the given outer event fires, condense the inner events into the contained patch. Non-firing inner events will be replaced with deletions.
1043coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)
1044coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ ffor e $ \(PatchMap m) -> mergeMap $ ffor m $ \case
1045 Nothing -> fmapCheap (const Nothing) e
1046 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
1048-- | See 'coincidencePatchMap'
1049coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)
1050coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ ffor e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case
1051 Nothing -> fmapCheap (const Nothing) e
1052 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
1054-- | See 'coincidencePatchMap'
1055coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)
1056coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ ffor e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
1057 PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->
1058 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1059 PatchMapWithMove.From_Move k -> fforCheap e $ \_ ->
1060 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }
1061 PatchMapWithMove.From_Insert ev -> leftmost
1062 [ fforCheap ev $ \v ->
1063 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }
1064 , fforCheap e $ \_ ->
1065 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1068-- | Given a 'PatchTarget' of events (e.g., a 'Map' with 'Event' values) and an event of 'Patch'es
1069-- (e.g., a 'PatchMap' with 'Event' values), produce an 'Event' of the 'PatchTarget' type that
1070-- fires with the patched value.
1071switchHoldPromptOnlyIncremental
1072 :: forall t m p pt w
1075 , Patch (p (Event t w))
1076 , PatchTarget (p (Event t w)) ~ pt (Event t w)
1078 , PatchTarget (p w) ~ pt w
1081 => (Incremental t (p (Event t w)) -> Event t (pt w))
1082 -> (Event t (p (Event t w)) -> Event t (p w))
1084 -> Event t (p (Event t w))
1085 -> m (Event t (pt w))
1086switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch e0 e' = do
1087 lag <- mergePatchIncremental <$> holdIncremental e0 e'
1088 pure $ ffor (align lag (coincidencePatch e')) $ \case
1090 That new -> new `applyAlways` mempty
1091 These old new -> new `applyAlways` old
1093instance Reflex t => Align (Event t) where
1095#if MIN_VERSION_these(0, 8, 0)
1096instance Reflex t => Semialign (Event t) where
1098 align = alignEventWithMaybe Just
1100#ifdef MIN_VERSION_semialign
1101#if MIN_VERSION_semialign(1,1,0)
1102instance Reflex t => Zip (Event t) where
1104 zip x y = mapMaybe justThese $ align x y
1107#ifdef MIN_VERSION_semialign
1108#if MIN_VERSION_semialign(1,1,0)
1109instance Reflex t => Unzip (Event t) where
1114-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
1115-- the 'Behavior' is true at the time of occurrence.
1116gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
1117gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
1119-- | Create a new behavior given a starting behavior and switch to the behavior
1120-- carried by the event when it fires.
1121switcher :: (Reflex t, MonadHold t m)
1122 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
1123switcher b eb = pull . (sample <=< sample) <$> hold b eb
1125instance (Reflex t, IsString a) => IsString (Dynamic t a) where
1126 fromString = pure . fromString
1128-- | Combine two 'Dynamic's. The result will change whenever either (or both)
1129-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
1130zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
1131zipDyn = zipDynWith (,)
1133-- | Combine two 'Dynamic's with a combining function. The result will change
1134-- whenever either (or both) input 'Dynamic' changes.
1135-- More efficient than 'liftA2'.
1136zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
1138 let eab = align (updated da) (updated db)
1139 ec = flip push eab $ \o -> do
1142 b <- sample $ current db
1145 a <- sample $ current da
1147 These a b -> return (a, b)
1148 return $ Just $ f a b
1149 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
1151instance (Reflex t, Semigroup a) => Semigroup (Dynamic t a) where
1152 (<>) = zipDynWith (<>)
1153 stimes n = fmap $ stimes n
1155instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
1156 mconcat = distributeListOverDynWith mconcat
1157 mempty = constDyn mempty
1158 mappend = zipDynWith mappend
1160-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1161-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1162-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1163distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
1164distributeDMapOverDynPure = distributeDMapOverDynPureG coerceDynamic
1166-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1167-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1168-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1169distributeDMapOverDynPureG
1170 :: forall t k q v. (Reflex t, GCompare k)
1171 => (forall a. q a -> Dynamic t (v a))
1172 -> DMap k q -> Dynamic t (DMap k v)
1173distributeDMapOverDynPureG nt dm = case DMap.toList dm of
1174 [] -> constDyn DMap.empty
1175 [k :=> v] -> DMap.singleton k <$> nt v
1177 let getInitial = DMap.traverseWithKey (\_ -> sample . current . nt) dm
1178 edmPre = mergeG getCompose $ DMap.map (Compose . updated . nt) dm
1179 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
1180 olds <- sample $ current result
1181 return $ DMap.unionWithKey (\_ _ new -> new) olds news
1184-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
1185distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
1186distributeListOverDyn = distributeListOverDynWith id
1188-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
1189distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
1190distributeListOverDynWith f =
1191 fmap (f . map fromDSum . DMap.toAscList) .
1192 distributeDMapOverDynPure .
1193 DMap.fromDistinctAscList .
1194 zipWith toDSum [0..]
1196 toDSum :: Int -> Dynamic t a -> DSum (Const2 Int a) (Dynamic t)
1197 toDSum k v = Const2 k :=> v
1198 fromDSum :: DSum (Const2 Int a) Identity -> a
1199 fromDSum (Const2 _ :=> Identity v) = v
1201-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
1202-- unless the second supplied 'Event' occurs simultaneously.
1203difference :: Reflex t => Event t a -> Event t b -> Event t a
1204difference = alignEventWithMaybe $ \case
1208-- | Zips two values by taking the union of their shapes and combining with the provided function.
1209-- 'Nothing' values are dropped.
1210alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
1211alignEventWithMaybe f ea eb = mapMaybe (f <=< dmapToThese) $
1212 merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
1214-- | Produces an 'Event' that fires only when the input event fires with a 'DSum' key that
1215-- matches the provided key.
1217 :: forall t m k v a.
1224 -> Event t (DSum k v)
1225 -> m (Event t (v a))
1226filterEventKey k kv' = do
1227 let f :: DSum k v -> Maybe (v a)
1228 f (newK :=> newV) = case newK `geq` k of
1229 Just Refl -> Just newV
1231 takeWhileJustE f kv'
1233-- | "Factor" the input 'DSum' 'Event' to produce an 'Event' which
1234-- fires when the 'DSum' key changes and contains both the value of the
1235-- 'DSum' at switchover and an 'Event' of values produced by subsequent
1236-- firings of the input 'Event' that do not change the 'DSum' key.
1238 :: forall t m k v a.
1245 -> Event t (DSum k v)
1246 -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))
1247factorEvent k0 kv' = do
1248 key :: Behavior t (Some k) <- hold (Some k0) $ fmapCheap (\(k :=> _) -> Some k) kv'
1249 let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case
1250 Some oldKey -> case newKey `geq` oldKey of
1251 Just Refl -> return Nothing
1253 newInner <- filterEventKey newKey kv'
1254 return $ Just $ newKey :=> Pair newVal (Compose newInner)
1255 eInitial <- filterEventKey k0 kv'
1256 return (eInitial, update)
1258--------------------------------------------------------------------------------
1260--------------------------------------------------------------------------------
1262-- | An 'Accumulator' type can be built by accumulating occurrences of an
1264#if __GLASGOW_HASKELL__ < 802
1265{-# WARNING accum "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1266{-# WARNING accumM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1267{-# WARNING accumMaybe "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1268{-# WARNING accumMaybeM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1270class Reflex t => Accumulator t f | f -> t where
1271 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
1272 accum f = accumMaybe $ \v o -> Just $ f v o
1273 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
1274 accumM f = accumMaybeM $ \v o -> Just <$> f v o
1275 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
1276 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
1277 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
1278 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
1279 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
1280 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
1281 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
1282 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1283 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
1284 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1286-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1287-- with the provided function. See 'foldDyn'.
1289 :: (Reflex t, MonadHold t m, MonadFix m)
1294accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o
1296-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1297-- with the provided 'PushM' action.
1299 :: (Reflex t, MonadHold t m, MonadFix m)
1300 => (a -> b -> PushM t a)
1304accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o
1306-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1307-- with the provided function, discarding 'Nothing' results.
1309 :: (Reflex t, MonadHold t m, MonadFix m)
1310 => (a -> b -> Maybe a)
1314accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o
1316-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1317-- with the provided 'PushM' action, discarding 'Nothing' results.
1319 :: (Reflex t, MonadHold t m, MonadFix m)
1320 => (a -> b -> PushM t (Maybe a))
1324accumMaybeMDyn f z e = do
1325 rec let e' = flip push e $ \o -> do
1326 v <- sample $ current d'
1331-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1332-- with a function that both accumulates and produces a value to fire
1333-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1335 :: (Reflex t, MonadHold t m, MonadFix m)
1336 => (a -> b -> (a, c))
1339 -> m (Dynamic t a, Event t c)
1340mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o
1342-- | Similar to 'mapAccumDyn' except that the combining function is a
1345 :: (Reflex t, MonadHold t m, MonadFix m)
1346 => (a -> b -> PushM t (a, c))
1349 -> m (Dynamic t a, Event t c)
1350mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o
1352-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event' with
1353-- a function that both optionally accumulates and optionally produces
1354-- a value to fire as a separate output 'Event'.
1355-- Note that because 'Nothing's are discarded in both cases, the output
1356-- 'Event' may fire even though the output 'Dynamic' has not changed, and
1357-- the output 'Dynamic' may update even when the output 'Event' is not firing.
1359 :: (Reflex t, MonadHold t m, MonadFix m)
1360 => (a -> b -> (Maybe a, Maybe c))
1363 -> m (Dynamic t a, Event t c)
1364mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o
1366-- | Like 'mapAccumMaybeDyn' except that the combining function is a
1369 :: (Reflex t, MonadHold t m, MonadFix m)
1370 => (a -> b -> PushM t (Maybe a, Maybe c))
1373 -> m (Dynamic t a, Event t c)
1374mapAccumMaybeMDyn f z e = do
1375 rec let e' = flip push e $ \o -> do
1376 v <- sample $ current d'
1378 return $ case result of
1379 (Nothing, Nothing) -> Nothing
1381 d' <- holdDyn z $ mapMaybe fst e'
1382 return (d', mapMaybe snd e')
1384-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1385-- with the provided function.
1386{-# INLINE accumB #-}
1388 :: (Reflex t, MonadHold t m, MonadFix m)
1393accumB f = accumMaybeB $ \v o -> Just $ f v o
1395-- | Like 'accumB' except that the combining function is a 'PushM' action.
1396{-# INLINE accumMB #-}
1398 :: (Reflex t, MonadHold t m, MonadFix m)
1399 => (a -> b -> PushM t a)
1403accumMB f = accumMaybeMB $ \v o -> Just <$> f v o
1405-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1406-- with the provided function, discarding 'Nothing' results.
1407{-# INLINE accumMaybeB #-}
1409 :: (Reflex t, MonadHold t m, MonadFix m)
1410 => (a -> b -> Maybe a)
1414accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o
1416-- | Like 'accumMaybeB' except that the combining function is a 'PushM' action.
1417{-# INLINE accumMaybeMB #-}
1418accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)
1419accumMaybeMB f z e = do
1420 rec let e' = flip push e $ \o -> do
1426-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1427-- with a function that both accumulates and produces a value to fire
1428-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1429{-# INLINE mapAccumB #-}
1431 :: (Reflex t, MonadHold t m, MonadFix m)
1432 => (a -> b -> (a, c))
1435 -> m (Behavior t a, Event t c)
1436mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o
1438-- | Like 'mapAccumB' except that the combining function is a 'PushM' action.
1439{-# INLINE mapAccumMB #-}
1441 :: (Reflex t, MonadHold t m, MonadFix m)
1442 => (a -> b -> PushM t (a, c))
1445 -> m (Behavior t a, Event t c)
1446mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o
1448-- | Accumulate a 'Behavior' by folding occurrences of an 'Event' with
1449-- a function that both optionally accumulates and optionally produces
1450-- a value to fire as a separate output 'Event'. 'Nothing's are discarded.
1451{-# INLINE mapAccumMaybeB #-}
1453 :: (Reflex t, MonadHold t m, MonadFix m)
1454 => (a -> b -> (Maybe a, Maybe c))
1457 -> m (Behavior t a, Event t c)
1458mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o
1460-- | Like 'mapAccumMaybeB' except that the combining function is a 'PushM' action.
1461{-# INLINE mapAccumMaybeMB #-}
1462mapAccumMaybeMB :: (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)
1463mapAccumMaybeMB f z e = do
1464 rec let e' = flip push e $ \o -> do
1467 return $ case result of
1468 (Nothing, Nothing) -> Nothing
1470 d' <- hold z $ mapMaybe fst e'
1471 return (d', mapMaybe snd e')
1473-- | Accumulate occurrences of an 'Event', producing an output occurrence each
1474-- time. Discard the underlying 'Accumulator'.
1475{-# INLINE mapAccum_ #-}
1476mapAccum_ :: 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)
1478 (_, result) <- mapAccumB f z e
1481-- | Accumulate occurrences of an 'Event', possibly producing an output
1482-- occurrence each time. Discard the underlying 'Accumulator'.
1483{-# INLINE mapAccumMaybe_ #-}
1484mapAccumMaybe_ :: 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)
1485mapAccumMaybe_ f z e = do
1486 (_, result) <- mapAccumMaybeB f z e
1489-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
1490-- an output occurrence each time. Discard the underlying 'Accumulator'.
1491{-# INLINE mapAccumM_ #-}
1492mapAccumM_ :: 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)
1493mapAccumM_ f z e = do
1494 (_, result) <- mapAccumMB f z e
1497-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
1498-- producing an output occurrence each time. Discard the underlying
1500{-# INLINE mapAccumMaybeM_ #-}
1501mapAccumMaybeM_ :: 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)
1502mapAccumMaybeM_ f z e = do
1503 (_, result) <- mapAccumMaybeMB f z e
1506instance Reflex t => Accumulator t (Dynamic t) where
1507 accumMaybeM = accumMaybeMDyn
1508 mapAccumMaybeM = mapAccumMaybeMDyn
1510instance Reflex t => Accumulator t (Behavior t) where
1511 accumMaybeM = accumMaybeMB
1512 mapAccumMaybeM = mapAccumMaybeMB
1514instance Reflex t => Accumulator t (Event t) where
1515 accumMaybeM f z e = updated <$> accumMaybeM f z e
1516 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
1518-- | Create a new 'Event' by combining each occurrence with the next value of the
1519-- list using the supplied function. If the list runs out of items, all
1520-- subsequent 'Event' occurrences will be ignored.
1521zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
1522zipListWithEvent f l e = do
1523 let f' a b = case a of
1524 h:t -> (Just t, Just $ f h b)
1525 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
1526 mapAccumMaybe_ f' l e
1528-- | Assign a number to each occurrence of the given 'Event', starting from 0
1529{-# INLINE numberOccurrences #-}
1530numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
1531numberOccurrences = numberOccurrencesFrom 0
1533-- | Assign a number to each occurrence of the given 'Event'
1534{-# INLINE numberOccurrencesFrom #-}
1535numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
1536numberOccurrencesFrom = mapAccum_ (\n a -> let !next = n + 1 in (next, (n, a)))
1538-- | Assign a number to each occurrence of the given 'Event'; discard the occurrences' values
1539{-# INLINE numberOccurrencesFrom_ #-}
1540numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
1541numberOccurrencesFrom_ = mapAccum_ (\n _ -> let !next = n + 1 in (next, n))
1543-- | This is used to sample the value of a 'Behavior' using an 'Event'.
1545-- The '<@>' operator is intended to be used in conjunction with
1546-- the 'Applicative' instance for 'Behavior'.
1548-- This is useful when we want to combine the values of one 'Event' and
1549-- the value of several 'Behavior's at the time the 'Event' is firing.
1553-- > f :: a -> b -> c -> d
1554-- > b1 :: Behavior t a
1555-- > b2 :: Behavior t b
1560-- > f <$> b1 <*> b2 <@> e :: Event t d
1562-- in order to apply the function 'f' to the relevant values.
1564-- The alternative would be something like:
1566-- > attachWith (\(x1, x2) y -> f x1 x2 y) ((,) <$> b1 <*> b2) e :: Event t d
1568-- or a variation involing a custom data type to hold the combination of
1569-- 'Behavior's even when that combination might only ever be used by 'f'.
1571-- A more suggestive example might be:
1573-- > handleMouse <$> bPlayerState <*> bMousePosition <@> eMouseClick :: Event t (GameState -> GameState)
1575(<@>) :: Reflex t => Behavior t (a -> b) -> Event t a -> Event t b
1576(<@>) b = push $ \x -> do
1578 return . Just . f $ x
1581-- | An version of '<@>' that does not use the value of the 'Event'.
1583-- Alternatively, it is 'tag' in operator form.
1585-- This is useful when we want to combine the values of several
1586-- 'Behavior's at particular points in time using an 'Applicative'
1591-- > g :: a -> b -> d
1592-- > b1 :: Behavior t a
1593-- > b2 :: Behavior t b
1596-- where 'e' is firing at the points in time of interest.
1598-- Then we can use '<@':
1600-- > g <$> b1 <*> b2 <@ e :: Event t d
1602-- to combine the values of 'b1' and 'b2' at each of those points of time,
1603-- with the function 'g' being used to combine the values.
1605-- This is the same as '<@>' except that the 'Event' is being used only
1606-- to act as a trigger.
1607(<@) :: (Reflex t) => Behavior t b -> Event t a -> Event t b
1615-- | A "cheap" version of 'pushAlways'. See the performance note on 'pushCheap'.
1616{-# INLINE pushAlwaysCheap #-}
1617pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
1618pushAlwaysCheap f = pushCheap (fmap Just . f)
1620-- | A "cheap" version of 'mapMaybe'. See the performance note on 'pushCheap'.
1621{-# INLINE mapMaybeCheap #-}
1622mapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1623mapMaybeCheap f = pushCheap $ return . f
1625-- | An alias for 'mapMaybeCheap'
1626{-# INLINE fmapMaybeCheap #-}
1627fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1628fmapMaybeCheap = mapMaybeCheap
1631-- | A "cheap" version of 'fforMaybe'. See the performance note on 'pushCheap'.
1632{-# INLINE fforMaybeCheap #-}
1633fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
1634fforMaybeCheap = flip mapMaybeCheap
1636-- | A "cheap" version of 'ffor'. See the performance note on 'pushCheap'.
1637{-# INLINE fforCheap #-}
1638fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
1639fforCheap = flip fmapCheap
1641-- | A "cheap" version of 'fmap'. See the performance note on 'pushCheap'.
1642{-# INLINE fmapCheap #-}
1643fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
1644fmapCheap f = pushCheap $ return . Just . f
1646-- | A "cheap" version of 'tag'. See the performance note on 'pushCheap'.
1647{-# INLINE tagCheap #-}
1648tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
1649tagCheap b = pushAlwaysCheap $ \_ -> sample b
1651-- | Merge a collection of events; the resulting 'Event' will only occur if at
1652-- least one input event is occurring, and will contain all of the input keys
1653-- that are occurring simultaneously
1654merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)
1655merge = mergeG coerceEvent
1658-- | Create a merge whose parents can change over time
1659mergeIncremental :: (Reflex t, GCompare k)
1660 => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
1661mergeIncremental = mergeIncrementalG coerceEvent
1663-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
1664mergeIncrementalWithMove :: (Reflex t, GCompare k)
1665 => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
1666mergeIncrementalWithMove = mergeIncrementalWithMoveG coerceEvent
1668-- | A "cheap" version of 'mergeWithCheap'. See the performance note on 'pushCheap'.
1669{-# INLINE mergeWithCheap #-}
1670mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
1671mergeWithCheap = mergeWithCheap' id
1673-- | A "cheap" version of 'mergeWithCheap''. See the performance note on 'pushCheap'.
1674{-# INLINE mergeWithCheap' #-}
1675mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
1676mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
1678-- | A "cheap" version of 'mergeWithFoldCheap''. See the performance note on 'pushCheap'.
1679{-# INLINE mergeWithFoldCheap' #-}
1680mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
1681mergeWithFoldCheap' f es =
1682 fmapCheap (f . (\(h : t) -> h :| t) . IntMap.elems)
1684 . IntMap.fromDistinctAscList
1685 $ zip [0 :: Int ..] es
1687--------------------------------------------------------------------------------
1688-- Deprecated functions
1689--------------------------------------------------------------------------------
1691{-# 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'. " #-}
1692-- | See 'switchHoldPromptly'
1693switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1694switchPromptly = switchHoldPromptly
1695{-# 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'. " #-}
1696-- | See 'switchHoldPromptOnly'
1697switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1698switchPromptOnly = 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