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
43 -- ** 'fan' related types
46 , EventSelectorInt (..)
47 -- * Convenience functions
50 -- ** Combining 'Event's
54 , mergeIncrementalWithMove
58 , mergeMapIncrementalWithMove
59 , mergeIntMapIncremental
61 , coincidencePatchMapWithMove
62 , coincidencePatchIntMap
67 -- ** Breaking up 'Event's
79 -- ** Collapsing 'Event . Event'
82 , switchHoldPromptOnly
83 , switchHoldPromptOnlyIncremental
84 -- ** Using 'Event's to sample 'Behavior's
90 -- ** Blocking an 'Event' based on a 'Behavior'
92 -- ** Combining 'Dynamic's
93 , distributeDMapOverDynPure
94 , distributeDMapOverDynPureG
95 , distributeListOverDyn
96 , distributeListOverDynWith
99 -- ** Accumulating state
123 , accumMaybeIncremental
124 , accumMaybeMIncremental
125 , mapAccumIncremental
126 , mapAccumMIncremental
127 , mapAccumMaybeIncremental
128 , mapAccumMaybeMIncremental
131 , numberOccurrencesFrom
132 , numberOccurrencesFrom_
142 -- * Debugging functions
145 -- * Unsafe functions
147 , unsafeMapIncremental
148 -- * 'Filterable' convenience functions
149 , FunctorMaybe -- fmapMaybe is purposely not exported from deprecated 'FunctorMaybe' and the new alias is exported instead
150 , mapMaybe -- Re-exported for convenience
156 -- * Miscellaneous convenience functions
160 -- * Deprecated functions
163 -- * "Cheap" functions
173 -- * Slow, but general, implementations
177import Control.Applicative
178import Control.Monad.Identity
179import Control.Monad.Reader
180import Control.Monad.State.Strict
181import Control.Monad.Trans.Cont (ContT)
182import Control.Monad.Trans.Except (ExceptT)
183import Control.Monad.Trans.RWS (RWST)
184import Control.Monad.Trans.Writer (WriterT)
189import Data.Dependent.Map (DMap, DSum (..))
190import qualified Data.Dependent.Map as DMap
191import Data.Functor.Compose
192import Data.Functor.Product
193import Data.GADT.Compare (GEq (..), GCompare (..), (:~:) (..))
194import Data.FastMutableIntMap (PatchIntMap)
196import Data.Functor.Bind
197import Data.Functor.Misc
198import Data.Functor.Plus
199import Data.IntMap.Strict (IntMap)
200import qualified Data.IntMap.Strict as IntMap
201import Data.List.NonEmpty (NonEmpty (..))
203import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
204import Data.Some (Some(Some))
207import Data.Type.Coercion
208import Data.Witherable (Filterable(..))
209import qualified Data.Witherable as W
210import Reflex.FunctorMaybe (FunctorMaybe)
211import qualified Reflex.FunctorMaybe
213import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
215import Debug.Trace (trace)
217-- | The 'Reflex' class contains all the primitive functionality needed for
218-- Functional Reactive Programming (FRP). The @/t/@ type parameter indicates
219-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
220-- and the type of the timeline determines the FRP engine to be used. For most
221-- purposes, the 'Reflex.Spider' implementation is recommended.
222class ( MonadHold t (PushM t)
223 , MonadSample t (PullM t)
225 , Functor (Dynamic t)
226 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
229 -- | A container for a value that can change over time. 'Behavior's can be
230 -- sampled at will, but it is not possible to be notified when they change
231 data Behavior t :: * -> *
232 -- | A stream of occurrences. During any given frame, an 'Event' is either
233 -- occurring or not occurring; if it is occurring, it will contain a value of
234 -- the given type (its "occurrence type")
235 data Event t :: * -> *
236 -- | A container for a value that can change over time and allows
237 -- notifications on changes. Basically a combination of a 'Behavior' and an
238 -- 'Event', with a rule that the 'Behavior' will change if and only if the
240 data Dynamic t :: * -> *
241 -- | An 'Incremental' is a more general form of a 'Dynamic'.
242 -- Instead of always fully replacing the value, only parts of it can be patched.
243 -- This is only needed for performance critical code via `mergeIncremental` to make small
244 -- changes to large values.
245 data Incremental t :: * -> *
246 -- | A monad for doing complex push-based calculations efficiently
247 type PushM t :: * -> *
248 -- | A monad for doing complex pull-based calculations efficiently
249 type PullM t :: * -> *
250 -- | An 'Event' with no occurrences
252 -- | Create a 'Behavior' that always has the given value
253 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
254 -- | Create an 'Event' from another 'Event'; the provided function can sample
255 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
256 -- (Just) or non-occurring (Nothing) result
257 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
258 -- | 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.
259 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
260 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
261 -- recomputed whenever any of the read 'Behavior's changes
262 pull :: PullM t a -> Behavior t a
263 -- | Merge a collection of events; the resulting 'Event' will only occur if at
264 -- least one input event is occurring, and will contain all of the input keys
265 -- that are occurring simultaneously
267 --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
268 mergeG :: GCompare k => (forall a. q a -> Event t (v a))
269 -> DMap k q -> Event t (DMap k v)
271 -- | Efficiently fan-out an event to many destinations. You should save the
272 -- result in a @let@-binding, and then repeatedly 'selectG' on the result to
273 -- create child events
274 fanG :: GCompare k => Event t (DMap k v) -> EventSelectorG t k v
276 -- | Create an 'Event' that will occur whenever the currently-selected input
278 switch :: Behavior t (Event t a) -> Event t a
279 -- | Create an 'Event' that will occur whenever the input event is occurring -- and its occurrence value, another 'Event', is also occurring
280 coincidence :: Event t (Event t a) -> Event t a
281 -- | Extract the 'Behavior' of a 'Dynamic'.
282 current :: Dynamic t a -> Behavior t a
283 -- | Extract the 'Event' of the 'Dynamic'.
284 updated :: Dynamic t a -> Event t a
285 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
286 -- recent firing of the given 'Event', if any.
287 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
288 -- | Create a new 'Incremental'. The given "PullM"'s value must always change
289 -- in the same way that the accumulated application of patches would change
291 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
292 -- | Create a merge whose parents can change over time
293 mergeIncrementalG :: GCompare k
294 => (forall a. q a -> Event t (v a))
295 -> Incremental t (PatchDMap k q)
296 -> Event t (DMap k v)
297 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
298 mergeIncrementalWithMoveG :: GCompare k
299 => (forall a. q a -> Event t (v a))
300 -> Incremental t (PatchDMapWithMove k q) -> Event t (DMap k v)
301 -- | Extract the 'Behavior' component of an 'Incremental'
302 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
303 -- | Extract the 'Event' component of an 'Incremental'
304 updatedIncremental :: Patch p => Incremental t p -> Event t p
305 -- | Convert an 'Incremental' to a 'Dynamic'
306 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
307 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
309 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
310 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
312 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
313 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
315 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
316 -- | Construct a 'Coercion' for an 'Incremental' given 'Coercion's for its
317 -- patch target and patch types.
319 :: Coercion (PatchTarget a) (PatchTarget b) -> Coercion a b -> Coercion (Incremental t a) (Incremental t b)
320 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
321 fanInt :: Event t (IntMap a) -> EventSelectorInt t a
323-- | Efficiently fan-out an event to many destinations. You should save the
324-- result in a @let@-binding, and then repeatedly 'select' on the result to
325-- create child events
326fan :: forall t k. (Reflex t, GCompare k)
327 => Event t (DMap k Identity) -> EventSelector t k
328 --TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it
329fan e = EventSelector (fixup (selectG (fanG e) :: k a -> Event t (Identity a)) :: forall a. k a -> Event t a)
331 fixup :: forall a. (k a -> Event t (Identity a)) -> k a -> Event t a
332 fixup = case eventCoercion Coercion :: Coercion (Event t (Identity a)) (Event t a) of
335--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on
336-- | Constructs a single 'Event' out of a map of events. The output event may fire with multiple
337-- keys simultaneously.
338mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
339mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never
341-- | Coerce a 'Behavior' between representationally-equivalent value types
342coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
343coerceBehavior = coerceWith $ behaviorCoercion Coercion
345-- | Coerce an 'Event' between representationally-equivalent occurrence types
346coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
347coerceEvent = coerceWith $ eventCoercion Coercion
349-- | Coerce a 'Dynamic' between representationally-equivalent value types
350coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
351coerceDynamic = coerceWith $ dynamicCoercion Coercion
353-- | Coerce an 'Incremental' between representationally-equivalent value types
355 :: (Reflex t, Coercible a b, Coercible (PatchTarget a) (PatchTarget b))
356 => Incremental t a -> Incremental t b
357coerceIncremental = coerceWith $ incrementalCoercion Coercion Coercion
359-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
360-- __must__ change when and only when the 'Event' fires, such that the
361-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
362-- if this is not the case, the resulting 'Dynamic' will behave
363-- nondeterministically.
364unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
365unsafeDynamic = unsafeBuildDynamic . sample
367-- | Construct a 'Dynamic' value that never changes
368constDyn :: Reflex t => a -> Dynamic t a
371instance (Reflex t, Default a) => Default (Dynamic t a) where
374-- | 'MonadSample' designates monads that can read the current value of a
375-- 'Behavior'. This includes both 'PullM' and 'PushM'.
376class (Applicative m, Monad m) => MonadSample t m | m -> t where
377 -- | Get the current value in the 'Behavior'
378 sample :: Behavior t a -> m a
380-- | 'MonadHold' designates monads that can create new 'Behavior's based on
381-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
382-- is required to create any stateful computations with Reflex.
383class MonadSample t m => MonadHold t m where
384 -- | Create a new 'Behavior' whose value will initially be equal to the given
385 -- value and will be updated whenever the given 'Event' occurs. The update
386 -- takes effect immediately after the 'Event' occurs; if the occurrence that
387 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
388 -- the 'Behavior', it will see the __old__ value of the 'Behavior', not the new
390 hold :: a -> Event t a -> m (Behavior t a)
391 default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)
392 hold v0 = lift . hold v0
393 -- | Create a 'Dynamic' value using the given initial value that changes every
394 -- time the 'Event' occurs.
395 holdDyn :: a -> Event t a -> m (Dynamic t a)
396 default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)
397 holdDyn v0 = lift . holdDyn v0
398 -- | Create an 'Incremental' value using the given initial value that changes
399 -- every time the 'Event' occurs.
400 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
401 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
402 holdIncremental v0 = lift . holdIncremental v0
403 buildDynamic :: PushM t a -> Event t a -> m (Dynamic t a)
405 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
406 buildDynamic getV0 = lift . buildDynamic getV0
408 -- | Create a new 'Event' that only occurs only once, on the first occurrence of
409 -- the supplied 'Event'.
410 headE :: Event t a -> m (Event t a)
412-- | Accumulate an 'Incremental' with the supplied initial value and the firings of the provided 'Event',
413-- using the combining function to produce a patch.
415 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
416 => (PatchTarget p -> b -> p)
419 -> m (Incremental t p)
420accumIncremental f = accumMaybeIncremental $ \v o -> Just $ f v o
422-- | Similar to 'accumIncremental' but the combining function runs in 'PushM'
424 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
425 => (PatchTarget p -> b -> PushM t p)
428 -> m (Incremental t p)
429accumMIncremental f = accumMaybeMIncremental $ \v o -> Just <$> f v o
431-- | Similar to 'accumIncremental' but allows filtering of updates (by dropping updates when the
432-- combining function produces @Nothing@)
434 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
435 => (PatchTarget p -> b -> Maybe p)
438 -> m (Incremental t p)
439accumMaybeIncremental f = accumMaybeMIncremental $ \v o -> return $ f v o
441-- | Similar to 'accumMaybeMIncremental' but the combining function runs in 'PushM'
442accumMaybeMIncremental
443 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
444 => (PatchTarget p -> b -> PushM t (Maybe p))
447 -> m (Incremental t p)
448accumMaybeMIncremental f z e = do
449 rec let e' = flip push e $ \o -> do
450 v <- sample $ currentIncremental d'
452 d' <- holdIncremental z e'
455-- | Accumulate an 'Incremental' by folding occurrences of an 'Event'
456-- with a function that both accumulates and produces a value to fire
457-- as an 'Event'. Returns both the accumulated value and the constructed
460 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
461 => (PatchTarget p -> b -> (p, c))
464 -> m (Incremental t p, Event t c)
465mapAccumIncremental f = mapAccumMaybeIncremental $ \v o -> bimap Just Just $ f v o
467-- | Like 'mapAccumIncremental' but the combining function runs in 'PushM'
469 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
470 => (PatchTarget p -> b -> PushM t (p, c))
473 -> m (Incremental t p, Event t c)
474mapAccumMIncremental f = mapAccumMaybeMIncremental $ \v o -> bimap Just Just <$> f v o
476-- | Accumulate an 'Incremental' by folding occurrences of an 'Event' with
477-- a function that both optionally accumulates and optionally produces
478-- a value to fire as a separate output 'Event'.
479-- Note that because 'Nothing's are discarded in both cases, the output
480-- 'Event' may fire even though the output 'Incremental' has not changed, and
481-- the output 'Incremental' may update even when the output 'Event' is not firing.
482mapAccumMaybeIncremental
483 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
484 => (PatchTarget p -> b -> (Maybe p, Maybe c))
487 -> m (Incremental t p, Event t c)
488mapAccumMaybeIncremental f = mapAccumMaybeMIncremental $ \v o -> return $ f v o
490-- | Like 'mapAccumMaybeIncremental' but the combining function is a 'PushM' action
491mapAccumMaybeMIncremental
492 :: (Reflex t, Patch p, MonadHold t m, MonadFix m)
493 => (PatchTarget p -> b -> PushM t (Maybe p, Maybe c))
496 -> m (Incremental t p, Event t c)
497mapAccumMaybeMIncremental f z e = do
498 rec let e' = flip push e $ \o -> do
499 v <- sample $ currentIncremental d'
501 return $ case result of
502 (Nothing, Nothing) -> Nothing
504 d' <- holdIncremental z $ mapMaybe fst e'
505 return (d', mapMaybe snd e')
507-- | A somewhat slow implementation of 'headE'
508slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
510 rec be <- hold e $ fmapCheap (const never) e'
514-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
515-- key. This is much more efficient than filtering for each key with
517newtype EventSelector t k = EventSelector
518 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
519 -- determined by the type of the key, so this can be used to fan-out
520 -- 'Event's whose sub-'Event's have different types.
522 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
523 -- (but equivalent to) using 'mapMaybe' to select only the relevant
524 -- occurrences of an 'Event'.
525 select :: forall a. k a -> Event t a
528newtype EventSelectorG t k v = EventSelectorG
529 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
530 -- determined by the type of the key, so this can be used to fan-out
531 -- 'Event's whose sub-'Event's have different types.
533 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
534 -- (but equivalent to) using 'mapMaybe' to select only the relevant
535 -- occurrences of an 'Event'.
536 selectG :: forall a. k a -> Event t (v a)
539-- | Efficiently select an 'Event' keyed on 'Int'. This is more efficient than manually
541newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }
543--------------------------------------------------------------------------------
545--------------------------------------------------------------------------------
547instance MonadSample t m => MonadSample t (ReaderT r m) where
548 sample = lift . sample
550instance MonadHold t m => MonadHold t (ReaderT r m) where
551 hold a0 = lift . hold a0
552 holdDyn a0 = lift . holdDyn a0
553 holdIncremental a0 = lift . holdIncremental a0
554 buildDynamic a0 = lift . buildDynamic a0
557instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
558 sample = lift . sample
560instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
561 hold a0 = lift . hold a0
562 holdDyn a0 = lift . holdDyn a0
563 holdIncremental a0 = lift . holdIncremental a0
564 buildDynamic a0 = lift . buildDynamic a0
567instance MonadSample t m => MonadSample t (StateT s m) where
568 sample = lift . sample
570instance MonadHold t m => MonadHold t (StateT s m) where
571 hold a0 = lift . hold a0
572 holdDyn a0 = lift . holdDyn a0
573 holdIncremental a0 = lift . holdIncremental a0
574 buildDynamic a0 = lift . buildDynamic a0
577instance MonadSample t m => MonadSample t (ExceptT e m) where
578 sample = lift . sample
580instance MonadHold t m => MonadHold t (ExceptT e m) where
581 hold a0 = lift . hold a0
582 holdDyn a0 = lift . holdDyn a0
583 holdIncremental a0 = lift . holdIncremental a0
584 buildDynamic a0 = lift . buildDynamic a0
587instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
588 sample = lift . sample
590instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
591 hold a0 = lift . hold a0
592 holdDyn a0 = lift . holdDyn a0
593 holdIncremental a0 = lift . holdIncremental a0
594 buildDynamic a0 = lift . buildDynamic a0
597instance MonadSample t m => MonadSample t (ContT r m) where
598 sample = lift . sample
600instance MonadHold t m => MonadHold t (ContT r m) where
601 hold a0 = lift . hold a0
602 holdDyn a0 = lift . holdDyn a0
603 holdIncremental a0 = lift . holdIncremental a0
604 buildDynamic a0 = lift . buildDynamic a0
607--------------------------------------------------------------------------------
608-- Convenience functions
609--------------------------------------------------------------------------------
611-- | Create an 'Event' from another 'Event'. The provided function can sample
612-- 'Behavior's and hold 'Event's.
613pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
614pushAlways f = push (fmap Just . f)
616-- | Flipped version of 'fmap'.
617ffor :: Functor f => f a -> (a -> b) -> f b
620-- | Rotated version of 'liftA2'.
621ffor2 :: Applicative f => f a -> f b -> (a -> b -> c) -> f c
622ffor2 a b f = liftA2 f a b
624-- | Rotated version of 'liftA3'.
625ffor3 :: Applicative f => f a -> f b -> f c -> (a -> b -> c -> d) -> f d
626ffor3 a b c f = liftA3 f a b c
628instance Reflex t => Applicative (Behavior t) where
630 f <*> x = pull $ sample f `ap` sample x
634instance Reflex t => Apply (Behavior t) where
637instance Reflex t => Bind (Behavior t) where
640instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
642 fromRational = pure . fromRational
645instance Reflex t => Functor (Behavior t) where
646 fmap f = pull . fmap f . sample
648instance (Reflex t, IsString a) => IsString (Behavior t a) where
649 fromString = pure . fromString
651instance Reflex t => Monad (Behavior t) where
652 a >>= f = pull $ sample a >>= sample . f
653 -- 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.
655 fail = error "Monad (Behavior t) does not support fail"
657instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
658 mempty = constant mempty
659 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
660 mconcat = pull . fmap mconcat . mapM sample
662instance (Reflex t, Num a) => Num (Behavior t a) where
667 fromInteger = pure . fromInteger
671instance (Num a, Reflex t) => Num (Dynamic t a) where
676 fromInteger = pure . fromInteger
680instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
681 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
682 sconcat = pull . fmap sconcat . mapM sample
683#if MIN_VERSION_semigroups(0,17,0)
684 stimes n = fmap $ stimes n
686 times1p n = fmap $ times1p n
689-- | Alias for 'mapMaybe'
690fmapMaybe :: Filterable f => (a -> Maybe b) -> f a -> f b
693-- | Flipped version of 'mapMaybe'.
694fforMaybe :: Filterable f => f a -> (a -> Maybe b) -> f b
695fforMaybe = flip mapMaybe
697-- | Filter 'f a' using the provided predicate.
698ffilter :: Filterable f => (a -> Bool) -> f a -> f a
701-- | Filter 'Left's from 'f (Either a b)' into 'a'.
702filterLeft :: Filterable f => f (Either a b) -> f a
703filterLeft = mapMaybe (either Just (const Nothing))
705-- | Filter 'Right's from 'f (Either a b)' into 'b'.
706filterRight :: Filterable f => f (Either a b) -> f b
707filterRight = mapMaybe (either (const Nothing) Just)
709-- | Left-biased event union (prefers left event on simultaneous
711instance Reflex t => Alt (Event t) where
712 ev1 <!> ev2 = leftmost [ev1, ev2]
714-- | 'Event' intersection (convenient interface to 'coincidence').
715instance Reflex t => Apply (Event t) where
716 evf <.> evx = coincidence (fmap (<$> evx) evf)
718-- | 'Event' intersection (convenient interface to 'coincidence').
719instance Reflex t => Bind (Event t) where
720 evx >>- f = coincidence (f <$> evx)
723instance Reflex t => Functor (Event t) where
725 fmap f = mapMaybe $ Just . f
727 x <$ e = fmapCheap (const x) e
729-- TODO Remove this instance
730instance Reflex t => FunctorMaybe (Event t) where
731 {-# INLINE fmapMaybe #-}
734instance Reflex t => Filterable (Event t) where
735 {-# INLINE mapMaybe #-}
736 mapMaybe f = push $ return . f
738-- | Never: @'zero' = 'never'@.
739instance Reflex t => Plus (Event t) where
742-- | Replace each occurrence value of the 'Event' with the value of the
743-- 'Behavior' at the time of that occurrence.
744tag :: Reflex t => Behavior t b -> Event t a -> Event t b
745tag b = pushAlways $ \_ -> sample b
747-- | Replace each occurrence value of the 'Event' with the value of the
748-- 'Behavior' at that time; if it is 'Just', fire with the contained value; if
749-- it is 'Nothing', drop the occurrence.
750tagMaybe :: Reflex t => Behavior t (Maybe b) -> Event t a -> Event t b
751tagMaybe b = push $ \_ -> sample b
753-- | Create a new 'Event' that combines occurrences of supplied 'Event' with the
754-- current value of the 'Behavior'.
755attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
756attach = attachWith (,)
758-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
759-- combining it with the current value of the 'Behavior'.
760attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
761attachWith f = attachWithMaybe $ \a b -> Just $ f a b
763-- | Create a new 'Event' by combining each occurrence with the current value of
764-- the 'Behavior'. The occurrence is discarded if the combining function returns
766attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
767attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
769-- | Create a new 'Event' that occurs on all but the first occurrence of the
771tailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a)
772tailE e = snd <$> headTailE e
774-- | Create a tuple of two 'Event's with the first one occurring only the first
775-- time the supplied 'Event' occurs and the second occurring on all but the first
777headTailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a, Event t a)
780 be <- hold never $ fmap (const e) eHead
781 return (eHead, switch be)
783-- | Take the streak of occurrences starting at the current time for which the
784-- event returns 'True'.
786-- Starting at the current time, fire all the occurrences of the 'Event' for
787-- which the given predicate returns 'True'. When first 'False' is returned,
788-- do not fire, and permanently stop firing, even if 'True' values would have
789-- been encountered later.
792 . (Reflex t, MonadFix m, MonadHold t m)
796takeWhileE f = takeWhileJustE $ \v -> guard (f v) $> v
798-- | Take the streak of occurrences starting at the current time for which the
799-- event returns 'Just b'.
801-- Starting at the current time, fire all the occurrences of the 'Event' for
802-- which the given predicate returns 'Just b'. When first 'Nothing' is returned,
803-- do not fire, and permanently stop firing, even if 'Just b' values would have
804-- been encountered later.
807 . (Reflex t, MonadFix m, MonadHold t m)
811takeWhileJustE f e = do
812 rec let (eBad, eTrue) = fanEither $ ffor e' $ \a -> case f a of
813 Nothing -> Left never
815 eFirstBad <- headE eBad
816 e' <- switchHold e eFirstBad
819-- | Drop the streak of occurrences starting at the current time for which the
820-- event returns 'True'.
822-- Starting at the current time, do not fire all the occurrences of the 'Event'
823-- for which the given predicate returns 'True'. When 'False' is first
824-- returned, do fire, and permanently continue firing, even if 'True' values
825-- would have been encountered later.
828 . (Reflex t, MonadFix m, MonadHold t m)
832dropWhileE f e = snd <$> takeDropWhileJustE (\v -> guard (f v) $> v) e
834-- | Both take and drop the streak of occurrences starting at the current time
835-- for which the event returns 'Just b'.
837-- For the left event, starting at the current time, fire all the occurrences
838-- of the 'Event' for which the given function returns 'Just b'. When
839-- 'Nothing' is returned, do not fire, and permanently stop firing, even if
840-- 'Just b' values would have been encountered later.
842-- For the right event, do not fire until the first occurrence where the given
843-- function returns 'Nothing', and fire that one and all subsequent
844-- occurrences. Even if the function would have again returned 'Just b', keep
848 . (Reflex t, MonadFix m, MonadHold t m)
851 -> m (Event t b, Event t a)
852takeDropWhileJustE f e = do
853 rec let (eBad, eGood) = fanEither $ ffor e' $ \a -> case f a of
856 eFirstBad <- headE eBad
857 e' <- switchHold e (never <$ eFirstBad)
858 eRest <- switchHoldPromptOnly never (e <$ eFirstBad)
859 return (eGood, eRest)
861-- | Split the supplied 'Event' into two individual 'Event's occurring at the
862-- same time with the respective values from the tuple.
863splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
864splitE e = (fmap fst e, fmap snd e)
866-- | Print the supplied 'String' and the value of the 'Event' on each
867-- occurrence. This should /only/ be used for debugging.
869-- Note: As with Debug.Trace.trace, the message will only be printed if the
870-- 'Event' is actually used.
871traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
872traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
874-- | Print the output of the supplied function on each occurrence of the
875-- 'Event'. This should /only/ be used for debugging.
877-- Note: As with Debug.Trace.trace, the message will only be printed if the
878-- 'Event' is actually used.
879traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
880traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
882instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
883 (<>) = alignWith (mergeThese (<>))
884 sconcat = fmap sconcat . mergeList . toList
885#if MIN_VERSION_semigroups(0,17,0)
886 stimes n = fmap $ stimes n
888 times1p n = fmap $ times1p n
891instance (Semigroup a, Reflex t) => Monoid (Event t a) where
894 mconcat = fmap sconcat . mergeList
896-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
897-- list occurs. If multiple occur at the same time they are folded from the left
898-- with the given function.
899{-# INLINE mergeWith #-}
900mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
901mergeWith = mergeWith' id
903{-# INLINE mergeWith' #-}
904mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
905mergeWith' f g es = fmap (Prelude.foldl1 g . fmap f)
907 . IntMap.fromDistinctAscList
908 $ zip [0 :: Int ..] es
910-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
911-- list occurs. If multiple occur at the same time the value is the value of the
913{-# INLINE leftmost #-}
914leftmost :: Reflex t => [Event t a] -> Event t a
915leftmost = mergeWith const
917-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
918-- list occurs and has a list of the values of all 'Event's occurring at that
920mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
922mergeList es = mergeWithFoldCheap' id es
925 :: (Reflex t, Patch p, Patch p')
926 => (PatchTarget p -> PatchTarget p')
930unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
932-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
933-- occurs if at least one of them occurs and has a map of values of all 'Event's
934-- occurring at that time.
935mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
936mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
938-- | Like 'mergeMap' but for 'IntMap'.
939mergeIntMap :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
940mergeIntMap = fmap dmapToIntMap . merge . intMapWithFunctorToDMap
942-- | Create a merge whose parents can change over time
943mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
944mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
946-- | Create a merge whose parents can change over time
947mergeIntMapIncremental :: Reflex t => Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
948mergeIntMapIncremental = fmap dmapToIntMap . mergeIncremental . unsafeMapIncremental intMapWithFunctorToDMap (const2IntPatchDMapWith id)
950-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
951mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
952mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
954-- | Split the event into separate events for 'Left' and 'Right' values.
955fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
957 let justLeft = either Just (const Nothing)
958 justRight = either (const Nothing) Just
959 in (mapMaybe justLeft e, mapMaybe justRight e)
961-- | Split the event into separate events for 'This' and 'That' values,
962-- allowing them to fire simultaneously when the input value is 'These'.
963fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
965 let this (This x) = Just x
966 this (These x _) = Just x
968 that (That y) = Just y
969 that (These _ y) = Just y
971 in (mapMaybe this e, mapMaybe that e)
973-- | Split the event into an 'EventSelector' that allows efficient selection of
974-- the individual 'Event's.
975fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
976fanMap = fan . fmap mapToDMap
978-- | Switches to the new event whenever it receives one. Only the old event is
979-- considered the moment a new one is switched in; the output event will fire at
980-- that moment only if the old event does.
982-- Because the simultaneous firing case is irrelevant, this function imposes
983-- laxer "timing requirements" on the overall circuit, avoiding many potential
984-- cyclic dependency / metastability failures. It's also more performant. Use
985-- this rather than 'switchHoldPromptly' and 'switchHoldPromptOnly' unless you
986-- are absolutely sure you need to act on the new event in the coincidental
988switchHold :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
989switchHold ea0 eea = switch <$> hold ea0 eea
991-- | Switches to the new event whenever it receives one. Whenever a new event is
992-- provided, if it is firing, its value will be the resulting event's value; if
993-- it is not firing, but the old one is, the old one's value will be used.
995-- 'switchHold', by always forwarding the old event the moment it is switched
996-- out, avoids many potential cyclic dependency problems / metastability
997-- problems. It's also more performant. Use it instead unless you are sure you
999switchHoldPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1000switchHoldPromptly ea0 eea = do
1002 let eLag = switch bea
1003 eCoincidences = coincidence eea
1004 return $ leftmost [eCoincidences, eLag]
1006-- | switches to a new event whenever it receives one. At the moment of
1007-- switching, the old event will be ignored if it fires, and the new one will be
1008-- used if it fires; this is the opposite of 'switch', which will use only the
1011-- 'switchHold', by always forwarding the old event the moment it is switched
1012-- out, avoids many potential cyclic dependency problems / metastability
1013-- problems. It's also more performant. Use it instead unless you are sure you
1015switchHoldPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1016switchHoldPromptOnly e0 e' = do
1017 eLag <- switch <$> hold e0 e'
1018 return $ coincidence $ leftmost [e', eLag <$ eLag]
1020-- | When the given outer event fires, condense the inner events into the contained patch. Non-firing inner events will be replaced with deletions.
1021coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)
1022coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ ffor e $ \(PatchMap m) -> mergeMap $ ffor m $ \case
1023 Nothing -> fmapCheap (const Nothing) e
1024 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
1026-- | See 'coincidencePatchMap'
1027coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)
1028coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ ffor e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case
1029 Nothing -> fmapCheap (const Nothing) e
1030 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
1032-- | See 'coincidencePatchMap'
1033coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)
1034coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ ffor e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
1035 PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->
1036 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1037 PatchMapWithMove.From_Move k -> fforCheap e $ \_ ->
1038 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }
1039 PatchMapWithMove.From_Insert ev -> leftmost
1040 [ fforCheap ev $ \v ->
1041 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }
1042 , fforCheap e $ \_ ->
1043 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1046-- | Given a 'PatchTarget' of events (e.g., a 'Map' with 'Event' values) and an event of 'Patch'es
1047-- (e.g., a 'PatchMap' with 'Event' values), produce an 'Event' of the 'PatchTarget' type that
1048-- fires with the patched value.
1049switchHoldPromptOnlyIncremental
1050 :: forall t m p pt w
1053 , Patch (p (Event t w))
1054 , PatchTarget (p (Event t w)) ~ pt (Event t w)
1056 , PatchTarget (p w) ~ pt w
1059 => (Incremental t (p (Event t w)) -> Event t (pt w))
1060 -> (Event t (p (Event t w)) -> Event t (p w))
1062 -> Event t (p (Event t w))
1063 -> m (Event t (pt w))
1064switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch e0 e' = do
1065 lag <- mergePatchIncremental <$> holdIncremental e0 e'
1066 pure $ ffor (align lag (coincidencePatch e')) $ \case
1068 That new -> new `applyAlways` mempty
1069 These old new -> new `applyAlways` old
1071instance Reflex t => Align (Event t) where
1073#if MIN_VERSION_these(0, 8, 0)
1074instance Reflex t => Semialign (Event t) where
1076 align = alignEventWithMaybe Just
1079-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
1080-- the 'Behavior' is true at the time of occurrence.
1081gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
1082gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
1084-- | Create a new behavior given a starting behavior and switch to the behavior
1085-- carried by the event when it fires.
1086switcher :: (Reflex t, MonadHold t m)
1087 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
1088switcher b eb = pull . (sample <=< sample) <$> hold b eb
1090instance (Reflex t, IsString a) => IsString (Dynamic t a) where
1091 fromString = pure . fromString
1093-- | Combine two 'Dynamic's. The result will change whenever either (or both)
1094-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
1095zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
1096zipDyn = zipDynWith (,)
1098-- | Combine two 'Dynamic's with a combining function. The result will change
1099-- whenever either (or both) input 'Dynamic' changes.
1100-- More efficient than 'liftA2'.
1101zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
1103 let eab = align (updated da) (updated db)
1104 ec = flip push eab $ \o -> do
1107 b <- sample $ current db
1110 a <- sample $ current da
1112 These a b -> return (a, b)
1113 return $ Just $ f a b
1114 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
1116instance (Reflex t, Semigroup a) => Semigroup (Dynamic t a) where
1117 (<>) = zipDynWith (<>)
1118#if MIN_VERSION_semigroups(0,17,0)
1119 stimes n = fmap $ stimes n
1121 times1p n = fmap $ times1p n
1124instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
1125 mconcat = distributeListOverDynWith mconcat
1126 mempty = constDyn mempty
1127 mappend = zipDynWith mappend
1129-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1130-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1131-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1132distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
1133distributeDMapOverDynPure = distributeDMapOverDynPureG coerceDynamic
1135-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1136-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1137-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1138distributeDMapOverDynPureG
1139 :: forall t k q v. (Reflex t, GCompare k)
1140 => (forall a. q a -> Dynamic t (v a))
1141 -> DMap k q -> Dynamic t (DMap k v)
1142distributeDMapOverDynPureG nt dm = case DMap.toList dm of
1143 [] -> constDyn DMap.empty
1144 [k :=> v] -> DMap.singleton k <$> nt v
1146 let getInitial = DMap.traverseWithKey (\_ -> sample . current . nt) dm
1147 edmPre = mergeG getCompose $ DMap.map (Compose . updated . nt) dm
1148 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
1149 olds <- sample $ current result
1150 return $ DMap.unionWithKey (\_ _ new -> new) olds news
1153-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
1154distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
1155distributeListOverDyn = distributeListOverDynWith id
1157-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
1158distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
1159distributeListOverDynWith f =
1160 fmap (f . map fromDSum . DMap.toAscList) .
1161 distributeDMapOverDynPure .
1162 DMap.fromDistinctAscList .
1163 zipWith toDSum [0..]
1165 toDSum :: Int -> Dynamic t a -> DSum (Const2 Int a) (Dynamic t)
1166 toDSum k v = Const2 k :=> v
1167 fromDSum :: DSum (Const2 Int a) Identity -> a
1168 fromDSum (Const2 _ :=> Identity v) = v
1170-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
1171-- unless the second supplied 'Event' occurs simultaneously.
1172difference :: Reflex t => Event t a -> Event t b -> Event t a
1173difference = alignEventWithMaybe $ \case
1177-- | Zips two values by taking the union of their shapes and combining with the provided function.
1178-- 'Nothing' values are dropped.
1179alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
1180alignEventWithMaybe f ea eb = mapMaybe (f <=< dmapToThese) $
1181 merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
1183-- | Produces an 'Event' that fires only when the input event fires with a 'DSum' key that
1184-- matches the provided key.
1186 :: forall t m k v a.
1193 -> Event t (DSum k v)
1194 -> m (Event t (v a))
1195filterEventKey k kv' = do
1196 let f :: DSum k v -> Maybe (v a)
1197 f (newK :=> newV) = case newK `geq` k of
1198 Just Refl -> Just newV
1200 takeWhileJustE f kv'
1202-- | "Factor" the input 'DSum' 'Event' to produce an 'Event' which
1203-- fires when the 'DSum' key changes and contains both the value of the
1204-- 'DSum' at switchover and an 'Event' of values produced by subsequent
1205-- firings of the input 'Event' that do not change the 'DSum' key.
1207 :: forall t m k v a.
1214 -> Event t (DSum k v)
1215 -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))
1216factorEvent k0 kv' = do
1217 key :: Behavior t (Some k) <- hold (Some k0) $ fmapCheap (\(k :=> _) -> Some k) kv'
1218 let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case
1219 Some oldKey -> case newKey `geq` oldKey of
1220 Just Refl -> return Nothing
1222 newInner <- filterEventKey newKey kv'
1223 return $ Just $ newKey :=> Pair newVal (Compose newInner)
1224 eInitial <- filterEventKey k0 kv'
1225 return (eInitial, update)
1227--------------------------------------------------------------------------------
1229--------------------------------------------------------------------------------
1231-- | An 'Accumulator' type can be built by accumulating occurrences of an
1233#if __GLASGOW_HASKELL__ < 802
1234{-# WARNING accum "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1235{-# WARNING accumM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1236{-# WARNING accumMaybe "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1237{-# WARNING accumMaybeM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
1239class Reflex t => Accumulator t f | f -> t where
1240 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
1241 accum f = accumMaybe $ \v o -> Just $ f v o
1242 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
1243 accumM f = accumMaybeM $ \v o -> Just <$> f v o
1244 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
1245 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
1246 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
1247 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
1248 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
1249 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
1250 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
1251 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1252 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
1253 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
1255-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1256-- with the provided function. See 'foldDyn'.
1258 :: (Reflex t, MonadHold t m, MonadFix m)
1263accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o
1265-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1266-- with the provided 'PushM' action.
1268 :: (Reflex t, MonadHold t m, MonadFix m)
1269 => (a -> b -> PushM t a)
1273accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o
1275-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1276-- with the provided function, discarding 'Nothing' results.
1278 :: (Reflex t, MonadHold t m, MonadFix m)
1279 => (a -> b -> Maybe a)
1283accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o
1285-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1286-- with the provided 'PushM' action, discarding 'Nothing' results.
1288 :: (Reflex t, MonadHold t m, MonadFix m)
1289 => (a -> b -> PushM t (Maybe a))
1293accumMaybeMDyn f z e = do
1294 rec let e' = flip push e $ \o -> do
1295 v <- sample $ current d'
1300-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'
1301-- with a function that both accumulates and produces a value to fire
1302-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1304 :: (Reflex t, MonadHold t m, MonadFix m)
1305 => (a -> b -> (a, c))
1308 -> m (Dynamic t a, Event t c)
1309mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o
1311-- | Similar to 'mapAccumDyn' except that the combining function is a
1314 :: (Reflex t, MonadHold t m, MonadFix m)
1315 => (a -> b -> PushM t (a, c))
1318 -> m (Dynamic t a, Event t c)
1319mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o
1321-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event' with
1322-- a function that both optionally accumulates and optionally produces
1323-- a value to fire as a separate output 'Event'.
1324-- Note that because 'Nothing's are discarded in both cases, the output
1325-- 'Event' may fire even though the output 'Dynamic' has not changed, and
1326-- the output 'Dynamic' may update even when the output 'Event' is not firing.
1328 :: (Reflex t, MonadHold t m, MonadFix m)
1329 => (a -> b -> (Maybe a, Maybe c))
1332 -> m (Dynamic t a, Event t c)
1333mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o
1335-- | Like 'mapAccumMaybeDyn' except that the combining function is a
1338 :: (Reflex t, MonadHold t m, MonadFix m)
1339 => (a -> b -> PushM t (Maybe a, Maybe c))
1342 -> m (Dynamic t a, Event t c)
1343mapAccumMaybeMDyn f z e = do
1344 rec let e' = flip push e $ \o -> do
1345 v <- sample $ current d'
1347 return $ case result of
1348 (Nothing, Nothing) -> Nothing
1350 d' <- holdDyn z $ mapMaybe fst e'
1351 return (d', mapMaybe snd e')
1353-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1354-- with the provided function.
1355{-# INLINE accumB #-}
1357 :: (Reflex t, MonadHold t m, MonadFix m)
1362accumB f = accumMaybeB $ \v o -> Just $ f v o
1364-- | Like 'accumB' except that the combining function is a 'PushM' action.
1365{-# INLINE accumMB #-}
1367 :: (Reflex t, MonadHold t m, MonadFix m)
1368 => (a -> b -> PushM t a)
1372accumMB f = accumMaybeMB $ \v o -> Just <$> f v o
1374-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1375-- with the provided function, discarding 'Nothing' results.
1376{-# INLINE accumMaybeB #-}
1378 :: (Reflex t, MonadHold t m, MonadFix m)
1379 => (a -> b -> Maybe a)
1383accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o
1385-- | Like 'accumMaybeB' except that the combining function is a 'PushM' action.
1386{-# INLINE accumMaybeMB #-}
1387accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)
1388accumMaybeMB f z e = do
1389 rec let e' = flip push e $ \o -> do
1395-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
1396-- with a function that both accumulates and produces a value to fire
1397-- as an 'Event'. Returns both the accumulated value and an 'Event'.
1398{-# INLINE mapAccumB #-}
1400 :: (Reflex t, MonadHold t m, MonadFix m)
1401 => (a -> b -> (a, c))
1404 -> m (Behavior t a, Event t c)
1405mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o
1407-- | Like 'mapAccumB' except that the combining function is a 'PushM' action.
1408{-# INLINE mapAccumMB #-}
1410 :: (Reflex t, MonadHold t m, MonadFix m)
1411 => (a -> b -> PushM t (a, c))
1414 -> m (Behavior t a, Event t c)
1415mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o
1417-- | Accumulate a 'Behavior' by folding occurrences of an 'Event' with
1418-- a function that both optionally accumulates and optionally produces
1419-- a value to fire as a separate output 'Event'. 'Nothing's are discarded.
1420{-# INLINE mapAccumMaybeB #-}
1422 :: (Reflex t, MonadHold t m, MonadFix m)
1423 => (a -> b -> (Maybe a, Maybe c))
1426 -> m (Behavior t a, Event t c)
1427mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o
1429-- | Like 'mapAccumMaybeB' except that the combining function is a 'PushM' action.
1430{-# INLINE mapAccumMaybeMB #-}
1431mapAccumMaybeMB :: (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)
1432mapAccumMaybeMB f z e = do
1433 rec let e' = flip push e $ \o -> do
1436 return $ case result of
1437 (Nothing, Nothing) -> Nothing
1439 d' <- hold z $ mapMaybe fst e'
1440 return (d', mapMaybe snd e')
1442-- | Accumulate occurrences of an 'Event', producing an output occurrence each
1443-- time. Discard the underlying 'Accumulator'.
1444{-# INLINE mapAccum_ #-}
1445mapAccum_ :: 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)
1447 (_, result) <- mapAccumB f z e
1450-- | Accumulate occurrences of an 'Event', possibly producing an output
1451-- occurrence each time. Discard the underlying 'Accumulator'.
1452{-# INLINE mapAccumMaybe_ #-}
1453mapAccumMaybe_ :: 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)
1454mapAccumMaybe_ f z e = do
1455 (_, result) <- mapAccumMaybeB f z e
1458-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
1459-- an output occurrence each time. Discard the underlying 'Accumulator'.
1460{-# INLINE mapAccumM_ #-}
1461mapAccumM_ :: 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)
1462mapAccumM_ f z e = do
1463 (_, result) <- mapAccumMB f z e
1466-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
1467-- producing an output occurrence each time. Discard the underlying
1469{-# INLINE mapAccumMaybeM_ #-}
1470mapAccumMaybeM_ :: 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)
1471mapAccumMaybeM_ f z e = do
1472 (_, result) <- mapAccumMaybeMB f z e
1475instance Reflex t => Accumulator t (Dynamic t) where
1476 accumMaybeM = accumMaybeMDyn
1477 mapAccumMaybeM = mapAccumMaybeMDyn
1479instance Reflex t => Accumulator t (Behavior t) where
1480 accumMaybeM = accumMaybeMB
1481 mapAccumMaybeM = mapAccumMaybeMB
1483instance Reflex t => Accumulator t (Event t) where
1484 accumMaybeM f z e = updated <$> accumMaybeM f z e
1485 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
1487-- | Create a new 'Event' by combining each occurrence with the next value of the
1488-- list using the supplied function. If the list runs out of items, all
1489-- subsequent 'Event' occurrences will be ignored.
1490zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
1491zipListWithEvent f l e = do
1492 let f' a b = case a of
1493 h:t -> (Just t, Just $ f h b)
1494 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
1495 mapAccumMaybe_ f' l e
1497-- | Assign a number to each occurrence of the given 'Event', starting from 0
1498{-# INLINE numberOccurrences #-}
1499numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
1500numberOccurrences = numberOccurrencesFrom 0
1502-- | Assign a number to each occurrence of the given 'Event'
1503{-# INLINE numberOccurrencesFrom #-}
1504numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
1505numberOccurrencesFrom = mapAccum_ (\n a -> let !next = n + 1 in (next, (n, a)))
1507-- | Assign a number to each occurrence of the given 'Event'; discard the occurrences' values
1508{-# INLINE numberOccurrencesFrom_ #-}
1509numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
1510numberOccurrencesFrom_ = mapAccum_ (\n _ -> let !next = n + 1 in (next, n))
1512-- | This is used to sample the value of a 'Behavior' using an 'Event'.
1514-- The '<@>' operator is intended to be used in conjunction with
1515-- the 'Applicative' instance for 'Behavior'.
1517-- This is useful when we want to combine the values of one 'Event' and
1518-- the value of several 'Behavior's at the time the 'Event' is firing.
1522-- > f :: a -> b -> c -> d
1523-- > b1 :: Behavior t a
1524-- > b2 :: Behavior t b
1529-- > f <$> b1 <*> b2 <@> e :: Event t d
1531-- in order to apply the function 'f' to the relevant values.
1533-- The alternative would be something like:
1535-- > attachWith (\(x1, x2) y -> f x1 x2 y) ((,) <$> b1 <*> b2) e :: Event t d
1537-- or a variation involing a custom data type to hold the combination of
1538-- 'Behavior's even when that combination might only ever be used by 'f'.
1540-- A more suggestive example might be:
1542-- > handleMouse <$> bPlayerState <*> bMousePosition <@> eMouseClick :: Event t (GameState -> GameState)
1544(<@>) :: Reflex t => Behavior t (a -> b) -> Event t a -> Event t b
1545(<@>) b = push $ \x -> do
1547 return . Just . f $ x
1550-- | An version of '<@>' that does not use the value of the 'Event'.
1552-- Alternatively, it is 'tag' in operator form.
1554-- This is useful when we want to combine the values of several
1555-- 'Behavior's at particular points in time using an 'Applicative'
1560-- > g :: a -> b -> d
1561-- > b1 :: Behavior t a
1562-- > b2 :: Behavior t b
1565-- where 'e' is firing at the points in time of interest.
1567-- Then we can use '<@':
1569-- > g <$> b1 <*> b2 <@ e :: Event t d
1571-- to combine the values of 'b1' and 'b2' at each of those points of time,
1572-- with the function 'g' being used to combine the values.
1574-- This is the same as '<@>' except that the 'Event' is being used only
1575-- to act as a trigger.
1576(<@) :: (Reflex t) => Behavior t b -> Event t a -> Event t b
1584-- | A "cheap" version of 'pushAlways'. See the performance note on 'pushCheap'.
1585{-# INLINE pushAlwaysCheap #-}
1586pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
1587pushAlwaysCheap f = pushCheap (fmap Just . f)
1589-- | A "cheap" version of 'mapMaybe'. See the performance note on 'pushCheap'.
1590{-# INLINE mapMaybeCheap #-}
1591mapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1592mapMaybeCheap f = pushCheap $ return . f
1594-- | An alias for 'mapMaybeCheap'
1595{-# INLINE fmapMaybeCheap #-}
1596fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1597fmapMaybeCheap = mapMaybeCheap
1600-- | A "cheap" version of 'fforMaybe'. See the performance note on 'pushCheap'.
1601{-# INLINE fforMaybeCheap #-}
1602fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
1603fforMaybeCheap = flip mapMaybeCheap
1605-- | A "cheap" version of 'ffor'. See the performance note on 'pushCheap'.
1606{-# INLINE fforCheap #-}
1607fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
1608fforCheap = flip fmapCheap
1610-- | A "cheap" version of 'fmap'. See the performance note on 'pushCheap'.
1611{-# INLINE fmapCheap #-}
1612fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
1613fmapCheap f = pushCheap $ return . Just . f
1615-- | A "cheap" version of 'tag'. See the performance note on 'pushCheap'.
1616{-# INLINE tagCheap #-}
1617tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
1618tagCheap b = pushAlwaysCheap $ \_ -> sample b
1620-- | Merge a collection of events; the resulting 'Event' will only occur if at
1621-- least one input event is occurring, and will contain all of the input keys
1622-- that are occurring simultaneously
1623merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)
1624merge = mergeG coerceEvent
1627-- | Create a merge whose parents can change over time
1628mergeIncremental :: (Reflex t, GCompare k)
1629 => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
1630mergeIncremental = mergeIncrementalG coerceEvent
1632-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
1633mergeIncrementalWithMove :: (Reflex t, GCompare k)
1634 => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
1635mergeIncrementalWithMove = mergeIncrementalWithMoveG coerceEvent
1637-- | A "cheap" version of 'mergeWithCheap'. See the performance note on 'pushCheap'.
1638{-# INLINE mergeWithCheap #-}
1639mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
1640mergeWithCheap = mergeWithCheap' id
1642-- | A "cheap" version of 'mergeWithCheap''. See the performance note on 'pushCheap'.
1643{-# INLINE mergeWithCheap' #-}
1644mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
1645mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
1647-- | A "cheap" version of 'mergeWithFoldCheap''. See the performance note on 'pushCheap'.
1648{-# INLINE mergeWithFoldCheap' #-}
1649mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
1650mergeWithFoldCheap' f es =
1651 fmapCheap (f . (\(h : t) -> h :| t) . IntMap.elems)
1653 . IntMap.fromDistinctAscList
1654 $ zip [0 :: Int ..] es
1656--------------------------------------------------------------------------------
1657-- Deprecated functions
1658--------------------------------------------------------------------------------
1660{-# 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'. " #-}
1661-- | See 'switchHoldPromptly'
1662switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1663switchPromptly = switchHoldPromptly
1664{-# 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'. " #-}
1665-- | See 'switchHoldPromptOnly'
1666switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
1667switchPromptOnly = 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