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
41 -- ** 'fan' related types
44 , EventSelectorInt (..)
45 -- * Convenience functions
48 -- ** Combining 'Event's
52 , mergeIncrementalWithMove
56 , mergeMapIncrementalWithMove
57 , mergeIntMapIncremental
59 , coincidencePatchMapWithMove
60 , coincidencePatchIntMap
65 -- ** Breaking up 'Event's
77 -- ** Collapsing 'Event . Event'
80 , switchHoldPromptOnly
81 , switchHoldPromptOnlyIncremental
82 -- ** Using 'Event's to sample 'Behavior's
88 -- ** Blocking an 'Event' based on a 'Behavior'
90 -- ** Combining 'Dynamic's
91 , distributeDMapOverDynPure
92 , distributeDMapOverDynPureG
93 , distributeListOverDyn
94 , distributeListOverDynWith
97 -- ** Accumulating state
121 , accumMaybeIncremental
122 , accumMaybeMIncremental
123 , mapAccumIncremental
124 , mapAccumMIncremental
125 , mapAccumMaybeIncremental
126 , mapAccumMaybeMIncremental
129 , numberOccurrencesFrom
130 , numberOccurrencesFrom_
140 -- * Debugging functions
143 -- * Unsafe functions
145 , unsafeMapIncremental
146 -- * 'Filterable' convenience functions
147 , FunctorMaybe -- fmapMaybe is purposely not exported from deprecated 'FunctorMaybe' and the new alias is exported instead
148 , mapMaybe -- Re-exported for convenience
154 -- * Miscellaneous convenience functions
158 -- * Deprecated functions
161 -- * "Cheap" functions
171 -- * Slow, but general, implementations
175#if defined(MIN_VERSION_semialign)
176import Prelude hiding (zip, zipWith)
178#if MIN_VERSION_these(0,8,0)
179import Data.These.Combinators (justThese)
183import Control.Applicative
184import Control.Monad.Identity
185import Control.Monad.Reader
186import Control.Monad.State.Strict
187import Control.Monad.Trans.Cont (ContT)
188import Control.Monad.Trans.Except (ExceptT)
189import Control.Monad.Trans.RWS (RWST)
190import Control.Monad.Trans.Writer (WriterT)
195import Data.Dependent.Map (DMap, DSum (..))
196import qualified Data.Dependent.Map as DMap
197import Data.Functor.Compose
198import Data.Functor.Product
199import Data.GADT.Compare (GEq (..), GCompare (..), (:~:) (..))
200import Data.FastMutableIntMap (PatchIntMap)
202import Data.Functor.Bind
203import Data.Functor.Misc
204import Data.Functor.Plus
205import Data.IntMap.Strict (IntMap)
206import qualified Data.IntMap.Strict as IntMap
207import Data.List.NonEmpty (NonEmpty (..))
209import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
210import Data.Some (Some(Some))
213import Data.Type.Coercion
214import Data.Witherable (Filterable(..))
215import qualified Data.Witherable as W
216import Reflex.FunctorMaybe (FunctorMaybe)
217import qualified Reflex.FunctorMaybe
219import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
221import Debug.Trace (trace)
223-- | The 'Reflex' class contains all the primitive functionality needed for
224-- Functional Reactive Programming (FRP). The @/t/@ type parameter indicates
225-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
226-- and the type of the timeline determines the FRP engine to be used. For most
227-- purposes, the 'Reflex.Spider' implementation is recommended.
228class ( MonadHold t (PushM t)
229 , MonadSample t (PullM t)
231 , Functor (Dynamic t)
232 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
235 -- | A container for a value that can change over time. 'Behavior's can be
236 -- sampled at will, but it is not possible to be notified when they change
237 data Behavior t :: * -> *
238 -- | A stream of occurrences. During any given frame, an 'Event' is either
239 -- occurring or not occurring; if it is occurring, it will contain a value of
240 -- the given type (its "occurrence type")
241 data Event t :: * -> *
242 -- | A container for a value that can change over time and allows
243 -- notifications on changes. Basically a combination of a 'Behavior' and an
244 -- 'Event', with a rule that the 'Behavior' will change if and only if the
246 data Dynamic t :: * -> *
247 -- | An 'Incremental' is a more general form of a 'Dynamic'.
248 -- Instead of always fully replacing the value, only parts of it can be patched.
249 -- This is only needed for performance critical code via `mergeIncremental` to make small
250 -- changes to large values.
251 data Incremental t :: * -> *
252 -- | A monad for doing complex push-based calculations efficiently
253 type PushM t :: * -> *
254 -- | A monad for doing complex pull-based calculations efficiently
255 type PullM t :: * -> *
256 -- | An 'Event' with no occurrences
258 -- | Create a 'Behavior' that always has the given value
259 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
260 -- | Create an 'Event' from another 'Event'; the provided function can sample
261 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
262 -- (Just) or non-occurring (Nothing) result
263 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
264 -- | 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.
265 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
266 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
267 -- recomputed whenever any of the read 'Behavior's changes
268 pull :: PullM t a -> Behavior t a
269 -- | Merge a collection of events; the resulting 'Event' will only occur if at
270 -- least one input event is occurring, and will contain all of the input keys
271 -- that are occurring simultaneously
273 --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
274 mergeG :: GCompare k => (forall a. q a -> Event t (v a))
275 -> DMap k q -> Event t (DMap k v)
277 -- | Efficiently fan-out an event to many destinations. You should save the
278 -- result in a @let@-binding, and then repeatedly 'selectG' on the result to
279 -- create child events
280 fanG :: GCompare k => Event t (DMap k v) -> EventSelectorG t k v
282 -- | Create an 'Event' that will occur whenever the currently-selected input
284 switch :: Behavior t (Event t a) -> Event t a
285 -- | Create an 'Event' that will occur whenever the input event is occurring -- and its occurrence value, another 'Event', is also occurring
286 coincidence :: Event t (Event t a) -> Event t a
287 -- | Extract the 'Behavior' of a 'Dynamic'.
288 current :: Dynamic t a -> Behavior t a
289 -- | Extract the 'Event' of the 'Dynamic'.
290 updated :: Dynamic t a -> Event t a
291 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
292 -- recent firing of the given 'Event', if any.
293 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
294 -- | Create a new 'Incremental'. The given "PullM"'s value must always change
295 -- in the same way that the accumulated application of patches would change
297 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
298 -- | Create a merge whose parents can change over time
299 mergeIncrementalG :: GCompare k
300 => (forall a. q a -> Event t (v a))
301 -> Incremental t (PatchDMap k q)
302 -> Event t (DMap k v)
303 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
304 mergeIncrementalWithMoveG :: GCompare k
305 => (forall a. q a -> Event t (v a))
306 -> Incremental t (PatchDMapWithMove k q) -> Event t (DMap k v)
307 -- | Extract the 'Behavior' component of an 'Incremental'
308 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
309 -- | Extract the 'Event' component of an 'Incremental'
310 updatedIncremental :: Patch p => Incremental t p -> Event t p
311 -- | Convert an 'Incremental' to a 'Dynamic'
312 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
313 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
315 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
316 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
318 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
319 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
321 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
322 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
323 fanInt :: Event t (IntMap a) -> EventSelectorInt t a
325-- | Efficiently fan-out an event to many destinations. You should save the
326-- result in a @let@-binding, and then repeatedly 'select' on the result to
327-- create child events
328fan :: forall t k. (Reflex t, GCompare k)
329 => Event t (DMap k Identity) -> EventSelector t k
330 --TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it
331fan e = EventSelector (fixup (selectG (fanG e) :: k a -> Event t (Identity a)) :: forall a. k a -> Event t a)
333 fixup :: forall a. (k a -> Event t (Identity a)) -> k a -> Event t a
334 fixup = case eventCoercion Coercion :: Coercion (Event t (Identity a)) (Event t a) of
337--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on
338-- | Constructs a single 'Event' out of a map of events. The output event may fire with multiple
339-- keys simultaneously.
340mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
341mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never
343-- | Coerce a 'Behavior' between representationally-equivalent value types
344coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
345coerceBehavior = coerceWith $ behaviorCoercion Coercion
347-- | Coerce an 'Event' between representationally-equivalent occurrence types
348coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
349coerceEvent = coerceWith $ eventCoercion Coercion
351-- | Coerce a 'Dynamic' between representationally-equivalent value types
352coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
353coerceDynamic = coerceWith $ dynamicCoercion Coercion
355-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
356-- __must__ change when and only when the 'Event' fires, such that the
357-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
358-- if this is not the case, the resulting 'Dynamic' will behave
359-- nondeterministically.
360unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
361unsafeDynamic = unsafeBuildDynamic . sample
363-- | Construct a 'Dynamic' value that never changes
364constDyn :: Reflex t => a -> Dynamic t a
367instance (Reflex t, Default a) => Default (Dynamic t a) where
370-- | 'MonadSample' designates monads that can read the current value of a
371-- 'Behavior'. This includes both 'PullM' and 'PushM'.
372class (Applicative m, Monad m) => MonadSample t m | m -> t where
373 -- | Get the current value in the 'Behavior'
374 sample :: Behavior t a -> m a
376-- | 'MonadHold' designates monads that can create new 'Behavior's based on
377-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
378-- is required to create any stateful computations with Reflex.
379class MonadSample t m => MonadHold t m where
380 -- | Create a new 'Behavior' whose value will initially be equal to the given
381 -- value and will be updated whenever the given 'Event' occurs. The update
382 -- takes effect immediately after the 'Event' occurs; if the occurrence that
383 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
384 -- the 'Behavior', it will see the __old__ value of the 'Behavior', not the new
386 hold :: a -> Event t a -> m (Behavior t a)
387 default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)
388 hold v0 = lift . hold v0
389 -- | Create a 'Dynamic' value using the given initial value that changes every
390 -- time the 'Event' occurs.
391 holdDyn :: a -> Event t a -> m (Dynamic t a)
392 default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)
393 holdDyn v0 = lift . holdDyn v0
394 -- | Create an 'Incremental' value using the given initial value that changes
395 -- every time the 'Event' occurs.
396 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
397 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
398 holdIncremental v0 = lift . holdIncremental v0
399 buildDynamic :: PushM t a -> Event t a -> m (Dynamic t a)
401 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
402 buildDynamic getV0 = lift . buildDynamic getV0
404 -- | Create a new 'Event' that only occurs only once, on the first occurrence of
405 -- the supplied 'Event'.
406 headE :: Event t a -> m (Event t a)
408-- | Accumulate an 'Incremental' with the supplied initial value and the firings of the provided 'Event',
409-- using the combining function to produce a patch.
411 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
412 => (PatchTarget p -> b -> p)
415 -> m (Incremental t p)
416accumIncremental f = accumMaybeIncremental $ \v o -> Just $ f v o
418-- | Similar to 'accumIncremental' but the combining function runs in 'PushM'
420 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
421 => (PatchTarget p -> b -> PushM t p)
424 -> m (Incremental t p)
425accumMIncremental f = accumMaybeMIncremental $ \v o -> Just <$> f v o
427-- | Similar to 'accumIncremental' but allows filtering of updates (by dropping updates when the
428-- combining function produces @Nothing@)
430 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
431 => (PatchTarget p -> b -> Maybe p)
434 -> m (Incremental t p)
435accumMaybeIncremental f = accumMaybeMIncremental $ \v o -> return $ f v o
437-- | Similar to 'accumMaybeMIncremental' but the combining function runs in 'PushM'
438accumMaybeMIncremental
439 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
440 => (PatchTarget p -> b -> PushM t (Maybe p))
443 -> m (Incremental t p)
444accumMaybeMIncremental f z e = do
445 rec let e' = flip push e $ \o -> do
446 v <- sample $ currentIncremental d'
448 d' <- holdIncremental z e'
451-- | Accumulate an 'Incremental' by folding occurrences of an 'Event'
452-- with a function that both accumulates and produces a value to fire
453-- as an 'Event'. Returns both the accumulated value and the constructed
456 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
457 => (PatchTarget p -> b -> (p, c))
460 -> m (Incremental t p, Event t c)
461mapAccumIncremental f = mapAccumMaybeIncremental $ \v o -> bimap Just Just $ f v o
463-- | Like 'mapAccumIncremental' but the combining function runs in 'PushM'
465 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
466 => (PatchTarget p -> b -> PushM t (p, c))
469 -> m (Incremental t p, Event t c)
470mapAccumMIncremental f = mapAccumMaybeMIncremental $ \v o -> bimap Just Just <$> f v o
472-- | Accumulate an 'Incremental' by folding occurrences of an 'Event' with
473-- a function that both optionally accumulates and optionally produces
474-- a value to fire as a separate output 'Event'.
475-- Note that because 'Nothing's are discarded in both cases, the output
476-- 'Event' may fire even though the output 'Incremental' has not changed, and
477-- the output 'Incremental' may update even when the output 'Event' is not firing.
478mapAccumMaybeIncremental
479 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
480 => (PatchTarget p -> b -> (Maybe p, Maybe c))
483 -> m (Incremental t p, Event t c)
484mapAccumMaybeIncremental f = mapAccumMaybeMIncremental $ \v o -> return $ f v o
486-- | Like 'mapAccumMaybeIncremental' but the combining function is a 'PushM' action
487mapAccumMaybeMIncremental
488 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
489 => (PatchTarget p -> b -> PushM t (Maybe p, Maybe c))
492 -> m (Incremental t p, Event t c)
493mapAccumMaybeMIncremental f z e = do
494 rec let e' = flip push e $ \o -> do
495 v <- sample $ currentIncremental d'
497 return $ case result of
498 (Nothing, Nothing) -> Nothing
500 d' <- holdIncremental z $ mapMaybe fst e'
501 return (d', mapMaybe snd e')
503-- | A somewhat slow implementation of 'headE'
504slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
506 rec be <- hold e $ fmapCheap (const never) e'
510-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
511-- key. This is much more efficient than filtering for each key with
513newtype EventSelector t k = EventSelector
514 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
515 -- determined by the type of the key, so this can be used to fan-out
516 -- 'Event's whose sub-'Event's have different types.
518 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
519 -- (but equivalent to) using 'mapMaybe' to select only the relevant
520 -- occurrences of an 'Event'.
521 select :: forall a. k a -> Event t a
524newtype EventSelectorG t k v = EventSelectorG
525 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
526 -- determined by the type of the key, so this can be used to fan-out
527 -- 'Event's whose sub-'Event's have different types.
529 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
530 -- (but equivalent to) using 'mapMaybe' to select only the relevant
531 -- occurrences of an 'Event'.
532 selectG :: forall a. k a -> Event t (v a)
535-- | Efficiently select an 'Event' keyed on 'Int'. This is more efficient than manually
537newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }
539--------------------------------------------------------------------------------
541--------------------------------------------------------------------------------
543instance MonadSample t m => MonadSample t (ReaderT r m) where
544 sample = lift . sample
546instance MonadHold t m => MonadHold t (ReaderT r m) where
547 hold a0 = lift . hold a0
548 holdDyn a0 = lift . holdDyn a0
549 holdIncremental a0 = lift . holdIncremental a0
550 buildDynamic a0 = lift . buildDynamic a0
553instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
554 sample = lift . sample
556instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
557 hold a0 = lift . hold a0
558 holdDyn a0 = lift . holdDyn a0
559 holdIncremental a0 = lift . holdIncremental a0
560 buildDynamic a0 = lift . buildDynamic a0
563instance MonadSample t m => MonadSample t (StateT s m) where
564 sample = lift . sample
566instance MonadHold t m => MonadHold t (StateT s m) where
567 hold a0 = lift . hold a0
568 holdDyn a0 = lift . holdDyn a0
569 holdIncremental a0 = lift . holdIncremental a0
570 buildDynamic a0 = lift . buildDynamic a0
573instance MonadSample t m => MonadSample t (ExceptT e m) where
574 sample = lift . sample
576instance MonadHold t m => MonadHold t (ExceptT e m) where
577 hold a0 = lift . hold a0
578 holdDyn a0 = lift . holdDyn a0
579 holdIncremental a0 = lift . holdIncremental a0
580 buildDynamic a0 = lift . buildDynamic a0
583instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
584 sample = lift . sample
586instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
587 hold a0 = lift . hold a0
588 holdDyn a0 = lift . holdDyn a0
589 holdIncremental a0 = lift . holdIncremental a0
590 buildDynamic a0 = lift . buildDynamic a0
593instance MonadSample t m => MonadSample t (ContT r m) where
594 sample = lift . sample
596instance MonadHold t m => MonadHold t (ContT r m) where
597 hold a0 = lift . hold a0
598 holdDyn a0 = lift . holdDyn a0
599 holdIncremental a0 = lift . holdIncremental a0
600 buildDynamic a0 = lift . buildDynamic a0
603--------------------------------------------------------------------------------
604-- Convenience functions
605--------------------------------------------------------------------------------
607-- | Create an 'Event' from another 'Event'. The provided function can sample
608-- 'Behavior's and hold 'Event's.
609pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
610pushAlways f = push (fmap Just . f)
612-- | Flipped version of 'fmap'.
613ffor :: Functor f => f a -> (a -> b) -> f b
616-- | Rotated version of 'liftA2'.
617ffor2 :: Applicative f => f a -> f b -> (a -> b -> c) -> f c
618ffor2 a b f = liftA2 f a b
620-- | Rotated version of 'liftA3'.
621ffor3 :: Applicative f => f a -> f b -> f c -> (a -> b -> c -> d) -> f d
622ffor3 a b c f = liftA3 f a b c
624instance Reflex t => Applicative (Behavior t) where
626 f <*> x = pull $ sample f `ap` sample x
630instance Reflex t => Apply (Behavior t) where
633instance Reflex t => Bind (Behavior t) where
636instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
638 fromRational = pure . fromRational
641instance Reflex t => Functor (Behavior t) where
642 fmap f = pull . fmap f . sample
644instance (Reflex t, IsString a) => IsString (Behavior t a) where
645 fromString = pure . fromString
647instance Reflex t => Monad (Behavior t) where
648 a >>= f = pull $ sample a >>= sample . f
649 -- 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.
651 fail = error "Monad (Behavior t) does not support fail"
653instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
654 mempty = constant mempty
655 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
656 mconcat = pull . fmap mconcat . mapM sample
658instance (Reflex t, Num a) => Num (Behavior t a) where
663 fromInteger = pure . fromInteger
667instance (Num a, Reflex t) => Num (Dynamic t a) where
672 fromInteger = pure . fromInteger
676instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
677 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
678 sconcat = pull . fmap sconcat . mapM sample
679 stimes n = fmap $ stimes n
681-- | Alias for 'mapMaybe'
682fmapMaybe :: Filterable f => (a -> Maybe b) -> f a -> f b
685-- | Flipped version of 'mapMaybe'.
686fforMaybe :: Filterable f => f a -> (a -> Maybe b) -> f b
687fforMaybe = flip mapMaybe
689-- | Filter 'f a' using the provided predicate.
690ffilter :: Filterable f => (a -> Bool) -> f a -> f a
693-- | Filter 'Left's from 'f (Either a b)' into 'a'.
694filterLeft :: Filterable f => f (Either a b) -> f a
695filterLeft = mapMaybe (either Just (const Nothing))
697-- | Filter 'Right's from 'f (Either a b)' into 'b'.
698filterRight :: Filterable f => f (Either a b) -> f b
699filterRight = mapMaybe (either (const Nothing) Just)
701-- | Left-biased event union (prefers left event on simultaneous
703instance Reflex t => Alt (Event t) where
704 ev1 <!> ev2 = leftmost [ev1, ev2]
706-- | 'Event' intersection (convenient interface to 'coincidence').
707instance Reflex t => Apply (Event t) where
708 evf <.> evx = coincidence (fmap (<$> evx) evf)
710-- | 'Event' intersection (convenient interface to 'coincidence').
711instance Reflex t => Bind (Event t) where
712 evx >>- f = coincidence (f <$> evx)
715instance Reflex t => Functor (Event t) where
717 fmap f = mapMaybe $ Just . f
719 x <$ e = fmapCheap (const x) e
721-- TODO Remove this instance
722instance Reflex t => FunctorMaybe (Event t) where
723 {-# INLINE fmapMaybe #-}
726instance Reflex t => Filterable (Event t) where
727 {-# INLINE mapMaybe #-}
728 mapMaybe f = push $ return . f
730-- | Never: @'zero' = 'never'@.
731instance Reflex t => Plus (Event t) where
734-- | Replace each occurrence value of the 'Event' with the value of the
735-- 'Behavior' at the time of that occurrence.
736tag :: Reflex t => Behavior t b -> Event t a -> Event t b
737tag b = pushAlways $ \_ -> sample b
739-- | Replace each occurrence value of the 'Event' with the value of the
740-- 'Behavior' at that time; if it is 'Just', fire with the contained value; if
741-- it is 'Nothing', drop the occurrence.
742tagMaybe :: Reflex t => Behavior t (Maybe b) -> Event t a -> Event t b
743tagMaybe b = push $ \_ -> sample b
745-- | Create a new 'Event' that combines occurrences of supplied 'Event' with the
746-- current value of the 'Behavior'.
747attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
748attach = attachWith (,)
750-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
751-- combining it with the current value of the 'Behavior'.
752attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
753attachWith f = attachWithMaybe $ \a b -> Just $ f a b
755-- | Create a new 'Event' by combining each occurrence with the current value of
756-- the 'Behavior'. The occurrence is discarded if the combining function returns
758attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
759attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
761-- | Create a new 'Event' that occurs on all but the first occurrence of the
763tailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a)
764tailE e = snd <$> headTailE e
766-- | Create a tuple of two 'Event's with the first one occurring only the first
767-- time the supplied 'Event' occurs and the second occurring on all but the first
769headTailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a, Event t a)
772 be <- hold never $ fmap (const e) eHead
773 return (eHead, switch be)
775-- | Take the streak of occurrences starting at the current time for which the
776-- event returns 'True'.
778-- Starting at the current time, fire all the occurrences of the 'Event' for
779-- which the given predicate returns 'True'. When first 'False' is returned,
780-- do not fire, and permanently stop firing, even if 'True' values would have
781-- been encountered later.
784 . (Reflex t, MonadFix m, MonadHold t m)
788takeWhileE f = takeWhileJustE $ \v -> guard (f v) $> v
790-- | Take the streak of occurrences starting at the current time for which the
791-- event returns 'Just b'.
793-- Starting at the current time, fire all the occurrences of the 'Event' for
794-- which the given predicate returns 'Just b'. When first 'Nothing' is returned,
795-- do not fire, and permanently stop firing, even if 'Just b' values would have
796-- been encountered later.
799 . (Reflex t, MonadFix m, MonadHold t m)
803takeWhileJustE f e = do
804 rec let (eBad, eTrue) = fanEither $ ffor e' $ \a -> case f a of
805 Nothing -> Left never
807 eFirstBad <- headE eBad
808 e' <- switchHold e eFirstBad
811-- | Drop the streak of occurrences starting at the current time for which the
812-- event returns 'True'.
814-- Starting at the current time, do not fire all the occurrences of the 'Event'
815-- for which the given predicate returns 'True'. When 'False' is first
816-- returned, do fire, and permanently continue firing, even if 'True' values
817-- would have been encountered later.
820 . (Reflex t, MonadFix m, MonadHold t m)
824dropWhileE f e = snd <$> takeDropWhileJustE (\v -> guard (f v) $> v) e
826-- | Both take and drop the streak of occurrences starting at the current time
827-- for which the event returns 'Just b'.
829-- For the left event, starting at the current time, fire all the occurrences
830-- of the 'Event' for which the given function returns 'Just b'. When
831-- 'Nothing' is returned, do not fire, and permanently stop firing, even if
832-- 'Just b' values would have been encountered later.
834-- For the right event, do not fire until the first occurrence where the given
835-- function returns 'Nothing', and fire that one and all subsequent
836-- occurrences. Even if the function would have again returned 'Just b', keep
840 . (Reflex t, MonadFix m, MonadHold t m)
843 -> m (Event t b, Event t a)
844takeDropWhileJustE f e = do
845 rec let (eBad, eGood) = fanEither $ ffor e' $ \a -> case f a of
848 eFirstBad <- headE eBad
849 e' <- switchHold e (never <$ eFirstBad)
850 eRest <- switchHoldPromptOnly never (e <$ eFirstBad)
851 return (eGood, eRest)
853-- | Split the supplied 'Event' into two individual 'Event's occurring at the
854-- same time with the respective values from the tuple.
855splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
856splitE e = (fmap fst e, fmap snd e)
858-- | Print the supplied 'String' and the value of the 'Event' on each
859-- occurrence. This should /only/ be used for debugging.
861-- Note: As with Debug.Trace.trace, the message will only be printed if the
862-- 'Event' is actually used.
863traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
864traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
866-- | Print the output of the supplied function on each occurrence of the
867-- 'Event'. This should /only/ be used for debugging.
869-- Note: As with Debug.Trace.trace, the message will only be printed if the
870-- 'Event' is actually used.
871traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
872traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
874instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
875 (<>) = alignWith (mergeThese (<>))
876 sconcat = fmap sconcat . mergeList . toList
877 stimes n = fmap $ stimes n
879instance (Semigroup a, Reflex t) => Monoid (Event t a) where
882 mconcat = fmap sconcat . mergeList
884-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
885-- list occurs. If multiple occur at the same time they are folded from the left
886-- with the given function.
887{-# INLINE mergeWith #-}
888mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
889mergeWith = mergeWith' id
891{-# INLINE mergeWith' #-}
892mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
893mergeWith' f g es = fmap (Prelude.foldl1 g . fmap f)
895 . IntMap.fromDistinctAscList
896 $ zip [0 :: Int ..] es
898-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
899-- list occurs. If multiple occur at the same time the value is the value of the
901{-# INLINE leftmost #-}
902leftmost :: Reflex t => [Event t a] -> Event t a
903leftmost = mergeWith const
905-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
906-- list occurs and has a list of the values of all 'Event's occurring at that
908mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
910mergeList es = mergeWithFoldCheap' id es
913 :: (Reflex t, Patch p, Patch p')
914 => (PatchTarget p -> PatchTarget p')
918unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
920-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
921-- occurs if at least one of them occurs and has a map of values of all 'Event's
922-- occurring at that time.
923mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
924mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
926-- | Like 'mergeMap' but for 'IntMap'.
927mergeIntMap :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
928mergeIntMap = fmap dmapToIntMap . merge . intMapWithFunctorToDMap
930-- | Create a merge whose parents can change over time
931mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
932mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
934-- | Create a merge whose parents can change over time
935mergeIntMapIncremental :: Reflex t => Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
936mergeIntMapIncremental = fmap dmapToIntMap . mergeIncremental . unsafeMapIncremental intMapWithFunctorToDMap (const2IntPatchDMapWith id)
938-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
939mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
940mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
942-- | Split the event into separate events for 'Left' and 'Right' values.
943fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
945 let justLeft = either Just (const Nothing)
946 justRight = either (const Nothing) Just
947 in (mapMaybe justLeft e, mapMaybe justRight e)
949-- | Split the event into separate events for 'This' and 'That' values,
950-- allowing them to fire simultaneously when the input value is 'These'.
951fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
953 let this (This x) = Just x
954 this (These x _) = Just x
956 that (That y) = Just y
957 that (These _ y) = Just y
959 in (mapMaybe this e, mapMaybe that e)
961-- | Split the event into an 'EventSelector' that allows efficient selection of
962-- the individual 'Event's.
963fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
964fanMap = fan . fmap mapToDMap
966-- | Switches to the new event whenever it receives one. Only the old event is
967-- considered the moment a new one is switched in; the output event will fire at
968-- that moment only if the old event does.
970-- Because the simultaneous firing case is irrelevant, this function imposes
971-- laxer "timing requirements" on the overall circuit, avoiding many potential
972-- cyclic dependency / metastability failures. It's also more performant. Use
973-- this rather than 'switchHoldPromptly' and 'switchHoldPromptOnly' unless you
974-- are absolutely sure you need to act on the new event in the coincidental
976switchHold :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
977switchHold ea0 eea = switch <$> hold ea0 eea
979-- | Switches to the new event whenever it receives one. Whenever a new event is
980-- provided, if it is firing, its value will be the resulting event's value; if
981-- it is not firing, but the old one is, the old one's value will be used.
983-- 'switchHold', by always forwarding the old event the moment it is switched
984-- out, avoids many potential cyclic dependency problems / metastability
985-- problems. It's also more performant. Use it instead unless you are sure you
987switchHoldPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
988switchHoldPromptly ea0 eea = do
990 let eLag = switch bea
991 eCoincidences = coincidence eea
992 return $ leftmost [eCoincidences, eLag]
994-- | switches to a new event whenever it receives one. At the moment of
995-- switching, the old event will be ignored if it fires, and the new one will be
996-- used if it fires; this is the opposite of 'switch', which will use only the
999-- 'switchHold', by always forwarding the old event the moment it is switched
1000-- out, avoids many potential cyclic dependency problems / metastability
1001-- problems. It's also more performant. Use it instead unless you are sure you
1003switchHoldPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1004switchHoldPromptOnly e0 e' = do
1005 eLag <- switch <$> hold e0 e'
1006 return $ coincidence $ leftmost [e', eLag <$ eLag]
1008-- | When the given outer event fires, condense the inner events into the contained patch. Non-firing inner events will be replaced with deletions.
1009coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)
1010coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ ffor e $ \(PatchMap m) -> mergeMap $ ffor m $ \case
1011 Nothing -> fmapCheap (const Nothing) e
1012 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
1014-- | See 'coincidencePatchMap'
1015coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)
1016coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ ffor e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case
1017 Nothing -> fmapCheap (const Nothing) e
1018 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
1020-- | See 'coincidencePatchMap'
1021coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)
1022coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ ffor e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
1023 PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->
1024 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1025 PatchMapWithMove.From_Move k -> fforCheap e $ \_ ->
1026 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }
1027 PatchMapWithMove.From_Insert ev -> leftmost
1028 [ fforCheap ev $ \v ->
1029 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }
1030 , fforCheap e $ \_ ->
1031 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1034-- | Given a 'PatchTarget' of events (e.g., a 'Map' with 'Event' values) and an event of 'Patch'es
1035-- (e.g., a 'PatchMap' with 'Event' values), produce an 'Event' of the 'PatchTarget' type that
1036-- fires with the patched value.
1037switchHoldPromptOnlyIncremental
1038 :: forall t m p pt w
1041 , Patch (p (Event t w))
1042 , PatchTarget (p (Event t w)) ~ pt (Event t w)
1044 , PatchTarget (p w) ~ pt w
1047 => (Incremental t (p (Event t w)) -> Event t (pt w))
1048 -> (Event t (p (Event t w)) -> Event t (p w))
1050 -> Event t (p (Event t w))
1051 -> m (Event t (pt w))
1052switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch e0 e' = do
1053 lag <- mergePatchIncremental <$> holdIncremental e0 e'
1054 pure $ ffor (align lag (coincidencePatch e')) $ \case
1056 That new -> new `applyAlways` mempty
1057 These old new -> new `applyAlways` old
1059instance Reflex t => Align (Event t) where
1061#if MIN_VERSION_these(0, 8, 0)
1062instance Reflex t => Semialign (Event t) where
1064 align = alignEventWithMaybe Just
1066#if defined(MIN_VERSION_semialign)
1067 zip x y = mapMaybe justThese $ align x y
1071-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
1072-- the 'Behavior' is true at the time of occurrence.
1073gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
1074gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
1076-- | Create a new behavior given a starting behavior and switch to the behavior
1077-- carried by the event when it fires.
1078switcher :: (Reflex t, MonadHold t m)
1079 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
1080switcher b eb = pull . (sample <=< sample) <$> hold b eb
1082instance (Reflex t, IsString a) => IsString (Dynamic t a) where
1083 fromString = pure . fromString
1085-- | Combine two 'Dynamic's. The result will change whenever either (or both)
1086-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
1087zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
1088zipDyn = zipDynWith (,)
1090-- | Combine two 'Dynamic's with a combining function. The result will change
1091-- whenever either (or both) input 'Dynamic' changes.
1092-- More efficient than 'liftA2'.
1093zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
1095 let eab = align (updated da) (updated db)
1096 ec = flip push eab $ \o -> do
1099 b <- sample $ current db
1102 a <- sample $ current da
1104 These a b -> return (a, b)
1105 return $ Just $ f a b
1106 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
1108instance (Reflex t, Semigroup a) => Semigroup (Dynamic t a) where
1109 (<>) = zipDynWith (<>)
1110 stimes n = fmap $ stimes n
1112instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
1113 mconcat = distributeListOverDynWith mconcat
1114 mempty = constDyn mempty
1115 mappend = zipDynWith mappend
1117-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1118-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1119-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1120distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
1121distributeDMapOverDynPure = distributeDMapOverDynPureG coerceDynamic
1123-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1124-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1125-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1126distributeDMapOverDynPureG
1127 :: forall t k q v. (Reflex t, GCompare k)
1128 => (forall a. q a -> Dynamic t (v a))
1129 -> DMap k q -> Dynamic t (DMap k v)
1130distributeDMapOverDynPureG nt dm = case DMap.toList dm of
1131 [] -> constDyn DMap.empty
1132 [k :=> v] -> DMap.singleton k <$> nt v
1134 let getInitial = DMap.traverseWithKey (\_ -> sample . current . nt) dm
1135 edmPre = mergeG getCompose $ DMap.map (Compose . updated . nt) dm
1136 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
1137 olds <- sample $ current result
1138 return $ DMap.unionWithKey (\_ _ new -> new) olds news
1141-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
1142distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
1143distributeListOverDyn = distributeListOverDynWith id
1145-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
1146distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
1147distributeListOverDynWith f =
1148 fmap (f . map fromDSum . DMap.toAscList) .
1149 distributeDMapOverDynPure .
1150 DMap.fromDistinctAscList .
1151 zipWith toDSum [0..]
1153 toDSum :: Int -> Dynamic t a -> DSum (Const2 Int a) (Dynamic t)
1154 toDSum k v = Const2 k :=> v
1155 fromDSum :: DSum (Const2 Int a) Identity -> a
1156 fromDSum (Const2 _ :=> Identity v) = v
1158-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
1159-- unless the second supplied 'Event' occurs simultaneously.
1160difference :: Reflex t => Event t a -> Event t b -> Event t a
1161difference = alignEventWithMaybe $ \case
1165-- | Zips two values by taking the union of their shapes and combining with the provided function.
1166-- 'Nothing' values are dropped.
1167alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
1168alignEventWithMaybe f ea eb = mapMaybe (f <=< dmapToThese) $
1169 merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
1171-- | Produces an 'Event' that fires only when the input event fires with a 'DSum' key that
1172-- matches the provided key.
1174 :: forall t m k v a.
1181 -> Event t (DSum k v)
1182 -> m (Event t (v a))
1183filterEventKey k kv' = do
1184 let f :: DSum k v -> Maybe (v a)
1185 f (newK :=> newV) = case newK `geq` k of
1186 Just Refl -> Just newV
1188 takeWhileJustE f kv'
1190-- | "Factor" the input 'DSum' 'Event' to produce an 'Event' which
1191-- fires when the 'DSum' key changes and contains both the value of the
1192-- 'DSum' at switchover and an 'Event' of values produced by subsequent
1193-- firings of the input 'Event' that do not change the 'DSum' key.
1195 :: forall t m k v a.
1202 -> Event t (DSum k v)
1203 -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))
1204factorEvent k0 kv' = do
1205 key :: Behavior t (Some k) <- hold (Some k0) $ fmapCheap (\(k :=> _) -> Some k) kv'
1206 let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case
1207 Some oldKey -> case newKey `geq` oldKey of
1208 Just Refl -> return Nothing
1210 newInner <- filterEventKey newKey kv'
1211 return $ Just $ newKey :=> Pair newVal (Compose newInner)
1212 eInitial <- filterEventKey k0 kv'
1213 return (eInitial, update)
1215--------------------------------------------------------------------------------
1217--------------------------------------------------------------------------------
1219-- | An 'Accumulator' type can be built by accumulating occurrences of an
1221#if __GLASGOW_HASKELL__ < 802
1222{-# WARNING accum "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1223{-# WARNING accumM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1224{-# WARNING accumMaybe "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1225{-# WARNING accumMaybeM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1227class Reflex t => Accumulator t f | f -> t where
1228 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
1229 accum f = accumMaybe $ \v o -> Just $ f v o
1230 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
1231 accumM f = accumMaybeM $ \v o -> Just <$> f v o
1232 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
1233 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
1234 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
1235 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
1236 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
1237 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
1238 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
1239 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1240 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
1241 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1243-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1244-- with the provided function. See 'foldDyn'.
1246 :: (Reflex t, MonadHold t m, MonadFix m)
1251accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o
1253-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1254-- with the provided 'PushM' action.
1256 :: (Reflex t, MonadHold t m, MonadFix m)
1257 => (a -> b -> PushM t a)
1261accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o
1263-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1264-- with the provided function, discarding 'Nothing' results.
1266 :: (Reflex t, MonadHold t m, MonadFix m)
1267 => (a -> b -> Maybe a)
1271accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o
1273-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1274-- with the provided 'PushM' action, discarding 'Nothing' results.
1276 :: (Reflex t, MonadHold t m, MonadFix m)
1277 => (a -> b -> PushM t (Maybe a))
1281accumMaybeMDyn f z e = do
1282 rec let e' = flip push e $ \o -> do
1283 v <- sample $ current d'
1288-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1289-- with a function that both accumulates and produces a value to fire
1290-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1292 :: (Reflex t, MonadHold t m, MonadFix m)
1293 => (a -> b -> (a, c))
1296 -> m (Dynamic t a, Event t c)
1297mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o
1299-- | Similar to 'mapAccumDyn' except that the combining function is a
1302 :: (Reflex t, MonadHold t m, MonadFix m)
1303 => (a -> b -> PushM t (a, c))
1306 -> m (Dynamic t a, Event t c)
1307mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o
1309-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event' with
1310-- a function that both optionally accumulates and optionally produces
1311-- a value to fire as a separate output 'Event'.
1312-- Note that because 'Nothing's are discarded in both cases, the output
1313-- 'Event' may fire even though the output 'Dynamic' has not changed, and
1314-- the output 'Dynamic' may update even when the output 'Event' is not firing.
1316 :: (Reflex t, MonadHold t m, MonadFix m)
1317 => (a -> b -> (Maybe a, Maybe c))
1320 -> m (Dynamic t a, Event t c)
1321mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o
1323-- | Like 'mapAccumMaybeDyn' except that the combining function is a
1326 :: (Reflex t, MonadHold t m, MonadFix m)
1327 => (a -> b -> PushM t (Maybe a, Maybe c))
1330 -> m (Dynamic t a, Event t c)
1331mapAccumMaybeMDyn f z e = do
1332 rec let e' = flip push e $ \o -> do
1333 v <- sample $ current d'
1335 return $ case result of
1336 (Nothing, Nothing) -> Nothing
1338 d' <- holdDyn z $ mapMaybe fst e'
1339 return (d', mapMaybe snd e')
1341-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1342-- with the provided function.
1343{-# INLINE accumB #-}
1345 :: (Reflex t, MonadHold t m, MonadFix m)
1350accumB f = accumMaybeB $ \v o -> Just $ f v o
1352-- | Like 'accumB' except that the combining function is a 'PushM' action.
1353{-# INLINE accumMB #-}
1355 :: (Reflex t, MonadHold t m, MonadFix m)
1356 => (a -> b -> PushM t a)
1360accumMB f = accumMaybeMB $ \v o -> Just <$> f v o
1362-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1363-- with the provided function, discarding 'Nothing' results.
1364{-# INLINE accumMaybeB #-}
1366 :: (Reflex t, MonadHold t m, MonadFix m)
1367 => (a -> b -> Maybe a)
1371accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o
1373-- | Like 'accumMaybeB' except that the combining function is a 'PushM' action.
1374{-# INLINE accumMaybeMB #-}
1375accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)
1376accumMaybeMB f z e = do
1377 rec let e' = flip push e $ \o -> do
1383-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1384-- with a function that both accumulates and produces a value to fire
1385-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1386{-# INLINE mapAccumB #-}
1388 :: (Reflex t, MonadHold t m, MonadFix m)
1389 => (a -> b -> (a, c))
1392 -> m (Behavior t a, Event t c)
1393mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o
1395-- | Like 'mapAccumB' except that the combining function is a 'PushM' action.
1396{-# INLINE mapAccumMB #-}
1398 :: (Reflex t, MonadHold t m, MonadFix m)
1399 => (a -> b -> PushM t (a, c))
1402 -> m (Behavior t a, Event t c)
1403mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o
1405-- | Accumulate a 'Behavior' by folding occurrences of an 'Event' with
1406-- a function that both optionally accumulates and optionally produces
1407-- a value to fire as a separate output 'Event'. 'Nothing's are discarded.
1408{-# INLINE mapAccumMaybeB #-}
1410 :: (Reflex t, MonadHold t m, MonadFix m)
1411 => (a -> b -> (Maybe a, Maybe c))
1414 -> m (Behavior t a, Event t c)
1415mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o
1417-- | Like 'mapAccumMaybeB' except that the combining function is a 'PushM' action.
1418{-# INLINE mapAccumMaybeMB #-}
1419mapAccumMaybeMB :: (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)
1420mapAccumMaybeMB f z e = do
1421 rec let e' = flip push e $ \o -> do
1424 return $ case result of
1425 (Nothing, Nothing) -> Nothing
1427 d' <- hold z $ mapMaybe fst e'
1428 return (d', mapMaybe snd e')
1430-- | Accumulate occurrences of an 'Event', producing an output occurrence each
1431-- time. Discard the underlying 'Accumulator'.
1432{-# INLINE mapAccum_ #-}
1433mapAccum_ :: 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)
1435 (_, result) <- mapAccumB f z e
1438-- | Accumulate occurrences of an 'Event', possibly producing an output
1439-- occurrence each time. Discard the underlying 'Accumulator'.
1440{-# INLINE mapAccumMaybe_ #-}
1441mapAccumMaybe_ :: 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)
1442mapAccumMaybe_ f z e = do
1443 (_, result) <- mapAccumMaybeB f z e
1446-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
1447-- an output occurrence each time. Discard the underlying 'Accumulator'.
1448{-# INLINE mapAccumM_ #-}
1449mapAccumM_ :: 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)
1450mapAccumM_ f z e = do
1451 (_, result) <- mapAccumMB f z e
1454-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
1455-- producing an output occurrence each time. Discard the underlying
1457{-# INLINE mapAccumMaybeM_ #-}
1458mapAccumMaybeM_ :: 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)
1459mapAccumMaybeM_ f z e = do
1460 (_, result) <- mapAccumMaybeMB f z e
1463instance Reflex t => Accumulator t (Dynamic t) where
1464 accumMaybeM = accumMaybeMDyn
1465 mapAccumMaybeM = mapAccumMaybeMDyn
1467instance Reflex t => Accumulator t (Behavior t) where
1468 accumMaybeM = accumMaybeMB
1469 mapAccumMaybeM = mapAccumMaybeMB
1471instance Reflex t => Accumulator t (Event t) where
1472 accumMaybeM f z e = updated <$> accumMaybeM f z e
1473 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
1475-- | Create a new 'Event' by combining each occurrence with the next value of the
1476-- list using the supplied function. If the list runs out of items, all
1477-- subsequent 'Event' occurrences will be ignored.
1478zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
1479zipListWithEvent f l e = do
1480 let f' a b = case a of
1481 h:t -> (Just t, Just $ f h b)
1482 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
1483 mapAccumMaybe_ f' l e
1485-- | Assign a number to each occurrence of the given 'Event', starting from 0
1486{-# INLINE numberOccurrences #-}
1487numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
1488numberOccurrences = numberOccurrencesFrom 0
1490-- | Assign a number to each occurrence of the given 'Event'
1491{-# INLINE numberOccurrencesFrom #-}
1492numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
1493numberOccurrencesFrom = mapAccum_ (\n a -> let !next = n + 1 in (next, (n, a)))
1495-- | Assign a number to each occurrence of the given 'Event'; discard the occurrences' values
1496{-# INLINE numberOccurrencesFrom_ #-}
1497numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
1498numberOccurrencesFrom_ = mapAccum_ (\n _ -> let !next = n + 1 in (next, n))
1500-- | This is used to sample the value of a 'Behavior' using an 'Event'.
1502-- The '<@>' operator is intended to be used in conjunction with
1503-- the 'Applicative' instance for 'Behavior'.
1505-- This is useful when we want to combine the values of one 'Event' and
1506-- the value of several 'Behavior's at the time the 'Event' is firing.
1510-- > f :: a -> b -> c -> d
1511-- > b1 :: Behavior t a
1512-- > b2 :: Behavior t b
1517-- > f <$> b1 <*> b2 <@> e :: Event t d
1519-- in order to apply the function 'f' to the relevant values.
1521-- The alternative would be something like:
1523-- > attachWith (\(x1, x2) y -> f x1 x2 y) ((,) <$> b1 <*> b2) e :: Event t d
1525-- or a variation involing a custom data type to hold the combination of
1526-- 'Behavior's even when that combination might only ever be used by 'f'.
1528-- A more suggestive example might be:
1530-- > handleMouse <$> bPlayerState <*> bMousePosition <@> eMouseClick :: Event t (GameState -> GameState)
1532(<@>) :: Reflex t => Behavior t (a -> b) -> Event t a -> Event t b
1533(<@>) b = push $ \x -> do
1535 return . Just . f $ x
1538-- | An version of '<@>' that does not use the value of the 'Event'.
1540-- Alternatively, it is 'tag' in operator form.
1542-- This is useful when we want to combine the values of several
1543-- 'Behavior's at particular points in time using an 'Applicative'
1548-- > g :: a -> b -> d
1549-- > b1 :: Behavior t a
1550-- > b2 :: Behavior t b
1553-- where 'e' is firing at the points in time of interest.
1555-- Then we can use '<@':
1557-- > g <$> b1 <*> b2 <@ e :: Event t d
1559-- to combine the values of 'b1' and 'b2' at each of those points of time,
1560-- with the function 'g' being used to combine the values.
1562-- This is the same as '<@>' except that the 'Event' is being used only
1563-- to act as a trigger.
1564(<@) :: (Reflex t) => Behavior t b -> Event t a -> Event t b
1572-- | A "cheap" version of 'pushAlways'. See the performance note on 'pushCheap'.
1573{-# INLINE pushAlwaysCheap #-}
1574pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
1575pushAlwaysCheap f = pushCheap (fmap Just . f)
1577-- | A "cheap" version of 'mapMaybe'. See the performance note on 'pushCheap'.
1578{-# INLINE mapMaybeCheap #-}
1579mapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1580mapMaybeCheap f = pushCheap $ return . f
1582-- | An alias for 'mapMaybeCheap'
1583{-# INLINE fmapMaybeCheap #-}
1584fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1585fmapMaybeCheap = mapMaybeCheap
1588-- | A "cheap" version of 'fforMaybe'. See the performance note on 'pushCheap'.
1589{-# INLINE fforMaybeCheap #-}
1590fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
1591fforMaybeCheap = flip mapMaybeCheap
1593-- | A "cheap" version of 'ffor'. See the performance note on 'pushCheap'.
1594{-# INLINE fforCheap #-}
1595fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
1596fforCheap = flip fmapCheap
1598-- | A "cheap" version of 'fmap'. See the performance note on 'pushCheap'.
1599{-# INLINE fmapCheap #-}
1600fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
1601fmapCheap f = pushCheap $ return . Just . f
1603-- | A "cheap" version of 'tag'. See the performance note on 'pushCheap'.
1604{-# INLINE tagCheap #-}
1605tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
1606tagCheap b = pushAlwaysCheap $ \_ -> sample b
1608-- | Merge a collection of events; the resulting 'Event' will only occur if at
1609-- least one input event is occurring, and will contain all of the input keys
1610-- that are occurring simultaneously
1611merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)
1612merge = mergeG coerceEvent
1615-- | Create a merge whose parents can change over time
1616mergeIncremental :: (Reflex t, GCompare k)
1617 => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
1618mergeIncremental = mergeIncrementalG coerceEvent
1620-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
1621mergeIncrementalWithMove :: (Reflex t, GCompare k)
1622 => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
1623mergeIncrementalWithMove = mergeIncrementalWithMoveG coerceEvent
1625-- | A "cheap" version of 'mergeWithCheap'. See the performance note on 'pushCheap'.
1626{-# INLINE mergeWithCheap #-}
1627mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
1628mergeWithCheap = mergeWithCheap' id
1630-- | A "cheap" version of 'mergeWithCheap''. See the performance note on 'pushCheap'.
1631{-# INLINE mergeWithCheap' #-}
1632mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
1633mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
1635-- | A "cheap" version of 'mergeWithFoldCheap''. See the performance note on 'pushCheap'.
1636{-# INLINE mergeWithFoldCheap' #-}
1637mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
1638mergeWithFoldCheap' f es =
1639 fmapCheap (f . (\(h : t) -> h :| t) . IntMap.elems)
1641 . IntMap.fromDistinctAscList
1642 $ zip [0 :: Int ..] es
1644--------------------------------------------------------------------------------
1645-- Deprecated functions
1646--------------------------------------------------------------------------------
1648{-# 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'. " #-}
1649-- | See 'switchHoldPromptly'
1650switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1651switchPromptly = switchHoldPromptly
1652{-# 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'. " #-}
1653-- | See 'switchHoldPromptOnly'
1654switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1655switchPromptOnly = 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