1{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE ConstraintKinds #-}
4{-# LANGUAGE DefaultSignatures #-}
5{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE FunctionalDependencies #-}
9{-# LANGUAGE LambdaCase #-}
10{-# LANGUAGE MultiParamTypeClasses #-}
11{-# LANGUAGE NoMonomorphismRestriction #-}
12{-# LANGUAGE PolyKinds #-}
13{-# LANGUAGE RankNTypes #-}
14{-# LANGUAGE RecursiveDo #-}
15{-# LANGUAGE RoleAnnotations #-}
16{-# LANGUAGE ScopedTypeVariables #-}
17{-# LANGUAGE TypeFamilies #-}
18{-# LANGUAGE TypeOperators #-}
19{-# LANGUAGE UndecidableInstances #-}
20{-# LANGUAGE Trustworthy #-}
21#ifdef USE_REFLEX_OPTIMIZER
22{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
29-- This module contains the Reflex interface, as well as a variety of
30-- convenience functions for working with 'Event's, 'Behavior's, and other
42 -- ** 'fan' related types
44 , EventSelectorInt (..)
45 -- * Convenience functions
48 -- ** Combining 'Event's
52 , mergeIncrementalWithMove
56 , mergeMapIncrementalWithMove
57 , mergeIntMapIncremental
59 , coincidencePatchMapWithMove
60 , coincidencePatchIntMap
65 -- ** Breaking up 'Event's
76 -- ** Collapsing 'Event . Event'
79 , switchHoldPromptOnly
80 , switchHoldPromptOnlyIncremental
81 -- ** Using 'Event's to sample 'Behavior's
87 -- ** Blocking an 'Event' based on a 'Behavior'
89 -- ** Combining 'Dynamic's
90 , distributeDMapOverDynPure
91 , distributeDMapOverDynPureG
92 , distributeListOverDyn
93 , distributeListOverDynWith
96 -- ** Accumulating state
120 , accumMaybeIncremental
121 , accumMaybeMIncremental
122 , mapAccumIncremental
123 , mapAccumMIncremental
124 , mapAccumMaybeIncremental
125 , mapAccumMaybeMIncremental
128 , numberOccurrencesFrom
129 , numberOccurrencesFrom_
139 -- * Debugging functions
142 -- * Unsafe functions
144 , unsafeMapIncremental
145 -- * 'Filterable' convenience functions
146 , FunctorMaybe -- fmapMaybe is purposely not exported from deprecated 'FunctorMaybe' and the new alias is exported instead
147 , mapMaybe -- Re-exported for convenience
153 -- * Miscellaneous convenience functions
157 -- * Deprecated functions
160 -- * "Cheap" functions
170 -- * Slow, but general, implementations
174import Control.Applicative
175import Control.Monad.Identity
176import Control.Monad.Reader
177import Control.Monad.State.Strict
178import Control.Monad.Trans.Cont (ContT)
179import Control.Monad.Trans.Except (ExceptT)
180import Control.Monad.Trans.RWS (RWST)
181import Control.Monad.Trans.Writer (WriterT)
186import Data.Dependent.Map (DMap, DSum (..))
187import qualified Data.Dependent.Map as DMap
188import Data.Functor.Compose
189import Data.Functor.Product
190import Data.GADT.Compare (GEq (..), GCompare (..), (:~:) (..))
191import Data.FastMutableIntMap (PatchIntMap)
193import Data.Functor.Bind
194import Data.Functor.Misc
195import Data.Functor.Plus
196import Data.IntMap.Strict (IntMap)
197import qualified Data.IntMap.Strict as IntMap
198import Data.List.NonEmpty (NonEmpty (..))
200import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
201import Data.Some (Some)
202import qualified Data.Some as Some
205import Data.Type.Coercion
206import Data.Witherable (Filterable(..))
207import qualified Data.Witherable as W
208import Reflex.FunctorMaybe (FunctorMaybe)
209import qualified Reflex.FunctorMaybe
211import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
213import Debug.Trace (trace)
215-- | The 'Reflex' class contains all the primitive functionality needed for
216-- Functional Reactive Programming (FRP). The @/t/@ type parameter indicates
217-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
218-- and the type of the timeline determines the FRP engine to be used. For most
219-- purposes, the 'Reflex.Spider' implementation is recommended.
220class ( MonadHold t (PushM t)
221 , MonadSample t (PullM t)
223 , Functor (Dynamic t)
224 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
227 -- | A container for a value that can change over time. 'Behavior's can be
228 -- sampled at will, but it is not possible to be notified when they change
229 data Behavior t :: * -> *
230 -- | A stream of occurrences. During any given frame, an 'Event' is either
231 -- occurring or not occurring; if it is occurring, it will contain a value of
232 -- the given type (its "occurrence type")
233 data Event t :: * -> *
234 -- | A container for a value that can change over time and allows
235 -- notifications on changes. Basically a combination of a 'Behavior' and an
236 -- 'Event', with a rule that the 'Behavior' will change if and only if the
238 data Dynamic t :: * -> *
239 -- | An 'Incremental' is a more general form of a 'Dynamic'.
240 -- Instead of always fully replacing the value, only parts of it can be patched.
241 -- This is only needed for performance critical code via `mergeIncremental` to make small
242 -- changes to large values.
243 data Incremental t :: * -> *
244 -- | A monad for doing complex push-based calculations efficiently
245 type PushM t :: * -> *
246 -- | A monad for doing complex pull-based calculations efficiently
247 type PullM t :: * -> *
248 -- | An 'Event' with no occurrences
250 -- | Create a 'Behavior' that always has the given value
251 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
252 -- | Create an 'Event' from another 'Event'; the provided function can sample
253 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
254 -- (Just) or non-occurring (Nothing) result
255 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
256 -- | 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.
257 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
258 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
259 -- recomputed whenever any of the read 'Behavior's changes
260 pull :: PullM t a -> Behavior t a
261 -- | Merge a collection of events; the resulting 'Event' will only occur if at
262 -- least one input event is occurring, and will contain all of the input keys
263 -- that are occurring simultaneously
264 mergeG :: GCompare k => (forall a. q a -> Event t (v a))
265 -> DMap k q -> Event t (DMap k v)
266 --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
267 -- | Efficiently fan-out an event to many destinations. You should save the
268 -- result in a @let@-binding, and then repeatedly 'select' on the result to
269 -- create child events
270 fan :: GCompare k => Event t (DMap k Identity) -> EventSelector t k
271 -- | Create an 'Event' that will occur whenever the currently-selected input
273 switch :: Behavior t (Event t a) -> Event t a
274 -- | Create an 'Event' that will occur whenever the input event is occurring -- and its occurrence value, another 'Event', is also occurring
275 coincidence :: Event t (Event t a) -> Event t a
276 -- | Extract the 'Behavior' of a 'Dynamic'.
277 current :: Dynamic t a -> Behavior t a
278 -- | Extract the 'Event' of the 'Dynamic'.
279 updated :: Dynamic t a -> Event t a
280 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
281 -- recent firing of the given 'Event', if any.
282 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
283 -- | Create a new 'Incremental'. The given "PullM"'s value must always change
284 -- in the same way that the accumulated application of patches would change
286 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
287 -- | Create a merge whose parents can change over time
288 mergeIncrementalG :: GCompare k
289 => (forall a. q a -> Event t (v a))
290 -> Incremental t (PatchDMap k q)
291 -> Event t (DMap k v)
292 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
293 mergeIncrementalWithMoveG :: GCompare k
294 => (forall a. q a -> Event t (v a))
295 -> Incremental t (PatchDMapWithMove k q) -> Event t (DMap k v)
296 -- | Extract the 'Behavior' component of an 'Incremental'
297 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
298 -- | Extract the 'Event' component of an 'Incremental'
299 updatedIncremental :: Patch p => Incremental t p -> Event t p
300 -- | Convert an 'Incremental' to a 'Dynamic'
301 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
302 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
304 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
305 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
307 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
308 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
310 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
311 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
312 fanInt :: Event t (IntMap a) -> EventSelectorInt t a
314--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on
315-- | Constructs a single 'Event' out of a map of events. The output event may fire with multiple
316-- keys simultaneously.
317mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
318mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never
320-- | Coerce a 'Behavior' between representationally-equivalent value types
321coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
322coerceBehavior = coerceWith $ behaviorCoercion Coercion
324-- | Coerce an 'Event' between representationally-equivalent occurrence types
325coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
326coerceEvent = coerceWith $ eventCoercion Coercion
328-- | Coerce a 'Dynamic' between representationally-equivalent value types
329coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
330coerceDynamic = coerceWith $ dynamicCoercion Coercion
332-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
333-- __must__ change when and only when the 'Event' fires, such that the
334-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
335-- if this is not the case, the resulting 'Dynamic' will behave
336-- nondeterministically.
337unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
338unsafeDynamic = unsafeBuildDynamic . sample
340-- | Construct a 'Dynamic' value that never changes
341constDyn :: Reflex t => a -> Dynamic t a
344instance (Reflex t, Default a) => Default (Dynamic t a) where
347-- | 'MonadSample' designates monads that can read the current value of a
348-- 'Behavior'. This includes both 'PullM' and 'PushM'.
349class (Applicative m, Monad m) => MonadSample t m | m -> t where
350 -- | Get the current value in the 'Behavior'
351 sample :: Behavior t a -> m a
353-- | 'MonadHold' designates monads that can create new 'Behavior's based on
354-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
355-- is required to create any stateful computations with Reflex.
356class MonadSample t m => MonadHold t m where
357 -- | Create a new 'Behavior' whose value will initially be equal to the given
358 -- value and will be updated whenever the given 'Event' occurs. The update
359 -- takes effect immediately after the 'Event' occurs; if the occurrence that
360 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
361 -- the 'Behavior', it will see the __old__ value of the 'Behavior', not the new
363 hold :: a -> Event t a -> m (Behavior t a)
364 default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)
365 hold v0 = lift . hold v0
366 -- | Create a 'Dynamic' value using the given initial value that changes every
367 -- time the 'Event' occurs.
368 holdDyn :: a -> Event t a -> m (Dynamic t a)
369 default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)
370 holdDyn v0 = lift . holdDyn v0
371 -- | Create an 'Incremental' value using the given initial value that changes
372 -- every time the 'Event' occurs.
373 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
374 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
375 holdIncremental v0 = lift . holdIncremental v0
376 buildDynamic :: PushM t a -> Event t a -> m (Dynamic t a)
378 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
379 buildDynamic getV0 = lift . buildDynamic getV0
381 -- | Create a new 'Event' that only occurs only once, on the first occurrence of
382 -- the supplied 'Event'.
383 headE :: Event t a -> m (Event t a)
385-- | Accumulate an 'Incremental' with the supplied initial value and the firings of the provided 'Event',
386-- using the combining function to produce a patch.
388 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
389 => (PatchTarget p -> b -> p)
392 -> m (Incremental t p)
393accumIncremental f = accumMaybeIncremental $ \v o -> Just $ f v o
395-- | Similar to 'accumIncremental' but the combining function runs in 'PushM'
397 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
398 => (PatchTarget p -> b -> PushM t p)
401 -> m (Incremental t p)
402accumMIncremental f = accumMaybeMIncremental $ \v o -> Just <$> f v o
404-- | Similar to 'accumIncremental' but allows filtering of updates (by dropping updates when the
405-- combining function produces @Nothing@)
407 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
408 => (PatchTarget p -> b -> Maybe p)
411 -> m (Incremental t p)
412accumMaybeIncremental f = accumMaybeMIncremental $ \v o -> return $ f v o
414-- | Similar to 'accumMaybeMIncremental' but the combining function runs in 'PushM'
415accumMaybeMIncremental
416 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
417 => (PatchTarget p -> b -> PushM t (Maybe p))
420 -> m (Incremental t p)
421accumMaybeMIncremental f z e = do
422 rec let e' = flip push e $ \o -> do
423 v <- sample $ currentIncremental d'
425 d' <- holdIncremental z e'
428-- | Accumulate an 'Incremental' by folding occurrences of an 'Event'
429-- with a function that both accumulates and produces a value to fire
430-- as an 'Event'. Returns both the accumulated value and the constructed
433 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
434 => (PatchTarget p -> b -> (p, c))
437 -> m (Incremental t p, Event t c)
438mapAccumIncremental f = mapAccumMaybeIncremental $ \v o -> bimap Just Just $ f v o
440-- | Like 'mapAccumIncremental' but the combining function runs in 'PushM'
442 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
443 => (PatchTarget p -> b -> PushM t (p, c))
446 -> m (Incremental t p, Event t c)
447mapAccumMIncremental f = mapAccumMaybeMIncremental $ \v o -> bimap Just Just <$> f v o
449-- | Accumulate an 'Incremental' by folding occurrences of an 'Event' with
450-- a function that both optionally accumulates and optionally produces
451-- a value to fire as a separate output 'Event'.
452-- Note that because 'Nothing's are discarded in both cases, the output
453-- 'Event' may fire even though the output 'Incremental' has not changed, and
454-- the output 'Incremental' may update even when the output 'Event' is not firing.
455mapAccumMaybeIncremental
456 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
457 => (PatchTarget p -> b -> (Maybe p, Maybe c))
460 -> m (Incremental t p, Event t c)
461mapAccumMaybeIncremental f = mapAccumMaybeMIncremental $ \v o -> return $ f v o
463-- | Like 'mapAccumMaybeIncremental' but the combining function is a 'PushM' action
464mapAccumMaybeMIncremental
465 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
466 => (PatchTarget p -> b -> PushM t (Maybe p, Maybe c))
469 -> m (Incremental t p, Event t c)
470mapAccumMaybeMIncremental f z e = do
471 rec let e' = flip push e $ \o -> do
472 v <- sample $ currentIncremental d'
474 return $ case result of
475 (Nothing, Nothing) -> Nothing
477 d' <- holdIncremental z $ mapMaybe fst e'
478 return (d', mapMaybe snd e')
480-- | A somewhat slow implementation of 'headE'
481slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
483 rec be <- hold e $ fmapCheap (const never) e'
487-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
488-- key. This is much more efficient than filtering for each key with
490newtype EventSelector t k = EventSelector
491 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
492 -- determined by the type of the key, so this can be used to fan-out
493 -- 'Event's whose sub-'Event's have different types.
495 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
496 -- (but equivalent to) using 'mapMaybe' to select only the relevant
497 -- occurrences of an 'Event'.
498 select :: forall a. k a -> Event t a
501-- | Efficiently select an 'Event' keyed on 'Int'. This is more efficient than manually
503newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }
505--------------------------------------------------------------------------------
507--------------------------------------------------------------------------------
509instance MonadSample t m => MonadSample t (ReaderT r m) where
510 sample = lift . sample
512instance MonadHold t m => MonadHold t (ReaderT r m) where
513 hold a0 = lift . hold a0
514 holdDyn a0 = lift . holdDyn a0
515 holdIncremental a0 = lift . holdIncremental a0
516 buildDynamic a0 = lift . buildDynamic a0
519instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
520 sample = lift . sample
522instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
523 hold a0 = lift . hold a0
524 holdDyn a0 = lift . holdDyn a0
525 holdIncremental a0 = lift . holdIncremental a0
526 buildDynamic a0 = lift . buildDynamic a0
529instance MonadSample t m => MonadSample t (StateT s m) where
530 sample = lift . sample
532instance MonadHold t m => MonadHold t (StateT s m) where
533 hold a0 = lift . hold a0
534 holdDyn a0 = lift . holdDyn a0
535 holdIncremental a0 = lift . holdIncremental a0
536 buildDynamic a0 = lift . buildDynamic a0
539instance MonadSample t m => MonadSample t (ExceptT e m) where
540 sample = lift . sample
542instance MonadHold t m => MonadHold t (ExceptT e m) where
543 hold a0 = lift . hold a0
544 holdDyn a0 = lift . holdDyn a0
545 holdIncremental a0 = lift . holdIncremental a0
546 buildDynamic a0 = lift . buildDynamic a0
549instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
550 sample = lift . sample
552instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
553 hold a0 = lift . hold a0
554 holdDyn a0 = lift . holdDyn a0
555 holdIncremental a0 = lift . holdIncremental a0
556 buildDynamic a0 = lift . buildDynamic a0
559instance MonadSample t m => MonadSample t (ContT r m) where
560 sample = lift . sample
562instance MonadHold t m => MonadHold t (ContT r m) where
563 hold a0 = lift . hold a0
564 holdDyn a0 = lift . holdDyn a0
565 holdIncremental a0 = lift . holdIncremental a0
566 buildDynamic a0 = lift . buildDynamic a0
569--------------------------------------------------------------------------------
570-- Convenience functions
571--------------------------------------------------------------------------------
573-- | Create an 'Event' from another 'Event'. The provided function can sample
574-- 'Behavior's and hold 'Event's.
575pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
576pushAlways f = push (fmap Just . f)
578-- | Flipped version of 'fmap'.
579ffor :: Functor f => f a -> (a -> b) -> f b
582-- | Rotated version of 'liftA2'.
583ffor2 :: Applicative f => f a -> f b -> (a -> b -> c) -> f c
584ffor2 a b f = liftA2 f a b
586-- | Rotated version of 'liftA3'.
587ffor3 :: Applicative f => f a -> f b -> f c -> (a -> b -> c -> d) -> f d
588ffor3 a b c f = liftA3 f a b c
590instance Reflex t => Applicative (Behavior t) where
592 f <*> x = pull $ sample f `ap` sample x
596instance Reflex t => Apply (Behavior t) where
599instance Reflex t => Bind (Behavior t) where
602instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
604 fromRational = pure . fromRational
607instance Reflex t => Functor (Behavior t) where
608 fmap f = pull . fmap f . sample
610instance (Reflex t, IsString a) => IsString (Behavior t a) where
611 fromString = pure . fromString
613instance Reflex t => Monad (Behavior t) where
614 a >>= f = pull $ sample a >>= sample . f
615 -- 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.
617 fail = error "Monad (Behavior t) does not support fail"
619instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
620 mempty = constant mempty
621 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
622 mconcat = pull . fmap mconcat . mapM sample
624instance (Reflex t, Num a) => Num (Behavior t a) where
629 fromInteger = pure . fromInteger
633instance (Num a, Reflex t) => Num (Dynamic t a) where
638 fromInteger = pure . fromInteger
642instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
643 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
644 sconcat = pull . fmap sconcat . mapM sample
645#if MIN_VERSION_semigroups(0,17,0)
646 stimes n = fmap $ stimes n
648 times1p n = fmap $ times1p n
651-- | Alias for 'mapMaybe'
652fmapMaybe :: Filterable f => (a -> Maybe b) -> f a -> f b
655-- | Flipped version of 'mapMaybe'.
656fforMaybe :: Filterable f => f a -> (a -> Maybe b) -> f b
657fforMaybe = flip mapMaybe
659-- | Filter 'f a' using the provided predicate.
660ffilter :: Filterable f => (a -> Bool) -> f a -> f a
663-- | Filter 'Left's from 'f (Either a b)' into 'a'.
664filterLeft :: Filterable f => f (Either a b) -> f a
665filterLeft = mapMaybe (either Just (const Nothing))
667-- | Filter 'Right's from 'f (Either a b)' into 'b'.
668filterRight :: Filterable f => f (Either a b) -> f b
669filterRight = mapMaybe (either (const Nothing) Just)
671-- | Left-biased event union (prefers left event on simultaneous
673instance Reflex t => Alt (Event t) where
674 ev1 <!> ev2 = leftmost [ev1, ev2]
676-- | 'Event' intersection (convenient interface to 'coincidence').
677instance Reflex t => Apply (Event t) where
678 evf <.> evx = coincidence (fmap (<$> evx) evf)
680-- | 'Event' intersection (convenient interface to 'coincidence').
681instance Reflex t => Bind (Event t) where
682 evx >>- f = coincidence (f <$> evx)
685instance Reflex t => Functor (Event t) where
687 fmap f = mapMaybe $ Just . f
689 x <$ e = fmapCheap (const x) e
691-- TODO Remove this instance
692instance Reflex t => FunctorMaybe (Event t) where
693 {-# INLINE fmapMaybe #-}
696instance Reflex t => Filterable (Event t) where
697 {-# INLINE mapMaybe #-}
698 mapMaybe f = push $ return . f
700-- | Never: @'zero' = 'never'@.
701instance Reflex t => Plus (Event t) where
704-- | Replace each occurrence value of the 'Event' with the value of the
705-- 'Behavior' at the time of that occurrence.
706tag :: Reflex t => Behavior t b -> Event t a -> Event t b
707tag b = pushAlways $ \_ -> sample b
709-- | Replace each occurrence value of the 'Event' with the value of the
710-- 'Behavior' at that time; if it is 'Just', fire with the contained value; if
711-- it is 'Nothing', drop the occurrence.
712tagMaybe :: Reflex t => Behavior t (Maybe b) -> Event t a -> Event t b
713tagMaybe b = push $ \_ -> sample b
715-- | Create a new 'Event' that combines occurrences of supplied 'Event' with the
716-- current value of the 'Behavior'.
717attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
718attach = attachWith (,)
720-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
721-- combining it with the current value of the 'Behavior'.
722attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
723attachWith f = attachWithMaybe $ \a b -> Just $ f a b
725-- | Create a new 'Event' by combining each occurrence with the current value of
726-- the 'Behavior'. The occurrence is discarded if the combining function returns
728attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
729attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
731-- | Create a new 'Event' that occurs on all but the first occurrence of the
733tailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a)
734tailE e = snd <$> headTailE e
736-- | Create a tuple of two 'Event's with the first one occurring only the first
737-- time the supplied 'Event' occurs and the second occurring on all but the first
739headTailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a, Event t a)
742 be <- hold never $ fmap (const e) eHead
743 return (eHead, switch be)
745-- | Take the streak of occurrences starting at the current time for which the
746-- event returns 'True'.
748-- Starting at the current time, fire all the occurrences of the 'Event' for
749-- which the given predicate returns 'True'. When first 'False' is returned,
750-- do not fire, and permanently stop firing, even if 'True' values would have
751-- been encountered later.
754 . (Reflex t, MonadFix m, MonadHold t m)
758takeWhileE f = takeWhileJustE $ \v -> guard (f v) $> v
760-- | Take the streak of occurrences starting at the current time for which the
761-- event returns 'Just b'.
763-- Starting at the current time, fire all the occurrences of the 'Event' for
764-- which the given predicate returns 'Just b'. When first 'Nothing' is returned,
765-- do not fire, and permanently stop firing, even if 'Just b' values would have
766-- been encountered later.
769 . (Reflex t, MonadFix m, MonadHold t m)
773takeWhileJustE f e = do
774 rec let (eBad, eTrue) = fanEither $ ffor e' $ \a -> case f a of
775 Nothing -> Left never
777 eFirstBad <- headE eBad
778 e' <- switchHold e eFirstBad
781-- | Drop the streak of occurrences starting at the current time for which the
782-- event returns 'True'.
784-- Starting at the current time, do not fire all the occurrences of the 'Event'
785-- for which the given predicate returns 'True'. When 'False' is first
786-- returned, do fire, and permanently continue firing, even if 'True' values
787-- would have been encountered later.
790 . (Reflex t, MonadFix m, MonadHold t m)
794dropWhileE f e = snd <$> takeDropWhileJustE (\v -> guard (f v) $> v) e
796-- | Both take and drop the streak of occurrences starting at the current time
797-- for which the event returns 'Just b'.
799-- For the left event, starting at the current time, fire all the occurrences
800-- of the 'Event' for which the given function returns 'Just b'. When
801-- 'Nothing' is returned, do not fire, and permanently stop firing, even if
802-- 'Just b' values would have been encountered later.
804-- For the right event, do not fire until the first occurrence where the given
805-- function returns 'Nothing', and fire that one and all subsequent
806-- occurrences. Even if the function would have again returned 'Just b', keep
810 . (Reflex t, MonadFix m, MonadHold t m)
813 -> m (Event t b, Event t a)
814takeDropWhileJustE f e = do
815 rec let (eBad, eGood) = fanEither $ ffor e' $ \a -> case f a of
818 eFirstBad <- headE eBad
819 e' <- switchHold e (never <$ eFirstBad)
820 eRest <- switchHoldPromptOnly never (e <$ eFirstBad)
821 return (eGood, eRest)
823-- | Split the supplied 'Event' into two individual 'Event's occurring at the
824-- same time with the respective values from the tuple.
825splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
826splitE e = (fmap fst e, fmap snd e)
828-- | Print the supplied 'String' and the value of the 'Event' on each
829-- occurrence. This should /only/ be used for debugging.
831-- Note: As with Debug.Trace.trace, the message will only be printed if the
832-- 'Event' is actually used.
833traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
834traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
836-- | Print the output of the supplied function on each occurrence of the
837-- 'Event'. This should /only/ be used for debugging.
839-- Note: As with Debug.Trace.trace, the message will only be printed if the
840-- 'Event' is actually used.
841traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
842traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
844instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
845 (<>) = alignWith (mergeThese (<>))
846 sconcat = fmap sconcat . mergeList . toList
847#if MIN_VERSION_semigroups(0,17,0)
848 stimes n = fmap $ stimes n
850 times1p n = fmap $ times1p n
853instance (Semigroup a, Reflex t) => Monoid (Event t a) where
856 mconcat = fmap sconcat . mergeList
858-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
859-- list occurs. If multiple occur at the same time they are folded from the left
860-- with the given function.
861{-# INLINE mergeWith #-}
862mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
863mergeWith = mergeWith' id
865{-# INLINE mergeWith' #-}
866mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
867mergeWith' f g es = fmap (Prelude.foldl1 g . fmap f)
869 . IntMap.fromDistinctAscList
870 $ zip [0 :: Int ..] es
872-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
873-- list occurs. If multiple occur at the same time the value is the value of the
875{-# INLINE leftmost #-}
876leftmost :: Reflex t => [Event t a] -> Event t a
877leftmost = mergeWith const
879-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
880-- list occurs and has a list of the values of all 'Event's occurring at that
882mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
884mergeList es = mergeWithFoldCheap' id es
887 :: (Reflex t, Patch p, Patch p')
888 => (PatchTarget p -> PatchTarget p')
892unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
894-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
895-- occurs if at least one of them occurs and has a map of values of all 'Event's
896-- occurring at that time.
897mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
898mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
900-- | Like 'mergeMap' but for 'IntMap'.
901mergeIntMap :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
902mergeIntMap = fmap dmapToIntMap . merge . intMapWithFunctorToDMap
904-- | Create a merge whose parents can change over time
905mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
906mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
908-- | Create a merge whose parents can change over time
909mergeIntMapIncremental :: Reflex t => Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
910mergeIntMapIncremental = fmap dmapToIntMap . mergeIncremental . unsafeMapIncremental intMapWithFunctorToDMap (const2IntPatchDMapWith id)
912-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
913mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
914mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
916-- | Split the event into separate events for 'Left' and 'Right' values.
917fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
919 let justLeft = either Just (const Nothing)
920 justRight = either (const Nothing) Just
921 in (mapMaybe justLeft e, mapMaybe justRight e)
923-- | Split the event into separate events for 'This' and 'That' values,
924-- allowing them to fire simultaneously when the input value is 'These'.
925fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
927 let this (This x) = Just x
928 this (These x _) = Just x
930 that (That y) = Just y
931 that (These _ y) = Just y
933 in (mapMaybe this e, mapMaybe that e)
935-- | Split the event into an 'EventSelector' that allows efficient selection of
936-- the individual 'Event's.
937fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
938fanMap = fan . fmap mapToDMap
940-- | Switches to the new event whenever it receives one. Only the old event is
941-- considered the moment a new one is switched in; the output event will fire at
942-- that moment only if the old event does.
944-- Because the simultaneous firing case is irrelevant, this function imposes
945-- laxer "timing requirements" on the overall circuit, avoiding many potential
946-- cyclic dependency / metastability failures. It's also more performant. Use
947-- this rather than 'switchHoldPromptly' and 'switchHoldPromptOnly' unless you
948-- are absolutely sure you need to act on the new event in the coincidental
950switchHold :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
951switchHold ea0 eea = switch <$> hold ea0 eea
953-- | Switches to the new event whenever it receives one. Whenever a new event is
954-- provided, if it is firing, its value will be the resulting event's value; if
955-- it is not firing, but the old one is, the old one's value will be used.
957-- 'switchHold', by always forwarding the old event the moment it is switched
958-- out, avoids many potential cyclic dependency problems / metastability
959-- problems. It's also more performant. Use it instead unless you are sure you
961switchHoldPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
962switchHoldPromptly ea0 eea = do
964 let eLag = switch bea
965 eCoincidences = coincidence eea
966 return $ leftmost [eCoincidences, eLag]
968-- | switches to a new event whenever it receives one. At the moment of
969-- switching, the old event will be ignored if it fires, and the new one will be
970-- used if it fires; this is the opposite of 'switch', which will use only the
973-- 'switchHold', by always forwarding the old event the moment it is switched
974-- out, avoids many potential cyclic dependency problems / metastability
975-- problems. It's also more performant. Use it instead unless you are sure you
977switchHoldPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
978switchHoldPromptOnly e0 e' = do
979 eLag <- switch <$> hold e0 e'
980 return $ coincidence $ leftmost [e', eLag <$ eLag]
982-- | When the given outer event fires, condense the inner events into the contained patch. Non-firing inner events will be replaced with deletions.
983coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)
984coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ ffor e $ \(PatchMap m) -> mergeMap $ ffor m $ \case
985 Nothing -> fmapCheap (const Nothing) e
986 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
988-- | See 'coincidencePatchMap'
989coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)
990coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ ffor e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case
991 Nothing -> fmapCheap (const Nothing) e
992 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
994-- | See 'coincidencePatchMap'
995coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)
996coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ ffor e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
997 PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->
998 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
999 PatchMapWithMove.From_Move k -> fforCheap e $ \_ ->
1000 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }
1001 PatchMapWithMove.From_Insert ev -> leftmost
1002 [ fforCheap ev $ \v ->
1003 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }
1004 , fforCheap e $ \_ ->
1005 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1008-- | Given a 'PatchTarget' of events (e.g., a 'Map' with 'Event' values) and an event of 'Patch'es
1009-- (e.g., a 'PatchMap' with 'Event' values), produce an 'Event' of the 'PatchTarget' type that
1010-- fires with the patched value.
1011switchHoldPromptOnlyIncremental
1012 :: forall t m p pt w
1015 , Patch (p (Event t w))
1016 , PatchTarget (p (Event t w)) ~ pt (Event t w)
1018 , PatchTarget (p w) ~ pt w
1021 => (Incremental t (p (Event t w)) -> Event t (pt w))
1022 -> (Event t (p (Event t w)) -> Event t (p w))
1024 -> Event t (p (Event t w))
1025 -> m (Event t (pt w))
1026switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch e0 e' = do
1027 lag <- mergePatchIncremental <$> holdIncremental e0 e'
1028 pure $ ffor (align lag (coincidencePatch e')) $ \case
1030 That new -> new `applyAlways` mempty
1031 These old new -> new `applyAlways` old
1033instance Reflex t => Align (Event t) where
1035#if MIN_VERSION_these(0, 8, 0)
1036instance Reflex t => Semialign (Event t) where
1038 align = alignEventWithMaybe Just
1041-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
1042-- the 'Behavior' is true at the time of occurrence.
1043gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
1044gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
1046-- | Create a new behavior given a starting behavior and switch to the behavior
1047-- carried by the event when it fires.
1048switcher :: (Reflex t, MonadHold t m)
1049 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
1050switcher b eb = pull . (sample <=< sample) <$> hold b eb
1052instance (Reflex t, IsString a) => IsString (Dynamic t a) where
1053 fromString = pure . fromString
1055-- | Combine two 'Dynamic's. The result will change whenever either (or both)
1056-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
1057zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
1058zipDyn = zipDynWith (,)
1060-- | Combine two 'Dynamic's with a combining function. The result will change
1061-- whenever either (or both) input 'Dynamic' changes.
1062-- More efficient than 'liftA2'.
1063zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
1065 let eab = align (updated da) (updated db)
1066 ec = flip push eab $ \o -> do
1069 b <- sample $ current db
1072 a <- sample $ current da
1074 These a b -> return (a, b)
1075 return $ Just $ f a b
1076 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
1078instance (Reflex t, Semigroup a) => Semigroup (Dynamic t a) where
1079 (<>) = zipDynWith (<>)
1080#if MIN_VERSION_semigroups(0,17,0)
1081 stimes n = fmap $ stimes n
1083 times1p n = fmap $ times1p n
1086instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
1087 mconcat = distributeListOverDynWith mconcat
1088 mempty = constDyn mempty
1089 mappend = zipDynWith mappend
1091-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1092-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1093-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1094distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
1095distributeDMapOverDynPure = distributeDMapOverDynPureG coerceDynamic
1097-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1098-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1099-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1100distributeDMapOverDynPureG
1101 :: forall t k q v. (Reflex t, GCompare k)
1102 => (forall a. q a -> Dynamic t (v a))
1103 -> DMap k q -> Dynamic t (DMap k v)
1104distributeDMapOverDynPureG nt dm = case DMap.toList dm of
1105 [] -> constDyn DMap.empty
1106 [k :=> v] -> DMap.singleton k <$> nt v
1108 let getInitial = DMap.traverseWithKey (\_ -> sample . current . nt) dm
1109 edmPre = mergeG getCompose $ DMap.map (Compose . updated . nt) dm
1110 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
1111 olds <- sample $ current result
1112 return $ DMap.unionWithKey (\_ _ new -> new) olds news
1115-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
1116distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
1117distributeListOverDyn = distributeListOverDynWith id
1119-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
1120distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
1121distributeListOverDynWith f =
1122 fmap (f . map fromDSum . DMap.toAscList) .
1123 distributeDMapOverDynPure .
1124 DMap.fromDistinctAscList .
1125 zipWith toDSum [0..]
1127 toDSum :: Int -> Dynamic t a -> DSum (Const2 Int a) (Dynamic t)
1128 toDSum k v = Const2 k :=> v
1129 fromDSum :: DSum (Const2 Int a) Identity -> a
1130 fromDSum (Const2 _ :=> Identity v) = v
1132-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
1133-- unless the second supplied 'Event' occurs simultaneously.
1134difference :: Reflex t => Event t a -> Event t b -> Event t a
1135difference = alignEventWithMaybe $ \case
1139-- | Zips two values by taking the union of their shapes and combining with the provided function.
1140-- 'Nothing' values are dropped.
1141alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
1142alignEventWithMaybe f ea eb = mapMaybe (f <=< dmapToThese) $
1143 merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
1145-- | Produces an 'Event' that fires only when the input event fires with a 'DSum' key that
1146-- matches the provided key.
1148 :: forall t m k v a.
1155 -> Event t (DSum k v)
1156 -> m (Event t (v a))
1157filterEventKey k kv' = do
1158 let f :: DSum k v -> Maybe (v a)
1159 f (newK :=> newV) = case newK `geq` k of
1160 Just Refl -> Just newV
1162 takeWhileJustE f kv'
1164-- | "Factor" the input 'DSum' 'Event' to produce an 'Event' which
1165-- fires when the 'DSum' key changes and contains both the value of the
1166-- 'DSum' at switchover and an 'Event' of values produced by subsequent
1167-- firings of the input 'Event' that do not change the 'DSum' key.
1169 :: forall t m k v a.
1176 -> Event t (DSum k v)
1177 -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))
1178factorEvent k0 kv' = do
1179 key :: Behavior t (Some k) <- hold (Some.This k0) $ fmapCheap (\(k :=> _) -> Some.This k) kv'
1180 let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case
1181 Some.This oldKey -> case newKey `geq` oldKey of
1182 Just Refl -> return Nothing
1184 newInner <- filterEventKey newKey kv'
1185 return $ Just $ newKey :=> Pair newVal (Compose newInner)
1186 eInitial <- filterEventKey k0 kv'
1187 return (eInitial, update)
1189--------------------------------------------------------------------------------
1191--------------------------------------------------------------------------------
1193-- | An 'Accumulator' type can be built by accumulating occurrences of an
1195#if __GLASGOW_HASKELL__ < 802
1196{-# WARNING accum "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1197{-# WARNING accumM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1198{-# WARNING accumMaybe "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1199{-# WARNING accumMaybeM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1201class Reflex t => Accumulator t f | f -> t where
1202 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
1203 accum f = accumMaybe $ \v o -> Just $ f v o
1204 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
1205 accumM f = accumMaybeM $ \v o -> Just <$> f v o
1206 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
1207 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
1208 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
1209 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
1210 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
1211 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
1212 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
1213 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1214 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
1215 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1217-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1218-- with the provided function. See 'foldDyn'.
1220 :: (Reflex t, MonadHold t m, MonadFix m)
1225accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o
1227-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1228-- with the provided 'PushM' action.
1230 :: (Reflex t, MonadHold t m, MonadFix m)
1231 => (a -> b -> PushM t a)
1235accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o
1237-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1238-- with the provided function, discarding 'Nothing' results.
1240 :: (Reflex t, MonadHold t m, MonadFix m)
1241 => (a -> b -> Maybe a)
1245accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o
1247-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1248-- with the provided 'PushM' action, discarding 'Nothing' results.
1250 :: (Reflex t, MonadHold t m, MonadFix m)
1251 => (a -> b -> PushM t (Maybe a))
1255accumMaybeMDyn f z e = do
1256 rec let e' = flip push e $ \o -> do
1257 v <- sample $ current d'
1262-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1263-- with a function that both accumulates and produces a value to fire
1264-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1266 :: (Reflex t, MonadHold t m, MonadFix m)
1267 => (a -> b -> (a, c))
1270 -> m (Dynamic t a, Event t c)
1271mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o
1273-- | Similar to 'mapAccumDyn' except that the combining function is a
1276 :: (Reflex t, MonadHold t m, MonadFix m)
1277 => (a -> b -> PushM t (a, c))
1280 -> m (Dynamic t a, Event t c)
1281mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o
1283-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event' with
1284-- a function that both optionally accumulates and optionally produces
1285-- a value to fire as a separate output 'Event'.
1286-- Note that because 'Nothing's are discarded in both cases, the output
1287-- 'Event' may fire even though the output 'Dynamic' has not changed, and
1288-- the output 'Dynamic' may update even when the output 'Event' is not firing.
1290 :: (Reflex t, MonadHold t m, MonadFix m)
1291 => (a -> b -> (Maybe a, Maybe c))
1294 -> m (Dynamic t a, Event t c)
1295mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o
1297-- | Like 'mapAccumMaybeDyn' except that the combining function is a
1300 :: (Reflex t, MonadHold t m, MonadFix m)
1301 => (a -> b -> PushM t (Maybe a, Maybe c))
1304 -> m (Dynamic t a, Event t c)
1305mapAccumMaybeMDyn f z e = do
1306 rec let e' = flip push e $ \o -> do
1307 v <- sample $ current d'
1309 return $ case result of
1310 (Nothing, Nothing) -> Nothing
1312 d' <- holdDyn z $ mapMaybe fst e'
1313 return (d', mapMaybe snd e')
1315-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1316-- with the provided function.
1317{-# INLINE accumB #-}
1319 :: (Reflex t, MonadHold t m, MonadFix m)
1324accumB f = accumMaybeB $ \v o -> Just $ f v o
1326-- | Like 'accumB' except that the combining function is a 'PushM' action.
1327{-# INLINE accumMB #-}
1329 :: (Reflex t, MonadHold t m, MonadFix m)
1330 => (a -> b -> PushM t a)
1334accumMB f = accumMaybeMB $ \v o -> Just <$> f v o
1336-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1337-- with the provided function, discarding 'Nothing' results.
1338{-# INLINE accumMaybeB #-}
1340 :: (Reflex t, MonadHold t m, MonadFix m)
1341 => (a -> b -> Maybe a)
1345accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o
1347-- | Like 'accumMaybeB' except that the combining function is a 'PushM' action.
1348{-# INLINE accumMaybeMB #-}
1349accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)
1350accumMaybeMB f z e = do
1351 rec let e' = flip push e $ \o -> do
1357-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1358-- with a function that both accumulates and produces a value to fire
1359-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1360{-# INLINE mapAccumB #-}
1362 :: (Reflex t, MonadHold t m, MonadFix m)
1363 => (a -> b -> (a, c))
1366 -> m (Behavior t a, Event t c)
1367mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o
1369-- | Like 'mapAccumB' except that the combining function is a 'PushM' action.
1370{-# INLINE mapAccumMB #-}
1372 :: (Reflex t, MonadHold t m, MonadFix m)
1373 => (a -> b -> PushM t (a, c))
1376 -> m (Behavior t a, Event t c)
1377mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o
1379-- | Accumulate a 'Behavior' by folding occurrences of an 'Event' with
1380-- a function that both optionally accumulates and optionally produces
1381-- a value to fire as a separate output 'Event'. 'Nothing's are discarded.
1382{-# INLINE mapAccumMaybeB #-}
1384 :: (Reflex t, MonadHold t m, MonadFix m)
1385 => (a -> b -> (Maybe a, Maybe c))
1388 -> m (Behavior t a, Event t c)
1389mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o
1391-- | Like 'mapAccumMaybeB' except that the combining function is a 'PushM' action.
1392{-# INLINE mapAccumMaybeMB #-}
1393mapAccumMaybeMB :: (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)
1394mapAccumMaybeMB f z e = do
1395 rec let e' = flip push e $ \o -> do
1398 return $ case result of
1399 (Nothing, Nothing) -> Nothing
1401 d' <- hold z $ mapMaybe fst e'
1402 return (d', mapMaybe snd e')
1404-- | Accumulate occurrences of an 'Event', producing an output occurrence each
1405-- time. Discard the underlying 'Accumulator'.
1406{-# INLINE mapAccum_ #-}
1407mapAccum_ :: 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)
1409 (_, result) <- mapAccumB f z e
1412-- | Accumulate occurrences of an 'Event', possibly producing an output
1413-- occurrence each time. Discard the underlying 'Accumulator'.
1414{-# INLINE mapAccumMaybe_ #-}
1415mapAccumMaybe_ :: 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)
1416mapAccumMaybe_ f z e = do
1417 (_, result) <- mapAccumMaybeB f z e
1420-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
1421-- an output occurrence each time. Discard the underlying 'Accumulator'.
1422{-# INLINE mapAccumM_ #-}
1423mapAccumM_ :: 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)
1424mapAccumM_ f z e = do
1425 (_, result) <- mapAccumMB f z e
1428-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
1429-- producing an output occurrence each time. Discard the underlying
1431{-# INLINE mapAccumMaybeM_ #-}
1432mapAccumMaybeM_ :: 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)
1433mapAccumMaybeM_ f z e = do
1434 (_, result) <- mapAccumMaybeMB f z e
1437instance Reflex t => Accumulator t (Dynamic t) where
1438 accumMaybeM = accumMaybeMDyn
1439 mapAccumMaybeM = mapAccumMaybeMDyn
1441instance Reflex t => Accumulator t (Behavior t) where
1442 accumMaybeM = accumMaybeMB
1443 mapAccumMaybeM = mapAccumMaybeMB
1445instance Reflex t => Accumulator t (Event t) where
1446 accumMaybeM f z e = updated <$> accumMaybeM f z e
1447 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
1449-- | Create a new 'Event' by combining each occurrence with the next value of the
1450-- list using the supplied function. If the list runs out of items, all
1451-- subsequent 'Event' occurrences will be ignored.
1452zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
1453zipListWithEvent f l e = do
1454 let f' a b = case a of
1455 h:t -> (Just t, Just $ f h b)
1456 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
1457 mapAccumMaybe_ f' l e
1459-- | Assign a number to each occurrence of the given 'Event', starting from 0
1460{-# INLINE numberOccurrences #-}
1461numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
1462numberOccurrences = numberOccurrencesFrom 0
1464-- | Assign a number to each occurrence of the given 'Event'
1465{-# INLINE numberOccurrencesFrom #-}
1466numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
1467numberOccurrencesFrom = mapAccum_ (\n a -> let !next = n + 1 in (next, (n, a)))
1469-- | Assign a number to each occurrence of the given 'Event'; discard the occurrences' values
1470{-# INLINE numberOccurrencesFrom_ #-}
1471numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
1472numberOccurrencesFrom_ = mapAccum_ (\n _ -> let !next = n + 1 in (next, n))
1474-- | This is used to sample the value of a 'Behavior' using an 'Event'.
1476-- The '<@>' operator is intended to be used in conjunction with
1477-- the 'Applicative' instance for 'Behavior'.
1479-- This is useful when we want to combine the values of one 'Event' and
1480-- the value of several 'Behavior's at the time the 'Event' is firing.
1484-- > f :: a -> b -> c -> d
1485-- > b1 :: Behavior t a
1486-- > b2 :: Behavior t b
1491-- > f <$> b1 <*> b2 <@> e :: Event t d
1493-- in order to apply the function 'f' to the relevant values.
1495-- The alternative would be something like:
1497-- > attachWith (\(x1, x2) y -> f x1 x2 y) ((,) <$> b1 <*> b2) e :: Event t d
1499-- or a variation involing a custom data type to hold the combination of
1500-- 'Behavior's even when that combination might only ever be used by 'f'.
1502-- A more suggestive example might be:
1504-- > handleMouse <$> bPlayerState <*> bMousePosition <@> eMouseClick :: Event t (GameState -> GameState)
1506(<@>) :: Reflex t => Behavior t (a -> b) -> Event t a -> Event t b
1507(<@>) b = push $ \x -> do
1509 return . Just . f $ x
1512-- | An version of '<@>' that does not use the value of the 'Event'.
1514-- Alternatively, it is 'tag' in operator form.
1516-- This is useful when we want to combine the values of several
1517-- 'Behavior's at particular points in time using an 'Applicative'
1522-- > g :: a -> b -> d
1523-- > b1 :: Behavior t a
1524-- > b2 :: Behavior t b
1527-- where 'e' is firing at the points in time of interest.
1529-- Then we can use '<@':
1531-- > g <$> b1 <*> b2 <@ e :: Event t d
1533-- to combine the values of 'b1' and 'b2' at each of those points of time,
1534-- with the function 'g' being used to combine the values.
1536-- This is the same as '<@>' except that the 'Event' is being used only
1537-- to act as a trigger.
1538(<@) :: (Reflex t) => Behavior t b -> Event t a -> Event t b
1546-- | A "cheap" version of 'pushAlways'. See the performance note on 'pushCheap'.
1547{-# INLINE pushAlwaysCheap #-}
1548pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
1549pushAlwaysCheap f = pushCheap (fmap Just . f)
1551-- | A "cheap" version of 'mapMaybe'. See the performance note on 'pushCheap'.
1552{-# INLINE mapMaybeCheap #-}
1553mapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1554mapMaybeCheap f = pushCheap $ return . f
1556-- | An alias for 'mapMaybeCheap'
1557{-# INLINE fmapMaybeCheap #-}
1558fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1559fmapMaybeCheap = mapMaybeCheap
1562-- | A "cheap" version of 'fforMaybe'. See the performance note on 'pushCheap'.
1563{-# INLINE fforMaybeCheap #-}
1564fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
1565fforMaybeCheap = flip mapMaybeCheap
1567-- | A "cheap" version of 'ffor'. See the performance note on 'pushCheap'.
1568{-# INLINE fforCheap #-}
1569fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
1570fforCheap = flip fmapCheap
1572-- | A "cheap" version of 'fmap'. See the performance note on 'pushCheap'.
1573{-# INLINE fmapCheap #-}
1574fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
1575fmapCheap f = pushCheap $ return . Just . f
1577-- | A "cheap" version of 'tag'. See the performance note on 'pushCheap'.
1578{-# INLINE tagCheap #-}
1579tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
1580tagCheap b = pushAlwaysCheap $ \_ -> sample b
1582-- | Merge a collection of events; the resulting 'Event' will only occur if at
1583-- least one input event is occurring, and will contain all of the input keys
1584-- that are occurring simultaneously
1585merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)
1586merge = mergeG coerceEvent
1589-- | Create a merge whose parents can change over time
1590mergeIncremental :: (Reflex t, GCompare k)
1591 => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
1592mergeIncremental = mergeIncrementalG coerceEvent
1594-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
1595mergeIncrementalWithMove :: (Reflex t, GCompare k)
1596 => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
1597mergeIncrementalWithMove = mergeIncrementalWithMoveG coerceEvent
1599-- | A "cheap" version of 'mergeWithCheap'. See the performance note on 'pushCheap'.
1600{-# INLINE mergeWithCheap #-}
1601mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
1602mergeWithCheap = mergeWithCheap' id
1604-- | A "cheap" version of 'mergeWithCheap''. See the performance note on 'pushCheap'.
1605{-# INLINE mergeWithCheap' #-}
1606mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
1607mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
1609-- | A "cheap" version of 'mergeWithFoldCheap''. See the performance note on 'pushCheap'.
1610{-# INLINE mergeWithFoldCheap' #-}
1611mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
1612mergeWithFoldCheap' f es =
1613 fmapCheap (f . (\(h : t) -> h :| t) . IntMap.elems)
1615 . IntMap.fromDistinctAscList
1616 $ zip [0 :: Int ..] es
1618--------------------------------------------------------------------------------
1619-- Deprecated functions
1620--------------------------------------------------------------------------------
1622{-# 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'. " #-}
1623-- | See 'switchHoldPromptly'
1624switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1625switchPromptly = switchHoldPromptly
1626{-# 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'. " #-}
1627-- | See 'switchHoldPromptOnly'
1628switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1629switchPromptOnly = 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