1{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE ConstraintKinds #-}
4{-# LANGUAGE DefaultSignatures #-}
5{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE FunctionalDependencies #-}
9{-# LANGUAGE LambdaCase #-}
10{-# LANGUAGE NoMonomorphismRestriction #-}
11{-# LANGUAGE PolyKinds #-}
12{-# LANGUAGE RankNTypes #-}
13{-# LANGUAGE RecursiveDo #-}
14{-# LANGUAGE RoleAnnotations #-}
15{-# LANGUAGE ScopedTypeVariables #-}
16{-# LANGUAGE TypeFamilies #-}
17{-# LANGUAGE TypeOperators #-}
18{-# LANGUAGE UndecidableInstances #-}
19{-# LANGUAGE Trustworthy #-}
20#ifdef USE_REFLEX_OPTIMIZER
21{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
28-- This module contains the Reflex interface, as well as a variety of
29-- convenience functions for working with 'Event's, 'Behavior's, and other
42 -- ** 'fan' related types
45 , EventSelectorInt (..)
46 -- * Convenience functions
49 -- ** Combining 'Event's
53 , mergeIncrementalWithMove
57 , mergeMapIncrementalWithMove
58 , mergeIntMapIncremental
60 , coincidencePatchMapWithMove
61 , coincidencePatchIntMap
66 -- ** Breaking up 'Event's
78 -- ** Collapsing 'Event . Event'
81 , switchHoldPromptOnly
82 , switchHoldPromptOnlyIncremental
83 -- ** Using 'Event's to sample 'Behavior's
89 -- ** Blocking an 'Event' based on a 'Behavior'
91 -- ** Combining 'Dynamic's
92 , distributeDMapOverDynPure
93 , distributeDMapOverDynPureG
94 , distributeListOverDyn
95 , distributeListOverDynWith
98 -- ** Accumulating state
122 , accumMaybeIncremental
123 , accumMaybeMIncremental
124 , mapAccumIncremental
125 , mapAccumMIncremental
126 , mapAccumMaybeIncremental
127 , mapAccumMaybeMIncremental
130 , numberOccurrencesFrom
131 , numberOccurrencesFrom_
141 -- * Debugging functions
144 -- * Unsafe functions
146 , unsafeMapIncremental
147 -- * 'Filterable' convenience functions
148 , FunctorMaybe -- fmapMaybe is purposely not exported from deprecated 'FunctorMaybe' and the new alias is exported instead
149 , mapMaybe -- Re-exported for convenience
155 -- * Miscellaneous convenience functions
159 -- * Deprecated functions
162 -- * "Cheap" functions
172 -- * Slow, but general, implementations
176#ifdef MIN_VERSION_semialign
177import Prelude hiding (zip, zipWith)
179#if MIN_VERSION_these(0,8,0)
180import Data.These.Combinators (justThese)
182#if MIN_VERSION_semialign(1,1,0)
183import Data.Zip (Zip (..))
187import Control.Applicative
188import Control.Monad.Identity
189import Control.Monad.Reader
190import Control.Monad.State.Strict
191import Control.Monad.Trans.Cont (ContT)
192import Control.Monad.Trans.Except (ExceptT)
193import Control.Monad.Trans.RWS (RWST)
194import Control.Monad.Trans.Writer (WriterT)
199import Data.Dependent.Map (DMap, DSum (..))
200import qualified Data.Dependent.Map as DMap
201import Data.Functor.Compose
202import Data.Functor.Product
203import Data.GADT.Compare (GEq (..), GCompare (..), (:~:) (..))
204import Data.FastMutableIntMap (PatchIntMap)
206import Data.Functor.Bind
207import Data.Functor.Misc
208import Data.Functor.Plus
209import Data.IntMap.Strict (IntMap)
210import qualified Data.IntMap.Strict as IntMap
211import Data.List.NonEmpty (NonEmpty (..))
213import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
214import Data.Some (Some(Some))
217import Data.Type.Coercion
218import Data.Witherable (Filterable(..))
219import qualified Data.Witherable as W
220import Reflex.FunctorMaybe (FunctorMaybe)
221import qualified Reflex.FunctorMaybe
223import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
225import Debug.Trace (trace)
227-- | The 'Reflex' class contains all the primitive functionality needed for
228-- Functional Reactive Programming (FRP). The @/t/@ type parameter indicates
229-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
230-- and the type of the timeline determines the FRP engine to be used. For most
231-- purposes, the 'Reflex.Spider' implementation is recommended.
232class ( MonadHold t (PushM t)
233 , MonadSample t (PullM t)
235 , Functor (Dynamic t)
236 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
239 -- | A container for a value that can change over time. 'Behavior's can be
240 -- sampled at will, but it is not possible to be notified when they change
241 data Behavior t :: * -> *
242 -- | A stream of occurrences. During any given frame, an 'Event' is either
243 -- occurring or not occurring; if it is occurring, it will contain a value of
244 -- the given type (its "occurrence type")
245 data Event t :: * -> *
246 -- | A container for a value that can change over time and allows
247 -- notifications on changes. Basically a combination of a 'Behavior' and an
248 -- 'Event', with a rule that the 'Behavior' will change if and only if the
250 data Dynamic t :: * -> *
251 -- | An 'Incremental' is a more general form of a 'Dynamic'.
252 -- Instead of always fully replacing the value, only parts of it can be patched.
253 -- This is only needed for performance critical code via `mergeIncremental` to make small
254 -- changes to large values.
255 data Incremental t :: * -> *
256 -- | A monad for doing complex push-based calculations efficiently
257 type PushM t :: * -> *
258 -- | A monad for doing complex pull-based calculations efficiently
259 type PullM t :: * -> *
260 -- | An 'Event' with no occurrences
262 -- | Create a 'Behavior' that always has the given value
263 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
264 -- | Create an 'Event' from another 'Event'; the provided function can sample
265 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
266 -- (Just) or non-occurring (Nothing) result
267 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
268 -- | 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.
269 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
270 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
271 -- recomputed whenever any of the read 'Behavior's changes
272 pull :: PullM t a -> Behavior t a
273 -- | Merge a collection of events; the resulting 'Event' will only occur if at
274 -- least one input event is occurring, and will contain all of the input keys
275 -- that are occurring simultaneously
277 --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
278 mergeG :: GCompare k => (forall a. q a -> Event t (v a))
279 -> DMap k q -> Event t (DMap k v)
281 -- | Efficiently fan-out an event to many destinations. You should save the
282 -- result in a @let@-binding, and then repeatedly 'selectG' on the result to
283 -- create child events
284 fanG :: GCompare k => Event t (DMap k v) -> EventSelectorG t k v
286 -- | Create an 'Event' that will occur whenever the currently-selected input
288 switch :: Behavior t (Event t a) -> Event t a
289 -- | Create an 'Event' that will occur whenever the input event is occurring -- and its occurrence value, another 'Event', is also occurring
290 coincidence :: Event t (Event t a) -> Event t a
291 -- | Extract the 'Behavior' of a 'Dynamic'.
292 current :: Dynamic t a -> Behavior t a
293 -- | Extract the 'Event' of the 'Dynamic'.
294 updated :: Dynamic t a -> Event t a
295 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
296 -- recent firing of the given 'Event', if any.
297 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
298 -- | Create a new 'Incremental'. The given "PullM"'s value must always change
299 -- in the same way that the accumulated application of patches would change
301 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
302 -- | Create a merge whose parents can change over time
303 mergeIncrementalG :: GCompare k
304 => (forall a. q a -> Event t (v a))
305 -> Incremental t (PatchDMap k q)
306 -> Event t (DMap k v)
307 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
308 mergeIncrementalWithMoveG :: GCompare k
309 => (forall a. q a -> Event t (v a))
310 -> Incremental t (PatchDMapWithMove k q) -> Event t (DMap k v)
311 -- | Extract the 'Behavior' component of an 'Incremental'
312 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
313 -- | Extract the 'Event' component of an 'Incremental'
314 updatedIncremental :: Patch p => Incremental t p -> Event t p
315 -- | Convert an 'Incremental' to a 'Dynamic'
316 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
317 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
319 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
320 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
322 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
323 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
325 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
326 -- | Construct a 'Coercion' for an 'Incremental' given 'Coercion's for its
327 -- patch target and patch types.
329 :: Coercion (PatchTarget a) (PatchTarget b) -> Coercion a b -> Coercion (Incremental t a) (Incremental t b)
330 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
331 fanInt :: Event t (IntMap a) -> EventSelectorInt t a
333-- | Efficiently fan-out an event to many destinations. You should save the
334-- result in a @let@-binding, and then repeatedly 'select' on the result to
335-- create child events
336fan :: forall t k. (Reflex t, GCompare k)
337 => Event t (DMap k Identity) -> EventSelector t k
338 --TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it
339fan e = EventSelector (fixup (selectG (fanG e) :: k a -> Event t (Identity a)) :: forall a. k a -> Event t a)
341 fixup :: forall a. (k a -> Event t (Identity a)) -> k a -> Event t a
342 fixup = case eventCoercion Coercion :: Coercion (Event t (Identity a)) (Event t a) of
345--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on
346-- | Constructs a single 'Event' out of a map of events. The output event may fire with multiple
347-- keys simultaneously.
348mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
349mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never
351-- | Coerce a 'Behavior' between representationally-equivalent value types
352coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
353coerceBehavior = coerceWith $ behaviorCoercion Coercion
355-- | Coerce an 'Event' between representationally-equivalent occurrence types
356coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
357coerceEvent = coerceWith $ eventCoercion Coercion
359-- | Coerce a 'Dynamic' between representationally-equivalent value types
360coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
361coerceDynamic = coerceWith $ dynamicCoercion Coercion
363-- | Coerce an 'Incremental' between representationally-equivalent value types
365 :: (Reflex t, Coercible a b, Coercible (PatchTarget a) (PatchTarget b))
366 => Incremental t a -> Incremental t b
367coerceIncremental = coerceWith $ incrementalCoercion Coercion Coercion
369-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
370-- __must__ change when and only when the 'Event' fires, such that the
371-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
372-- if this is not the case, the resulting 'Dynamic' will behave
373-- nondeterministically.
374unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
375unsafeDynamic = unsafeBuildDynamic . sample
377-- | Construct a 'Dynamic' value that never changes
378constDyn :: Reflex t => a -> Dynamic t a
381instance (Reflex t, Default a) => Default (Dynamic t a) where
384-- | 'MonadSample' designates monads that can read the current value of a
385-- 'Behavior'. This includes both 'PullM' and 'PushM'.
386class (Applicative m, Monad m) => MonadSample t m | m -> t where
387 -- | Get the current value in the 'Behavior'
388 sample :: Behavior t a -> m a
390-- | 'MonadHold' designates monads that can create new 'Behavior's based on
391-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
392-- is required to create any stateful computations with Reflex.
393class MonadSample t m => MonadHold t m where
394 -- | Create a new 'Behavior' whose value will initially be equal to the given
395 -- value and will be updated whenever the given 'Event' occurs. The update
396 -- takes effect immediately after the 'Event' occurs; if the occurrence that
397 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
398 -- the 'Behavior', it will see the __old__ value of the 'Behavior', not the new
400 hold :: a -> Event t a -> m (Behavior t a)
401 default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)
402 hold v0 = lift . hold v0
403 -- | Create a 'Dynamic' value using the given initial value that changes every
404 -- time the 'Event' occurs.
405 holdDyn :: a -> Event t a -> m (Dynamic t a)
406 default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)
407 holdDyn v0 = lift . holdDyn v0
408 -- | Create an 'Incremental' value using the given initial value that changes
409 -- every time the 'Event' occurs.
410 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
411 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
412 holdIncremental v0 = lift . holdIncremental v0
413 buildDynamic :: PushM t a -> Event t a -> m (Dynamic t a)
415 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
416 buildDynamic getV0 = lift . buildDynamic getV0
418 -- | Create a new 'Event' that only occurs only once, on the first occurrence of
419 -- the supplied 'Event'.
420 headE :: Event t a -> m (Event t a)
422-- | Accumulate an 'Incremental' with the supplied initial value and the firings of the provided 'Event',
423-- using the combining function to produce a patch.
425 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
426 => (PatchTarget p -> b -> p)
429 -> m (Incremental t p)
430accumIncremental f = accumMaybeIncremental $ \v o -> Just $ f v o
432-- | Similar to 'accumIncremental' but the combining function runs in 'PushM'
434 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
435 => (PatchTarget p -> b -> PushM t p)
438 -> m (Incremental t p)
439accumMIncremental f = accumMaybeMIncremental $ \v o -> Just <$> f v o
441-- | Similar to 'accumIncremental' but allows filtering of updates (by dropping updates when the
442-- combining function produces @Nothing@)
444 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
445 => (PatchTarget p -> b -> Maybe p)
448 -> m (Incremental t p)
449accumMaybeIncremental f = accumMaybeMIncremental $ \v o -> return $ f v o
451-- | Similar to 'accumMaybeMIncremental' but the combining function runs in 'PushM'
452accumMaybeMIncremental
453 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
454 => (PatchTarget p -> b -> PushM t (Maybe p))
457 -> m (Incremental t p)
458accumMaybeMIncremental f z e = do
459 rec let e' = flip push e $ \o -> do
460 v <- sample $ currentIncremental d'
462 d' <- holdIncremental z e'
465-- | Accumulate an 'Incremental' by folding occurrences of an 'Event'
466-- with a function that both accumulates and produces a value to fire
467-- as an 'Event'. Returns both the accumulated value and the constructed
470 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
471 => (PatchTarget p -> b -> (p, c))
474 -> m (Incremental t p, Event t c)
475mapAccumIncremental f = mapAccumMaybeIncremental $ \v o -> bimap Just Just $ f v o
477-- | Like 'mapAccumIncremental' but the combining function runs in 'PushM'
479 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
480 => (PatchTarget p -> b -> PushM t (p, c))
483 -> m (Incremental t p, Event t c)
484mapAccumMIncremental f = mapAccumMaybeMIncremental $ \v o -> bimap Just Just <$> f v o
486-- | Accumulate an 'Incremental' by folding occurrences of an 'Event' with
487-- a function that both optionally accumulates and optionally produces
488-- a value to fire as a separate output 'Event'.
489-- Note that because 'Nothing's are discarded in both cases, the output
490-- 'Event' may fire even though the output 'Incremental' has not changed, and
491-- the output 'Incremental' may update even when the output 'Event' is not firing.
492mapAccumMaybeIncremental
493 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
494 => (PatchTarget p -> b -> (Maybe p, Maybe c))
497 -> m (Incremental t p, Event t c)
498mapAccumMaybeIncremental f = mapAccumMaybeMIncremental $ \v o -> return $ f v o
500-- | Like 'mapAccumMaybeIncremental' but the combining function is a 'PushM' action
501mapAccumMaybeMIncremental
502 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
503 => (PatchTarget p -> b -> PushM t (Maybe p, Maybe c))
506 -> m (Incremental t p, Event t c)
507mapAccumMaybeMIncremental f z e = do
508 rec let e' = flip push e $ \o -> do
509 v <- sample $ currentIncremental d'
511 return $ case result of
512 (Nothing, Nothing) -> Nothing
514 d' <- holdIncremental z $ mapMaybe fst e'
515 return (d', mapMaybe snd e')
517-- | A somewhat slow implementation of 'headE'
518slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
520 rec be <- hold e $ fmapCheap (const never) e'
524-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
525-- key. This is much more efficient than filtering for each key with
527newtype EventSelector t k = EventSelector
528 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
529 -- determined by the type of the key, so this can be used to fan-out
530 -- 'Event's whose sub-'Event's have different types.
532 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
533 -- (but equivalent to) using 'mapMaybe' to select only the relevant
534 -- occurrences of an 'Event'.
535 select :: forall a. k a -> Event t a
538newtype EventSelectorG t k v = EventSelectorG
539 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
540 -- determined by the type of the key, so this can be used to fan-out
541 -- 'Event's whose sub-'Event's have different types.
543 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
544 -- (but equivalent to) using 'mapMaybe' to select only the relevant
545 -- occurrences of an 'Event'.
546 selectG :: forall a. k a -> Event t (v a)
549-- | Efficiently select an 'Event' keyed on 'Int'. This is more efficient than manually
551newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }
553--------------------------------------------------------------------------------
555--------------------------------------------------------------------------------
557instance MonadSample t m => MonadSample t (ReaderT r m) where
558 sample = lift . sample
560instance MonadHold t m => MonadHold t (ReaderT r m) where
561 hold a0 = lift . hold a0
562 holdDyn a0 = lift . holdDyn a0
563 holdIncremental a0 = lift . holdIncremental a0
564 buildDynamic a0 = lift . buildDynamic a0
567instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
568 sample = lift . sample
570instance (MonadHold t m, Monoid r) => MonadHold t (WriterT 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
577instance MonadSample t m => MonadSample t (StateT s m) where
578 sample = lift . sample
580instance MonadHold t m => MonadHold t (StateT s m) where
581 hold a0 = lift . hold a0
582 holdDyn a0 = lift . holdDyn a0
583 holdIncremental a0 = lift . holdIncremental a0
584 buildDynamic a0 = lift . buildDynamic a0
587instance MonadSample t m => MonadSample t (ExceptT e m) where
588 sample = lift . sample
590instance MonadHold t m => MonadHold t (ExceptT e m) where
591 hold a0 = lift . hold a0
592 holdDyn a0 = lift . holdDyn a0
593 holdIncremental a0 = lift . holdIncremental a0
594 buildDynamic a0 = lift . buildDynamic a0
597instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
598 sample = lift . sample
600instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
601 hold a0 = lift . hold a0
602 holdDyn a0 = lift . holdDyn a0
603 holdIncremental a0 = lift . holdIncremental a0
604 buildDynamic a0 = lift . buildDynamic a0
607instance MonadSample t m => MonadSample t (ContT r m) where
608 sample = lift . sample
610instance MonadHold t m => MonadHold t (ContT r m) where
611 hold a0 = lift . hold a0
612 holdDyn a0 = lift . holdDyn a0
613 holdIncremental a0 = lift . holdIncremental a0
614 buildDynamic a0 = lift . buildDynamic a0
617--------------------------------------------------------------------------------
618-- Convenience functions
619--------------------------------------------------------------------------------
621-- | Create an 'Event' from another 'Event'. The provided function can sample
622-- 'Behavior's and hold 'Event's.
623pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
624pushAlways f = push (fmap Just . f)
626-- | Flipped version of 'fmap'.
627ffor :: Functor f => f a -> (a -> b) -> f b
630-- | Rotated version of 'liftA2'.
631ffor2 :: Applicative f => f a -> f b -> (a -> b -> c) -> f c
632ffor2 a b f = liftA2 f a b
634-- | Rotated version of 'liftA3'.
635ffor3 :: Applicative f => f a -> f b -> f c -> (a -> b -> c -> d) -> f d
636ffor3 a b c f = liftA3 f a b c
638instance Reflex t => Applicative (Behavior t) where
640 f <*> x = pull $ sample f `ap` sample x
644instance Reflex t => Apply (Behavior t) where
647instance Reflex t => Bind (Behavior t) where
650instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
652 fromRational = pure . fromRational
655instance Reflex t => Functor (Behavior t) where
656 fmap f = pull . fmap f . sample
658instance (Reflex t, IsString a) => IsString (Behavior t a) where
659 fromString = pure . fromString
661instance Reflex t => Monad (Behavior t) where
662 a >>= f = pull $ sample a >>= sample . f
663 -- 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.
665 fail = error "Monad (Behavior t) does not support fail"
667instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
668 mempty = constant mempty
669 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
670 mconcat = pull . fmap mconcat . mapM sample
672instance (Reflex t, Num a) => Num (Behavior t a) where
677 fromInteger = pure . fromInteger
681instance (Num a, Reflex t) => Num (Dynamic t a) where
686 fromInteger = pure . fromInteger
690instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
691 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
692 sconcat = pull . fmap sconcat . mapM sample
693 stimes n = fmap $ stimes n
695-- | Alias for 'mapMaybe'
696fmapMaybe :: Filterable f => (a -> Maybe b) -> f a -> f b
699-- | Flipped version of 'mapMaybe'.
700fforMaybe :: Filterable f => f a -> (a -> Maybe b) -> f b
701fforMaybe = flip mapMaybe
703-- | Filter 'f a' using the provided predicate.
704ffilter :: Filterable f => (a -> Bool) -> f a -> f a
707-- | Filter 'Left's from 'f (Either a b)' into 'a'.
708filterLeft :: Filterable f => f (Either a b) -> f a
709filterLeft = mapMaybe (either Just (const Nothing))
711-- | Filter 'Right's from 'f (Either a b)' into 'b'.
712filterRight :: Filterable f => f (Either a b) -> f b
713filterRight = mapMaybe (either (const Nothing) Just)
715-- | Left-biased event union (prefers left event on simultaneous
717instance Reflex t => Alt (Event t) where
718 ev1 <!> ev2 = leftmost [ev1, ev2]
720-- | 'Event' intersection. Only occurs when both events are co-incident.
721instance Reflex t => Apply (Event t) where
722 evf <.> evx = mapMaybe f (align evf evx) where
723 f (These g a) = Just (g a)
727-- | 'Event' intersection (convenient interface to 'coincidence').
728instance Reflex t => Bind (Event t) where
729 evx >>- f = coincidence (f <$> evx)
732instance Reflex t => Functor (Event t) where
734 fmap f = mapMaybe $ Just . f
736 x <$ e = fmapCheap (const x) e
738-- TODO Remove this instance
739instance Reflex t => FunctorMaybe (Event t) where
740 {-# INLINE fmapMaybe #-}
743instance Reflex t => Filterable (Event t) where
744 {-# INLINE mapMaybe #-}
745 mapMaybe f = push $ return . f
747-- | Never: @'zero' = 'never'@.
748instance Reflex t => Plus (Event t) where
751-- | Replace each occurrence value of the 'Event' with the value of the
752-- 'Behavior' at the time of that occurrence.
753tag :: Reflex t => Behavior t b -> Event t a -> Event t b
754tag b = pushAlways $ \_ -> sample b
756-- | Replace each occurrence value of the 'Event' with the value of the
757-- 'Behavior' at that time; if it is 'Just', fire with the contained value; if
758-- it is 'Nothing', drop the occurrence.
759tagMaybe :: Reflex t => Behavior t (Maybe b) -> Event t a -> Event t b
760tagMaybe b = push $ \_ -> sample b
762-- | Create a new 'Event' that combines occurrences of supplied 'Event' with the
763-- current value of the 'Behavior'.
764attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
765attach = attachWith (,)
767-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
768-- combining it with the current value of the 'Behavior'.
769attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
770attachWith f = attachWithMaybe $ \a b -> Just $ f a b
772-- | Create a new 'Event' by combining each occurrence with the current value of
773-- the 'Behavior'. The occurrence is discarded if the combining function returns
775attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
776attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
778-- | Create a new 'Event' that occurs on all but the first occurrence of the
780tailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a)
781tailE e = snd <$> headTailE e
783-- | Create a tuple of two 'Event's with the first one occurring only the first
784-- time the supplied 'Event' occurs and the second occurring on all but the first
786headTailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a, Event t a)
789 be <- hold never $ fmap (const e) eHead
790 return (eHead, switch be)
792-- | Take the streak of occurrences starting at the current time for which the
793-- event returns 'True'.
795-- Starting at the current time, fire all the occurrences of the 'Event' for
796-- which the given predicate returns 'True'. When first 'False' is returned,
797-- do not fire, and permanently stop firing, even if 'True' values would have
798-- been encountered later.
801 . (Reflex t, MonadFix m, MonadHold t m)
805takeWhileE f = takeWhileJustE $ \v -> guard (f v) $> v
807-- | Take the streak of occurrences starting at the current time for which the
808-- event returns 'Just b'.
810-- Starting at the current time, fire all the occurrences of the 'Event' for
811-- which the given predicate returns 'Just b'. When first 'Nothing' is returned,
812-- do not fire, and permanently stop firing, even if 'Just b' values would have
813-- been encountered later.
816 . (Reflex t, MonadFix m, MonadHold t m)
820takeWhileJustE f e = do
821 rec let (eBad, eTrue) = fanEither $ ffor e' $ \a -> case f a of
822 Nothing -> Left never
824 eFirstBad <- headE eBad
825 e' <- switchHold e eFirstBad
828-- | Drop the streak of occurrences starting at the current time for which the
829-- event returns 'True'.
831-- Starting at the current time, do not fire all the occurrences of the 'Event'
832-- for which the given predicate returns 'True'. When 'False' is first
833-- returned, do fire, and permanently continue firing, even if 'True' values
834-- would have been encountered later.
837 . (Reflex t, MonadFix m, MonadHold t m)
841dropWhileE f e = snd <$> takeDropWhileJustE (\v -> guard (f v) $> v) e
843-- | Both take and drop the streak of occurrences starting at the current time
844-- for which the event returns 'Just b'.
846-- For the left event, starting at the current time, fire all the occurrences
847-- of the 'Event' for which the given function returns 'Just b'. When
848-- 'Nothing' is returned, do not fire, and permanently stop firing, even if
849-- 'Just b' values would have been encountered later.
851-- For the right event, do not fire until the first occurrence where the given
852-- function returns 'Nothing', and fire that one and all subsequent
853-- occurrences. Even if the function would have again returned 'Just b', keep
857 . (Reflex t, MonadFix m, MonadHold t m)
860 -> m (Event t b, Event t a)
861takeDropWhileJustE f e = do
862 rec let (eBad, eGood) = fanEither $ ffor e' $ \a -> case f a of
865 eFirstBad <- headE eBad
866 e' <- switchHold e (never <$ eFirstBad)
867 eRest <- switchHoldPromptOnly never (e <$ eFirstBad)
868 return (eGood, eRest)
870-- | Split the supplied 'Event' into two individual 'Event's occurring at the
871-- same time with the respective values from the tuple.
872splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
873splitE e = (fmap fst e, fmap snd e)
875-- | Print the supplied 'String' and the value of the 'Event' on each
876-- occurrence. This should /only/ be used for debugging.
878-- Note: As with Debug.Trace.trace, the message will only be printed if the
879-- 'Event' is actually used.
880traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
881traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
883-- | Print the output of the supplied function on each occurrence of the
884-- 'Event'. This should /only/ be used for debugging.
886-- Note: As with Debug.Trace.trace, the message will only be printed if the
887-- 'Event' is actually used.
888traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
889traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
891instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
892 (<>) = alignWith (mergeThese (<>))
893 sconcat = fmap sconcat . mergeList . toList
894 stimes n = fmap $ stimes n
896instance (Semigroup a, Reflex t) => Monoid (Event t a) where
899 mconcat = fmap sconcat . mergeList
901-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
902-- list occurs. If multiple occur at the same time they are folded from the left
903-- with the given function.
904{-# INLINE mergeWith #-}
905mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
906mergeWith = mergeWith' id
908{-# INLINE mergeWith' #-}
909mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
910mergeWith' f g es = fmap (Prelude.foldl1 g . fmap f)
912 . IntMap.fromDistinctAscList
913 $ zip [0 :: Int ..] es
915-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
916-- list occurs. If multiple occur at the same time the value is the value of the
918{-# INLINE leftmost #-}
919leftmost :: Reflex t => [Event t a] -> Event t a
920leftmost = mergeWith const
922-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
923-- list occurs and has a list of the values of all 'Event's occurring at that
925mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
927mergeList es = mergeWithFoldCheap' id es
930 :: (Reflex t, Patch p, Patch p')
931 => (PatchTarget p -> PatchTarget p')
935unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
937-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
938-- occurs if at least one of them occurs and has a map of values of all 'Event's
939-- occurring at that time.
940mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
941mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
943-- | Like 'mergeMap' but for 'IntMap'.
944mergeIntMap :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
945mergeIntMap = fmap dmapToIntMap . merge . intMapWithFunctorToDMap
947-- | Create a merge whose parents can change over time
948mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
949mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
951-- | Create a merge whose parents can change over time
952mergeIntMapIncremental :: Reflex t => Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
953mergeIntMapIncremental = fmap dmapToIntMap . mergeIncremental . unsafeMapIncremental intMapWithFunctorToDMap (const2IntPatchDMapWith id)
955-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
956mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
957mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
959-- | Split the event into separate events for 'Left' and 'Right' values.
960fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
962 let justLeft = either Just (const Nothing)
963 justRight = either (const Nothing) Just
964 in (mapMaybe justLeft e, mapMaybe justRight e)
966-- | Split the event into separate events for 'This' and 'That' values,
967-- allowing them to fire simultaneously when the input value is 'These'.
968fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
970 let this (This x) = Just x
971 this (These x _) = Just x
973 that (That y) = Just y
974 that (These _ y) = Just y
976 in (mapMaybe this e, mapMaybe that e)
978-- | Split the event into an 'EventSelector' that allows efficient selection of
979-- the individual 'Event's.
980fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
981fanMap = fan . fmap mapToDMap
983-- | Switches to the new event whenever it receives one. Only the old event is
984-- considered the moment a new one is switched in; the output event will fire at
985-- that moment only if the old event does.
987-- Because the simultaneous firing case is irrelevant, this function imposes
988-- laxer "timing requirements" on the overall circuit, avoiding many potential
989-- cyclic dependency / metastability failures. It's also more performant. Use
990-- this rather than 'switchHoldPromptly' and 'switchHoldPromptOnly' unless you
991-- are absolutely sure you need to act on the new event in the coincidental
993switchHold :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
994switchHold ea0 eea = switch <$> hold ea0 eea
996-- | Switches to the new event whenever it receives one. Whenever a new event is
997-- provided, if it is firing, its value will be the resulting event's value; if
998-- it is not firing, but the old one is, the old one's value will be used.
1000-- 'switchHold', by always forwarding the old event the moment it is switched
1001-- out, avoids many potential cyclic dependency problems / metastability
1002-- problems. It's also more performant. Use it instead unless you are sure you
1004switchHoldPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1005switchHoldPromptly ea0 eea = do
1007 let eLag = switch bea
1008 eCoincidences = coincidence eea
1009 return $ leftmost [eCoincidences, eLag]
1011-- | switches to a new event whenever it receives one. At the moment of
1012-- switching, the old event will be ignored if it fires, and the new one will be
1013-- used if it fires; this is the opposite of 'switch', which will use only the
1016-- 'switchHold', by always forwarding the old event the moment it is switched
1017-- out, avoids many potential cyclic dependency problems / metastability
1018-- problems. It's also more performant. Use it instead unless you are sure you
1020switchHoldPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1021switchHoldPromptOnly e0 e' = do
1022 eLag <- switch <$> hold e0 e'
1023 return $ coincidence $ leftmost [e', eLag <$ eLag]
1025-- | When the given outer event fires, condense the inner events into the contained patch. Non-firing inner events will be replaced with deletions.
1026coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)
1027coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ ffor e $ \(PatchMap m) -> mergeMap $ ffor m $ \case
1028 Nothing -> fmapCheap (const Nothing) e
1029 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
1031-- | See 'coincidencePatchMap'
1032coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)
1033coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ ffor e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case
1034 Nothing -> fmapCheap (const Nothing) e
1035 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
1037-- | See 'coincidencePatchMap'
1038coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)
1039coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ ffor e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
1040 PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->
1041 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1042 PatchMapWithMove.From_Move k -> fforCheap e $ \_ ->
1043 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }
1044 PatchMapWithMove.From_Insert ev -> leftmost
1045 [ fforCheap ev $ \v ->
1046 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }
1047 , fforCheap e $ \_ ->
1048 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1051-- | Given a 'PatchTarget' of events (e.g., a 'Map' with 'Event' values) and an event of 'Patch'es
1052-- (e.g., a 'PatchMap' with 'Event' values), produce an 'Event' of the 'PatchTarget' type that
1053-- fires with the patched value.
1054switchHoldPromptOnlyIncremental
1055 :: forall t m p pt w
1058 , Patch (p (Event t w))
1059 , PatchTarget (p (Event t w)) ~ pt (Event t w)
1061 , PatchTarget (p w) ~ pt w
1064 => (Incremental t (p (Event t w)) -> Event t (pt w))
1065 -> (Event t (p (Event t w)) -> Event t (p w))
1067 -> Event t (p (Event t w))
1068 -> m (Event t (pt w))
1069switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch e0 e' = do
1070 lag <- mergePatchIncremental <$> holdIncremental e0 e'
1071 pure $ ffor (align lag (coincidencePatch e')) $ \case
1073 That new -> new `applyAlways` mempty
1074 These old new -> new `applyAlways` old
1076instance Reflex t => Align (Event t) where
1078#if MIN_VERSION_these(0, 8, 0)
1079instance Reflex t => Semialign (Event t) where
1081 align = alignEventWithMaybe Just
1083#ifdef MIN_VERSION_semialign
1084#if MIN_VERSION_semialign(1,1,0)
1085instance Reflex t => Zip (Event t) where
1087 zip x y = mapMaybe justThese $ align x y
1091-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
1092-- the 'Behavior' is true at the time of occurrence.
1093gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
1094gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
1096-- | Create a new behavior given a starting behavior and switch to the behavior
1097-- carried by the event when it fires.
1098switcher :: (Reflex t, MonadHold t m)
1099 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
1100switcher b eb = pull . (sample <=< sample) <$> hold b eb
1102instance (Reflex t, IsString a) => IsString (Dynamic t a) where
1103 fromString = pure . fromString
1105-- | Combine two 'Dynamic's. The result will change whenever either (or both)
1106-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
1107zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
1108zipDyn = zipDynWith (,)
1110-- | Combine two 'Dynamic's with a combining function. The result will change
1111-- whenever either (or both) input 'Dynamic' changes.
1112-- More efficient than 'liftA2'.
1113zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
1115 let eab = align (updated da) (updated db)
1116 ec = flip push eab $ \o -> do
1119 b <- sample $ current db
1122 a <- sample $ current da
1124 These a b -> return (a, b)
1125 return $ Just $ f a b
1126 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
1128instance (Reflex t, Semigroup a) => Semigroup (Dynamic t a) where
1129 (<>) = zipDynWith (<>)
1130 stimes n = fmap $ stimes n
1132instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
1133 mconcat = distributeListOverDynWith mconcat
1134 mempty = constDyn mempty
1135 mappend = zipDynWith mappend
1137-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1138-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1139-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1140distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
1141distributeDMapOverDynPure = distributeDMapOverDynPureG coerceDynamic
1143-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1144-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1145-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1146distributeDMapOverDynPureG
1147 :: forall t k q v. (Reflex t, GCompare k)
1148 => (forall a. q a -> Dynamic t (v a))
1149 -> DMap k q -> Dynamic t (DMap k v)
1150distributeDMapOverDynPureG nt dm = case DMap.toList dm of
1151 [] -> constDyn DMap.empty
1152 [k :=> v] -> DMap.singleton k <$> nt v
1154 let getInitial = DMap.traverseWithKey (\_ -> sample . current . nt) dm
1155 edmPre = mergeG getCompose $ DMap.map (Compose . updated . nt) dm
1156 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
1157 olds <- sample $ current result
1158 return $ DMap.unionWithKey (\_ _ new -> new) olds news
1161-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
1162distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
1163distributeListOverDyn = distributeListOverDynWith id
1165-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
1166distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
1167distributeListOverDynWith f =
1168 fmap (f . map fromDSum . DMap.toAscList) .
1169 distributeDMapOverDynPure .
1170 DMap.fromDistinctAscList .
1171 zipWith toDSum [0..]
1173 toDSum :: Int -> Dynamic t a -> DSum (Const2 Int a) (Dynamic t)
1174 toDSum k v = Const2 k :=> v
1175 fromDSum :: DSum (Const2 Int a) Identity -> a
1176 fromDSum (Const2 _ :=> Identity v) = v
1178-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
1179-- unless the second supplied 'Event' occurs simultaneously.
1180difference :: Reflex t => Event t a -> Event t b -> Event t a
1181difference = alignEventWithMaybe $ \case
1185-- | Zips two values by taking the union of their shapes and combining with the provided function.
1186-- 'Nothing' values are dropped.
1187alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
1188alignEventWithMaybe f ea eb = mapMaybe (f <=< dmapToThese) $
1189 merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
1191-- | Produces an 'Event' that fires only when the input event fires with a 'DSum' key that
1192-- matches the provided key.
1194 :: forall t m k v a.
1201 -> Event t (DSum k v)
1202 -> m (Event t (v a))
1203filterEventKey k kv' = do
1204 let f :: DSum k v -> Maybe (v a)
1205 f (newK :=> newV) = case newK `geq` k of
1206 Just Refl -> Just newV
1208 takeWhileJustE f kv'
1210-- | "Factor" the input 'DSum' 'Event' to produce an 'Event' which
1211-- fires when the 'DSum' key changes and contains both the value of the
1212-- 'DSum' at switchover and an 'Event' of values produced by subsequent
1213-- firings of the input 'Event' that do not change the 'DSum' key.
1215 :: forall t m k v a.
1222 -> Event t (DSum k v)
1223 -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))
1224factorEvent k0 kv' = do
1225 key :: Behavior t (Some k) <- hold (Some k0) $ fmapCheap (\(k :=> _) -> Some k) kv'
1226 let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case
1227 Some oldKey -> case newKey `geq` oldKey of
1228 Just Refl -> return Nothing
1230 newInner <- filterEventKey newKey kv'
1231 return $ Just $ newKey :=> Pair newVal (Compose newInner)
1232 eInitial <- filterEventKey k0 kv'
1233 return (eInitial, update)
1235--------------------------------------------------------------------------------
1237--------------------------------------------------------------------------------
1239-- | An 'Accumulator' type can be built by accumulating occurrences of an
1241#if __GLASGOW_HASKELL__ < 802
1242{-# WARNING accum "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1243{-# WARNING accumM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1244{-# WARNING accumMaybe "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1245{-# WARNING accumMaybeM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1247class Reflex t => Accumulator t f | f -> t where
1248 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
1249 accum f = accumMaybe $ \v o -> Just $ f v o
1250 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
1251 accumM f = accumMaybeM $ \v o -> Just <$> f v o
1252 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
1253 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
1254 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
1255 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
1256 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
1257 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
1258 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
1259 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1260 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
1261 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1263-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1264-- with the provided function. See 'foldDyn'.
1266 :: (Reflex t, MonadHold t m, MonadFix m)
1271accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o
1273-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1274-- with the provided 'PushM' action.
1276 :: (Reflex t, MonadHold t m, MonadFix m)
1277 => (a -> b -> PushM t a)
1281accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o
1283-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1284-- with the provided function, discarding 'Nothing' results.
1286 :: (Reflex t, MonadHold t m, MonadFix m)
1287 => (a -> b -> Maybe a)
1291accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o
1293-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1294-- with the provided 'PushM' action, discarding 'Nothing' results.
1296 :: (Reflex t, MonadHold t m, MonadFix m)
1297 => (a -> b -> PushM t (Maybe a))
1301accumMaybeMDyn f z e = do
1302 rec let e' = flip push e $ \o -> do
1303 v <- sample $ current d'
1308-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1309-- with a function that both accumulates and produces a value to fire
1310-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1312 :: (Reflex t, MonadHold t m, MonadFix m)
1313 => (a -> b -> (a, c))
1316 -> m (Dynamic t a, Event t c)
1317mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o
1319-- | Similar to 'mapAccumDyn' except that the combining function is a
1322 :: (Reflex t, MonadHold t m, MonadFix m)
1323 => (a -> b -> PushM t (a, c))
1326 -> m (Dynamic t a, Event t c)
1327mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o
1329-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event' with
1330-- a function that both optionally accumulates and optionally produces
1331-- a value to fire as a separate output 'Event'.
1332-- Note that because 'Nothing's are discarded in both cases, the output
1333-- 'Event' may fire even though the output 'Dynamic' has not changed, and
1334-- the output 'Dynamic' may update even when the output 'Event' is not firing.
1336 :: (Reflex t, MonadHold t m, MonadFix m)
1337 => (a -> b -> (Maybe a, Maybe c))
1340 -> m (Dynamic t a, Event t c)
1341mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o
1343-- | Like 'mapAccumMaybeDyn' except that the combining function is a
1346 :: (Reflex t, MonadHold t m, MonadFix m)
1347 => (a -> b -> PushM t (Maybe a, Maybe c))
1350 -> m (Dynamic t a, Event t c)
1351mapAccumMaybeMDyn f z e = do
1352 rec let e' = flip push e $ \o -> do
1353 v <- sample $ current d'
1355 return $ case result of
1356 (Nothing, Nothing) -> Nothing
1358 d' <- holdDyn z $ mapMaybe fst e'
1359 return (d', mapMaybe snd e')
1361-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1362-- with the provided function.
1363{-# INLINE accumB #-}
1365 :: (Reflex t, MonadHold t m, MonadFix m)
1370accumB f = accumMaybeB $ \v o -> Just $ f v o
1372-- | Like 'accumB' except that the combining function is a 'PushM' action.
1373{-# INLINE accumMB #-}
1375 :: (Reflex t, MonadHold t m, MonadFix m)
1376 => (a -> b -> PushM t a)
1380accumMB f = accumMaybeMB $ \v o -> Just <$> f v o
1382-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1383-- with the provided function, discarding 'Nothing' results.
1384{-# INLINE accumMaybeB #-}
1386 :: (Reflex t, MonadHold t m, MonadFix m)
1387 => (a -> b -> Maybe a)
1391accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o
1393-- | Like 'accumMaybeB' except that the combining function is a 'PushM' action.
1394{-# INLINE accumMaybeMB #-}
1395accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)
1396accumMaybeMB f z e = do
1397 rec let e' = flip push e $ \o -> do
1403-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1404-- with a function that both accumulates and produces a value to fire
1405-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1406{-# INLINE mapAccumB #-}
1408 :: (Reflex t, MonadHold t m, MonadFix m)
1409 => (a -> b -> (a, c))
1412 -> m (Behavior t a, Event t c)
1413mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o
1415-- | Like 'mapAccumB' except that the combining function is a 'PushM' action.
1416{-# INLINE mapAccumMB #-}
1418 :: (Reflex t, MonadHold t m, MonadFix m)
1419 => (a -> b -> PushM t (a, c))
1422 -> m (Behavior t a, Event t c)
1423mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o
1425-- | Accumulate a 'Behavior' by folding occurrences of an 'Event' with
1426-- a function that both optionally accumulates and optionally produces
1427-- a value to fire as a separate output 'Event'. 'Nothing's are discarded.
1428{-# INLINE mapAccumMaybeB #-}
1430 :: (Reflex t, MonadHold t m, MonadFix m)
1431 => (a -> b -> (Maybe a, Maybe c))
1434 -> m (Behavior t a, Event t c)
1435mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o
1437-- | Like 'mapAccumMaybeB' except that the combining function is a 'PushM' action.
1438{-# INLINE mapAccumMaybeMB #-}
1439mapAccumMaybeMB :: (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)
1440mapAccumMaybeMB f z e = do
1441 rec let e' = flip push e $ \o -> do
1444 return $ case result of
1445 (Nothing, Nothing) -> Nothing
1447 d' <- hold z $ mapMaybe fst e'
1448 return (d', mapMaybe snd e')
1450-- | Accumulate occurrences of an 'Event', producing an output occurrence each
1451-- time. Discard the underlying 'Accumulator'.
1452{-# INLINE mapAccum_ #-}
1453mapAccum_ :: 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)
1455 (_, result) <- mapAccumB f z e
1458-- | Accumulate occurrences of an 'Event', possibly producing an output
1459-- occurrence each time. Discard the underlying 'Accumulator'.
1460{-# INLINE mapAccumMaybe_ #-}
1461mapAccumMaybe_ :: 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)
1462mapAccumMaybe_ f z e = do
1463 (_, result) <- mapAccumMaybeB f z e
1466-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
1467-- an output occurrence each time. Discard the underlying 'Accumulator'.
1468{-# INLINE mapAccumM_ #-}
1469mapAccumM_ :: 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)
1470mapAccumM_ f z e = do
1471 (_, result) <- mapAccumMB f z e
1474-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
1475-- producing an output occurrence each time. Discard the underlying
1477{-# INLINE mapAccumMaybeM_ #-}
1478mapAccumMaybeM_ :: 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)
1479mapAccumMaybeM_ f z e = do
1480 (_, result) <- mapAccumMaybeMB f z e
1483instance Reflex t => Accumulator t (Dynamic t) where
1484 accumMaybeM = accumMaybeMDyn
1485 mapAccumMaybeM = mapAccumMaybeMDyn
1487instance Reflex t => Accumulator t (Behavior t) where
1488 accumMaybeM = accumMaybeMB
1489 mapAccumMaybeM = mapAccumMaybeMB
1491instance Reflex t => Accumulator t (Event t) where
1492 accumMaybeM f z e = updated <$> accumMaybeM f z e
1493 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
1495-- | Create a new 'Event' by combining each occurrence with the next value of the
1496-- list using the supplied function. If the list runs out of items, all
1497-- subsequent 'Event' occurrences will be ignored.
1498zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
1499zipListWithEvent f l e = do
1500 let f' a b = case a of
1501 h:t -> (Just t, Just $ f h b)
1502 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
1503 mapAccumMaybe_ f' l e
1505-- | Assign a number to each occurrence of the given 'Event', starting from 0
1506{-# INLINE numberOccurrences #-}
1507numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
1508numberOccurrences = numberOccurrencesFrom 0
1510-- | Assign a number to each occurrence of the given 'Event'
1511{-# INLINE numberOccurrencesFrom #-}
1512numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
1513numberOccurrencesFrom = mapAccum_ (\n a -> let !next = n + 1 in (next, (n, a)))
1515-- | Assign a number to each occurrence of the given 'Event'; discard the occurrences' values
1516{-# INLINE numberOccurrencesFrom_ #-}
1517numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
1518numberOccurrencesFrom_ = mapAccum_ (\n _ -> let !next = n + 1 in (next, n))
1520-- | This is used to sample the value of a 'Behavior' using an 'Event'.
1522-- The '<@>' operator is intended to be used in conjunction with
1523-- the 'Applicative' instance for 'Behavior'.
1525-- This is useful when we want to combine the values of one 'Event' and
1526-- the value of several 'Behavior's at the time the 'Event' is firing.
1530-- > f :: a -> b -> c -> d
1531-- > b1 :: Behavior t a
1532-- > b2 :: Behavior t b
1537-- > f <$> b1 <*> b2 <@> e :: Event t d
1539-- in order to apply the function 'f' to the relevant values.
1541-- The alternative would be something like:
1543-- > attachWith (\(x1, x2) y -> f x1 x2 y) ((,) <$> b1 <*> b2) e :: Event t d
1545-- or a variation involing a custom data type to hold the combination of
1546-- 'Behavior's even when that combination might only ever be used by 'f'.
1548-- A more suggestive example might be:
1550-- > handleMouse <$> bPlayerState <*> bMousePosition <@> eMouseClick :: Event t (GameState -> GameState)
1552(<@>) :: Reflex t => Behavior t (a -> b) -> Event t a -> Event t b
1553(<@>) b = push $ \x -> do
1555 return . Just . f $ x
1558-- | An version of '<@>' that does not use the value of the 'Event'.
1560-- Alternatively, it is 'tag' in operator form.
1562-- This is useful when we want to combine the values of several
1563-- 'Behavior's at particular points in time using an 'Applicative'
1568-- > g :: a -> b -> d
1569-- > b1 :: Behavior t a
1570-- > b2 :: Behavior t b
1573-- where 'e' is firing at the points in time of interest.
1575-- Then we can use '<@':
1577-- > g <$> b1 <*> b2 <@ e :: Event t d
1579-- to combine the values of 'b1' and 'b2' at each of those points of time,
1580-- with the function 'g' being used to combine the values.
1582-- This is the same as '<@>' except that the 'Event' is being used only
1583-- to act as a trigger.
1584(<@) :: (Reflex t) => Behavior t b -> Event t a -> Event t b
1592-- | A "cheap" version of 'pushAlways'. See the performance note on 'pushCheap'.
1593{-# INLINE pushAlwaysCheap #-}
1594pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
1595pushAlwaysCheap f = pushCheap (fmap Just . f)
1597-- | A "cheap" version of 'mapMaybe'. See the performance note on 'pushCheap'.
1598{-# INLINE mapMaybeCheap #-}
1599mapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1600mapMaybeCheap f = pushCheap $ return . f
1602-- | An alias for 'mapMaybeCheap'
1603{-# INLINE fmapMaybeCheap #-}
1604fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1605fmapMaybeCheap = mapMaybeCheap
1608-- | A "cheap" version of 'fforMaybe'. See the performance note on 'pushCheap'.
1609{-# INLINE fforMaybeCheap #-}
1610fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
1611fforMaybeCheap = flip mapMaybeCheap
1613-- | A "cheap" version of 'ffor'. See the performance note on 'pushCheap'.
1614{-# INLINE fforCheap #-}
1615fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
1616fforCheap = flip fmapCheap
1618-- | A "cheap" version of 'fmap'. See the performance note on 'pushCheap'.
1619{-# INLINE fmapCheap #-}
1620fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
1621fmapCheap f = pushCheap $ return . Just . f
1623-- | A "cheap" version of 'tag'. See the performance note on 'pushCheap'.
1624{-# INLINE tagCheap #-}
1625tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
1626tagCheap b = pushAlwaysCheap $ \_ -> sample b
1628-- | Merge a collection of events; the resulting 'Event' will only occur if at
1629-- least one input event is occurring, and will contain all of the input keys
1630-- that are occurring simultaneously
1631merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)
1632merge = mergeG coerceEvent
1635-- | Create a merge whose parents can change over time
1636mergeIncremental :: (Reflex t, GCompare k)
1637 => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
1638mergeIncremental = mergeIncrementalG coerceEvent
1640-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
1641mergeIncrementalWithMove :: (Reflex t, GCompare k)
1642 => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
1643mergeIncrementalWithMove = mergeIncrementalWithMoveG coerceEvent
1645-- | A "cheap" version of 'mergeWithCheap'. See the performance note on 'pushCheap'.
1646{-# INLINE mergeWithCheap #-}
1647mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
1648mergeWithCheap = mergeWithCheap' id
1650-- | A "cheap" version of 'mergeWithCheap''. See the performance note on 'pushCheap'.
1651{-# INLINE mergeWithCheap' #-}
1652mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
1653mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
1655-- | A "cheap" version of 'mergeWithFoldCheap''. See the performance note on 'pushCheap'.
1656{-# INLINE mergeWithFoldCheap' #-}
1657mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
1658mergeWithFoldCheap' f es =
1659 fmapCheap (f . (\(h : t) -> h :| t) . IntMap.elems)
1661 . IntMap.fromDistinctAscList
1662 $ zip [0 :: Int ..] es
1664--------------------------------------------------------------------------------
1665-- Deprecated functions
1666--------------------------------------------------------------------------------
1668{-# 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'. " #-}
1669-- | See 'switchHoldPromptly'
1670switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1671switchPromptly = switchHoldPromptly
1672{-# 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'. " #-}
1673-- | See 'switchHoldPromptOnly'
1674switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1675switchPromptOnly = 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