2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FunctionalDependencies #-}
6{-# LANGUAGE LambdaCase #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE NoMonomorphismRestriction #-}
9{-# LANGUAGE RankNTypes #-}
10{-# LANGUAGE RecursiveDo #-}
11{-# LANGUAGE RoleAnnotations #-}
12{-# LANGUAGE ScopedTypeVariables #-}
13{-# LANGUAGE TypeFamilies #-}
14{-# LANGUAGE TypeOperators #-}
15{-# LANGUAGE UndecidableInstances #-}
16#ifdef USE_REFLEX_OPTIMIZER
17{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
19#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
20{-# LANGUAGE EmptyDataDecls #-}
21{-# OPTIONS_GHC -Wno-redundant-constraints #-}
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
36 -- ** 'fan'-related types
38 -- ** 'Incremental'-related types
39 -- * Convenience functions
42 -- ** Combining 'Event's
46 , mergeMapIncrementalWithMove
50 -- ** Breaking up 'Event's
59 -- ** Switching between 'Event's
62 -- ** Using 'Event's to sample 'Behavior's
67 -- ** Blocking an 'Event' based on a 'Behavior'
69 -- ** Combining 'Dynamic's
70 , distributeDMapOverDynPure
71 , distributeListOverDyn
72 , distributeListOverDynWith
75 -- ** Accumulating state
86 -- * Debugging functions
91 , unsafeMapIncremental
96 -- * Miscellaneous convenience functions
99 , sequenceDMapWithAdjust
100 , sequenceDMapWithAdjustWithMove
101 -- * Deprecated functions
113#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
134 , unsafeBuildIncremental
138 , incrementalToDynamic
145import Control.Applicative
146import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
147import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
148import Control.Monad.State.Strict hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
149import Control.Monad.Trans.Cont (ContT ())
150import Control.Monad.Trans.Except (ExceptT ())
151import Control.Monad.Trans.RWS (RWST ())
152import Control.Monad.Trans.Writer (WriterT ())
157import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
158import qualified Data.Dependent.Map as DMap
161import Data.Functor.Bind hiding (join)
162import qualified Data.Functor.Bind as Bind
163import Data.Functor.Misc
164import Data.Functor.Plus
165import Data.List.NonEmpty (NonEmpty (..))
168import Data.Monoid hiding (Alt, (<>))
169import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
172import Data.Traversable
173import Data.Type.Coercion
174import Reflex.FunctorMaybe
177#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
178import Reflex.Spider.Internal (EventM, Global, HasSpiderTimeline, SpiderHost (..), SpiderHostFrame (..),
179 SpiderPullM, SpiderPushM (..), behaviorHoldIdentity, dynamicConst,
180 dynamicCurrent, dynamicDynIdentity, dynamicHold, dynamicHoldIdentity,
181 dynamicUpdated, newMapDyn, readBehaviorTracked, readBehaviorUntracked,
182 runFrame, runSpiderHostFrame, unsafeDyn)
183import qualified Reflex.Spider.Internal
184import qualified Reflex.Spider.Internal as S
188-- Note: must come last to silence warnings due to AMP on GHC < 7.10
189import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)
191import Debug.Trace (trace)
193#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
194#include "Spider/SpiderTimeline.include.hs"
197-- | The 'Reflex' class contains all the primitive functionality needed for
198-- Functional Reactive Programming (FRP). The @t@ type parameter indicates
199-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
200-- and the type of the timeline determines the FRP engine to be used. For most
201-- purposes, the 'Reflex.Spider' implementation is recommended.
202class ( MonadHold t (PushM t)
203 , MonadSample t (PullM t)
205 , Functor (Dynamic t)
206 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
208#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
209 , t ~ SpiderTimeline Global
212 -- | A container for a value that can change over time. 'Behavior's can be
213 -- sampled at will, but it is not possible to be notified when they change
214 data Behavior t :: * -> *
215 -- | A stream of occurrences. During any given frame, an 'Event' is either
216 -- occurring or not occurring; if it is occurring, it will contain a value of
217 -- the given type (its "occurrence type")
218 data Event t :: * -> *
219 -- | A container for a value that can change over time and allows
220 -- notifications on changes. Basically a combination of a 'Behavior' and an
221 -- 'Event', with a rule that the 'Behavior' will change if and only if the
223 data Dynamic t :: * -> *
224 -- | An 'Incremental' is a more general form of a 'Dynamic'.
225 -- Instead of always fully replacing the value, only parts of it can be patched.
226 -- This is only needed for performance critical code via `mergeIncremental` to make small
227 -- changes to large values.
228 data Incremental t :: * -> *
229 -- | A monad for doing complex push-based calculations efficiently
230 type PushM t :: * -> *
231 -- | A monad for doing complex pull-based calculations efficiently
232 type PullM t :: * -> *
233#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
234 -- | An 'Event' with no occurrences
236 -- | Create a 'Behavior' that always has the given value
237 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
238 -- | Create an 'Event' from another 'Event'; the provided function can sample
239 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
240 -- (Just) or non-occurring (Nothing) result
241 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
242 -- | 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.
243 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
244 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
245 -- recomputed whenever any of the read 'Behavior's changes
246 pull :: PullM t a -> Behavior t a
247 -- | Merge a collection of events; the resulting 'Event' will only occur if at
248 -- least one input event is occuring, and will contain all of the input keys
249 -- that are occurring simultaneously
250 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
251 -- | Efficiently fan-out an event to many destinations. This function should
252 -- be partially applied, and then the result applied repeatedly to create
254 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
255 -- | Create an 'Event' that will occur whenever the currently-selected input
257 switch :: Behavior t (Event t a) -> Event t a
258 -- | Create an 'Event' that will occur whenever the input event is occurring
259 -- and its occurrence value, another 'Event', is also occurring
260 coincidence :: Event t (Event t a) -> Event t a
261 -- | Extract the 'Behavior' of a 'Dynamic'.
262 current :: Dynamic t a -> Behavior t a
263 -- | Extract the 'Event' of the 'Dynamic'.
264 updated :: Dynamic t a -> Event t a
265 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
266 -- recent firing of the given 'Event', if any.
267 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
268 -- | Create a new 'Incremental'. The given 'PullM''s value must always change
269 -- in the same way that the accumulated application of patches would change
271 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
272 -- | Create a merge whose parents can change over time
273 mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
274 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
275 mergeIncrementalWithMove :: GCompare k => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
276 -- | Extract the 'Behavior' component of an 'Incremental'
277 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
278 -- | Extract the 'Event' component of an 'Incremental'
279 updatedIncremental :: Patch p => Incremental t p -> Event t p
280 -- | Convert an 'Incremental' to a 'Dynamic'
281 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
282 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
284 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
285 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
287 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
288 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
290 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
293#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
294instance t ~ SpiderTimeline Global => Reflex t where
295 newtype Behavior t a = SpiderBehavior { unSpiderBehavior :: Reflex.Spider.Internal.Behavior Global a }
296 newtype Event t a = SpiderEvent { unSpiderEvent :: Reflex.Spider.Internal.Event Global a }
297 newtype Dynamic t a = SpiderDynamic { unSpiderDynamic :: Reflex.Spider.Internal.Dynamic Global (Identity a) } -- deriving (Functor, Applicative, Monad)
298 newtype Incremental t p = SpiderIncremental { unSpiderIncremental :: Reflex.Spider.Internal.Dynamic Global p }
299 type PullM t = SpiderPullM Global
300 type PushM t = SpiderPushM Global
301never :: Reflex t => Event t a
302constant :: Reflex t => a -> Behavior t a
303push :: Reflex t => (a -> PushM t (Maybe b)) -> Event t a -> Event t b
304pushCheap :: Reflex t => (a -> PushM t (Maybe b)) -> Event t a -> Event t b
305pull :: Reflex t => PullM t a -> Behavior t a
306merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)
307fan :: (Reflex t, GCompare k) => Event t (DMap k Identity) -> EventSelector t k
308switch :: Reflex t => Behavior t (Event t a) -> Event t a
309coincidence :: Reflex t => Event t (Event t a) -> Event t a
310current :: Reflex t => Dynamic t a -> Behavior t a
311updated :: Reflex t => Dynamic t a -> Event t a
312unsafeBuildDynamic :: Reflex t => PullM t a -> Event t a -> Dynamic t a
313unsafeBuildIncremental :: (Reflex t, Patch p) => PullM t (PatchTarget p) -> Event t p -> Incremental t p
314mergeIncremental :: (Reflex t, GCompare k) => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
315currentIncremental :: (Reflex t, Patch p) => Incremental t p -> Behavior t (PatchTarget p)
316updatedIncremental :: (Reflex t, Patch p) => Incremental t p -> Event t p
317incrementalToDynamic :: (Reflex t, Patch p) => Incremental t p -> Dynamic t (PatchTarget p)
318behaviorCoercion :: Reflex t => Coercion a b -> Coercion (Behavior t a) (Behavior t b)
319eventCoercion :: Reflex t => Coercion a b -> Coercion (Event t a) (Event t b)
320dynamicCoercion :: Reflex t => Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
322never = SpiderEvent S.eventNever
323{-# INLINE constant #-}
324constant = SpiderBehavior . S.behaviorConst
326push f = SpiderEvent . S.push (coerce f) . unSpiderEvent
327{-# INLINE pushCheap #-}
328pushCheap f = SpiderEvent . S.pushCheap (coerce f) . unSpiderEvent
330pull = SpiderBehavior . S.pull . coerce
332merge = SpiderEvent . S.merge . S.dynamicConst . (coerce :: DMap k (Event (SpiderTimeline x)) -> DMap k (S.Event x))
334fan e = EventSelector $ SpiderEvent . S.select (S.fan (unSpiderEvent e))
336switch = SpiderEvent . S.switch . (coerce :: S.Behavior x (Event (SpiderTimeline x) a) -> S.Behavior x (S.Event x a)) . unSpiderBehavior
337{-# INLINE coincidence #-}
338coincidence = SpiderEvent . S.coincidence . (coerce :: S.Event x (Event (SpiderTimeline x) a) -> S.Event x (S.Event x a)) . unSpiderEvent
339{-# INLINE current #-}
340current = SpiderBehavior . S.dynamicCurrent . unSpiderDynamic
341{-# INLINE updated #-}
342updated = coerceEvent . SpiderEvent . dynamicUpdated . unSpiderDynamic
343{-# INLINE unsafeBuildDynamic #-}
344unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ unsafeDyn (coerce readV0) $ coerce $ unSpiderEvent v'
345{-# INLINE unsafeBuildIncremental #-}
346unsafeBuildIncremental readV0 dv = SpiderIncremental $ S.dynamicDyn $ unsafeDyn (coerce readV0) $ unSpiderEvent dv
347{-# INLINE mergeIncremental #-}
348mergeIncremental = SpiderEvent . S.merge . (unsafeCoerce :: S.Dynamic x (PatchDMap k (Event (SpiderTimeline x))) -> S.Dynamic x (PatchDMap k (S.Event x))) . unSpiderIncremental
349{-# INLINE currentIncremental #-}
350currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental
351{-# INLINE updatedIncremental #-}
352updatedIncremental = SpiderEvent . dynamicUpdated . unSpiderIncremental
353{-# INLINE incrementalToDynamic #-}
354incrementalToDynamic (SpiderIncremental i) = SpiderDynamic $ dynamicDynIdentity $ unsafeDyn (readBehaviorUntracked $ dynamicCurrent i) $ flip S.push (dynamicUpdated i) $ \p -> do
355 c <- readBehaviorUntracked $ dynamicCurrent i
356 return $ Identity <$> apply p c
357eventCoercion Coercion = Coercion
358behaviorCoercion Coercion = Coercion
359dynamicCoercion = unsafeCoerce
362-- | Coerce a 'Behavior' between representationally-equivalent value types
363coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
364coerceBehavior = coerceWith $ behaviorCoercion Coercion
366-- | Coerce an 'Event' between representationally-equivalent occurrence types
367coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
368coerceEvent = coerceWith $ eventCoercion Coercion
370-- | Coerce a 'Dynamic' between representationally-equivalent value types
371coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
372coerceDynamic = coerceWith $ dynamicCoercion Coercion
374-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
375-- _must_ change when and only when the 'Event' fires, such that the
376-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
377-- if this is not the case, the resulting 'Dynamic' will behave
378-- nondeterministically.
379unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
380unsafeDynamic = unsafeBuildDynamic . sample
382-- | Construct a 'Dynamic' value that never changes
383constDyn :: Reflex t => a -> Dynamic t a
386instance (Reflex t, Default a) => Default (Dynamic t a) where
389-- | 'MonadSample' designates monads that can read the current value of a
390-- 'Behavior'. This includes both 'PullM' and 'PushM'.
391class (Applicative m, Monad m) => MonadSample t m | m -> t where
392 -- | Get the current value in the 'Behavior'
393 sample :: Behavior t a -> m a
395-- | 'MonadHold' designates monads that can create new 'Behavior's based on
396-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
397-- is required to create any stateful computations with Reflex.
398class MonadSample t m => MonadHold t m where
399 -- | Create a new 'Behavior' whose value will initially be equal to the given
400 -- value and will be updated whenever the given 'Event' occurs. The update
401 -- takes effect immediately after the 'Event' occurs; if the occurrence that
402 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
403 -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new
405 hold :: a -> Event t a -> m (Behavior t a)
406 -- | Create a 'Dynamic' value using the given initial value that changes every
407 -- time the 'Event' occurs.
408 holdDyn :: a -> Event t a -> m (Dynamic t a)
409 -- | Create an 'Incremental' value using the given initial value that changes
410 -- every time the 'Event' occurs.
411 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
413-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
414-- key. This is much more efficient than filtering for each key with
416newtype EventSelector t k = EventSelector
417 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
418 -- determined by the type of the key, so this can be used to fan-out
419 -- 'Event's whose sub-'Event's have different types.
421 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
422 -- (but equivalent to) using 'fmapMaybe' to select only the relevant
423 -- occurrences of an 'Event'.
424 select :: forall a. k a -> Event t a
427--------------------------------------------------------------------------------
429--------------------------------------------------------------------------------
431instance MonadSample t m => MonadSample t (ReaderT r m) where
432 sample = lift . sample
434instance MonadHold t m => MonadHold t (ReaderT r m) where
435 hold a0 = lift . hold a0
436 holdDyn a0 = lift . holdDyn a0
437 holdIncremental a0 = lift . holdIncremental a0
439instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
440 sample = lift . sample
442instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
443 hold a0 = lift . hold a0
444 holdDyn a0 = lift . holdDyn a0
445 holdIncremental a0 = lift . holdIncremental a0
447instance MonadSample t m => MonadSample t (StateT s m) where
448 sample = lift . sample
450instance MonadHold t m => MonadHold t (StateT s m) where
451 hold a0 = lift . hold a0
452 holdDyn a0 = lift . holdDyn a0
453 holdIncremental a0 = lift . holdIncremental a0
455instance MonadSample t m => MonadSample t (ExceptT e m) where
456 sample = lift . sample
458instance MonadHold t m => MonadHold t (ExceptT e m) where
459 hold a0 = lift . hold a0
460 holdDyn a0 = lift . holdDyn a0
461 holdIncremental a0 = lift . holdIncremental a0
463instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
464 sample = lift . sample
466instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
467 hold a0 = lift . hold a0
468 holdDyn a0 = lift . holdDyn a0
469 holdIncremental a0 = lift . holdIncremental 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
479--------------------------------------------------------------------------------
480-- Convenience functions
481--------------------------------------------------------------------------------
483-- | Create an 'Event' from another 'Event'. The provided function can sample
484-- 'Behavior's and hold 'Event's.
485pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
486pushAlways f = push (fmap Just . f)
488-- | Flipped version of 'fmap'.
489ffor :: Functor f => f a -> (a -> b) -> f b
492instance Reflex t => Applicative (Behavior t) where
494 f <*> x = pull $ sample f `ap` sample x
498instance Reflex t => Apply (Behavior t) where
501instance Reflex t => Bind (Behavior t) where
504instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
506 fromRational = pure . fromRational
509instance Reflex t => Functor (Behavior t) where
510 fmap f = pull . fmap f . sample
512instance (Reflex t, IsString a) => IsString (Behavior t a) where
513 fromString = pure . fromString
515instance Reflex t => Monad (Behavior t) where
516 a >>= f = pull $ sample a >>= sample . f
517 -- 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.
519 fail = error "Monad (Behavior t) does not support fail"
521instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
522 mempty = constant mempty
523 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
524 mconcat = pull . fmap mconcat . mapM sample
526instance (Reflex t, Num a) => Num (Behavior t a) where
531 fromInteger = pure . fromInteger
535instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
536 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
537 sconcat = pull . fmap sconcat . mapM sample
538#if MIN_VERSION_semigroups(0,17,0)
539 stimes n = fmap $ stimes n
541 times1p n = fmap $ times1p n
544-- | Flipped version of 'fmapMaybe'.
545fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b
546fforMaybe = flip fmapMaybe
548-- | Filter 'f a' using the provided predicate.
549-- Relies on 'fforMaybe'.
550ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
551ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
553-- | Left-biased event union (prefers left event on simultaneous
555instance Reflex t => Alt (Event t) where
556 ev1 <!> ev2 = leftmost [ev1, ev2]
558-- | 'Event' intersection (convenient interface to 'coincidence').
559instance Reflex t => Apply (Event t) where
560 evf <.> evx = coincidence (fmap (<$> evx) evf)
562-- | 'Event' intersection (convenient interface to 'coincidence').
563instance Reflex t => Bind (Event t) where
564 evx >>- f = coincidence (f <$> evx)
567instance Reflex t => Functor (Event t) where
569 fmap f = fmapMaybe $ Just . f
571instance Reflex t => FunctorMaybe (Event t) where
572 {-# INLINE fmapMaybe #-}
573 fmapMaybe f = push $ return . f
575-- | Never: @'zero' = 'never'@.
576instance Reflex t => Plus (Event t) where
579-- | Replace each occurrence value of the 'Event' with the value of the
580-- 'Behavior' at the time of that occurrence.
581tag :: Reflex t => Behavior t b -> Event t a -> Event t b
582tag b = pushAlways $ \_ -> sample b
584-- | Create a new 'Event' that combines occurences of supplied 'Event' with the
585-- current value of the 'Behavior'.
586attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
587attach = attachWith (,)
589-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
590-- combining it with the current value of the 'Behavior'.
591attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
592attachWith f = attachWithMaybe $ \a b -> Just $ f a b
594-- | Create a new 'Event' by combining each occurence with the current value of
595-- the 'Behavior'. The occurrence is discarded if the combining function returns
597attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
598attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
600-- | Create a new 'Event' that only occurs only once, on the first occurence of
601-- the supplied 'Event'.
602headE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
604 rec be <- hold e $ fmap (const never) e'
608-- | Create a new 'Event' that occurs on all but the first occurence of the
610tailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
611tailE e = snd <$> headTailE e
613-- | Create a tuple of two 'Event's with the first one occuring only the first
614-- time the supplied 'Event' occurs and the second occuring on all but the first
616headTailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a, Event t a)
619 be <- hold never $ fmap (const e) eHead
620 return (eHead, switch be)
622-- | Split the supplied 'Event' into two individual 'Event's occuring at the
623-- same time with the respective values from the tuple.
624splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
625splitE e = (fmap fst e, fmap snd e)
627-- | Print the supplied 'String' and the value of the 'Event' on each
628-- occurence. This should /only/ be used for debugging.
630-- Note: As with Debug.Trace.trace, the message will only be printed if the
631-- 'Event' is actually used.
632traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
633traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
635-- | Print the output of the supplied function on each occurence of the
636-- 'Event'. This should /only/ be used for debugging.
638-- Note: As with Debug.Trace.trace, the message will only be printed if the
639-- 'Event' is actually used.
640traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
641traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
643instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
644 (<>) = alignWith (mergeThese (<>))
645 sconcat = fmap sconcat . mergeList . toList
646#if MIN_VERSION_semigroups(0,17,0)
647 stimes n = fmap $ stimes n
649 times1p n = fmap $ times1p n
652instance (Semigroup a, Reflex t) => Monoid (Event t a) where
655 mconcat = fmap sconcat . mergeList
657-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
658-- list occurs. If multiple occur at the same time they are folded from the left
659-- with the given function.
660{-# INLINE mergeWith #-}
661mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
662mergeWith = mergeWith' id
664{-# INLINE mergeWith' #-}
665mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
666mergeWith' f g es = fmap (Prelude.foldl1 g . map (\(Const2 _ :=> Identity v) -> f v) . DMap.toList)
668 . DMap.fromDistinctAscList
669 . map (\(k, v) -> Const2 k :=> v)
670 $ zip [0 :: Int ..] es
672-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
673-- list occurs. If multiple occur at the same time the value is the value of the
675{-# INLINE leftmost #-}
676leftmost :: Reflex t => [Event t a] -> Event t a
677leftmost = mergeWith const
679-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
680-- list occurs and has a list of the values of all 'Event's occuring at that
682mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
684mergeList es = mergeWithCheap' (:|[]) (<>) es
686unsafeMapIncremental :: (Reflex t, Patch p, Patch p') => (PatchTarget p -> PatchTarget p') -> (p -> p') -> Incremental t p -> Incremental t p'
687unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
689-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
690-- occurs if at least one of them occurs and has a map of values of all 'Event's
691-- occuring at that time.
692mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
693mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
695-- | Create a merge whose parents can change over time
696mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
697mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
699-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
700mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
701mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
703-- | Split the event into separate events for 'Left' and 'Right' values.
704fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
706 let justLeft = either Just (const Nothing)
707 justRight = either (const Nothing) Just
708 in (fmapMaybe justLeft e, fmapMaybe justRight e)
710-- | Split the event into separate events for 'This' and 'That' values,
711-- allowing them to fire simultaneously when the input value is 'These'.
712fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
714 let this (This x) = Just x
715 this (These x _) = Just x
717 that (That y) = Just y
718 that (These _ y) = Just y
720 in (fmapMaybe this e, fmapMaybe that e)
722-- | Split the event into an 'EventSelector' that allows efficient selection of
723-- the individual 'Event's.
724fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
725fanMap = fan . fmap mapToDMap
727-- | Switches to the new event whenever it receives one. Whenever a new event
728-- is provided, if it is firing, its value will be the resulting event's value;
729-- if it is not firing, but the old one is, the old one's value will be used.
730switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
731switchPromptly ea0 eea = do
733 let eLag = switch bea
734 eCoincidences = coincidence eea
735 return $ leftmost [eCoincidences, eLag]
737-- | 'switch'es to a new event whenever it receives one. At the moment of
738-- switching, the old event will be ignored if it fires, and the new one will be
739-- used if it fires; this is the opposite of 'switch', which will use only the
741switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
742switchPromptOnly e0 e' = do
743 eLag <- switch <$> hold e0 e'
744 return $ coincidence $ leftmost [e', eLag <$ eLag]
746instance Reflex t => Align (Event t) where
748 align = alignWithMaybe Just
750-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
751-- the 'Behavior' is true at the time of occurence.
752gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
753gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
755-- | Create a new behavior given a starting behavior and switch to a the behvior
756-- carried by the event when it fires.
757switcher :: (Reflex t, MonadHold t m)
758 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
759switcher b eb = pull . (sample <=< sample) <$> hold b eb
761-- | Combine two 'Dynamic's. The result will change whenever either (or both)
762-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
763zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
764zipDyn = zipDynWith (,)
766-- | Combine two 'Dynamic's with a combining function. The result will change
767-- whenever either (or both) input 'Dynamic' changes.
768-- More efficient than liftA2.
769zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
771 let eab = align (updated da) (updated db)
772 ec = flip push eab $ \o -> do
775 b <- sample $ current db
778 a <- sample $ current da
780 These a b -> return (a, b)
781 return $ Just $ f a b
782 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
784instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
785 mconcat = distributeListOverDynWith mconcat
786 mempty = constDyn mempty
787 mappend = zipDynWith mappend
789-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
790-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
791-- through the use of multiple uses of 'zipWithDyn' or 'Applicative' operators.
792distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
793distributeDMapOverDynPure dm = case DMap.toList dm of
794 [] -> constDyn DMap.empty
795 [k :=> v] -> fmap (DMap.singleton k . Identity) v
797 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
798 edmPre = merge $ DMap.map updated dm
799 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
800 olds <- sample $ current result
801 return $ DMap.unionWithKey (\_ _ new -> new) olds news
804-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
805distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
806distributeListOverDyn = distributeListOverDynWith id
808-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
809distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
810distributeListOverDynWith f = fmap (f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]
812-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
813-- unless the second supplied 'Event' occurs simultaneously.
814difference :: Reflex t => Event t a -> Event t b -> Event t a
815difference = alignWithMaybe $ \case
819-- (intentially not exported, for now)
821 :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
822alignWithMaybe f ea eb =
823 fmapMaybe (f <=< dmapToThese)
825 $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
828--------------------------------------------------------------------------------
830--------------------------------------------------------------------------------
832-- | An 'Accumulator' type can be built by accumulating occurrences of an
834class Reflex t => Accumulator t f | f -> t where
835 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
836 accum f = accumMaybe $ \v o -> Just $ f v o
837 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
838 accumM f = accumMaybeM $ \v o -> Just <$> f v o
839 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
840 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
841 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
842 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
843 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
844 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
845 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
846 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
847 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
848 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
850-- | Accumulate occurrences of an 'Event', producing an output occurrence each
851-- time. Discard the underlying 'Accumulator'.
852mapAccum_ :: 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)
854 (_ :: Behavior t a, result) <- mapAccum f z e
857-- | Accumulate occurrences of an 'Event', possibly producing an output
858-- occurrence each time. Discard the underlying 'Accumulator'.
859mapAccumMaybe_ :: 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)
860mapAccumMaybe_ f z e = do
861 (_ :: Behavior t a, result) <- mapAccumMaybe f z e
864-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
865-- an output occurrence each time. Discard the underlying 'Accumulator'.
866mapAccumM_ :: 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)
868 (_ :: Behavior t a, result) <- mapAccumM f z e
871-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
872-- producing an output occurrence each time. Discard the underlying
874mapAccumMaybeM_ :: 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)
875mapAccumMaybeM_ f z e = do
876 (_ :: Behavior t a, result) <- mapAccumMaybeM f z e
879instance Reflex t => Accumulator t (Dynamic t) where
880 accumMaybeM f z e = do
881 rec let e' = flip push e $ \o -> do
882 v <- sample $ current d'
886 mapAccumMaybeM f z e = do
887 rec let e' = flip push e $ \o -> do
888 v <- sample $ current d'
890 return $ case result of
891 (Nothing, Nothing) -> Nothing
893 d' <- holdDyn z $ fmapMaybe fst e'
894 return (d', fmapMaybe snd e')
896instance Reflex t => Accumulator t (Behavior t) where
897 accumMaybeM f z e = current <$> accumMaybeM f z e
898 mapAccumMaybeM f z e = first current <$> mapAccumMaybeM f z e
900instance Reflex t => Accumulator t (Event t) where
901 accumMaybeM f z e = updated <$> accumMaybeM f z e
902 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
904-- | Create a new 'Event' by combining each occurence with the next value of the
905-- list using the supplied function. If the list runs out of items, all
906-- subsequent 'Event' occurrences will be ignored.
907zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
908zipListWithEvent f l e = do
909 let f' a b = case a of
910 h:t -> (Just t, Just $ f h b)
911 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
912 mapAccumMaybe_ f' l e
914-- | A 'Monad' that supports adjustment over time. After an action has been
915-- run, if the given events fire, it will adjust itself so that its net effect
916-- is as though it had originally been run with the new value. Note that there
917-- is some issue here with persistent side-effects: obviously, IO (and some
918-- other side-effects) cannot be undone, so it is up to the instance implementer
919-- to determine what the best meaning for this class is in such cases.
920class (Reflex t, Monad m) => MonadAdjust t m | m -> t where
921 runWithReplace :: m a -> Event t (m b) -> m (a, Event t b)
922 traverseDMapWithKeyWithAdjust :: GCompare k => (forall a. k a -> v a -> m (v' a)) -> DMap k v -> Event t (PatchDMap k v) -> m (DMap k v', Event t (PatchDMap k v'))
923 traverseDMapWithKeyWithAdjustWithMove :: GCompare k => (forall a. k a -> v a -> m (v' a)) -> DMap k v -> Event t (PatchDMapWithMove k v) -> m (DMap k v', Event t (PatchDMapWithMove k v'))
925instance (Reflex t, MonadAdjust t m) => MonadAdjust t (ReaderT r m) where
926 runWithReplace a0 a' = do
928 lift $ runWithReplace (runReaderT a0 r) $ fmap (`runReaderT` r) a'
929 traverseDMapWithKeyWithAdjust f dm0 dm' = do
931 lift $ traverseDMapWithKeyWithAdjust (\k v -> runReaderT (f k v) r) dm0 dm'
932 traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = do
934 lift $ traverseDMapWithKeyWithAdjustWithMove (\k v -> runReaderT (f k v) r) dm0 dm'
936sequenceDMapWithAdjust :: (GCompare k, MonadAdjust t m) => DMap k m -> Event t (PatchDMap k m) -> m (DMap k Identity, Event t (PatchDMap k Identity))
937sequenceDMapWithAdjust = traverseDMapWithKeyWithAdjust $ \_ -> fmap Identity
939sequenceDMapWithAdjustWithMove :: (GCompare k, MonadAdjust t m) => DMap k m -> Event t (PatchDMapWithMove k m) -> m (DMap k Identity, Event t (PatchDMapWithMove k Identity))
940sequenceDMapWithAdjustWithMove = traverseDMapWithKeyWithAdjustWithMove $ \_ -> fmap Identity
946{-# INLINE pushAlwaysCheap #-}
947pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
948pushAlwaysCheap f = pushCheap (fmap Just . f)
950{-# INLINE fmapMaybeCheap #-}
951fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
952fmapMaybeCheap f = pushCheap $ return . f
954{-# INLINE fforMaybeCheap #-}
955fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
956fforMaybeCheap = flip fmapMaybeCheap
958{-# INLINE fforCheap #-}
959fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
960fforCheap = flip fmapCheap
962{-# INLINE fmapCheap #-}
963fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
964fmapCheap f = pushCheap $ return . Just . f
966{-# INLINE tagCheap #-}
967tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
968tagCheap b = pushAlwaysCheap $ \_ -> sample b
970{-# INLINE mergeWithCheap #-}
971mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
972mergeWithCheap = mergeWithCheap' id
974{-# INLINE mergeWithCheap' #-}
975mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
976mergeWithCheap' f g es = fmapCheap (Prelude.foldl1 g . map (\(Const2 _ :=> Identity v) -> f v) . DMap.toList)
978 . DMap.fromDistinctAscList
979 . map (\(k, v) -> Const2 k :=> v)
980 $ zip [0 :: Int ..] es
982--------------------------------------------------------------------------------
983-- Deprecated functions
984--------------------------------------------------------------------------------
986-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
987-- occurs. If both occur at the same time they are combined using 'mappend'.
988{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}
989appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
990appendEvents = alignWith $ mergeThese mappend
992-- | Alias for 'headE'
993{-# DEPRECATED onceE "Use 'headE' instead" #-}
994onceE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
997-- | Run both sides of a 'These' monadically, combining the results.
998{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
999#ifdef USE_TEMPLATE_HASKELL
1000{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
1002sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
1003sequenceThese t = case t of
1004 This ma -> fmap This ma
1005 These ma mb -> liftM2 These ma mb
1006 That mb -> fmap That mb
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