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)
200import Data.Dependent.Sum (DSum (..))
201import qualified Data.Dependent.Map as DMap
202import Data.Functor.Compose
203import Data.Functor.Product
204import Data.GADT.Compare (GEq (..), GCompare (..))
205import Data.FastMutableIntMap (PatchIntMap)
207import Data.Functor.Bind
208import Data.Functor.Misc
209import Data.Functor.Plus
210import Data.IntMap.Strict (IntMap)
211import qualified Data.IntMap.Strict as IntMap
212import Data.List.NonEmpty (NonEmpty (..))
214import Data.Semigroup (Semigroup (..))
215import Data.Some (Some(Some))
218import Data.Type.Coercion
219import Data.Type.Equality ((:~:) (..))
220import Data.Witherable (Filterable(..))
221import qualified Data.Witherable as W
222import Reflex.FunctorMaybe (FunctorMaybe)
223import qualified Reflex.FunctorMaybe
225import qualified Data.Patch.MapWithMove as PatchMapWithMove
227import Debug.Trace (trace)
229-- | The 'Reflex' class contains all the primitive functionality needed for
230-- Functional Reactive Programming (FRP). The @/t/@ type parameter indicates
231-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
232-- and the type of the timeline determines the FRP engine to be used. For most
233-- purposes, the 'Reflex.Spider' implementation is recommended.
234class ( MonadHold t (PushM t)
235 , MonadSample t (PullM t)
237 , Functor (Dynamic t)
238 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
241 -- | A container for a value that can change over time. 'Behavior's can be
242 -- sampled at will, but it is not possible to be notified when they change
243 data Behavior t :: * -> *
244 -- | A stream of occurrences. During any given frame, an 'Event' is either
245 -- occurring or not occurring; if it is occurring, it will contain a value of
246 -- the given type (its "occurrence type")
247 data Event t :: * -> *
248 -- | A container for a value that can change over time and allows
249 -- notifications on changes. Basically a combination of a 'Behavior' and an
250 -- 'Event', with a rule that the 'Behavior' will change if and only if the
252 data Dynamic t :: * -> *
253 -- | An 'Incremental' is a more general form of a 'Dynamic'.
254 -- Instead of always fully replacing the value, only parts of it can be patched.
255 -- This is only needed for performance critical code via `mergeIncremental` to make small
256 -- changes to large values.
257 data Incremental t :: * -> *
258 -- | A monad for doing complex push-based calculations efficiently
259 type PushM t :: * -> *
260 -- | A monad for doing complex pull-based calculations efficiently
261 type PullM t :: * -> *
262 -- | An 'Event' with no occurrences
264 -- | Create a 'Behavior' that always has the given value
265 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
266 -- | Create an 'Event' from another 'Event'; the provided function can sample
267 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
268 -- (Just) or non-occurring (Nothing) result
269 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
270 -- | 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.
271 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
272 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
273 -- recomputed whenever any of the read 'Behavior's changes
274 pull :: PullM t a -> Behavior t a
275 -- | Merge a collection of events; the resulting 'Event' will only occur if at
276 -- least one input event is occurring, and will contain all of the input keys
277 -- that are occurring simultaneously
279 --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
280 mergeG :: GCompare k => (forall a. q a -> Event t (v a))
281 -> DMap k q -> Event t (DMap k v)
283 -- | Efficiently fan-out an event to many destinations. You should save the
284 -- result in a @let@-binding, and then repeatedly 'selectG' on the result to
285 -- create child events
286 fanG :: GCompare k => Event t (DMap k v) -> EventSelectorG t k v
288 -- | Create an 'Event' that will occur whenever the currently-selected input
290 switch :: Behavior t (Event t a) -> Event t a
291 -- | Create an 'Event' that will occur whenever the input event is occurring -- and its occurrence value, another 'Event', is also occurring.
292 -- You maybe looking for '@switchHold@ @never@' instead.
293 coincidence :: Event t (Event t a) -> Event t a
294 -- | Extract the 'Behavior' of a 'Dynamic'.
295 current :: Dynamic t a -> Behavior t a
296 -- | Extract the 'Event' of the 'Dynamic'.
297 updated :: Dynamic t a -> Event t a
298 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
299 -- recent firing of the given 'Event', if any.
300 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
301 -- | Create a new 'Incremental'. The given "PullM"'s value must always change
302 -- in the same way that the accumulated application of patches would change
304 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
305 -- | Create a merge whose parents can change over time
306 mergeIncrementalG :: GCompare k
307 => (forall a. q a -> Event t (v a))
308 -> Incremental t (PatchDMap k q)
309 -> Event t (DMap k v)
310 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
311 mergeIncrementalWithMoveG :: GCompare k
312 => (forall a. q a -> Event t (v a))
313 -> Incremental t (PatchDMapWithMove k q) -> Event t (DMap k v)
314 -- | Extract the 'Behavior' component of an 'Incremental'
315 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
316 -- | Extract the 'Event' component of an 'Incremental'
317 updatedIncremental :: Patch p => Incremental t p -> Event t p
318 -- | Convert an 'Incremental' to a 'Dynamic'
319 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
320 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
322 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
323 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
325 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
326 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
328 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
329 -- | Construct a 'Coercion' for an 'Incremental' given 'Coercion's for its
330 -- patch target and patch types.
332 :: Coercion (PatchTarget a) (PatchTarget b) -> Coercion a b -> Coercion (Incremental t a) (Incremental t b)
333 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
334 fanInt :: Event t (IntMap a) -> EventSelectorInt t a
336-- | Efficiently fan-out an event to many destinations. You should save the
337-- result in a @let@-binding, and then repeatedly 'select' on the result to
338-- create child events
339fan :: forall t k. (Reflex t, GCompare k)
340 => Event t (DMap k Identity) -> EventSelector t k
341 --TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it
342fan e = EventSelector (fixup (selectG (fanG e) :: k a -> Event t (Identity a)) :: forall a. k a -> Event t a)
344 fixup :: forall a. (k a -> Event t (Identity a)) -> k a -> Event t a
345 fixup = case eventCoercion Coercion :: Coercion (Event t (Identity a)) (Event t a) of
348--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on
349-- | Constructs a single 'Event' out of a map of events. The output event may fire with multiple
350-- keys simultaneously.
351mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
352mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never
354-- | Coerce a 'Behavior' between representationally-equivalent value types
355coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
356coerceBehavior = coerceWith $ behaviorCoercion Coercion
358-- | Coerce an 'Event' between representationally-equivalent occurrence types
359coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
360coerceEvent = coerceWith $ eventCoercion Coercion
362-- | Coerce a 'Dynamic' between representationally-equivalent value types
363coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
364coerceDynamic = coerceWith $ dynamicCoercion Coercion
366-- | Coerce an 'Incremental' between representationally-equivalent value types
368 :: (Reflex t, Coercible a b, Coercible (PatchTarget a) (PatchTarget b))
369 => Incremental t a -> Incremental t b
370coerceIncremental = coerceWith $ incrementalCoercion Coercion Coercion
372-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
373-- __must__ change when and only when the 'Event' fires, such that the
374-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
375-- if this is not the case, the resulting 'Dynamic' will behave
376-- nondeterministically.
377unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
378unsafeDynamic = unsafeBuildDynamic . sample
380-- | Construct a 'Dynamic' value that never changes
381constDyn :: Reflex t => a -> Dynamic t a
384instance (Reflex t, Default a) => Default (Dynamic t a) where
387-- | 'MonadSample' designates monads that can read the current value of a
388-- 'Behavior'. This includes both 'PullM' and 'PushM'.
389class (Applicative m, Monad m) => MonadSample t m | m -> t where
390 -- | Get the current value in the 'Behavior'
391 sample :: Behavior t a -> m a
393-- | 'MonadHold' designates monads that can create new 'Behavior's based on
394-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
395-- is required to create any stateful computations with Reflex.
396class MonadSample t m => MonadHold t m where
397 -- | Create a new 'Behavior' whose value will initially be equal to the given
398 -- value and will be updated whenever the given 'Event' occurs. The update
399 -- takes effect immediately after the 'Event' occurs; if the occurrence that
400 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
401 -- the 'Behavior', it will see the __old__ value of the 'Behavior', not the new
403 hold :: a -> Event t a -> m (Behavior t a)
404 default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)
405 hold v0 = lift . hold v0
406 -- | Create a 'Dynamic' value using the given initial value that changes every
407 -- time the 'Event' occurs.
408 holdDyn :: a -> Event t a -> m (Dynamic t a)
409 default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)
410 holdDyn v0 = lift . holdDyn v0
411 -- | Create an 'Incremental' value using the given initial value that changes
412 -- every time the 'Event' occurs.
413 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
414 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
415 holdIncremental v0 = lift . holdIncremental v0
416 buildDynamic :: PushM t a -> Event t a -> m (Dynamic t a)
418 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
419 buildDynamic getV0 = lift . buildDynamic getV0
421 -- | Create a new 'Event' that only occurs only once, on the first occurrence of
422 -- the supplied 'Event'.
423 headE :: Event t a -> m (Event t a)
424 -- | An event which only occurs at the current moment in time, such that:
426 -- > coincidence (pushAlways (\a -> (a <$) <$> now) e) = e
428 now :: m (Event t ())
429 default now :: (m ~ f m', MonadTrans f, MonadHold t m') => m (Event t ())
432-- | Accumulate an 'Incremental' with the supplied initial value and the firings of the provided 'Event',
433-- using the combining function to produce a patch.
435 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
436 => (PatchTarget p -> b -> p)
439 -> m (Incremental t p)
440accumIncremental f = accumMaybeIncremental $ \v o -> Just $ f v o
442-- | Similar to 'accumIncremental' but the combining function runs in 'PushM'
444 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
445 => (PatchTarget p -> b -> PushM t p)
448 -> m (Incremental t p)
449accumMIncremental f = accumMaybeMIncremental $ \v o -> Just <$> f v o
451-- | Similar to 'accumIncremental' but allows filtering of updates (by dropping updates when the
452-- combining function produces @Nothing@)
454 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
455 => (PatchTarget p -> b -> Maybe p)
458 -> m (Incremental t p)
459accumMaybeIncremental f = accumMaybeMIncremental $ \v o -> return $ f v o
461-- | Similar to 'accumMaybeMIncremental' but the combining function runs in 'PushM'
462accumMaybeMIncremental
463 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
464 => (PatchTarget p -> b -> PushM t (Maybe p))
467 -> m (Incremental t p)
468accumMaybeMIncremental f z e = do
469 rec let e' = flip push e $ \o -> do
470 v <- sample $ currentIncremental d'
472 d' <- holdIncremental z e'
475-- | Accumulate an 'Incremental' by folding occurrences of an 'Event'
476-- with a function that both accumulates and produces a value to fire
477-- as an 'Event'. Returns both the accumulated value and the constructed
480 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
481 => (PatchTarget p -> b -> (p, c))
484 -> m (Incremental t p, Event t c)
485mapAccumIncremental f = mapAccumMaybeIncremental $ \v o -> bimap Just Just $ f v o
487-- | Like 'mapAccumIncremental' but the combining function runs in 'PushM'
489 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
490 => (PatchTarget p -> b -> PushM t (p, c))
493 -> m (Incremental t p, Event t c)
494mapAccumMIncremental f = mapAccumMaybeMIncremental $ \v o -> bimap Just Just <$> f v o
496-- | Accumulate an 'Incremental' by folding occurrences of an 'Event' with
497-- a function that both optionally accumulates and optionally produces
498-- a value to fire as a separate output 'Event'.
499-- Note that because 'Nothing's are discarded in both cases, the output
500-- 'Event' may fire even though the output 'Incremental' has not changed, and
501-- the output 'Incremental' may update even when the output 'Event' is not firing.
502mapAccumMaybeIncremental
503 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
504 => (PatchTarget p -> b -> (Maybe p, Maybe c))
507 -> m (Incremental t p, Event t c)
508mapAccumMaybeIncremental f = mapAccumMaybeMIncremental $ \v o -> return $ f v o
510-- | Like 'mapAccumMaybeIncremental' but the combining function is a 'PushM' action
511mapAccumMaybeMIncremental
512 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
513 => (PatchTarget p -> b -> PushM t (Maybe p, Maybe c))
516 -> m (Incremental t p, Event t c)
517mapAccumMaybeMIncremental f z e = do
518 rec let e' = flip push e $ \o -> do
519 v <- sample $ currentIncremental d'
521 return $ case result of
522 (Nothing, Nothing) -> Nothing
524 d' <- holdIncremental z $ mapMaybe fst e'
525 return (d', mapMaybe snd e')
527-- | A somewhat slow implementation of 'headE'
528slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
530 rec be <- hold e $ fmapCheap (const never) e'
534-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
535-- key. This is much more efficient than filtering for each key with
537newtype EventSelector t k = EventSelector
538 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
539 -- determined by the type of the key, so this can be used to fan-out
540 -- 'Event's whose sub-'Event's have different types.
542 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
543 -- (but equivalent to) using 'mapMaybe' to select only the relevant
544 -- occurrences of an 'Event'.
545 select :: forall a. k a -> Event t a
548newtype EventSelectorG t k v = EventSelectorG
549 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
550 -- determined by the type of the key, so this can be used to fan-out
551 -- 'Event's whose sub-'Event's have different types.
553 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
554 -- (but equivalent to) using 'mapMaybe' to select only the relevant
555 -- occurrences of an 'Event'.
556 selectG :: forall a. k a -> Event t (v a)
559-- | Efficiently select an 'Event' keyed on 'Int'. This is more efficient than manually
561newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }
563--------------------------------------------------------------------------------
565--------------------------------------------------------------------------------
567instance MonadSample t m => MonadSample t (ReaderT r m) where
568 sample = lift . sample
570instance MonadHold t m => MonadHold t (ReaderT r m) where
571 hold a0 = lift . hold a0
572 holdDyn a0 = lift . holdDyn a0
573 holdIncremental a0 = lift . holdIncremental a0
574 buildDynamic a0 = lift . buildDynamic a0
578instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
579 sample = lift . sample
581instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
582 hold a0 = lift . hold a0
583 holdDyn a0 = lift . holdDyn a0
584 holdIncremental a0 = lift . holdIncremental a0
585 buildDynamic a0 = lift . buildDynamic a0
589instance MonadSample t m => MonadSample t (StateT s m) where
590 sample = lift . sample
592instance MonadHold t m => MonadHold t (StateT s m) where
593 hold a0 = lift . hold a0
594 holdDyn a0 = lift . holdDyn a0
595 holdIncremental a0 = lift . holdIncremental a0
596 buildDynamic a0 = lift . buildDynamic a0
600instance MonadSample t m => MonadSample t (ExceptT e m) where
601 sample = lift . sample
603instance MonadHold t m => MonadHold t (ExceptT e m) where
604 hold a0 = lift . hold a0
605 holdDyn a0 = lift . holdDyn a0
606 holdIncremental a0 = lift . holdIncremental a0
607 buildDynamic a0 = lift . buildDynamic a0
611instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
612 sample = lift . sample
614instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
615 hold a0 = lift . hold a0
616 holdDyn a0 = lift . holdDyn a0
617 holdIncremental a0 = lift . holdIncremental a0
618 buildDynamic a0 = lift . buildDynamic a0
622instance MonadSample t m => MonadSample t (ContT r m) where
623 sample = lift . sample
625instance MonadHold t m => MonadHold t (ContT r m) where
626 hold a0 = lift . hold a0
627 holdDyn a0 = lift . holdDyn a0
628 holdIncremental a0 = lift . holdIncremental a0
629 buildDynamic a0 = lift . buildDynamic a0
633--------------------------------------------------------------------------------
634-- Convenience functions
635--------------------------------------------------------------------------------
637-- | Create an 'Event' from another 'Event'. The provided function can sample
638-- 'Behavior's and hold 'Event's.
639pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
640pushAlways f = push (fmap Just . f)
642-- | Flipped version of 'fmap'.
643ffor :: Functor f => f a -> (a -> b) -> f b
646-- | Rotated version of 'liftA2'.
647ffor2 :: Applicative f => f a -> f b -> (a -> b -> c) -> f c
648ffor2 a b f = liftA2 f a b
650-- | Rotated version of 'liftA3'.
651ffor3 :: Applicative f => f a -> f b -> f c -> (a -> b -> c -> d) -> f d
652ffor3 a b c f = liftA3 f a b c
654instance Reflex t => Applicative (Behavior t) where
656 f <*> x = pull $ sample f `ap` sample x
660instance Reflex t => Apply (Behavior t) where
663instance Reflex t => Bind (Behavior t) where
666instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
668 fromRational = pure . fromRational
671instance Reflex t => Functor (Behavior t) where
672 fmap f = pull . fmap f . sample
674instance (Reflex t, IsString a) => IsString (Behavior t a) where
675 fromString = pure . fromString
677instance Reflex t => Monad (Behavior t) where
678 a >>= f = pull $ sample a >>= sample . f
679 -- 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.
681#if !MIN_VERSION_base(4,13,0)
682 fail = error "Monad (Behavior t) does not support fail"
685instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
686 mempty = constant mempty
687 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
688 mconcat = pull . fmap mconcat . mapM sample
690instance (Reflex t, Num a) => Num (Behavior t a) where
695 fromInteger = pure . fromInteger
699instance (Num a, Reflex t) => Num (Dynamic t a) where
704 fromInteger = pure . fromInteger
708instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
709 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
710 sconcat = pull . fmap sconcat . mapM sample
711 stimes n = fmap $ stimes n
713-- | Alias for 'mapMaybe'
714fmapMaybe :: Filterable f => (a -> Maybe b) -> f a -> f b
717-- | Flipped version of 'mapMaybe'.
718fforMaybe :: Filterable f => f a -> (a -> Maybe b) -> f b
719fforMaybe = flip mapMaybe
721-- | Filter 'f a' using the provided predicate.
722ffilter :: Filterable f => (a -> Bool) -> f a -> f a
725-- | Filter 'Left's from 'f (Either a b)' into 'a'.
726filterLeft :: Filterable f => f (Either a b) -> f a
727filterLeft = mapMaybe (either Just (const Nothing))
729-- | Filter 'Right's from 'f (Either a b)' into 'b'.
730filterRight :: Filterable f => f (Either a b) -> f b
731filterRight = mapMaybe (either (const Nothing) Just)
733-- | Left-biased event union (prefers left event on simultaneous
735instance Reflex t => Alt (Event t) where
736 ev1 <!> ev2 = leftmost [ev1, ev2]
738-- | 'Event' intersection. Only occurs when both events are co-incident.
739instance Reflex t => Apply (Event t) where
740 evf <.> evx = mapMaybe f (align evf evx) where
741 f (These g a) = Just (g a)
745-- | 'Event' intersection (convenient interface to 'coincidence').
746instance Reflex t => Bind (Event t) where
747 evx >>- f = coincidence (f <$> evx)
750instance Reflex t => Functor (Event t) where
752 fmap f = mapMaybe $ Just . f
754 x <$ e = fmapCheap (const x) e
756-- TODO Remove this instance
757instance Reflex t => FunctorMaybe (Event t) where
758 {-# INLINE fmapMaybe #-}
761instance Reflex t => Filterable (Event t) where
762 {-# INLINE mapMaybe #-}
763 mapMaybe f = push $ return . f
765-- | Never: @'zero' = 'never'@.
766instance Reflex t => Plus (Event t) where
769-- | Replace each occurrence value of the 'Event' with the value of the
770-- 'Behavior' at the time of that occurrence.
771tag :: Reflex t => Behavior t b -> Event t a -> Event t b
772tag b = pushAlways $ \_ -> sample b
774-- | Replace each occurrence value of the 'Event' with the value of the
775-- 'Behavior' at that time; if it is 'Just', fire with the contained value; if
776-- it is 'Nothing', drop the occurrence.
777tagMaybe :: Reflex t => Behavior t (Maybe b) -> Event t a -> Event t b
778tagMaybe b = push $ \_ -> sample b
780-- | Create a new 'Event' that combines occurrences of supplied 'Event' with the
781-- current value of the 'Behavior'.
782attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
783attach = attachWith (,)
785-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
786-- combining it with the current value of the 'Behavior'.
787attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
788attachWith f = attachWithMaybe $ \a b -> Just $ f a b
790-- | Create a new 'Event' by combining each occurrence with the current value of
791-- the 'Behavior'. The occurrence is discarded if the combining function returns
793attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
794attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
796-- | Create a new 'Event' that occurs on all but the first occurrence of the
798tailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a)
799tailE e = snd <$> headTailE e
801-- | Create a tuple of two 'Event's with the first one occurring only the first
802-- time the supplied 'Event' occurs and the second occurring on all but the first
804headTailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a, Event t a)
807 be <- hold never $ fmap (const e) eHead
808 return (eHead, switch be)
810-- | Take the streak of occurrences starting at the current time for which the
811-- event returns 'True'.
813-- Starting at the current time, fire all the occurrences of the 'Event' for
814-- which the given predicate returns 'True'. When first 'False' is returned,
815-- do not fire, and permanently stop firing, even if 'True' values would have
816-- been encountered later.
819 . (Reflex t, MonadFix m, MonadHold t m)
823takeWhileE f = takeWhileJustE $ \v -> guard (f v) $> v
825-- | Take the streak of occurrences starting at the current time for which the
826-- event returns 'Just b'.
828-- Starting at the current time, fire all the occurrences of the 'Event' for
829-- which the given predicate returns 'Just b'. When first 'Nothing' is returned,
830-- do not fire, and permanently stop firing, even if 'Just b' values would have
831-- been encountered later.
834 . (Reflex t, MonadFix m, MonadHold t m)
838takeWhileJustE f e = do
839 rec let (eBad, eTrue) = fanEither $ ffor e' $ \a -> case f a of
840 Nothing -> Left never
842 eFirstBad <- headE eBad
843 e' <- switchHold e eFirstBad
846-- | Drop the streak of occurrences starting at the current time for which the
847-- event returns 'True'.
849-- Starting at the current time, do not fire all the occurrences of the 'Event'
850-- for which the given predicate returns 'True'. When 'False' is first
851-- returned, do fire, and permanently continue firing, even if 'True' values
852-- would have been encountered later.
855 . (Reflex t, MonadFix m, MonadHold t m)
859dropWhileE f e = snd <$> takeDropWhileJustE (\v -> guard (f v) $> v) e
861-- | Both take and drop the streak of occurrences starting at the current time
862-- for which the event returns 'Just b'.
864-- For the left event, starting at the current time, fire all the occurrences
865-- of the 'Event' for which the given function returns 'Just b'. When
866-- 'Nothing' is returned, do not fire, and permanently stop firing, even if
867-- 'Just b' values would have been encountered later.
869-- For the right event, do not fire until the first occurrence where the given
870-- function returns 'Nothing', and fire that one and all subsequent
871-- occurrences. Even if the function would have again returned 'Just b', keep
875 . (Reflex t, MonadFix m, MonadHold t m)
878 -> m (Event t b, Event t a)
879takeDropWhileJustE f e = do
880 rec let (eBad, eGood) = fanEither $ ffor e' $ \a -> case f a of
883 eFirstBad <- headE eBad
884 e' <- switchHold e (never <$ eFirstBad)
885 eRest <- switchHoldPromptOnly never (e <$ eFirstBad)
886 return (eGood, eRest)
888-- | Split the supplied 'Event' into two individual 'Event's occurring at the
889-- same time with the respective values from the tuple.
890splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
891splitE e = (fmap fst e, fmap snd e)
893-- | Print the supplied 'String' and the value of the 'Event' on each
894-- occurrence. This should /only/ be used for debugging.
896-- Note: As with Debug.Trace.trace, the message will only be printed if the
897-- 'Event' is actually used.
898traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
899traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
901-- | Print the output of the supplied function on each occurrence of the
902-- 'Event'. This should /only/ be used for debugging.
904-- Note: As with Debug.Trace.trace, the message will only be printed if the
905-- 'Event' is actually used.
906traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
907traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
909instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
910 (<>) = alignWith (mergeThese (<>))
911 sconcat = fmap sconcat . mergeList . toList
912 stimes n = fmap $ stimes n
914instance (Semigroup a, Reflex t) => Monoid (Event t a) where
917 mconcat = fmap sconcat . mergeList
919-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
920-- list occurs. If multiple occur at the same time they are folded from the left
921-- with the given function.
922{-# INLINE mergeWith #-}
923mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
924mergeWith = mergeWith' id
926{-# INLINE mergeWith' #-}
927mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
928mergeWith' f g es = fmap (Prelude.foldl1 g . fmap f)
930 . IntMap.fromDistinctAscList
931 $ zip [0 :: Int ..] es
933-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
934-- list occurs. If multiple occur at the same time the value is the value of the
936{-# INLINE leftmost #-}
937leftmost :: Reflex t => [Event t a] -> Event t a
938leftmost = mergeWith const
940-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
941-- list occurs and has a list of the values of all 'Event's occurring at that
943mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
945mergeList es = mergeWithFoldCheap' id es
948 :: (Reflex t, Patch p, Patch p')
949 => (PatchTarget p -> PatchTarget p')
953unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
955-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
956-- occurs if at least one of them occurs and has a map of values of all 'Event's
957-- occurring at that time.
958mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
959mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
961-- | Like 'mergeMap' but for 'IntMap'.
962mergeIntMap :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
963mergeIntMap = fmap dmapToIntMap . merge . intMapWithFunctorToDMap
965-- | Create a merge whose parents can change over time
966mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
967mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
969-- | Create a merge whose parents can change over time
970mergeIntMapIncremental :: Reflex t => Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
971mergeIntMapIncremental = fmap dmapToIntMap . mergeIncremental . unsafeMapIncremental intMapWithFunctorToDMap (const2IntPatchDMapWith id)
973-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
974mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
975mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
977-- | Split the event into separate events for 'Left' and 'Right' values.
978fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
980 let justLeft = either Just (const Nothing)
981 justRight = either (const Nothing) Just
982 in (mapMaybe justLeft e, mapMaybe justRight e)
984-- | Split the event into separate events for 'This' and 'That' values,
985-- allowing them to fire simultaneously when the input value is 'These'.
986fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
988 let this (This x) = Just x
989 this (These x _) = Just x
991 that (That y) = Just y
992 that (These _ y) = Just y
994 in (mapMaybe this e, mapMaybe that e)
996-- | Split the event into an 'EventSelector' that allows efficient selection of
997-- the individual 'Event's.
998fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
999fanMap = fan . fmap mapToDMap
1001-- | Switches to the new event whenever it receives one. Only the old event is
1002-- considered the moment a new one is switched in; the output event will fire at
1003-- that moment only if the old event does.
1005-- Because the simultaneous firing case is irrelevant, this function imposes
1006-- laxer "timing requirements" on the overall circuit, avoiding many potential
1007-- cyclic dependency / metastability failures. It's also more performant. Use
1008-- this rather than 'switchHoldPromptly' and 'switchHoldPromptOnly' unless you
1009-- are absolutely sure you need to act on the new event in the coincidental
1011switchHold :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1012switchHold ea0 eea = switch <$> hold ea0 eea
1014-- | Switches to the new event whenever it receives one. Whenever a new event is
1015-- provided, if it is firing, its value will be the resulting event's value; if
1016-- it is not firing, but the old one is, the old one's value will be used.
1018-- 'switchHold', by always forwarding the old event the moment it is switched
1019-- out, avoids many potential cyclic dependency problems / metastability
1020-- problems. It's also more performant. Use it instead unless you are sure you
1022switchHoldPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1023switchHoldPromptly ea0 eea = do
1025 let eLag = switch bea
1026 eCoincidences = coincidence eea
1027 return $ leftmost [eCoincidences, eLag]
1029-- | switches to a new event whenever it receives one. At the moment of
1030-- switching, the old event will be ignored if it fires, and the new one will be
1031-- used if it fires; this is the opposite of 'switch', which will use only the
1034-- 'switchHold', by always forwarding the old event the moment it is switched
1035-- out, avoids many potential cyclic dependency problems / metastability
1036-- problems. It's also more performant. Use it instead unless you are sure you
1038switchHoldPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1039switchHoldPromptOnly e0 e' = do
1040 eLag <- switch <$> hold e0 e'
1041 return $ coincidence $ leftmost [e', eLag <$ eLag]
1043-- | When the given outer event fires, condense the inner events into the contained patch. Non-firing inner events will be replaced with deletions.
1044coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)
1045coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ ffor e $ \(PatchMap m) -> mergeMap $ ffor m $ \case
1046 Nothing -> fmapCheap (const Nothing) e
1047 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
1049-- | See 'coincidencePatchMap'
1050coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)
1051coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ ffor e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case
1052 Nothing -> fmapCheap (const Nothing) e
1053 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
1055-- | See 'coincidencePatchMap'
1056coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)
1057coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ ffor e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
1058 PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->
1059 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1060 PatchMapWithMove.From_Move k -> fforCheap e $ \_ ->
1061 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }
1062 PatchMapWithMove.From_Insert ev -> leftmost
1063 [ fforCheap ev $ \v ->
1064 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }
1065 , fforCheap e $ \_ ->
1066 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1069-- | Given a 'PatchTarget' of events (e.g., a 'Map' with 'Event' values) and an event of 'Patch'es
1070-- (e.g., a 'PatchMap' with 'Event' values), produce an 'Event' of the 'PatchTarget' type that
1071-- fires with the patched value.
1072switchHoldPromptOnlyIncremental
1073 :: forall t m p pt w
1076 , Patch (p (Event t w))
1077 , PatchTarget (p (Event t w)) ~ pt (Event t w)
1079 , PatchTarget (p w) ~ pt w
1082 => (Incremental t (p (Event t w)) -> Event t (pt w))
1083 -> (Event t (p (Event t w)) -> Event t (p w))
1085 -> Event t (p (Event t w))
1086 -> m (Event t (pt w))
1087switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch e0 e' = do
1088 lag <- mergePatchIncremental <$> holdIncremental e0 e'
1089 pure $ ffor (align lag (coincidencePatch e')) $ \case
1091 That new -> new `applyAlways` mempty
1092 These old new -> new `applyAlways` old
1094instance Reflex t => Align (Event t) where
1096#if MIN_VERSION_these(0, 8, 0)
1097instance Reflex t => Semialign (Event t) where
1099 align = alignEventWithMaybe Just
1101#ifdef MIN_VERSION_semialign
1102#if MIN_VERSION_semialign(1,1,0)
1103instance Reflex t => Zip (Event t) where
1105 zip x y = mapMaybe justThese $ align x y
1108#ifdef MIN_VERSION_semialign
1109#if MIN_VERSION_semialign(1,1,0)
1110instance Reflex t => Unzip (Event t) where
1115-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
1116-- the 'Behavior' is true at the time of occurrence.
1117gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
1118gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
1120-- | Create a new behavior given a starting behavior and switch to the behavior
1121-- carried by the event when it fires.
1122switcher :: (Reflex t, MonadHold t m)
1123 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
1124switcher b eb = pull . (sample <=< sample) <$> hold b eb
1126instance (Reflex t, IsString a) => IsString (Dynamic t a) where
1127 fromString = pure . fromString
1129-- | Combine two 'Dynamic's. The result will change whenever either (or both)
1130-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
1131zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
1132zipDyn = zipDynWith (,)
1134-- | Combine two 'Dynamic's with a combining function. The result will change
1135-- whenever either (or both) input 'Dynamic' changes.
1136-- More efficient than 'liftA2'.
1137zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
1139 let eab = align (updated da) (updated db)
1140 ec = flip push eab $ \o -> do
1143 b <- sample $ current db
1146 a <- sample $ current da
1148 These a b -> return (a, b)
1149 return $ Just $ f a b
1150 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
1152instance (Reflex t, Semigroup a) => Semigroup (Dynamic t a) where
1153 (<>) = zipDynWith (<>)
1154 stimes n = fmap $ stimes n
1156instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
1157 mconcat = distributeListOverDynWith mconcat
1158 mempty = constDyn mempty
1159 mappend = zipDynWith mappend
1161-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1162-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1163-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1164distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
1165distributeDMapOverDynPure = distributeDMapOverDynPureG coerceDynamic
1167-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1168-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1169-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1170distributeDMapOverDynPureG
1171 :: forall t k q v. (Reflex t, GCompare k)
1172 => (forall a. q a -> Dynamic t (v a))
1173 -> DMap k q -> Dynamic t (DMap k v)
1174distributeDMapOverDynPureG nt dm = case DMap.toList dm of
1175 [] -> constDyn DMap.empty
1176 [k :=> v] -> DMap.singleton k <$> nt v
1178 let getInitial = DMap.traverseWithKey (\_ -> sample . current . nt) dm
1179 edmPre = mergeG getCompose $ DMap.map (Compose . updated . nt) dm
1180 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
1181 olds <- sample $ current result
1182 return $ DMap.unionWithKey (\_ _ new -> new) olds news
1185-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
1186distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
1187distributeListOverDyn = distributeListOverDynWith id
1189-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
1190distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
1191distributeListOverDynWith f =
1192 fmap (f . map fromDSum . DMap.toAscList) .
1193 distributeDMapOverDynPure .
1194 DMap.fromDistinctAscList .
1195 zipWith toDSum [0..]
1197 toDSum :: Int -> Dynamic t a -> DSum (Const2 Int a) (Dynamic t)
1198 toDSum k v = Const2 k :=> v
1199 fromDSum :: DSum (Const2 Int a) Identity -> a
1200 fromDSum (Const2 _ :=> Identity v) = v
1202-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
1203-- unless the second supplied 'Event' occurs simultaneously.
1204difference :: Reflex t => Event t a -> Event t b -> Event t a
1205difference = alignEventWithMaybe $ \case
1209-- | Zips two values by taking the union of their shapes and combining with the provided function.
1210-- 'Nothing' values are dropped.
1211alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
1212alignEventWithMaybe f ea eb = mapMaybe (f <=< dmapToThese) $
1213 merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
1215-- | Produces an 'Event' that fires only when the input event fires with a 'DSum' key that
1216-- matches the provided key.
1218 :: forall t m k v a.
1225 -> Event t (DSum k v)
1226 -> m (Event t (v a))
1227filterEventKey k kv' = do
1228 let f :: DSum k v -> Maybe (v a)
1229 f (newK :=> newV) = case newK `geq` k of
1230 Just Refl -> Just newV
1232 takeWhileJustE f kv'
1234-- | "Factor" the input 'DSum' 'Event' to produce an 'Event' which
1235-- fires when the 'DSum' key changes and contains both the value of the
1236-- 'DSum' at switchover and an 'Event' of values produced by subsequent
1237-- firings of the input 'Event' that do not change the 'DSum' key.
1239 :: forall t m k v a.
1246 -> Event t (DSum k v)
1247 -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))
1248factorEvent k0 kv' = do
1249 key :: Behavior t (Some k) <- hold (Some k0) $ fmapCheap (\(k :=> _) -> Some k) kv'
1250 let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case
1251 Some oldKey -> case newKey `geq` oldKey of
1252 Just Refl -> return Nothing
1254 newInner <- filterEventKey newKey kv'
1255 return $ Just $ newKey :=> Pair newVal (Compose newInner)
1256 eInitial <- filterEventKey k0 kv'
1257 return (eInitial, update)
1259--------------------------------------------------------------------------------
1261--------------------------------------------------------------------------------
1263-- | An 'Accumulator' type can be built by accumulating occurrences of an
1265#if __GLASGOW_HASKELL__ < 802
1266{-# WARNING accum "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1267{-# WARNING accumM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1268{-# WARNING accumMaybe "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1269{-# WARNING accumMaybeM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1271class Reflex t => Accumulator t f | f -> t where
1272 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
1273 accum f = accumMaybe $ \v o -> Just $ f v o
1274 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
1275 accumM f = accumMaybeM $ \v o -> Just <$> f v o
1276 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
1277 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
1278 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
1279 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
1280 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
1281 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
1282 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
1283 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1284 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
1285 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1287-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1288-- with the provided function. See 'foldDyn'.
1290 :: (Reflex t, MonadHold t m, MonadFix m)
1295accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o
1297-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1298-- with the provided 'PushM' action.
1300 :: (Reflex t, MonadHold t m, MonadFix m)
1301 => (a -> b -> PushM t a)
1305accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o
1307-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1308-- with the provided function, discarding 'Nothing' results.
1310 :: (Reflex t, MonadHold t m, MonadFix m)
1311 => (a -> b -> Maybe a)
1315accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o
1317-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1318-- with the provided 'PushM' action, discarding 'Nothing' results.
1320 :: (Reflex t, MonadHold t m, MonadFix m)
1321 => (a -> b -> PushM t (Maybe a))
1325accumMaybeMDyn f z e = do
1326 rec let e' = flip push e $ \o -> do
1327 v <- sample $ current d'
1332-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1333-- with a function that both accumulates and produces a value to fire
1334-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1336 :: (Reflex t, MonadHold t m, MonadFix m)
1337 => (a -> b -> (a, c))
1340 -> m (Dynamic t a, Event t c)
1341mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o
1343-- | Similar to 'mapAccumDyn' except that the combining function is a
1346 :: (Reflex t, MonadHold t m, MonadFix m)
1347 => (a -> b -> PushM t (a, c))
1350 -> m (Dynamic t a, Event t c)
1351mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o
1353-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event' with
1354-- a function that both optionally accumulates and optionally produces
1355-- a value to fire as a separate output 'Event'.
1356-- Note that because 'Nothing's are discarded in both cases, the output
1357-- 'Event' may fire even though the output 'Dynamic' has not changed, and
1358-- the output 'Dynamic' may update even when the output 'Event' is not firing.
1360 :: (Reflex t, MonadHold t m, MonadFix m)
1361 => (a -> b -> (Maybe a, Maybe c))
1364 -> m (Dynamic t a, Event t c)
1365mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o
1367-- | Like 'mapAccumMaybeDyn' except that the combining function is a
1370 :: (Reflex t, MonadHold t m, MonadFix m)
1371 => (a -> b -> PushM t (Maybe a, Maybe c))
1374 -> m (Dynamic t a, Event t c)
1375mapAccumMaybeMDyn f z e = do
1376 rec let e' = flip push e $ \o -> do
1377 v <- sample $ current d'
1379 return $ case result of
1380 (Nothing, Nothing) -> Nothing
1382 d' <- holdDyn z $ mapMaybe fst e'
1383 return (d', mapMaybe snd e')
1385-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1386-- with the provided function.
1387{-# INLINE accumB #-}
1389 :: (Reflex t, MonadHold t m, MonadFix m)
1394accumB f = accumMaybeB $ \v o -> Just $ f v o
1396-- | Like 'accumB' except that the combining function is a 'PushM' action.
1397{-# INLINE accumMB #-}
1399 :: (Reflex t, MonadHold t m, MonadFix m)
1400 => (a -> b -> PushM t a)
1404accumMB f = accumMaybeMB $ \v o -> Just <$> f v o
1406-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1407-- with the provided function, discarding 'Nothing' results.
1408{-# INLINE accumMaybeB #-}
1410 :: (Reflex t, MonadHold t m, MonadFix m)
1411 => (a -> b -> Maybe a)
1415accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o
1417-- | Like 'accumMaybeB' except that the combining function is a 'PushM' action.
1418{-# INLINE accumMaybeMB #-}
1419accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)
1420accumMaybeMB f z e = do
1421 rec let e' = flip push e $ \o -> do
1427-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1428-- with a function that both accumulates and produces a value to fire
1429-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1430{-# INLINE mapAccumB #-}
1432 :: (Reflex t, MonadHold t m, MonadFix m)
1433 => (a -> b -> (a, c))
1436 -> m (Behavior t a, Event t c)
1437mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o
1439-- | Like 'mapAccumB' except that the combining function is a 'PushM' action.
1440{-# INLINE mapAccumMB #-}
1442 :: (Reflex t, MonadHold t m, MonadFix m)
1443 => (a -> b -> PushM t (a, c))
1446 -> m (Behavior t a, Event t c)
1447mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o
1449-- | Accumulate a 'Behavior' by folding occurrences of an 'Event' with
1450-- a function that both optionally accumulates and optionally produces
1451-- a value to fire as a separate output 'Event'. 'Nothing's are discarded.
1452{-# INLINE mapAccumMaybeB #-}
1454 :: (Reflex t, MonadHold t m, MonadFix m)
1455 => (a -> b -> (Maybe a, Maybe c))
1458 -> m (Behavior t a, Event t c)
1459mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o
1461-- | Like 'mapAccumMaybeB' except that the combining function is a 'PushM' action.
1462{-# INLINE mapAccumMaybeMB #-}
1463mapAccumMaybeMB :: (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)
1464mapAccumMaybeMB f z e = do
1465 rec let e' = flip push e $ \o -> do
1468 return $ case result of
1469 (Nothing, Nothing) -> Nothing
1471 d' <- hold z $ mapMaybe fst e'
1472 return (d', mapMaybe snd e')
1474-- | Accumulate occurrences of an 'Event', producing an output occurrence each
1475-- time. Discard the underlying 'Accumulator'.
1476{-# INLINE mapAccum_ #-}
1477mapAccum_ :: 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)
1479 (_, result) <- mapAccumB f z e
1482-- | Accumulate occurrences of an 'Event', possibly producing an output
1483-- occurrence each time. Discard the underlying 'Accumulator'.
1484{-# INLINE mapAccumMaybe_ #-}
1485mapAccumMaybe_ :: 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)
1486mapAccumMaybe_ f z e = do
1487 (_, result) <- mapAccumMaybeB f z e
1490-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
1491-- an output occurrence each time. Discard the underlying 'Accumulator'.
1492{-# INLINE mapAccumM_ #-}
1493mapAccumM_ :: 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)
1494mapAccumM_ f z e = do
1495 (_, result) <- mapAccumMB f z e
1498-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
1499-- producing an output occurrence each time. Discard the underlying
1501{-# INLINE mapAccumMaybeM_ #-}
1502mapAccumMaybeM_ :: 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)
1503mapAccumMaybeM_ f z e = do
1504 (_, result) <- mapAccumMaybeMB f z e
1507instance Reflex t => Accumulator t (Dynamic t) where
1508 accumMaybeM = accumMaybeMDyn
1509 mapAccumMaybeM = mapAccumMaybeMDyn
1511instance Reflex t => Accumulator t (Behavior t) where
1512 accumMaybeM = accumMaybeMB
1513 mapAccumMaybeM = mapAccumMaybeMB
1515instance Reflex t => Accumulator t (Event t) where
1516 accumMaybeM f z e = updated <$> accumMaybeM f z e
1517 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
1519-- | Create a new 'Event' by combining each occurrence with the next value of the
1520-- list using the supplied function. If the list runs out of items, all
1521-- subsequent 'Event' occurrences will be ignored.
1522zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
1523zipListWithEvent f l e = do
1524 let f' a b = case a of
1525 h:t -> (Just t, Just $ f h b)
1526 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
1527 mapAccumMaybe_ f' l e
1529-- | Assign a number to each occurrence of the given 'Event', starting from 0
1530{-# INLINE numberOccurrences #-}
1531numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
1532numberOccurrences = numberOccurrencesFrom 0
1534-- | Assign a number to each occurrence of the given 'Event'
1535{-# INLINE numberOccurrencesFrom #-}
1536numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
1537numberOccurrencesFrom = mapAccum_ (\n a -> let !next = n + 1 in (next, (n, a)))
1539-- | Assign a number to each occurrence of the given 'Event'; discard the occurrences' values
1540{-# INLINE numberOccurrencesFrom_ #-}
1541numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
1542numberOccurrencesFrom_ = mapAccum_ (\n _ -> let !next = n + 1 in (next, n))
1544-- | This is used to sample the value of a 'Behavior' using an 'Event'.
1546-- The '<@>' operator is intended to be used in conjunction with
1547-- the 'Applicative' instance for 'Behavior'.
1549-- This is useful when we want to combine the values of one 'Event' and
1550-- the value of several 'Behavior's at the time the 'Event' is firing.
1554-- > f :: a -> b -> c -> d
1555-- > b1 :: Behavior t a
1556-- > b2 :: Behavior t b
1561-- > f <$> b1 <*> b2 <@> e :: Event t d
1563-- in order to apply the function 'f' to the relevant values.
1565-- The alternative would be something like:
1567-- > attachWith (\(x1, x2) y -> f x1 x2 y) ((,) <$> b1 <*> b2) e :: Event t d
1569-- or a variation involing a custom data type to hold the combination of
1570-- 'Behavior's even when that combination might only ever be used by 'f'.
1572-- A more suggestive example might be:
1574-- > handleMouse <$> bPlayerState <*> bMousePosition <@> eMouseClick :: Event t (GameState -> GameState)
1576(<@>) :: Reflex t => Behavior t (a -> b) -> Event t a -> Event t b
1577(<@>) b = push $ \x -> do
1579 return . Just . f $ x
1582-- | An version of '<@>' that does not use the value of the 'Event'.
1584-- Alternatively, it is 'tag' in operator form.
1586-- This is useful when we want to combine the values of several
1587-- 'Behavior's at particular points in time using an 'Applicative'
1592-- > g :: a -> b -> d
1593-- > b1 :: Behavior t a
1594-- > b2 :: Behavior t b
1597-- where 'e' is firing at the points in time of interest.
1599-- Then we can use '<@':
1601-- > g <$> b1 <*> b2 <@ e :: Event t d
1603-- to combine the values of 'b1' and 'b2' at each of those points of time,
1604-- with the function 'g' being used to combine the values.
1606-- This is the same as '<@>' except that the 'Event' is being used only
1607-- to act as a trigger.
1608(<@) :: (Reflex t) => Behavior t b -> Event t a -> Event t b
1616-- | A "cheap" version of 'pushAlways'. See the performance note on 'pushCheap'.
1617{-# INLINE pushAlwaysCheap #-}
1618pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
1619pushAlwaysCheap f = pushCheap (fmap Just . f)
1621-- | A "cheap" version of 'mapMaybe'. See the performance note on 'pushCheap'.
1622{-# INLINE mapMaybeCheap #-}
1623mapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1624mapMaybeCheap f = pushCheap $ return . f
1626-- | An alias for 'mapMaybeCheap'
1627{-# INLINE fmapMaybeCheap #-}
1628fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1629fmapMaybeCheap = mapMaybeCheap
1632-- | A "cheap" version of 'fforMaybe'. See the performance note on 'pushCheap'.
1633{-# INLINE fforMaybeCheap #-}
1634fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
1635fforMaybeCheap = flip mapMaybeCheap
1637-- | A "cheap" version of 'ffor'. See the performance note on 'pushCheap'.
1638{-# INLINE fforCheap #-}
1639fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
1640fforCheap = flip fmapCheap
1642-- | A "cheap" version of 'fmap'. See the performance note on 'pushCheap'.
1643{-# INLINE fmapCheap #-}
1644fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
1645fmapCheap f = pushCheap $ return . Just . f
1647-- | A "cheap" version of 'tag'. See the performance note on 'pushCheap'.
1648{-# INLINE tagCheap #-}
1649tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
1650tagCheap b = pushAlwaysCheap $ \_ -> sample b
1652-- | Merge a collection of events; the resulting 'Event' will only occur if at
1653-- least one input event is occurring, and will contain all of the input keys
1654-- that are occurring simultaneously
1655merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)
1656merge = mergeG coerceEvent
1659-- | Create a merge whose parents can change over time
1660mergeIncremental :: (Reflex t, GCompare k)
1661 => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
1662mergeIncremental = mergeIncrementalG coerceEvent
1664-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
1665mergeIncrementalWithMove :: (Reflex t, GCompare k)
1666 => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
1667mergeIncrementalWithMove = mergeIncrementalWithMoveG coerceEvent
1669-- | A "cheap" version of 'mergeWithCheap'. See the performance note on 'pushCheap'.
1670{-# INLINE mergeWithCheap #-}
1671mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
1672mergeWithCheap = mergeWithCheap' id
1674-- | A "cheap" version of 'mergeWithCheap''. See the performance note on 'pushCheap'.
1675{-# INLINE mergeWithCheap' #-}
1676mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
1677mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
1679-- | A "cheap" version of 'mergeWithFoldCheap''. See the performance note on 'pushCheap'.
1680{-# INLINE mergeWithFoldCheap' #-}
1681mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
1682mergeWithFoldCheap' f es =
1683 fmapCheap (f . (\(h : t) -> h :| t) . IntMap.elems)
1685 . IntMap.fromDistinctAscList
1686 $ zip [0 :: Int ..] es
1688--------------------------------------------------------------------------------
1689-- Deprecated functions
1690--------------------------------------------------------------------------------
1692{-# 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'. " #-}
1693-- | See 'switchHoldPromptly'
1694switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1695switchPromptly = switchHoldPromptly
1696{-# 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'. " #-}
1697-- | See 'switchHoldPromptOnly'
1698switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1699switchPromptOnly = 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