2{-# LANGUAGE DeriveFunctor #-}
3{-# LANGUAGE EmptyDataDecls #-}
4{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE FunctionalDependencies #-}
8{-# LANGUAGE LambdaCase #-}
9{-# LANGUAGE MultiParamTypeClasses #-}
10{-# LANGUAGE NoMonomorphismRestriction #-}
11{-# LANGUAGE RankNTypes #-}
12{-# LANGUAGE RecursiveDo #-}
13{-# LANGUAGE RoleAnnotations #-}
14{-# LANGUAGE ScopedTypeVariables #-}
15{-# LANGUAGE StandaloneDeriving #-}
16{-# LANGUAGE TypeFamilies #-}
17{-# LANGUAGE TypeOperators #-}
18{-# LANGUAGE UndecidableInstances #-}
19{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
20#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
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
47 -- ** Breaking up 'Event's
56 -- ** Switching between 'Event's
58 -- ** Using 'Event's to sample 'Behavior's
63 -- ** Blocking an 'Event' based on a 'Behavior'
65 -- ** Combining 'Dynamic's
66 , distributeDMapOverDynPure
67 , distributeListOverDyn
68 , distributeListOverDynWith
71 -- ** Accumulating state
82 -- * Debugging functions
91 -- * Miscellaneous convenience functions
94 -- * Deprecated functions
98#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
118 , unsafeBuildIncremental
122 , incrementalToDynamic
129import Control.Applicative
130import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
131import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
132import Control.Monad.State.Strict hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
133import Control.Monad.Trans.Cont (ContT ())
134import Control.Monad.Trans.Except (ExceptT ())
135import Control.Monad.Trans.RWS (RWST ())
136import Control.Monad.Trans.Writer (WriterT ())
140import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
141import qualified Data.Dependent.Map as DMap
144import Data.Functor.Bind hiding (join)
145import qualified Data.Functor.Bind as Bind
146import Data.Functor.Misc
147import Data.Functor.Plus
148import Data.List.NonEmpty (NonEmpty (..))
151import Data.Monoid hiding (Alt, (<>))
152import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
155import Data.Traversable
156import Data.Type.Coercion
158import Reflex.FunctorMaybe
160#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
161import Reflex.Spider.Internal (Global, SpiderPullM, SpiderPushM (..), HasSpiderTimeline, EventM, readBehaviorUntracked, readBehaviorTracked, dynamicHoldIdentity, dynamicHold, dynamicDynIdentity, newMapDyn, dynamicCurrent, dynamicUpdated, unsafeDyn, dynamicConst, behaviorHoldIdentity, SpiderHost (..), runFrame, runSpiderHostFrame, SpiderHostFrame (..))
162import qualified Reflex.Spider.Internal
163import qualified Reflex.Spider.Internal as S
167-- Note: must come last to silence warnings due to AMP on GHC < 7.10
168import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)
170import Debug.Trace (trace)
172#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
173#include "Spider/SpiderTimeline.include.hs"
176-- | The 'Reflex' class contains all the primitive functionality needed for
177-- Functional Reactive Programming (FRP). The @t@ type parameter indicates
178-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
179-- and the type of the timeline determines the FRP engine to be used. For most
180-- purposes, the 'Reflex.Spider' implementation is recommended.
181class ( MonadHold t (PushM t)
182 , MonadSample t (PullM t)
184 , Functor (Dynamic t)
185 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
187#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
188 , t ~ SpiderTimeline Global
191 -- | A container for a value that can change over time. 'Behavior's can be
192 -- sampled at will, but it is not possible to be notified when they change
193 data Behavior t :: * -> *
194 -- | A stream of occurrences. During any given frame, an 'Event' is either
195 -- occurring or not occurring; if it is occurring, it will contain a value of
196 -- the given type (its "occurrence type")
197 data Event t :: * -> *
198 -- | A container for a value that can change over time and allows
199 -- notifications on changes. Basically a combination of a 'Behavior' and an
200 -- 'Event', with a rule that the 'Behavior' will change if and only if the
202 data Dynamic t :: * -> *
203 -- | A container for a value that can change over time and allows
204 -- notifications on changes. Basically a combination of a 'Behavior' and an
205 -- 'Event', with a rule that the 'Behavior' will change if and only if the
207 data Incremental t :: * -> *
208 -- | A monad for doing complex push-based calculations efficiently
209 type PushM t :: * -> *
210 -- | A monad for doing complex pull-based calculations efficiently
211 type PullM t :: * -> *
212#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
213 -- | An 'Event' with no occurrences
215 -- | Create a 'Behavior' that always has the given value
216 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
217 -- | Create an 'Event' from another 'Event'; the provided function can sample
218 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
219 -- (Just) or non-occurring (Nothing) result
220 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
221 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
222 -- recomputed whenever any of the read 'Behavior's changes
223 pull :: PullM t a -> Behavior t a
224 -- | Merge a collection of events; the resulting 'Event' will only occur if at
225 -- least one input event is occuring, and will contain all of the input keys
226 -- that are occurring simultaneously
227 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
228 -- | Efficiently fan-out an event to many destinations. This function should
229 -- be partially applied, and then the result applied repeatedly to create
231 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
232 -- | Create an 'Event' that will occur whenever the currently-selected input
234 switch :: Behavior t (Event t a) -> Event t a
235 -- | Create an 'Event' that will occur whenever the input event is occurring
236 -- and its occurrence value, another 'Event', is also occurring
237 coincidence :: Event t (Event t a) -> Event t a
238 -- | Extract the 'Behavior' of a 'Dynamic'.
239 current :: Dynamic t a -> Behavior t a
240 -- | Extract the 'Event' of the 'Dynamic'.
241 updated :: Dynamic t a -> Event t a
242 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
243 -- recent firing of the given 'Event', if any.
244 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
245 -- | Create a new 'Incremental'. The given 'PullM''s value must always change
246 -- in the same way that the accumulated application of patches would change
248 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
249 -- | Create a merge whose parents can change over time
250 mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
251 -- | Extract the 'Behavior' component of an 'Incremental'
252 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
253 -- | Extract the 'Event' component of an 'Incremental'
254 updatedIncremental :: Patch p => Incremental t p -> Event t p
255 -- | Convert an 'Incremental' to a 'Dynamic'
256 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
257 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
259 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
260 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
262 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
263 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
265 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
268#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
269instance t ~ SpiderTimeline Global => Reflex t where
270 newtype Behavior t a = SpiderBehavior { unSpiderBehavior :: Reflex.Spider.Internal.Behavior Global a }
271 newtype Event t a = SpiderEvent { unSpiderEvent :: Reflex.Spider.Internal.Event Global a }
272 newtype Dynamic t a = SpiderDynamic { unSpiderDynamic :: Reflex.Spider.Internal.Dynamic Global (Identity a) } -- deriving (Functor, Applicative, Monad)
273 newtype Incremental t p = SpiderIncremental { unSpiderIncremental :: Reflex.Spider.Internal.Dynamic Global p }
274 type PullM t = SpiderPullM Global
275 type PushM t = SpiderPushM Global
276never :: Reflex t => Event t a
277constant :: Reflex t => a -> Behavior t a
278push :: Reflex t => (a -> PushM t (Maybe b)) -> Event t a -> Event t b
279pull :: Reflex t => PullM t a -> Behavior t a
280merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)
281fan :: (Reflex t, GCompare k) => Event t (DMap k Identity) -> EventSelector t k
282switch :: Reflex t => Behavior t (Event t a) -> Event t a
283coincidence :: Reflex t => Event t (Event t a) -> Event t a
284current :: Reflex t => Dynamic t a -> Behavior t a
285updated :: Reflex t => Dynamic t a -> Event t a
286unsafeBuildDynamic :: Reflex t => PullM t a -> Event t a -> Dynamic t a
287unsafeBuildIncremental :: (Reflex t, Patch p) => PullM t (PatchTarget p) -> Event t p -> Incremental t p
288mergeIncremental :: (Reflex t, GCompare k) => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
289currentIncremental :: (Reflex t, Patch p) => Incremental t p -> Behavior t (PatchTarget p)
290updatedIncremental :: (Reflex t, Patch p) => Incremental t p -> Event t p
291incrementalToDynamic :: (Reflex t, Patch p) => Incremental t p -> Dynamic t (PatchTarget p)
292behaviorCoercion :: Reflex t => Coercion a b -> Coercion (Behavior t a) (Behavior t b)
293eventCoercion :: Reflex t => Coercion a b -> Coercion (Event t a) (Event t b)
294dynamicCoercion :: Reflex t => Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
296never = SpiderEvent S.eventNever
297{-# INLINE constant #-}
298constant = SpiderBehavior . S.behaviorConst
300push f = SpiderEvent . S.push (coerce f) . unSpiderEvent
302pull = SpiderBehavior . S.pull . coerce
304merge = SpiderEvent . S.merge . S.dynamicConst . (coerce :: DMap k (Event (SpiderTimeline x)) -> DMap k (S.Event x))
306fan e = EventSelector $ SpiderEvent . S.select (S.fan (unSpiderEvent e))
308switch = SpiderEvent . S.switch . (coerce :: S.Behavior x (Event (SpiderTimeline x) a) -> S.Behavior x (S.Event x a)) . unSpiderBehavior
309{-# INLINE coincidence #-}
310coincidence = SpiderEvent . S.coincidence . (coerce :: S.Event x (Event (SpiderTimeline x) a) -> S.Event x (S.Event x a)) . unSpiderEvent
311{-# INLINE current #-}
312current = SpiderBehavior . S.dynamicCurrent . unSpiderDynamic
313{-# INLINE updated #-}
314updated = SpiderEvent . fmap runIdentity . dynamicUpdated . unSpiderDynamic
315{-# INLINE unsafeBuildDynamic #-}
316unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ unsafeDyn (coerce readV0) $ coerce $ unSpiderEvent v'
317{-# INLINE unsafeBuildIncremental #-}
318unsafeBuildIncremental readV0 dv = SpiderIncremental $ S.dynamicDyn $ unsafeDyn (coerce readV0) $ unSpiderEvent dv
319{-# INLINE mergeIncremental #-}
320mergeIncremental = SpiderEvent . S.merge . (unsafeCoerce :: S.Dynamic x (PatchDMap k (Event (SpiderTimeline x))) -> S.Dynamic x (PatchDMap k (S.Event x))) . unSpiderIncremental
321{-# INLINE currentIncremental #-}
322currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental
323{-# INLINE updatedIncremental #-}
324updatedIncremental = SpiderEvent . dynamicUpdated . unSpiderIncremental
325{-# INLINE incrementalToDynamic #-}
326incrementalToDynamic (SpiderIncremental i) = SpiderDynamic $ dynamicDynIdentity $ unsafeDyn (readBehaviorUntracked $ dynamicCurrent i) $ flip S.push (dynamicUpdated i) $ \p -> do
327 c <- readBehaviorUntracked $ dynamicCurrent i
328 return $ Identity <$> apply p c
329eventCoercion Coercion = Coercion
330behaviorCoercion Coercion = Coercion
331dynamicCoercion = unsafeCoerce
334-- | Coerce a 'Behavior' between representationally-equivalent value types
335coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
336coerceBehavior = coerceWith $ behaviorCoercion Coercion
338-- | Coerce an 'Event' between representationally-equivalent occurrence types
339coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
340coerceEvent = coerceWith $ eventCoercion Coercion
342-- | Coerce a 'Dynamic' between representationally-equivalent value types
343coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
344coerceDynamic = coerceWith $ dynamicCoercion Coercion
346-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
347-- _must_ change when and only when the 'Event' fires, such that the
348-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
349-- if this is not the case, the resulting 'Dynamic' will behave
350-- nondeterministically.
351unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
352unsafeDynamic = unsafeBuildDynamic . sample
354-- | Construct a 'Dynamic' value that never changes
355constDyn :: Reflex t => a -> Dynamic t a
358-- | 'MonadSample' designates monads that can read the current value of a
359-- 'Behavior'. This includes both 'PullM' and 'PushM'.
360class (Applicative m, Monad m) => MonadSample t m | m -> t where
361 -- | Get the current value in the 'Behavior'
362 sample :: Behavior t a -> m a
364-- | 'MonadHold' designates monads that can create new 'Behavior's based on
365-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
366-- is required to create any stateful computations with Reflex.
367class MonadSample t m => MonadHold t m where
368 -- | Create a new 'Behavior' whose value will initially be equal to the given
369 -- value and will be updated whenever the given 'Event' occurs. The update
370 -- takes effect immediately after the 'Event' occurs; if the occurrence that
371 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
372 -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new
374 hold :: a -> Event t a -> m (Behavior t a)
375 -- | Create a 'Dynamic' value using the given initial value that changes every
376 -- time the 'Event' occurs.
377 holdDyn :: a -> Event t a -> m (Dynamic t a)
378 -- | Create an 'Incremental' value using the given initial value that changes
379 -- every time the 'Event' occurs.
380 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
382-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
383-- key. This is much more efficient than filtering for each key with
385newtype EventSelector t k = EventSelector
386 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
387 -- determined by the type of the key, so this can be used to fan-out
388 -- 'Event's whose sub-'Event's have different types.
390 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
391 -- (but equivalent to) using 'fmapMaybe' to select only the relevant
392 -- occurrences of an 'Event'.
393 select :: forall a. k a -> Event t a
396--------------------------------------------------------------------------------
398--------------------------------------------------------------------------------
400instance MonadSample t m => MonadSample t (ReaderT r m) where
401 sample = lift . sample
403instance MonadHold t m => MonadHold t (ReaderT r m) where
404 hold a0 = lift . hold a0
405 holdDyn a0 = lift . holdDyn a0
406 holdIncremental a0 = lift . holdIncremental a0
408instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
409 sample = lift . sample
411instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
412 hold a0 = lift . hold a0
413 holdDyn a0 = lift . holdDyn a0
414 holdIncremental a0 = lift . holdIncremental a0
416instance MonadSample t m => MonadSample t (StateT s m) where
417 sample = lift . sample
419instance MonadHold t m => MonadHold t (StateT s m) where
420 hold a0 = lift . hold a0
421 holdDyn a0 = lift . holdDyn a0
422 holdIncremental a0 = lift . holdIncremental a0
424instance MonadSample t m => MonadSample t (ExceptT e m) where
425 sample = lift . sample
427instance MonadHold t m => MonadHold t (ExceptT e m) where
428 hold a0 = lift . hold a0
429 holdDyn a0 = lift . holdDyn a0
430 holdIncremental a0 = lift . holdIncremental a0
432instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
433 sample = lift . sample
435instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
436 hold a0 = lift . hold a0
437 holdDyn a0 = lift . holdDyn a0
438 holdIncremental a0 = lift . holdIncremental a0
440instance MonadSample t m => MonadSample t (ContT r m) where
441 sample = lift . sample
443instance MonadHold t m => MonadHold t (ContT r m) where
444 hold a0 = lift . hold a0
445 holdDyn a0 = lift . holdDyn a0
446 holdIncremental a0 = lift . holdIncremental a0
448--------------------------------------------------------------------------------
449-- Convenience functions
450--------------------------------------------------------------------------------
452-- | Create an 'Event' from another 'Event'. The provided function can sample
453-- 'Behavior's and hold 'Event's.
454pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
455pushAlways f = push (fmap Just . f)
457-- | Flipped version of 'fmap'.
458ffor :: Functor f => f a -> (a -> b) -> f b
461instance Reflex t => Applicative (Behavior t) where
463 f <*> x = pull $ sample f `ap` sample x
467instance Reflex t => Apply (Behavior t) where
470instance Reflex t => Bind (Behavior t) where
473instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
475 fromRational = pure . fromRational
478instance Reflex t => Functor (Behavior t) where
479 fmap f = pull . fmap f . sample
481instance (Reflex t, IsString a) => IsString (Behavior t a) where
482 fromString = pure . fromString
484instance Reflex t => Monad (Behavior t) where
485 a >>= f = pull $ sample a >>= sample . f
486 -- 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.
488 fail = error "Monad (Behavior t) does not support fail"
490instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
491 mempty = constant mempty
492 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
493 mconcat = pull . fmap mconcat . mapM sample
495instance (Reflex t, Num a) => Num (Behavior t a) where
500 fromInteger = pure . fromInteger
504instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
505 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
506 sconcat = pull . fmap sconcat . mapM sample
507#if MIN_VERSION_semigroups(0,17,0)
508 stimes n = fmap $ stimes n
510 times1p n = fmap $ times1p n
513-- | Flipped version of 'fmapMaybe'.
514fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b
515fforMaybe = flip fmapMaybe
517-- | Filter 'f a' using the provided predicate.
518-- Relies on 'fforMaybe'.
519ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
520ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
522-- | Left-biased event union (prefers left event on simultaneous
524instance Reflex t => Alt (Event t) where
525 ev1 <!> ev2 = leftmost [ev1, ev2]
527-- | 'Event' intersection (convenient interface to 'coincidence').
528instance Reflex t => Apply (Event t) where
529 evf <.> evx = coincidence (fmap (<$> evx) evf)
531-- | 'Event' intersection (convenient interface to 'coincidence').
532instance Reflex t => Bind (Event t) where
533 evx >>- f = coincidence (f <$> evx)
536instance Reflex t => Functor (Event t) where
538 fmap f = fmapMaybe $ Just . f
540instance Reflex t => FunctorMaybe (Event t) where
541 {-# INLINE fmapMaybe #-}
542 fmapMaybe f = push $ return . f
544-- | Never: @'zero' = 'never'@.
545instance Reflex t => Plus (Event t) where
548-- | Replace each occurrence value of the 'Event' with the value of the
549-- 'Behavior' at the time of that occurrence.
550tag :: Reflex t => Behavior t b -> Event t a -> Event t b
551tag b = pushAlways $ \_ -> sample b
553-- | Create a new 'Event' that combines occurences of supplied 'Event' with the
554-- current value of the 'Behavior'.
555attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
556attach = attachWith (,)
558-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
559-- combining it with the current value of the 'Behavior'.
560attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
561attachWith f = attachWithMaybe $ \a b -> Just $ f a b
563-- | Create a new 'Event' by combining each occurence with the current value of
564-- the 'Behavior'. The occurrence is discarded if the combining function returns
566attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
567attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
569-- | Create a new 'Event' that only occurs only once, on the first occurence of
570-- the supplied 'Event'.
571headE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
573 rec be <- hold e $ fmap (const never) e'
577-- | Create a new 'Event' that occurs on all but the first occurence of the
579tailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
580tailE e = snd <$> headTailE e
582-- | Create a tuple of two 'Event's with the first one occuring only the first
583-- time the supplied 'Event' occurs and the second occuring on all but the first
585headTailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a, Event t a)
588 be <- hold never $ fmap (const e) eHead
589 return (eHead, switch be)
591-- | Split the supplied 'Event' into two individual 'Event's occuring at the
592-- same time with the respective values from the tuple.
593splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
594splitE e = (fmap fst e, fmap snd e)
596-- | Print the supplied 'String' and the value of the 'Event' on each
597-- occurence. This should /only/ be used for debugging.
599-- Note: As with Debug.Trace.trace, the message will only be printed if the
600-- 'Event' is actually used.
601traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
602traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
604-- | Print the output of the supplied function on each occurence of the
605-- 'Event'. This should /only/ be used for debugging.
607-- Note: As with Debug.Trace.trace, the message will only be printed if the
608-- 'Event' is actually used.
609traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
610traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
612instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
613 (<>) = alignWith (mergeThese (<>))
614 sconcat = fmap sconcat . mergeList . toList
615#if MIN_VERSION_semigroups(0,17,0)
616 stimes n = fmap $ stimes n
618 times1p n = fmap $ times1p n
621instance (Semigroup a, Reflex t) => Monoid (Event t a) where
624 mconcat = fmap sconcat . mergeList
626-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
627-- list occurs. If multiple occur at the same time they are folded from the left
628-- with the given function.
629{-# INLINE mergeWith #-}
630mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
631mergeWith f es = fmap (Prelude.foldl1 f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList)
633 . DMap.fromDistinctAscList
634 . map (\(k, v) -> Const2 k :=> v)
635 $ zip [0 :: Int ..] es
637-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
638-- list occurs. If multiple occur at the same time the value is the value of the
640{-# INLINE leftmost #-}
641leftmost :: Reflex t => [Event t a] -> Event t a
642leftmost = mergeWith const
644-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
645-- list occurs and has a list of the values of all 'Event's occuring at that
647mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
649mergeList es = mergeWith (<>) $ map (fmap (:|[])) es
651-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
652-- occurs if at least one of them occurs and has a map of values of all 'Event's
653-- occuring at that time.
654mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
655mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
657-- | Split the event into separate events for 'Left' and 'Right' values.
658fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
660 let justLeft = either Just (const Nothing)
661 justRight = either (const Nothing) Just
662 in (fmapMaybe justLeft e, fmapMaybe justRight e)
664-- | Split the event into separate events for 'This' and 'That' values,
665-- allowing them to fire simultaneously when the input value is 'These'.
666fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
668 let this (This x) = Just x
669 this (These x _) = Just x
671 that (That y) = Just y
672 that (These _ y) = Just y
674 in (fmapMaybe this e, fmapMaybe that e)
676-- | Split the event into an 'EventSelector' that allows efficient selection of
677-- the individual 'Event's.
678fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
679fanMap = fan . fmap mapToDMap
681-- | Switches to the new event whenever it receives one; the new event is used
682-- immediately, on the same frame that it is switched to
683switchPromptly :: forall t m a. (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
684switchPromptly ea0 eea = do
686 let eLag = switch bea
687 eCoincidences = coincidence eea
688 return $ leftmost [eCoincidences, eLag]
690instance Reflex t => Align (Event t) where
692 align ea eb = fmapMaybe dmapToThese $ merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
694-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
695-- the 'Behavior' is true at the time of occurence.
696gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
697gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
699-- | Create a new behavior given a starting behavior and switch to a the behvior
700-- carried by the event when it fires.
701switcher :: (Reflex t, MonadHold t m)
702 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
703switcher b eb = pull . (sample <=< sample) <$> hold b eb
705-- | Combine two 'Dynamic's. The result will change whenever either (or both)
706-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
707zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
708zipDyn = zipDynWith (,)
710-- | Combine two 'Dynamic's with a combining function. The result will change
711-- whenever either (or both) input 'Dynamic' changes.
712zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
714 let eab = align (updated da) (updated db)
715 ec = flip push eab $ \o -> do
718 b <- sample $ current db
721 a <- sample $ current da
723 These a b -> return (a, b)
724 return $ Just $ f a b
725 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
727instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
728 mconcat = distributeListOverDynWith mconcat
729 mempty = constDyn mempty
730 mappend = zipDynWith mappend
732-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
733-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
734-- through the use of multiple uses of 'zipWithDyn' or 'Applicative' operators.
735distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
736distributeDMapOverDynPure dm = case DMap.toList dm of
737 [] -> constDyn DMap.empty
738 [k :=> v] -> fmap (DMap.singleton k . Identity) v
740 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
741 edmPre = merge $ DMap.map updated dm
742 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
743 olds <- sample $ current result
744 return $ DMap.unionWithKey (\_ _ new -> new) olds news
747-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
748distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
749distributeListOverDyn = distributeListOverDynWith id
751-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
752distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
753distributeListOverDynWith f = fmap (f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]
756--------------------------------------------------------------------------------
758--------------------------------------------------------------------------------
760-- | An 'Accumulator' type can be built by accumulating occurrences of an
762class Reflex t => Accumulator t f | f -> t where
763 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
764 accum f = accumMaybe $ \v o -> Just $ f v o
765 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
766 accumM f = accumMaybeM $ \v o -> Just <$> f v o
767 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
768 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
769 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
770 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
771 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
772 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
773 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
774 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
775 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
776 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
778-- | Accumulate occurrences of an 'Event', producing an output occurrence each
779-- time. Discard the underlying 'Accumulator'.
780mapAccum_ :: 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)
782 (_ :: Behavior t a, result) <- mapAccum f z e
785-- | Accumulate occurrences of an 'Event', possibly producing an output
786-- occurrence each time. Discard the underlying 'Accumulator'.
787mapAccumMaybe_ :: 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)
788mapAccumMaybe_ f z e = do
789 (_ :: Behavior t a, result) <- mapAccumMaybe f z e
792-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
793-- an output occurrence each time. Discard the underlying 'Accumulator'.
794mapAccumM_ :: 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)
796 (_ :: Behavior t a, result) <- mapAccumM f z e
799-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
800-- producing an output occurrence each time. Discard the underlying
802mapAccumMaybeM_ :: 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)
803mapAccumMaybeM_ f z e = do
804 (_ :: Behavior t a, result) <- mapAccumMaybeM f z e
807instance Reflex t => Accumulator t (Dynamic t) where
808 accumMaybeM f z e = do
809 rec let e' = flip push e $ \o -> do
810 v <- sample $ current d'
814 mapAccumMaybeM f z e = do
815 rec let e' = flip push e $ \o -> do
816 v <- sample $ current d'
818 return $ case result of
819 (Nothing, Nothing) -> Nothing
821 d' <- holdDyn z $ fmapMaybe fst e'
822 return (d', fmapMaybe snd e')
824instance Reflex t => Accumulator t (Behavior t) where
825 accumMaybeM f z e = current <$> accumMaybeM f z e
826 mapAccumMaybeM f z e = first current <$> mapAccumMaybeM f z e
828instance Reflex t => Accumulator t (Event t) where
829 accumMaybeM f z e = updated <$> accumMaybeM f z e
830 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
832-- | Create a new 'Event' by combining each occurence with the next value of the
833-- list using the supplied function. If the list runs out of items, all
834-- subsequent 'Event' occurrences will be ignored.
835zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
836zipListWithEvent f l e = do
837 let f' a b = case a of
838 h:t -> (Just t, Just $ f h b)
839 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
840 mapAccumMaybe_ f' l e
842class (Reflex t, Monad m) => MonadAdjust t m | m -> t where
843 runWithReplace :: m a -> Event t (m b) -> m (a, Event t b)
844 sequenceDMapWithAdjust :: GCompare k => DMap k m -> Event t (PatchDMap k m) -> m (DMap k Identity, Event t (PatchDMap k Identity))
846instance (Reflex t, MonadAdjust t m) => MonadAdjust t (ReaderT r m) where
847 runWithReplace a0 a' = do
849 lift $ runWithReplace (runReaderT a0 r) $ fmap (`runReaderT` r) a'
850 sequenceDMapWithAdjust dm0 dm' = do
852 let loweredDm0 = DMap.map (`runReaderT` r) dm0
853 loweredDm' = ffor dm' $ \(PatchDMap p) -> PatchDMap $
854 DMap.map (\(ComposeMaybe mv) -> ComposeMaybe $ fmap (`runReaderT` r) mv) p
855 lift $ sequenceDMapWithAdjust loweredDm0 loweredDm'
857--------------------------------------------------------------------------------
858-- Deprecated functions
859--------------------------------------------------------------------------------
861-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
862-- occurs. If both occur at the same time they are combined using 'mappend'.
863{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}
864appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
865appendEvents = alignWith $ mergeThese mappend
867-- | Alias for 'headE'
868{-# DEPRECATED onceE "Use 'headE' instead" #-}
869onceE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
872{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
873{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
874sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
875sequenceThese t = case t of
876 This ma -> liftM This ma
877 These ma mb -> liftM2 These ma mb
878 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