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#ifdef USE_REFLEX_OPTIMIZER
21{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
24-- | This module contains the Reflex interface, as well as a variety of
25-- convenience functions for working with 'Event's, 'Behavior's, and other
37 -- ** 'fan'-related types
39 , EventSelectorInt (..)
40 -- ** 'Incremental'-related types
41 -- * Convenience functions
44 -- ** Combining 'Event's
49 , mergeMapIncrementalWithMove
50 , mergeIntMapIncremental
52 , coincidencePatchMapWithMove
53 , coincidencePatchIntMap
58 -- ** Breaking up 'Event's
69 -- ** Collapsing 'Event . Event'
72 , switchHoldPromptOnly
73 , switchHoldPromptOnlyIncremental
74 -- ** Using 'Event's to sample 'Behavior's
80 -- ** Blocking an 'Event' based on a 'Behavior'
82 -- ** Combining 'Dynamic's
83 , distributeDMapOverDynPure
84 , distributeListOverDyn
85 , distributeListOverDynWith
88 -- ** Accumulating state
112 , accumMaybeIncremental
113 , accumMaybeMIncremental
114 , mapAccumIncremental
115 , mapAccumMIncremental
116 , mapAccumMaybeIncremental
117 , mapAccumMaybeMIncremental
120 , numberOccurrencesFrom
121 , numberOccurrencesFrom_
131 -- * Debugging functions
134 -- * Unsafe functions
136 , unsafeMapIncremental
143 -- * Miscellaneous convenience functions
147 -- * Deprecated functions
161 -- * Slow, but general, implementations
165import Control.Applicative
166import Control.Monad.Identity
167import Control.Monad.Reader
168import Control.Monad.State.Strict
169import Control.Monad.Trans.Cont (ContT)
170import Control.Monad.Trans.Except (ExceptT)
171import Control.Monad.Trans.RWS (RWST)
172import Control.Monad.Trans.Writer (WriterT)
177import Data.Dependent.Map (DMap, DSum (..))
178import qualified Data.Dependent.Map as DMap
179import Data.Functor.Compose
180import Data.Functor.Product
181import Data.GADT.Compare (GEq (..), GCompare (..), (:~:) (..))
182import Data.FastMutableIntMap (PatchIntMap)
184import Data.Functor.Bind
185import Data.Functor.Misc
186import Data.Functor.Plus
187import Data.IntMap.Strict (IntMap)
188import qualified Data.IntMap.Strict as IntMap
189import Data.List.NonEmpty (NonEmpty (..))
191import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
192import Data.Some (Some)
193import qualified Data.Some as Some
196import Data.Type.Coercion
197import Reflex.FunctorMaybe
199import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
201import Debug.Trace (trace)
203-- | The 'Reflex' class contains all the primitive functionality needed for
204-- Functional Reactive Programming (FRP). The @t@ type parameter indicates
205-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
206-- and the type of the timeline determines the FRP engine to be used. For most
207-- purposes, the 'Reflex.Spider' implementation is recommended.
208class ( MonadHold t (PushM t)
209 , MonadSample t (PullM t)
211 , Functor (Dynamic t)
212 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
215 -- | A container for a value that can change over time. 'Behavior's can be
216 -- sampled at will, but it is not possible to be notified when they change
217 data Behavior t :: * -> *
218 -- | A stream of occurrences. During any given frame, an 'Event' is either
219 -- occurring or not occurring; if it is occurring, it will contain a value of
220 -- the given type (its "occurrence type")
221 data Event t :: * -> *
222 -- | A container for a value that can change over time and allows
223 -- notifications on changes. Basically a combination of a 'Behavior' and an
224 -- 'Event', with a rule that the 'Behavior' will change if and only if the
226 data Dynamic t :: * -> *
227 -- | An 'Incremental' is a more general form of a 'Dynamic'.
228 -- Instead of always fully replacing the value, only parts of it can be patched.
229 -- This is only needed for performance critical code via `mergeIncremental` to make small
230 -- changes to large values.
231 data Incremental t :: * -> *
232 -- | A monad for doing complex push-based calculations efficiently
233 type PushM t :: * -> *
234 -- | A monad for doing complex pull-based calculations efficiently
235 type PullM t :: * -> *
236 -- | An 'Event' with no occurrences
238 -- | Create a 'Behavior' that always has the given value
239 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
240 -- | Create an 'Event' from another 'Event'; the provided function can sample
241 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
242 -- (Just) or non-occurring (Nothing) result
243 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
244 -- | 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.
245 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
246 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
247 -- recomputed whenever any of the read 'Behavior's changes
248 pull :: PullM t a -> Behavior t a
249 -- | Merge a collection of events; the resulting 'Event' will only occur if at
250 -- least one input event is occurring, and will contain all of the input keys
251 -- that are occurring simultaneously
252 merge :: GCompare k => DMap k (Event t) -> Event t (DMap k Identity) --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
253 -- | Efficiently fan-out an event to many destinations. This function should
254 -- be partially applied, and then the result applied repeatedly to create
256 fan :: GCompare k => Event t (DMap k Identity) -> EventSelector t k --TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it
257 -- | Create an 'Event' that will occur whenever the currently-selected input
259 switch :: Behavior t (Event t a) -> Event t a
260 -- | Create an 'Event' that will occur whenever the input event is occurring
261 -- and its occurrence value, another 'Event', is also occurring
262 coincidence :: Event t (Event t a) -> Event t a
263 -- | Extract the 'Behavior' of a 'Dynamic'.
264 current :: Dynamic t a -> Behavior t a
265 -- | Extract the 'Event' of the 'Dynamic'.
266 updated :: Dynamic t a -> Event t a
267 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
268 -- recent firing of the given 'Event', if any.
269 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
270 -- | Create a new 'Incremental'. The given 'PullM''s value must always change
271 -- in the same way that the accumulated application of patches would change
273 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
274 -- | Create a merge whose parents can change over time
275 mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
276 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
277 mergeIncrementalWithMove :: GCompare k => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
278 -- | Extract the 'Behavior' component of an 'Incremental'
279 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
280 -- | Extract the 'Event' component of an 'Incremental'
281 updatedIncremental :: Patch p => Incremental t p -> Event t p
282 -- | Convert an 'Incremental' to a 'Dynamic'
283 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
284 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
286 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
287 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
289 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
290 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
292 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
293 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
294 fanInt :: Event t (IntMap a) -> EventSelectorInt t a
296--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on
297mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
298mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never
300-- | Coerce a 'Behavior' between representationally-equivalent value types
301coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
302coerceBehavior = coerceWith $ behaviorCoercion Coercion
304-- | Coerce an 'Event' between representationally-equivalent occurrence types
305coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
306coerceEvent = coerceWith $ eventCoercion Coercion
308-- | Coerce a 'Dynamic' between representationally-equivalent value types
309coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
310coerceDynamic = coerceWith $ dynamicCoercion Coercion
312-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
313-- _must_ change when and only when the 'Event' fires, such that the
314-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
315-- if this is not the case, the resulting 'Dynamic' will behave
316-- nondeterministically.
317unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
318unsafeDynamic = unsafeBuildDynamic . sample
320-- | Construct a 'Dynamic' value that never changes
321constDyn :: Reflex t => a -> Dynamic t a
324instance (Reflex t, Default a) => Default (Dynamic t a) where
327-- | 'MonadSample' designates monads that can read the current value of a
328-- 'Behavior'. This includes both 'PullM' and 'PushM'.
329class (Applicative m, Monad m) => MonadSample t m | m -> t where
330 -- | Get the current value in the 'Behavior'
331 sample :: Behavior t a -> m a
333-- | 'MonadHold' designates monads that can create new 'Behavior's based on
334-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
335-- is required to create any stateful computations with Reflex.
336class MonadSample t m => MonadHold t m where
337 -- | Create a new 'Behavior' whose value will initially be equal to the given
338 -- value and will be updated whenever the given 'Event' occurs. The update
339 -- takes effect immediately after the 'Event' occurs; if the occurrence that
340 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
341 -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new
343 hold :: a -> Event t a -> m (Behavior t a)
344 default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)
345 hold v0 = lift . hold v0
346 -- | Create a 'Dynamic' value using the given initial value that changes every
347 -- time the 'Event' occurs.
348 holdDyn :: a -> Event t a -> m (Dynamic t a)
349 default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)
350 holdDyn v0 = lift . holdDyn v0
351 -- | Create an 'Incremental' value using the given initial value that changes
352 -- every time the 'Event' occurs.
353 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
354 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
355 holdIncremental v0 = lift . holdIncremental v0
356 buildDynamic :: PushM t a -> Event t a -> m (Dynamic t a)
358 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
359 buildDynamic getV0 = lift . buildDynamic getV0
361 -- | Create a new 'Event' that only occurs only once, on the first occurrence of
362 -- the supplied 'Event'.
363 headE :: Event t a -> m (Event t a)
365accumIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> p) -> PatchTarget p -> Event t b -> m (Incremental t p)
366accumIncremental f = accumMaybeIncremental $ \v o -> Just $ f v o
367accumMIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> PushM t p) -> PatchTarget p -> Event t b -> m (Incremental t p)
368accumMIncremental f = accumMaybeMIncremental $ \v o -> Just <$> f v o
369accumMaybeIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> Maybe p) -> PatchTarget p -> Event t b -> m (Incremental t p)
370accumMaybeIncremental f = accumMaybeMIncremental $ \v o -> return $ f v o
371accumMaybeMIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> PushM t (Maybe p)) -> PatchTarget p -> Event t b -> m (Incremental t p)
372accumMaybeMIncremental f z e = do
373 rec let e' = flip push e $ \o -> do
374 v <- sample $ currentIncremental d'
376 d' <- holdIncremental z e'
378mapAccumIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> (p, c)) -> PatchTarget p -> Event t b -> m (Incremental t p, Event t c)
379mapAccumIncremental f = mapAccumMaybeIncremental $ \v o -> bimap Just Just $ f v o
380mapAccumMIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> PushM t (p, c)) -> PatchTarget p -> Event t b -> m (Incremental t p, Event t c)
381mapAccumMIncremental f = mapAccumMaybeMIncremental $ \v o -> bimap Just Just <$> f v o
382mapAccumMaybeIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> (Maybe p, Maybe c)) -> PatchTarget p -> Event t b -> m (Incremental t p, Event t c)
383mapAccumMaybeIncremental f = mapAccumMaybeMIncremental $ \v o -> return $ f v o
384mapAccumMaybeMIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> PushM t (Maybe p, Maybe c)) -> PatchTarget p -> Event t b -> m (Incremental t p, Event t c)
385mapAccumMaybeMIncremental f z e = do
386 rec let e' = flip push e $ \o -> do
387 v <- sample $ currentIncremental d'
389 return $ case result of
390 (Nothing, Nothing) -> Nothing
392 d' <- holdIncremental z $ fmapMaybe fst e'
393 return (d', fmapMaybe snd e')
395slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
397 rec be <- hold e $ fmapCheap (const never) e'
401-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
402-- key. This is much more efficient than filtering for each key with
404newtype EventSelector t k = EventSelector
405 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
406 -- determined by the type of the key, so this can be used to fan-out
407 -- 'Event's whose sub-'Event's have different types.
409 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
410 -- (but equivalent to) using 'fmapMaybe' to select only the relevant
411 -- occurrences of an 'Event'.
412 select :: forall a. k a -> Event t a
415newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }
417--------------------------------------------------------------------------------
419--------------------------------------------------------------------------------
421instance MonadSample t m => MonadSample t (ReaderT r m) where
422 sample = lift . sample
424instance MonadHold t m => MonadHold t (ReaderT r m) where
425 hold a0 = lift . hold a0
426 holdDyn a0 = lift . holdDyn a0
427 holdIncremental a0 = lift . holdIncremental a0
428 buildDynamic a0 = lift . buildDynamic a0
431instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
432 sample = lift . sample
434instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
435 hold a0 = lift . hold a0
436 holdDyn a0 = lift . holdDyn a0
437 holdIncremental a0 = lift . holdIncremental a0
438 buildDynamic a0 = lift . buildDynamic a0
441instance MonadSample t m => MonadSample t (StateT s m) where
442 sample = lift . sample
444instance MonadHold t m => MonadHold t (StateT s m) where
445 hold a0 = lift . hold a0
446 holdDyn a0 = lift . holdDyn a0
447 holdIncremental a0 = lift . holdIncremental a0
448 buildDynamic a0 = lift . buildDynamic a0
451instance MonadSample t m => MonadSample t (ExceptT e m) where
452 sample = lift . sample
454instance MonadHold t m => MonadHold t (ExceptT e m) where
455 hold a0 = lift . hold a0
456 holdDyn a0 = lift . holdDyn a0
457 holdIncremental a0 = lift . holdIncremental a0
458 buildDynamic a0 = lift . buildDynamic a0
461instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
462 sample = lift . sample
464instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
465 hold a0 = lift . hold a0
466 holdDyn a0 = lift . holdDyn a0
467 holdIncremental a0 = lift . holdIncremental a0
468 buildDynamic a0 = lift . buildDynamic a0
471instance MonadSample t m => MonadSample t (ContT r m) where
472 sample = lift . sample
474instance MonadHold t m => MonadHold t (ContT r m) where
475 hold a0 = lift . hold a0
476 holdDyn a0 = lift . holdDyn a0
477 holdIncremental a0 = lift . holdIncremental a0
478 buildDynamic a0 = lift . buildDynamic a0
481--------------------------------------------------------------------------------
482-- Convenience functions
483--------------------------------------------------------------------------------
485-- | Create an 'Event' from another 'Event'. The provided function can sample
486-- 'Behavior's and hold 'Event's.
487pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
488pushAlways f = push (fmap Just . f)
490-- | Flipped version of 'fmap'.
491ffor :: Functor f => f a -> (a -> b) -> f b
494-- | Rotated version of 'liftA2'.
495ffor2 :: Applicative f => f a -> f b -> (a -> b -> c) -> f c
496ffor2 a b f = liftA2 f a b
498-- | Rotated version of 'liftA3'.
499ffor3 :: Applicative f => f a -> f b -> f c -> (a -> b -> c -> d) -> f d
500ffor3 a b c f = liftA3 f a b c
502instance Reflex t => Applicative (Behavior t) where
504 f <*> x = pull $ sample f `ap` sample x
508instance Reflex t => Apply (Behavior t) where
511instance Reflex t => Bind (Behavior t) where
514instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
516 fromRational = pure . fromRational
519instance Reflex t => Functor (Behavior t) where
520 fmap f = pull . fmap f . sample
522instance (Reflex t, IsString a) => IsString (Behavior t a) where
523 fromString = pure . fromString
525instance Reflex t => Monad (Behavior t) where
526 a >>= f = pull $ sample a >>= sample . f
527 -- 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.
529 fail = error "Monad (Behavior t) does not support fail"
531instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
532 mempty = constant mempty
533 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
534 mconcat = pull . fmap mconcat . mapM sample
536instance (Reflex t, Num a) => Num (Behavior t a) where
541 fromInteger = pure . fromInteger
545instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
546 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
547 sconcat = pull . fmap sconcat . mapM sample
548#if MIN_VERSION_semigroups(0,17,0)
549 stimes n = fmap $ stimes n
551 times1p n = fmap $ times1p n
554-- | Flipped version of 'fmapMaybe'.
555fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b
556fforMaybe = flip fmapMaybe
558-- | Filter 'f a' using the provided predicate.
559-- Relies on 'fforMaybe'.
560ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
561ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
563-- | Filter 'Left's from 'f (Either a b)' into 'a'.
564filterLeft :: FunctorMaybe f => f (Either a b) -> f a
565filterLeft = fmapMaybe (either Just (const Nothing))
567-- | Filter 'Right's from 'f (Either a b)' into 'b'.
568filterRight :: FunctorMaybe f => f (Either a b) -> f b
569filterRight = fmapMaybe (either (const Nothing) Just)
571-- | Left-biased event union (prefers left event on simultaneous
573instance Reflex t => Alt (Event t) where
574 ev1 <!> ev2 = leftmost [ev1, ev2]
576-- | 'Event' intersection (convenient interface to 'coincidence').
577instance Reflex t => Apply (Event t) where
578 evf <.> evx = coincidence (fmap (<$> evx) evf)
580-- | 'Event' intersection (convenient interface to 'coincidence').
581instance Reflex t => Bind (Event t) where
582 evx >>- f = coincidence (f <$> evx)
585instance Reflex t => Functor (Event t) where
587 fmap f = fmapMaybe $ Just . f
589 x <$ e = fmapCheap (const x) e
591instance Reflex t => FunctorMaybe (Event t) where
592 {-# INLINE fmapMaybe #-}
593 fmapMaybe f = push $ return . f
595-- | Never: @'zero' = 'never'@.
596instance Reflex t => Plus (Event t) where
599-- | Replace each occurrence value of the 'Event' with the value of the
600-- 'Behavior' at the time of that occurrence.
601tag :: Reflex t => Behavior t b -> Event t a -> Event t b
602tag b = pushAlways $ \_ -> sample b
604-- | Replace each occurrence value of the 'Event' with the value of the
605-- 'Behavior' at that time; if it is 'Just', fire with the contained value; if
606-- it is 'Nothing', drop the occurrence.
607tagMaybe :: Reflex t => Behavior t (Maybe b) -> Event t a -> Event t b
608tagMaybe b = push $ \_ -> sample b
610-- | Create a new 'Event' that combines occurrences of supplied 'Event' with the
611-- current value of the 'Behavior'.
612attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
613attach = attachWith (,)
615-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
616-- combining it with the current value of the 'Behavior'.
617attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
618attachWith f = attachWithMaybe $ \a b -> Just $ f a b
620-- | Create a new 'Event' by combining each occurrence with the current value of
621-- the 'Behavior'. The occurrence is discarded if the combining function returns
623attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
624attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
626-- | Create a new 'Event' that occurs on all but the first occurrence of the
628tailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a)
629tailE e = snd <$> headTailE e
631-- | Create a tuple of two 'Event's with the first one occurring only the first
632-- time the supplied 'Event' occurs and the second occurring on all but the first
634headTailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a, Event t a)
637 be <- hold never $ fmap (const e) eHead
638 return (eHead, switch be)
640-- | Take the streak of occurrences starting at the current time for which the
641-- event returns 'True'.
643-- Starting at the current time, fire all the occurrences of the 'Event' for
644-- which the given predicate returns 'True'. When 'False' first is returned,
645-- do not fire, and permanently stop firing, even if 'True' values would have
646-- been encountered later.
649 . (Reflex t, MonadFix m, MonadHold t m)
653takeWhileE f = takeWhileJustE $ \v -> guard (f v) $> v
655-- | Take the streak of occurrences starting at the current time for which the
656-- event returns 'Just b'.
658-- Starting at the current time, fire all the occurrences of the 'Event' for
659-- which the given predicate returns 'Just b'. When 'Nothing' first is returned,
660-- do not fire, and permanently stop firing, even if 'Just b' values would have
661-- been encountered later.
664 . (Reflex t, MonadFix m, MonadHold t m)
668takeWhileJustE f e = do
669 rec let (eBad, eTrue) = fanEither $ ffor e' $ \a -> case f a of
670 Nothing -> Left never
672 eFirstBad <- headE eBad
673 e' <- switchHold e eFirstBad
676-- | Drop the streak of occurrences starting at the current time for which the
677-- event returns 'True'.
679-- Starting at the current time, do not fire all the occurrences of the 'Event'
680-- for which the given predicate returns 'True'. When 'False' is first
681-- returned, do fire, and permanently continue firing, even if 'True' values
682-- would have been encountered later.
685 . (Reflex t, MonadFix m, MonadHold t m)
689dropWhileE f e = snd <$> takeDropWhileJustE (\v -> guard (f v) $> v) e
691-- | Both take and drop the streak of occurrences starting at the current time
692-- for which the event returns 'Just b'.
694-- For the left event, starting at the current time, fire all the occurrences
695-- of the 'Event' for which the given function returns 'Just b'. When
696-- 'Nothing' is returned, do not fire, and permanently stop firing, even if
697-- 'Just b' values would have been encountered later.
699-- For the right event, do not fire until the first occurrence where the given
700-- function returns 'Nothing', and fire that one and all subsequent
701-- occurrences. Even if the function would have again returned 'Just b', keep
705 . (Reflex t, MonadFix m, MonadHold t m)
708 -> m (Event t b, Event t a)
709takeDropWhileJustE f e = do
710 rec let (eBad, eGood) = fanEither $ ffor e' $ \a -> case f a of
713 eFirstBad <- headE eBad
714 e' <- switchHold e (never <$ eFirstBad)
715 eRest <- switchHoldPromptOnly never (e <$ eFirstBad)
716 return (eGood, eRest)
718-- | Split the supplied 'Event' into two individual 'Event's occurring at the
719-- same time with the respective values from the tuple.
720splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
721splitE e = (fmap fst e, fmap snd e)
723-- | Print the supplied 'String' and the value of the 'Event' on each
724-- occurrence. This should /only/ be used for debugging.
726-- Note: As with Debug.Trace.trace, the message will only be printed if the
727-- 'Event' is actually used.
728traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
729traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
731-- | Print the output of the supplied function on each occurrence of the
732-- 'Event'. This should /only/ be used for debugging.
734-- Note: As with Debug.Trace.trace, the message will only be printed if the
735-- 'Event' is actually used.
736traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
737traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
739instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
740 (<>) = alignWith (mergeThese (<>))
741 sconcat = fmap sconcat . mergeList . toList
742#if MIN_VERSION_semigroups(0,17,0)
743 stimes n = fmap $ stimes n
745 times1p n = fmap $ times1p n
748instance (Semigroup a, Reflex t) => Monoid (Event t a) where
751 mconcat = fmap sconcat . mergeList
753-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
754-- list occurs. If multiple occur at the same time they are folded from the left
755-- with the given function.
756{-# INLINE mergeWith #-}
757mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
758mergeWith = mergeWith' id
760{-# INLINE mergeWith' #-}
761mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
762mergeWith' f g es = fmap (Prelude.foldl1 g . fmap f)
764 . IntMap.fromDistinctAscList
765 $ zip [0 :: Int ..] es
767-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
768-- list occurs. If multiple occur at the same time the value is the value of the
770{-# INLINE leftmost #-}
771leftmost :: Reflex t => [Event t a] -> Event t a
772leftmost = mergeWith const
774-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
775-- list occurs and has a list of the values of all 'Event's occurring at that
777mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
779mergeList es = mergeWithFoldCheap' id es
781unsafeMapIncremental :: (Reflex t, Patch p, Patch p') => (PatchTarget p -> PatchTarget p') -> (p -> p') -> Incremental t p -> Incremental t p'
782unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
784-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
785-- occurs if at least one of them occurs and has a map of values of all 'Event's
786-- occurring at that time.
787mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
788mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
790-- | Like 'mergeMap' but for 'IntMap'.
791mergeIntMap :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
792mergeIntMap = fmap dmapToIntMap . merge . intMapWithFunctorToDMap
794-- | Create a merge whose parents can change over time
795mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
796mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
798-- | Create a merge whose parents can change over time
799mergeIntMapIncremental :: Reflex t => Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
800mergeIntMapIncremental = fmap dmapToIntMap . mergeIncremental . unsafeMapIncremental intMapWithFunctorToDMap (const2IntPatchDMapWith id)
802-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
803mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
804mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
806-- | Split the event into separate events for 'Left' and 'Right' values.
807fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
809 let justLeft = either Just (const Nothing)
810 justRight = either (const Nothing) Just
811 in (fmapMaybe justLeft e, fmapMaybe justRight e)
813-- | Split the event into separate events for 'This' and 'That' values,
814-- allowing them to fire simultaneously when the input value is 'These'.
815fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
817 let this (This x) = Just x
818 this (These x _) = Just x
820 that (That y) = Just y
821 that (These _ y) = Just y
823 in (fmapMaybe this e, fmapMaybe that e)
825-- | Split the event into an 'EventSelector' that allows efficient selection of
826-- the individual 'Event's.
827fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
828fanMap = fan . fmap mapToDMap
830-- | Switches to the new event whenever it receives one. Only the old event is
831-- considered the moment a new one is switched in; the output event will fire at
832-- that moment if only if the old event does.
834-- Because the simultaneous firing case is irrelevant, this function imposes
835-- laxer "timing requirements" on the overall circuit, avoiding many potential
836-- cyclic dependency / metastability failures. It's also more performant. Use
837-- this rather than 'switchHoldPromptly' and 'switchHoldPromptOnly' unless you
838-- are absolutely sure you need to act on the new event in the coincidental
840switchHold :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
841switchHold ea0 eea = switch <$> hold ea0 eea
843-- | Switches to the new event whenever it receives one. Whenever a new event is
844-- provided, if it is firing, its value will be the resulting event's value; if
845-- it is not firing, but the old one is, the old one's value will be used.
847-- 'switchHold', by always forwarding the old event the moment it is switched
848-- out, avoids many potential cyclic dependency problems / metastability
849-- problems. It's also more performant. Use it instead unless you are sure you
851switchHoldPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
852switchHoldPromptly ea0 eea = do
854 let eLag = switch bea
855 eCoincidences = coincidence eea
856 return $ leftmost [eCoincidences, eLag]
858-- | switches to a new event whenever it receives one. At the moment of
859-- switching, the old event will be ignored if it fires, and the new one will be
860-- used if it fires; this is the opposite of 'switch', which will use only the
863-- 'switchHold', by always forwarding the old event the moment it is switched
864-- out, avoids many potential cyclic dependency problems / metastability
865-- problems. It's also more performant. Use it instead unless you are sure you
867switchHoldPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
868switchHoldPromptOnly e0 e' = do
869 eLag <- switch <$> hold e0 e'
870 return $ coincidence $ leftmost [e', eLag <$ eLag]
872-- | When the given outer event fires, condense the inner events into the contained patch. Non-firing inner events will be replaced with deletions.
873coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)
874coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ ffor e $ \(PatchMap m) -> mergeMap $ ffor m $ \case
875 Nothing -> fmapCheap (const Nothing) e
876 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
878-- | See 'coincicencePatchMap'
879coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)
880coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ ffor e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case
881 Nothing -> fmapCheap (const Nothing) e
882 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
884-- | See 'coincicencePatchMap'
885coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)
886coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ ffor e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
887 PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->
888 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
889 PatchMapWithMove.From_Move k -> fforCheap e $ \_ ->
890 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }
891 PatchMapWithMove.From_Insert ev -> leftmost
892 [ fforCheap ev $ \v ->
893 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }
894 , fforCheap e $ \_ ->
895 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
898switchHoldPromptOnlyIncremental
902 , Patch (p (Event t w))
903 , PatchTarget (p (Event t w)) ~ pt (Event t w)
905 , PatchTarget (p w) ~ pt w
908 => (Incremental t (p (Event t w)) -> Event t (pt w))
909 -> (Event t (p (Event t w)) -> Event t (p w))
911 -> Event t (p (Event t w))
912 -> m (Event t (pt w))
913switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch e0 e' = do
914 lag <- mergePatchIncremental <$> holdIncremental e0 e'
915 pure $ ffor (align lag (coincidencePatch e')) $ \case
917 That new -> new `applyAlways` mempty
918 These old new -> new `applyAlways` old
920instance Reflex t => Align (Event t) where
922 align = alignEventWithMaybe Just
924-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
925-- the 'Behavior' is true at the time of occurrence.
926gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
927gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
929-- | Create a new behavior given a starting behavior and switch to a the behvior
930-- carried by the event when it fires.
931switcher :: (Reflex t, MonadHold t m)
932 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
933switcher b eb = pull . (sample <=< sample) <$> hold b eb
935instance (Reflex t, IsString a) => IsString (Dynamic t a) where
936 fromString = pure . fromString
938-- | Combine two 'Dynamic's. The result will change whenever either (or both)
939-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
940zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
941zipDyn = zipDynWith (,)
943-- | Combine two 'Dynamic's with a combining function. The result will change
944-- whenever either (or both) input 'Dynamic' changes.
945-- More efficient than liftA2.
946zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
948 let eab = align (updated da) (updated db)
949 ec = flip push eab $ \o -> do
952 b <- sample $ current db
955 a <- sample $ current da
957 These a b -> return (a, b)
958 return $ Just $ f a b
959 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
961instance (Reflex t, Semigroup a) => Semigroup (Dynamic t a) where
962 (<>) = zipDynWith (<>)
963#if MIN_VERSION_semigroups(0,17,0)
964 stimes n = fmap $ stimes n
966 times1p n = fmap $ times1p n
969instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
970 mconcat = distributeListOverDynWith mconcat
971 mempty = constDyn mempty
972 mappend = zipDynWith mappend
974-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
975-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
976-- through the use of multiple uses of 'zipWithDyn' or 'Applicative' operators.
977distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
978distributeDMapOverDynPure dm = case DMap.toList dm of
979 [] -> constDyn DMap.empty
980 [k :=> v] -> fmap (DMap.singleton k . Identity) v
982 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
983 edmPre = merge $ DMap.map updated dm
984 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
985 olds <- sample $ current result
986 return $ DMap.unionWithKey (\_ _ new -> new) olds news
989-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
990distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
991distributeListOverDyn = distributeListOverDynWith id
993-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
994distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
995distributeListOverDynWith f = fmap (f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]
997-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
998-- unless the second supplied 'Event' occurs simultaneously.
999difference :: Reflex t => Event t a -> Event t b -> Event t a
1000difference = alignEventWithMaybe $ \case
1004alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
1005alignEventWithMaybe f ea eb =
1006 fmapMaybe (f <=< dmapToThese)
1008 $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
1011 :: forall t m k v a.
1018 -> Event t (DSum k v)
1019 -> m (Event t (v a))
1020filterEventKey k kv' = do
1021 let f :: DSum k v -> Maybe (v a)
1022 f (newK :=> newV) = case newK `geq` k of
1023 Just Refl -> Just newV
1025 takeWhileJustE f kv'
1029 :: forall t m k v a.
1036 -> Event t (DSum k v)
1037 -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))
1038factorEvent k0 kv' = do
1039 key :: Behavior t (Some k) <- hold (Some.This k0) $ fmapCheap (\(k :=> _) -> Some.This k) kv'
1040 let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case
1041 Some.This oldKey -> case newKey `geq` oldKey of
1042 Just Refl -> return Nothing
1044 newInner <- filterEventKey newKey kv'
1045 return $ Just $ newKey :=> Pair newVal (Compose newInner)
1046 eInitial <- filterEventKey k0 kv'
1047 return (eInitial, update)
1049--------------------------------------------------------------------------------
1051--------------------------------------------------------------------------------
1053-- | An 'Accumulator' type can be built by accumulating occurrences of an
1055#if __GLASGOW_HASKELL__ < 802
1056{-# WARNING accum "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1057{-# WARNING accumM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1058{-# WARNING accumMaybe "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1059{-# WARNING accumMaybeM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1061class Reflex t => Accumulator t f | f -> t where
1062 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
1063 accum f = accumMaybe $ \v o -> Just $ f v o
1064 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
1065 accumM f = accumMaybeM $ \v o -> Just <$> f v o
1066 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
1067 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
1068 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
1069 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
1070 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
1071 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
1072 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
1073 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1074 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
1075 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1077accumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Dynamic t a)
1078accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o
1079accumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Dynamic t a)
1080accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o
1081accumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Dynamic t a)
1082accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o
1083accumMaybeMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Dynamic t a)
1084accumMaybeMDyn f z e = do
1085 rec let e' = flip push e $ \o -> do
1086 v <- sample $ current d'
1090mapAccumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
1091mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o
1092mapAccumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
1093mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o
1094mapAccumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
1095mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o
1096mapAccumMaybeMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
1097mapAccumMaybeMDyn f z e = do
1098 rec let e' = flip push e $ \o -> do
1099 v <- sample $ current d'
1101 return $ case result of
1102 (Nothing, Nothing) -> Nothing
1104 d' <- holdDyn z $ fmapMaybe fst e'
1105 return (d', fmapMaybe snd e')
1107{-# INLINE accumB #-}
1108accumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Behavior t a)
1109accumB f = accumMaybeB $ \v o -> Just $ f v o
1110{-# INLINE accumMB #-}
1111accumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Behavior t a)
1112accumMB f = accumMaybeMB $ \v o -> Just <$> f v o
1113{-# INLINE accumMaybeB #-}
1114accumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Behavior t a)
1115accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o
1116{-# INLINE accumMaybeMB #-}
1117accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)
1118accumMaybeMB f z e = do
1119 rec let e' = flip push e $ \o -> do
1124{-# INLINE mapAccumB #-}
1125mapAccumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)
1126mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o
1127{-# INLINE mapAccumMB #-}
1128mapAccumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)
1129mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o
1130{-# INLINE mapAccumMaybeB #-}
1131mapAccumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)
1132mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o
1134{-# INLINE mapAccumMaybeMB #-}
1135mapAccumMaybeMB :: (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)
1136mapAccumMaybeMB f z e = do
1137 rec let e' = flip push e $ \o -> do
1140 return $ case result of
1141 (Nothing, Nothing) -> Nothing
1143 d' <- hold z $ fmapMaybe fst e'
1144 return (d', fmapMaybe snd e')
1146-- | Accumulate occurrences of an 'Event', producing an output occurrence each
1147-- time. Discard the underlying 'Accumulator'.
1148{-# INLINE mapAccum_ #-}
1149mapAccum_ :: 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)
1151 (_, result) <- mapAccumB f z e
1154-- | Accumulate occurrences of an 'Event', possibly producing an output
1155-- occurrence each time. Discard the underlying 'Accumulator'.
1156{-# INLINE mapAccumMaybe_ #-}
1157mapAccumMaybe_ :: 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)
1158mapAccumMaybe_ f z e = do
1159 (_, result) <- mapAccumMaybeB f z e
1162-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
1163-- an output occurrence each time. Discard the underlying 'Accumulator'.
1164{-# INLINE mapAccumM_ #-}
1165mapAccumM_ :: 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)
1166mapAccumM_ f z e = do
1167 (_, result) <- mapAccumMB f z e
1170-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
1171-- producing an output occurrence each time. Discard the underlying
1173{-# INLINE mapAccumMaybeM_ #-}
1174mapAccumMaybeM_ :: 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)
1175mapAccumMaybeM_ f z e = do
1176 (_, result) <- mapAccumMaybeMB f z e
1179instance Reflex t => Accumulator t (Dynamic t) where
1180 accumMaybeM = accumMaybeMDyn
1181 mapAccumMaybeM = mapAccumMaybeMDyn
1183instance Reflex t => Accumulator t (Behavior t) where
1184 accumMaybeM = accumMaybeMB
1185 mapAccumMaybeM = mapAccumMaybeMB
1187instance Reflex t => Accumulator t (Event t) where
1188 accumMaybeM f z e = updated <$> accumMaybeM f z e
1189 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
1191-- | Create a new 'Event' by combining each occurrence with the next value of the
1192-- list using the supplied function. If the list runs out of items, all
1193-- subsequent 'Event' occurrences will be ignored.
1194zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
1195zipListWithEvent f l e = do
1196 let f' a b = case a of
1197 h:t -> (Just t, Just $ f h b)
1198 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
1199 mapAccumMaybe_ f' l e
1201-- | Assign a number to each occurrence of the given 'Event', starting from 0
1202{-# INLINE numberOccurrences #-}
1203numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
1204numberOccurrences = numberOccurrencesFrom 0
1206-- | Assign a number to each occurrence of the given 'Event'
1207{-# INLINE numberOccurrencesFrom #-}
1208numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
1209numberOccurrencesFrom = mapAccum_ (\n a -> let !next = n + 1 in (next, (n, a)))
1211-- | Assign a number to each occurrence of the given 'Event'; discard the occurrences' values
1212{-# INLINE numberOccurrencesFrom_ #-}
1213numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
1214numberOccurrencesFrom_ = mapAccum_ (\n _ -> let !next = n + 1 in (next, n))
1216-- | This is used to sample the value of a 'Behavior' using an 'Event'.
1218-- The '<@>' operator is intended to be used in conjunction with
1219-- the 'Applicative' instance for 'Behavior'.
1221-- This is useful when we want to combine the values of one 'Event' and
1222-- the value of several 'Behavior's at the time the 'Event' is firing.
1226-- > f :: a -> b -> c -> d
1227-- > b1 :: Behavior t a
1228-- > b2 :: Behavior t b
1233-- > f <$> b1 <*> b2 <@> e :: Event t d
1235-- in order to apply the function 'f' to the relevant values.
1237-- The alternative would be something like:
1239-- > attachWith (\(x1, x2) y -> f x1 x2 y) ((,) <$> b1 <*> b2) e :: Event t d
1241-- or a variation involing a custom data type to hold the combination of
1242-- 'Behavior's even when that combination might only ever be used by 'f'.
1244-- A more suggestive example might be:
1246-- > handleMouse <$> bPlayerState <*> bMousePosition <@> eMouseClick :: Event t (GameState -> GameState)
1248(<@>) :: Reflex t => Behavior t (a -> b) -> Event t a -> Event t b
1249(<@>) b = push $ \x -> do
1251 return . Just . f $ x
1254-- | An version of '<@>' that does not use the value of the 'Event'.
1256-- Alternatively, it is 'tag' in operator form.
1258-- This is useful when we want to combine the values of several
1259-- 'Behavior's at particular points in time using an 'Applicative'
1264-- > g :: a -> b -> d
1265-- > b1 :: Behavior t a
1266-- > b2 :: Behavior t b
1269-- where 'e' is firing at the points in time of interest.
1271-- Then we can use '<@':
1273-- > g <$> b1 <*> b2 <@ e :: Event t d
1275-- to combine the values of 'b1' and 'b2' at each of those points of time,
1276-- with the function 'g' being used to combine the values.
1278-- This is the same as '<@>' except that the 'Event' is being used only
1279-- to act as a trigger.
1280(<@) :: (Reflex t) => Behavior t b -> Event t a -> Event t b
1288{-# INLINE pushAlwaysCheap #-}
1289pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
1290pushAlwaysCheap f = pushCheap (fmap Just . f)
1292{-# INLINE fmapMaybeCheap #-}
1293fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1294fmapMaybeCheap f = pushCheap $ return . f
1296{-# INLINE fforMaybeCheap #-}
1297fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
1298fforMaybeCheap = flip fmapMaybeCheap
1300{-# INLINE fforCheap #-}
1301fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
1302fforCheap = flip fmapCheap
1304{-# INLINE fmapCheap #-}
1305fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
1306fmapCheap f = pushCheap $ return . Just . f
1308{-# INLINE tagCheap #-}
1309tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
1310tagCheap b = pushAlwaysCheap $ \_ -> sample b
1312{-# INLINE mergeWithCheap #-}
1313mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
1314mergeWithCheap = mergeWithCheap' id
1316{-# INLINE mergeWithCheap' #-}
1317mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
1318mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
1320{-# INLINE mergeWithFoldCheap' #-}
1321mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
1322mergeWithFoldCheap' f es =
1323 fmapCheap (f . (\(h : t) -> h :| t) . IntMap.elems)
1325 . IntMap.fromDistinctAscList
1326 $ zip [0 :: Int ..] es
1328--------------------------------------------------------------------------------
1329-- Deprecated functions
1330--------------------------------------------------------------------------------
1332-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
1333-- occurs. If both occur at the same time they are combined using 'mappend'.
1334{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}
1335appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
1336appendEvents = alignWith $ mergeThese mappend
1338-- | Alias for 'headE'
1339{-# DEPRECATED onceE "Use 'headE' instead" #-}
1340onceE :: MonadHold t m => Event t a -> m (Event t a)
1343-- | Run both sides of a 'These' monadically, combining the results.
1344{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
1345#ifdef USE_TEMPLATE_HASKELL
1346{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
1348sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
1349sequenceThese t = case t of
1350 This ma -> fmap This ma
1351 These ma mb -> liftM2 These ma mb
1352 That mb -> fmap That mb
1354{-# 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'. " #-}
1355switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1356switchPromptly = switchHoldPromptly
1357{-# 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'. " #-}
1358switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1359switchPromptOnly = 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