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
48 -- ** Breaking up 'Event's
57 -- ** Switching between 'Event's
60 -- ** Using 'Event's to sample 'Behavior's
65 -- ** Blocking an 'Event' based on a 'Behavior'
67 -- ** Combining 'Dynamic's
68 , distributeDMapOverDynPure
69 , distributeListOverDyn
70 , distributeListOverDynWith
73 -- ** Accumulating state
84 -- * Debugging functions
93 -- * Miscellaneous convenience functions
96 -- * Deprecated functions
100#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
120 , unsafeBuildIncremental
124 , incrementalToDynamic
131import Control.Applicative
132import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
133import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
134import Control.Monad.State.Strict hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
135import Control.Monad.Trans.Cont (ContT ())
136import Control.Monad.Trans.Except (ExceptT ())
137import Control.Monad.Trans.RWS (RWST ())
138import Control.Monad.Trans.Writer (WriterT ())
143import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
144import qualified Data.Dependent.Map as DMap
147import Data.Functor.Bind hiding (join)
148import qualified Data.Functor.Bind as Bind
149import Data.Functor.Misc
150import Data.Functor.Plus
151import Data.List.NonEmpty (NonEmpty (..))
154import Data.Monoid hiding (Alt, (<>))
155import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
158import Data.Traversable
159import Data.Type.Coercion
160import Reflex.FunctorMaybe
163#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
164import Reflex.Spider.Internal (EventM, Global, HasSpiderTimeline, SpiderHost (..), SpiderHostFrame (..),
165 SpiderPullM, SpiderPushM (..), behaviorHoldIdentity, dynamicConst,
166 dynamicCurrent, dynamicDynIdentity, dynamicHold, dynamicHoldIdentity,
167 dynamicUpdated, newMapDyn, readBehaviorTracked, readBehaviorUntracked,
168 runFrame, runSpiderHostFrame, unsafeDyn)
169import qualified Reflex.Spider.Internal
170import qualified Reflex.Spider.Internal as S
174-- Note: must come last to silence warnings due to AMP on GHC < 7.10
175import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)
177import Debug.Trace (trace)
179#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
180#include "Spider/SpiderTimeline.include.hs"
183-- | The 'Reflex' class contains all the primitive functionality needed for
184-- Functional Reactive Programming (FRP). The @t@ type parameter indicates
185-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
186-- and the type of the timeline determines the FRP engine to be used. For most
187-- purposes, the 'Reflex.Spider' implementation is recommended.
188class ( MonadHold t (PushM t)
189 , MonadSample t (PullM t)
191 , Functor (Dynamic t)
192 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
194#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
195 , t ~ SpiderTimeline Global
198 -- | A container for a value that can change over time. 'Behavior's can be
199 -- sampled at will, but it is not possible to be notified when they change
200 data Behavior t :: * -> *
201 -- | A stream of occurrences. During any given frame, an 'Event' is either
202 -- occurring or not occurring; if it is occurring, it will contain a value of
203 -- the given type (its "occurrence type")
204 data Event t :: * -> *
205 -- | A container for a value that can change over time and allows
206 -- notifications on changes. Basically a combination of a 'Behavior' and an
207 -- 'Event', with a rule that the 'Behavior' will change if and only if the
209 data Dynamic t :: * -> *
210 -- | A container for a value that can change over time and allows
211 -- notifications on changes. Basically a combination of a 'Behavior' and an
212 -- 'Event', with a rule that the 'Behavior' will change if and only if the
214 data Incremental t :: * -> *
215 -- | A monad for doing complex push-based calculations efficiently
216 type PushM t :: * -> *
217 -- | A monad for doing complex pull-based calculations efficiently
218 type PullM t :: * -> *
219#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
220 -- | An 'Event' with no occurrences
222 -- | Create a 'Behavior' that always has the given value
223 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
224 -- | Create an 'Event' from another 'Event'; the provided function can sample
225 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
226 -- (Just) or non-occurring (Nothing) result
227 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
228 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
229 -- recomputed whenever any of the read 'Behavior's changes
230 pull :: PullM t a -> Behavior t a
231 -- | Merge a collection of events; the resulting 'Event' will only occur if at
232 -- least one input event is occuring, and will contain all of the input keys
233 -- that are occurring simultaneously
234 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
235 -- | Efficiently fan-out an event to many destinations. This function should
236 -- be partially applied, and then the result applied repeatedly to create
238 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
239 -- | Create an 'Event' that will occur whenever the currently-selected input
241 switch :: Behavior t (Event t a) -> Event t a
242 -- | Create an 'Event' that will occur whenever the input event is occurring
243 -- and its occurrence value, another 'Event', is also occurring
244 coincidence :: Event t (Event t a) -> Event t a
245 -- | Extract the 'Behavior' of a 'Dynamic'.
246 current :: Dynamic t a -> Behavior t a
247 -- | Extract the 'Event' of the 'Dynamic'.
248 updated :: Dynamic t a -> Event t a
249 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
250 -- recent firing of the given 'Event', if any.
251 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
252 -- | Create a new 'Incremental'. The given 'PullM''s value must always change
253 -- in the same way that the accumulated application of patches would change
255 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
256 -- | Create a merge whose parents can change over time
257 mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
258 -- | Extract the 'Behavior' component of an 'Incremental'
259 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
260 -- | Extract the 'Event' component of an 'Incremental'
261 updatedIncremental :: Patch p => Incremental t p -> Event t p
262 -- | Convert an 'Incremental' to a 'Dynamic'
263 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
264 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
266 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
267 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
269 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
270 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
272 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
275#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
276instance t ~ SpiderTimeline Global => Reflex t where
277 newtype Behavior t a = SpiderBehavior { unSpiderBehavior :: Reflex.Spider.Internal.Behavior Global a }
278 newtype Event t a = SpiderEvent { unSpiderEvent :: Reflex.Spider.Internal.Event Global a }
279 newtype Dynamic t a = SpiderDynamic { unSpiderDynamic :: Reflex.Spider.Internal.Dynamic Global (Identity a) } -- deriving (Functor, Applicative, Monad)
280 newtype Incremental t p = SpiderIncremental { unSpiderIncremental :: Reflex.Spider.Internal.Dynamic Global p }
281 type PullM t = SpiderPullM Global
282 type PushM t = SpiderPushM Global
283never :: Reflex t => Event t a
284constant :: Reflex t => a -> Behavior t a
285push :: Reflex t => (a -> PushM t (Maybe b)) -> Event t a -> Event t b
286pull :: Reflex t => PullM t a -> Behavior t a
287merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)
288fan :: (Reflex t, GCompare k) => Event t (DMap k Identity) -> EventSelector t k
289switch :: Reflex t => Behavior t (Event t a) -> Event t a
290coincidence :: Reflex t => Event t (Event t a) -> Event t a
291current :: Reflex t => Dynamic t a -> Behavior t a
292updated :: Reflex t => Dynamic t a -> Event t a
293unsafeBuildDynamic :: Reflex t => PullM t a -> Event t a -> Dynamic t a
294unsafeBuildIncremental :: (Reflex t, Patch p) => PullM t (PatchTarget p) -> Event t p -> Incremental t p
295mergeIncremental :: (Reflex t, GCompare k) => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
296currentIncremental :: (Reflex t, Patch p) => Incremental t p -> Behavior t (PatchTarget p)
297updatedIncremental :: (Reflex t, Patch p) => Incremental t p -> Event t p
298incrementalToDynamic :: (Reflex t, Patch p) => Incremental t p -> Dynamic t (PatchTarget p)
299behaviorCoercion :: Reflex t => Coercion a b -> Coercion (Behavior t a) (Behavior t b)
300eventCoercion :: Reflex t => Coercion a b -> Coercion (Event t a) (Event t b)
301dynamicCoercion :: Reflex t => Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
303never = SpiderEvent S.eventNever
304{-# INLINE constant #-}
305constant = SpiderBehavior . S.behaviorConst
307push f = SpiderEvent . S.push (coerce f) . unSpiderEvent
309pull = SpiderBehavior . S.pull . coerce
311merge = SpiderEvent . S.merge . S.dynamicConst . (coerce :: DMap k (Event (SpiderTimeline x)) -> DMap k (S.Event x))
313fan e = EventSelector $ SpiderEvent . S.select (S.fan (unSpiderEvent e))
315switch = SpiderEvent . S.switch . (coerce :: S.Behavior x (Event (SpiderTimeline x) a) -> S.Behavior x (S.Event x a)) . unSpiderBehavior
316{-# INLINE coincidence #-}
317coincidence = SpiderEvent . S.coincidence . (coerce :: S.Event x (Event (SpiderTimeline x) a) -> S.Event x (S.Event x a)) . unSpiderEvent
318{-# INLINE current #-}
319current = SpiderBehavior . S.dynamicCurrent . unSpiderDynamic
320{-# INLINE updated #-}
321updated = SpiderEvent . fmap runIdentity . dynamicUpdated . unSpiderDynamic
322{-# INLINE unsafeBuildDynamic #-}
323unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ unsafeDyn (coerce readV0) $ coerce $ unSpiderEvent v'
324{-# INLINE unsafeBuildIncremental #-}
325unsafeBuildIncremental readV0 dv = SpiderIncremental $ S.dynamicDyn $ unsafeDyn (coerce readV0) $ unSpiderEvent dv
326{-# INLINE mergeIncremental #-}
327mergeIncremental = SpiderEvent . S.merge . (unsafeCoerce :: S.Dynamic x (PatchDMap k (Event (SpiderTimeline x))) -> S.Dynamic x (PatchDMap k (S.Event x))) . unSpiderIncremental
328{-# INLINE currentIncremental #-}
329currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental
330{-# INLINE updatedIncremental #-}
331updatedIncremental = SpiderEvent . dynamicUpdated . unSpiderIncremental
332{-# INLINE incrementalToDynamic #-}
333incrementalToDynamic (SpiderIncremental i) = SpiderDynamic $ dynamicDynIdentity $ unsafeDyn (readBehaviorUntracked $ dynamicCurrent i) $ flip S.push (dynamicUpdated i) $ \p -> do
334 c <- readBehaviorUntracked $ dynamicCurrent i
335 return $ Identity <$> apply p c
336eventCoercion Coercion = Coercion
337behaviorCoercion Coercion = Coercion
338dynamicCoercion = unsafeCoerce
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-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
354-- _must_ change when and only when the 'Event' fires, such that the
355-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
356-- if this is not the case, the resulting 'Dynamic' will behave
357-- nondeterministically.
358unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
359unsafeDynamic = unsafeBuildDynamic . sample
361-- | Construct a 'Dynamic' value that never changes
362constDyn :: Reflex t => a -> Dynamic t a
365instance (Reflex t, Default a) => Default (Dynamic t a) where
368-- | 'MonadSample' designates monads that can read the current value of a
369-- 'Behavior'. This includes both 'PullM' and 'PushM'.
370class (Applicative m, Monad m) => MonadSample t m | m -> t where
371 -- | Get the current value in the 'Behavior'
372 sample :: Behavior t a -> m a
374-- | 'MonadHold' designates monads that can create new 'Behavior's based on
375-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
376-- is required to create any stateful computations with Reflex.
377class MonadSample t m => MonadHold t m where
378 -- | Create a new 'Behavior' whose value will initially be equal to the given
379 -- value and will be updated whenever the given 'Event' occurs. The update
380 -- takes effect immediately after the 'Event' occurs; if the occurrence that
381 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
382 -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new
384 hold :: a -> Event t a -> m (Behavior t a)
385 -- | Create a 'Dynamic' value using the given initial value that changes every
386 -- time the 'Event' occurs.
387 holdDyn :: a -> Event t a -> m (Dynamic t a)
388 -- | Create an 'Incremental' value using the given initial value that changes
389 -- every time the 'Event' occurs.
390 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
392-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
393-- key. This is much more efficient than filtering for each key with
395newtype EventSelector t k = EventSelector
396 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
397 -- determined by the type of the key, so this can be used to fan-out
398 -- 'Event's whose sub-'Event's have different types.
400 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
401 -- (but equivalent to) using 'fmapMaybe' to select only the relevant
402 -- occurrences of an 'Event'.
403 select :: forall a. k a -> Event t a
406--------------------------------------------------------------------------------
408--------------------------------------------------------------------------------
410instance MonadSample t m => MonadSample t (ReaderT r m) where
411 sample = lift . sample
413instance MonadHold t m => MonadHold t (ReaderT r m) where
414 hold a0 = lift . hold a0
415 holdDyn a0 = lift . holdDyn a0
416 holdIncremental a0 = lift . holdIncremental a0
418instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
419 sample = lift . sample
421instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
422 hold a0 = lift . hold a0
423 holdDyn a0 = lift . holdDyn a0
424 holdIncremental a0 = lift . holdIncremental a0
426instance MonadSample t m => MonadSample t (StateT s m) where
427 sample = lift . sample
429instance MonadHold t m => MonadHold t (StateT s m) where
430 hold a0 = lift . hold a0
431 holdDyn a0 = lift . holdDyn a0
432 holdIncremental a0 = lift . holdIncremental a0
434instance MonadSample t m => MonadSample t (ExceptT e m) where
435 sample = lift . sample
437instance MonadHold t m => MonadHold t (ExceptT e m) where
438 hold a0 = lift . hold a0
439 holdDyn a0 = lift . holdDyn a0
440 holdIncremental a0 = lift . holdIncremental a0
442instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
443 sample = lift . sample
445instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
446 hold a0 = lift . hold a0
447 holdDyn a0 = lift . holdDyn a0
448 holdIncremental a0 = lift . holdIncremental a0
450instance MonadSample t m => MonadSample t (ContT r m) where
451 sample = lift . sample
453instance MonadHold t m => MonadHold t (ContT r m) where
454 hold a0 = lift . hold a0
455 holdDyn a0 = lift . holdDyn a0
456 holdIncremental a0 = lift . holdIncremental a0
458--------------------------------------------------------------------------------
459-- Convenience functions
460--------------------------------------------------------------------------------
462-- | Create an 'Event' from another 'Event'. The provided function can sample
463-- 'Behavior's and hold 'Event's.
464pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
465pushAlways f = push (fmap Just . f)
467-- | Flipped version of 'fmap'.
468ffor :: Functor f => f a -> (a -> b) -> f b
471instance Reflex t => Applicative (Behavior t) where
473 f <*> x = pull $ sample f `ap` sample x
477instance Reflex t => Apply (Behavior t) where
480instance Reflex t => Bind (Behavior t) where
483instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
485 fromRational = pure . fromRational
488instance Reflex t => Functor (Behavior t) where
489 fmap f = pull . fmap f . sample
491instance (Reflex t, IsString a) => IsString (Behavior t a) where
492 fromString = pure . fromString
494instance Reflex t => Monad (Behavior t) where
495 a >>= f = pull $ sample a >>= sample . f
496 -- 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.
498 fail = error "Monad (Behavior t) does not support fail"
500instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
501 mempty = constant mempty
502 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
503 mconcat = pull . fmap mconcat . mapM sample
505instance (Reflex t, Num a) => Num (Behavior t a) where
510 fromInteger = pure . fromInteger
514instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
515 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
516 sconcat = pull . fmap sconcat . mapM sample
517#if MIN_VERSION_semigroups(0,17,0)
518 stimes n = fmap $ stimes n
520 times1p n = fmap $ times1p n
523-- | Flipped version of 'fmapMaybe'.
524fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b
525fforMaybe = flip fmapMaybe
527-- | Filter 'f a' using the provided predicate.
528-- Relies on 'fforMaybe'.
529ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
530ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
532-- | Left-biased event union (prefers left event on simultaneous
534instance Reflex t => Alt (Event t) where
535 ev1 <!> ev2 = leftmost [ev1, ev2]
537-- | 'Event' intersection (convenient interface to 'coincidence').
538instance Reflex t => Apply (Event t) where
539 evf <.> evx = coincidence (fmap (<$> evx) evf)
541-- | 'Event' intersection (convenient interface to 'coincidence').
542instance Reflex t => Bind (Event t) where
543 evx >>- f = coincidence (f <$> evx)
546instance Reflex t => Functor (Event t) where
548 fmap f = fmapMaybe $ Just . f
550instance Reflex t => FunctorMaybe (Event t) where
551 {-# INLINE fmapMaybe #-}
552 fmapMaybe f = push $ return . f
554-- | Never: @'zero' = 'never'@.
555instance Reflex t => Plus (Event t) where
558-- | Replace each occurrence value of the 'Event' with the value of the
559-- 'Behavior' at the time of that occurrence.
560tag :: Reflex t => Behavior t b -> Event t a -> Event t b
561tag b = pushAlways $ \_ -> sample b
563-- | Create a new 'Event' that combines occurences of supplied 'Event' with the
564-- current value of the 'Behavior'.
565attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
566attach = attachWith (,)
568-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
569-- combining it with the current value of the 'Behavior'.
570attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
571attachWith f = attachWithMaybe $ \a b -> Just $ f a b
573-- | Create a new 'Event' by combining each occurence with the current value of
574-- the 'Behavior'. The occurrence is discarded if the combining function returns
576attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
577attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
579-- | Create a new 'Event' that only occurs only once, on the first occurence of
580-- the supplied 'Event'.
581headE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
583 rec be <- hold e $ fmap (const never) e'
587-- | Create a new 'Event' that occurs on all but the first occurence of the
589tailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
590tailE e = snd <$> headTailE e
592-- | Create a tuple of two 'Event's with the first one occuring only the first
593-- time the supplied 'Event' occurs and the second occuring on all but the first
595headTailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a, Event t a)
598 be <- hold never $ fmap (const e) eHead
599 return (eHead, switch be)
601-- | Split the supplied 'Event' into two individual 'Event's occuring at the
602-- same time with the respective values from the tuple.
603splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
604splitE e = (fmap fst e, fmap snd e)
606-- | Print the supplied 'String' and the value of the 'Event' on each
607-- occurence. This should /only/ be used for debugging.
609-- Note: As with Debug.Trace.trace, the message will only be printed if the
610-- 'Event' is actually used.
611traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
612traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
614-- | Print the output of the supplied function on each occurence of the
615-- 'Event'. This should /only/ be used for debugging.
617-- Note: As with Debug.Trace.trace, the message will only be printed if the
618-- 'Event' is actually used.
619traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
620traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
622instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
623 (<>) = alignWith (mergeThese (<>))
624 sconcat = fmap sconcat . mergeList . toList
625#if MIN_VERSION_semigroups(0,17,0)
626 stimes n = fmap $ stimes n
628 times1p n = fmap $ times1p n
631instance (Semigroup a, Reflex t) => Monoid (Event t a) where
634 mconcat = fmap sconcat . mergeList
636-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
637-- list occurs. If multiple occur at the same time they are folded from the left
638-- with the given function.
639{-# INLINE mergeWith #-}
640mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
641mergeWith f es = fmap (Prelude.foldl1 f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList)
643 . DMap.fromDistinctAscList
644 . map (\(k, v) -> Const2 k :=> v)
645 $ zip [0 :: Int ..] es
647-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
648-- list occurs. If multiple occur at the same time the value is the value of the
650{-# INLINE leftmost #-}
651leftmost :: Reflex t => [Event t a] -> Event t a
652leftmost = mergeWith const
654-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
655-- list occurs and has a list of the values of all 'Event's occuring at that
657mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
659mergeList es = mergeWith (<>) $ map (fmap (:|[])) es
661-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
662-- occurs if at least one of them occurs and has a map of values of all 'Event's
663-- occuring at that time.
664mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
665mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
667-- | Split the event into separate events for 'Left' and 'Right' values.
668fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
670 let justLeft = either Just (const Nothing)
671 justRight = either (const Nothing) Just
672 in (fmapMaybe justLeft e, fmapMaybe justRight e)
674-- | Split the event into separate events for 'This' and 'That' values,
675-- allowing them to fire simultaneously when the input value is 'These'.
676fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
678 let this (This x) = Just x
679 this (These x _) = Just x
681 that (That y) = Just y
682 that (These _ y) = Just y
684 in (fmapMaybe this e, fmapMaybe that e)
686-- | Split the event into an 'EventSelector' that allows efficient selection of
687-- the individual 'Event's.
688fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
689fanMap = fan . fmap mapToDMap
691-- | Switches to the new event whenever it receives one. Whenever a new event
692-- is provided, if it is firing, its value will be the resulting event's value;
693-- if it is not firing, but the old one is, the old one's value will be used.
694switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
695switchPromptly ea0 eea = do
697 let eLag = switch bea
698 eCoincidences = coincidence eea
699 return $ leftmost [eCoincidences, eLag]
701-- | 'switch'es to a new event whenever it receives one. At the moment of
702-- switching, the old event will be ignored if it fires, and the new one will be
703-- used if it fires; this is the opposite of 'switch', which will use only the
705switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
706switchPromptOnly e0 e' = do
707 eLag <- switch <$> hold e0 e'
708 return $ coincidence $ leftmost [e', eLag <$ eLag]
710instance Reflex t => Align (Event t) where
712 align = alignWithMaybe Just
714-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
715-- the 'Behavior' is true at the time of occurence.
716gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
717gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
719-- | Create a new behavior given a starting behavior and switch to a the behvior
720-- carried by the event when it fires.
721switcher :: (Reflex t, MonadHold t m)
722 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
723switcher b eb = pull . (sample <=< sample) <$> hold b eb
725-- | Combine two 'Dynamic's. The result will change whenever either (or both)
726-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
727zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
728zipDyn = zipDynWith (,)
730-- | Combine two 'Dynamic's with a combining function. The result will change
731-- whenever either (or both) input 'Dynamic' changes.
732-- More efficient than liftA2.
733zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
735 let eab = align (updated da) (updated db)
736 ec = flip push eab $ \o -> do
739 b <- sample $ current db
742 a <- sample $ current da
744 These a b -> return (a, b)
745 return $ Just $ f a b
746 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
748instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
749 mconcat = distributeListOverDynWith mconcat
750 mempty = constDyn mempty
751 mappend = zipDynWith mappend
753-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
754-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
755-- through the use of multiple uses of 'zipWithDyn' or 'Applicative' operators.
756distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
757distributeDMapOverDynPure dm = case DMap.toList dm of
758 [] -> constDyn DMap.empty
759 [k :=> v] -> fmap (DMap.singleton k . Identity) v
761 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
762 edmPre = merge $ DMap.map updated dm
763 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
764 olds <- sample $ current result
765 return $ DMap.unionWithKey (\_ _ new -> new) olds news
768-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
769distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
770distributeListOverDyn = distributeListOverDynWith id
772-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
773distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
774distributeListOverDynWith f = fmap (f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]
776-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
777-- unless the second supplied 'Event' occurs simultaneously.
778difference :: Reflex t => Event t a -> Event t b -> Event t a
779difference = alignWithMaybe $ \case
783-- (intentially not exported, for now)
785 :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
786alignWithMaybe f ea eb =
787 fmapMaybe (f <=< dmapToThese)
789 $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
792--------------------------------------------------------------------------------
794--------------------------------------------------------------------------------
796-- | An 'Accumulator' type can be built by accumulating occurrences of an
798class Reflex t => Accumulator t f | f -> t where
799 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
800 accum f = accumMaybe $ \v o -> Just $ f v o
801 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
802 accumM f = accumMaybeM $ \v o -> Just <$> f v o
803 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
804 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
805 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
806 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
807 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
808 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
809 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
810 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
811 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
812 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
814-- | Accumulate occurrences of an 'Event', producing an output occurrence each
815-- time. Discard the underlying 'Accumulator'.
816mapAccum_ :: 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)
818 (_ :: Behavior t a, result) <- mapAccum f z e
821-- | Accumulate occurrences of an 'Event', possibly producing an output
822-- occurrence each time. Discard the underlying 'Accumulator'.
823mapAccumMaybe_ :: 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)
824mapAccumMaybe_ f z e = do
825 (_ :: Behavior t a, result) <- mapAccumMaybe f z e
828-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
829-- an output occurrence each time. Discard the underlying 'Accumulator'.
830mapAccumM_ :: 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)
832 (_ :: Behavior t a, result) <- mapAccumM f z e
835-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
836-- producing an output occurrence each time. Discard the underlying
838mapAccumMaybeM_ :: 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)
839mapAccumMaybeM_ f z e = do
840 (_ :: Behavior t a, result) <- mapAccumMaybeM f z e
843instance Reflex t => Accumulator t (Dynamic t) where
844 accumMaybeM f z e = do
845 rec let e' = flip push e $ \o -> do
846 v <- sample $ current d'
850 mapAccumMaybeM f z e = do
851 rec let e' = flip push e $ \o -> do
852 v <- sample $ current d'
854 return $ case result of
855 (Nothing, Nothing) -> Nothing
857 d' <- holdDyn z $ fmapMaybe fst e'
858 return (d', fmapMaybe snd e')
860instance Reflex t => Accumulator t (Behavior t) where
861 accumMaybeM f z e = current <$> accumMaybeM f z e
862 mapAccumMaybeM f z e = first current <$> mapAccumMaybeM f z e
864instance Reflex t => Accumulator t (Event t) where
865 accumMaybeM f z e = updated <$> accumMaybeM f z e
866 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
868-- | Create a new 'Event' by combining each occurence with the next value of the
869-- list using the supplied function. If the list runs out of items, all
870-- subsequent 'Event' occurrences will be ignored.
871zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
872zipListWithEvent f l e = do
873 let f' a b = case a of
874 h:t -> (Just t, Just $ f h b)
875 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
876 mapAccumMaybe_ f' l e
878-- | A 'Monad' that supports adjustment over time. After an action has been
879-- run, if the given events fire, it will adjust itself so that its net effect
880-- is as though it had originally been run with the new value. Note that there
881-- is some issue here with persistent side-effects: obviously, IO (and some
882-- other side-effects) cannot be undone, so it is up to the instance implementer
883-- to determine what the best meaning for this class is in such cases.
884class (Reflex t, Monad m) => MonadAdjust t m | m -> t where
885 runWithReplace :: m a -> Event t (m b) -> m (a, Event t b)
886 sequenceDMapWithAdjust :: GCompare k => DMap k m -> Event t (PatchDMap k m) -> m (DMap k Identity, Event t (PatchDMap k Identity))
888instance (Reflex t, MonadAdjust t m) => MonadAdjust t (ReaderT r m) where
889 runWithReplace a0 a' = do
891 lift $ runWithReplace (runReaderT a0 r) $ fmap (`runReaderT` r) a'
892 sequenceDMapWithAdjust dm0 dm' = do
894 let loweredDm0 = DMap.map (`runReaderT` r) dm0
895 loweredDm' = ffor dm' $ \(PatchDMap p) -> PatchDMap $
896 DMap.map (\(ComposeMaybe mv) -> ComposeMaybe $ fmap (`runReaderT` r) mv) p
897 lift $ sequenceDMapWithAdjust loweredDm0 loweredDm'
899--------------------------------------------------------------------------------
900-- Deprecated functions
901--------------------------------------------------------------------------------
903-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
904-- occurs. If both occur at the same time they are combined using 'mappend'.
905{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}
906appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
907appendEvents = alignWith $ mergeThese mappend
909-- | Alias for 'headE'
910{-# DEPRECATED onceE "Use 'headE' instead" #-}
911onceE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
914-- | Run both sides of a 'These' monadically, combining the results.
915{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
916{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
917sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
918sequenceThese t = case t of
919 This ma -> liftM This ma
920 These ma mb -> liftM2 These ma mb
921 That mb -> liftM 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