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
51 -- ** Breaking up 'Event's
60 -- ** Switching between 'Event's
63 -- ** Using 'Event's to sample 'Behavior's
68 -- ** Blocking an 'Event' based on a 'Behavior'
70 -- ** Combining 'Dynamic's
71 , distributeDMapOverDynPure
72 , distributeListOverDyn
73 , distributeListOverDynWith
76 -- ** Accumulating state
87 -- * Debugging functions
92 , unsafeMapIncremental
97 -- * Miscellaneous convenience functions
100 , sequenceDMapWithAdjust
101 , sequenceDMapWithAdjustWithMove
102 , mapMapWithAdjustWithMove
103 -- * Deprecated functions
115#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
136 , unsafeBuildIncremental
138 , mergeIncrementalWithMove
141 , incrementalToDynamic
148import Control.Applicative
149import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
150import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
151import Control.Monad.State.Strict hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
152import Control.Monad.Trans.Cont (ContT ())
153import Control.Monad.Trans.Except (ExceptT ())
154import Control.Monad.Trans.RWS (RWST ())
155import Control.Monad.Trans.Writer (WriterT ())
160import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
161import qualified Data.Dependent.Map as DMap
164import Data.Functor.Bind hiding (join)
165import qualified Data.Functor.Bind as Bind
166import Data.Functor.Constant
167import Data.Functor.Misc
168import Data.Functor.Plus
169import Data.List.NonEmpty (NonEmpty (..))
172import Data.Monoid hiding (Alt, (<>))
173import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
176import Data.Traversable
177import Data.Type.Coercion
178import Reflex.FunctorMaybe
181#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
182import Reflex.Spider.Internal (EventM, Global, HasSpiderTimeline, SpiderHost (..), SpiderHostFrame (..),
183 SpiderPullM, SpiderPushM (..), behaviorHoldIdentity, dynamicConst,
184 dynamicCurrent, dynamicDynIdentity, dynamicHold, dynamicHoldIdentity,
185 dynamicUpdated, newMapDyn, readBehaviorTracked, readBehaviorUntracked,
186 runFrame, runSpiderHostFrame, unsafeDyn)
187import qualified Reflex.Spider.Internal
188import qualified Reflex.Spider.Internal as S
192-- Note: must come last to silence warnings due to AMP on GHC < 7.10
193import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)
195import Debug.Trace (trace)
197#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
198#include "Spider/SpiderTimeline.include.hs"
201-- | The 'Reflex' class contains all the primitive functionality needed for
202-- Functional Reactive Programming (FRP). The @t@ type parameter indicates
203-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
204-- and the type of the timeline determines the FRP engine to be used. For most
205-- purposes, the 'Reflex.Spider' implementation is recommended.
206class ( MonadHold t (PushM t)
207 , MonadSample t (PullM t)
209 , Functor (Dynamic t)
210 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
212#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
213 , t ~ SpiderTimeline Global
216 -- | A container for a value that can change over time. 'Behavior's can be
217 -- sampled at will, but it is not possible to be notified when they change
218 data Behavior t :: * -> *
219 -- | A stream of occurrences. During any given frame, an 'Event' is either
220 -- occurring or not occurring; if it is occurring, it will contain a value of
221 -- the given type (its "occurrence type")
222 data Event t :: * -> *
223 -- | A container for a value that can change over time and allows
224 -- notifications on changes. Basically a combination of a 'Behavior' and an
225 -- 'Event', with a rule that the 'Behavior' will change if and only if the
227 data Dynamic t :: * -> *
228 -- | An 'Incremental' is a more general form of a 'Dynamic'.
229 -- Instead of always fully replacing the value, only parts of it can be patched.
230 -- This is only needed for performance critical code via `mergeIncremental` to make small
231 -- changes to large values.
232 data Incremental t :: * -> *
233 -- | A monad for doing complex push-based calculations efficiently
234 type PushM t :: * -> *
235 -- | A monad for doing complex pull-based calculations efficiently
236 type PullM t :: * -> *
237#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
238 -- | An 'Event' with no occurrences
240 -- | Create a 'Behavior' that always has the given value
241 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
242 -- | Create an 'Event' from another 'Event'; the provided function can sample
243 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
244 -- (Just) or non-occurring (Nothing) result
245 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
246 -- | 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.
247 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
248 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
249 -- recomputed whenever any of the read 'Behavior's changes
250 pull :: PullM t a -> Behavior t a
251 -- | Merge a collection of events; the resulting 'Event' will only occur if at
252 -- least one input event is occuring, and will contain all of the input keys
253 -- that are occurring simultaneously
254 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
255 -- | Efficiently fan-out an event to many destinations. This function should
256 -- be partially applied, and then the result applied repeatedly to create
258 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
259 -- | Create an 'Event' that will occur whenever the currently-selected input
261 switch :: Behavior t (Event t a) -> Event t a
262 -- | Create an 'Event' that will occur whenever the input event is occurring
263 -- and its occurrence value, another 'Event', is also occurring
264 coincidence :: Event t (Event t a) -> Event t a
265 -- | Extract the 'Behavior' of a 'Dynamic'.
266 current :: Dynamic t a -> Behavior t a
267 -- | Extract the 'Event' of the 'Dynamic'.
268 updated :: Dynamic t a -> Event t a
269 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
270 -- recent firing of the given 'Event', if any.
271 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
272 -- | Create a new 'Incremental'. The given 'PullM''s value must always change
273 -- in the same way that the accumulated application of patches would change
275 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
276 -- | Create a merge whose parents can change over time
277 mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
278 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
279 mergeIncrementalWithMove :: GCompare k => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
280 -- | Extract the 'Behavior' component of an 'Incremental'
281 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
282 -- | Extract the 'Event' component of an 'Incremental'
283 updatedIncremental :: Patch p => Incremental t p -> Event t p
284 -- | Convert an 'Incremental' to a 'Dynamic'
285 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
286 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
288 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
289 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
291 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
292 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
294 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
297#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
298instance t ~ SpiderTimeline Global => Reflex t where
299 newtype Behavior t a = SpiderBehavior { unSpiderBehavior :: Reflex.Spider.Internal.Behavior Global a }
300 newtype Event t a = SpiderEvent { unSpiderEvent :: Reflex.Spider.Internal.Event Global a }
301 newtype Dynamic t a = SpiderDynamic { unSpiderDynamic :: Reflex.Spider.Internal.Dynamic Global (Identity a) } -- deriving (Functor, Applicative, Monad)
302 newtype Incremental t p = SpiderIncremental { unSpiderIncremental :: Reflex.Spider.Internal.Dynamic Global p }
303 type PullM t = SpiderPullM Global
304 type PushM t = SpiderPushM Global
305never :: Reflex t => Event t a
306constant :: Reflex t => a -> Behavior t a
307push :: Reflex t => (a -> PushM t (Maybe b)) -> Event t a -> Event t b
308pushCheap :: Reflex t => (a -> PushM t (Maybe b)) -> Event t a -> Event t b
309pull :: Reflex t => PullM t a -> Behavior t a
310merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)
311fan :: (Reflex t, GCompare k) => Event t (DMap k Identity) -> EventSelector t k
312switch :: Reflex t => Behavior t (Event t a) -> Event t a
313coincidence :: Reflex t => Event t (Event t a) -> Event t a
314current :: Reflex t => Dynamic t a -> Behavior t a
315updated :: Reflex t => Dynamic t a -> Event t a
316unsafeBuildDynamic :: Reflex t => PullM t a -> Event t a -> Dynamic t a
317unsafeBuildIncremental :: (Reflex t, Patch p) => PullM t (PatchTarget p) -> Event t p -> Incremental t p
318mergeIncremental :: (Reflex t, GCompare k) => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
319mergeIncrementalWithMove :: (Reflex t, GCompare k) => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
320currentIncremental :: (Reflex t, Patch p) => Incremental t p -> Behavior t (PatchTarget p)
321updatedIncremental :: (Reflex t, Patch p) => Incremental t p -> Event t p
322incrementalToDynamic :: (Reflex t, Patch p) => Incremental t p -> Dynamic t (PatchTarget p)
323behaviorCoercion :: Reflex t => Coercion a b -> Coercion (Behavior t a) (Behavior t b)
324eventCoercion :: Reflex t => Coercion a b -> Coercion (Event t a) (Event t b)
325dynamicCoercion :: Reflex t => Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
327never = SpiderEvent S.eventNever
328{-# INLINE constant #-}
329constant = SpiderBehavior . S.behaviorConst
331push f = SpiderEvent . S.push (coerce f) . unSpiderEvent
332{-# INLINE pushCheap #-}
333pushCheap f = SpiderEvent . S.pushCheap (coerce f) . unSpiderEvent
335pull = SpiderBehavior . S.pull . coerce
337merge = SpiderEvent . S.merge . S.dynamicConst . (coerce :: DMap k (Event (SpiderTimeline x)) -> DMap k (S.Event x))
339fan e = EventSelector $ SpiderEvent . S.select (S.fan (unSpiderEvent e))
341switch = SpiderEvent . S.switch . (coerce :: S.Behavior x (Event (SpiderTimeline x) a) -> S.Behavior x (S.Event x a)) . unSpiderBehavior
342{-# INLINE coincidence #-}
343coincidence = SpiderEvent . S.coincidence . (coerce :: S.Event x (Event (SpiderTimeline x) a) -> S.Event x (S.Event x a)) . unSpiderEvent
344{-# INLINE current #-}
345current = SpiderBehavior . S.dynamicCurrent . unSpiderDynamic
346{-# INLINE updated #-}
347updated = coerceEvent . SpiderEvent . dynamicUpdated . unSpiderDynamic
348{-# INLINE unsafeBuildDynamic #-}
349unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ unsafeDyn (coerce readV0) $ coerce $ unSpiderEvent v'
350{-# INLINE unsafeBuildIncremental #-}
351unsafeBuildIncremental readV0 dv = SpiderIncremental $ S.dynamicDyn $ unsafeDyn (coerce readV0) $ unSpiderEvent dv
352{-# INLINE mergeIncremental #-}
353mergeIncremental = SpiderEvent . S.merge . (unsafeCoerce :: S.Dynamic x (PatchDMap k (Event (SpiderTimeline x))) -> S.Dynamic x (PatchDMap k (S.Event x))) . unSpiderIncremental
354{-# INLINE mergeIncrementalWithMove #-}
355mergeIncrementalWithMove = SpiderEvent . S.mergeWithMove . (unsafeCoerce :: S.Dynamic x (PatchDMapWithMove k (Event (SpiderTimeline x))) -> S.Dynamic x (PatchDMapWithMove k (S.Event x))) . unSpiderIncremental
356{-# INLINE currentIncremental #-}
357currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental
358{-# INLINE updatedIncremental #-}
359updatedIncremental = SpiderEvent . dynamicUpdated . unSpiderIncremental
360{-# INLINE incrementalToDynamic #-}
361incrementalToDynamic (SpiderIncremental i) = SpiderDynamic $ dynamicDynIdentity $ unsafeDyn (readBehaviorUntracked $ dynamicCurrent i) $ flip S.push (dynamicUpdated i) $ \p -> do
362 c <- readBehaviorUntracked $ dynamicCurrent i
363 return $ Identity <$> apply p c
364eventCoercion Coercion = Coercion
365behaviorCoercion Coercion = Coercion
366dynamicCoercion = unsafeCoerce
369-- | Coerce a 'Behavior' between representationally-equivalent value types
370coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
371coerceBehavior = coerceWith $ behaviorCoercion Coercion
373-- | Coerce an 'Event' between representationally-equivalent occurrence types
374coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
375coerceEvent = coerceWith $ eventCoercion Coercion
377-- | Coerce a 'Dynamic' between representationally-equivalent value types
378coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
379coerceDynamic = coerceWith $ dynamicCoercion Coercion
381-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
382-- _must_ change when and only when the 'Event' fires, such that the
383-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
384-- if this is not the case, the resulting 'Dynamic' will behave
385-- nondeterministically.
386unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
387unsafeDynamic = unsafeBuildDynamic . sample
389-- | Construct a 'Dynamic' value that never changes
390constDyn :: Reflex t => a -> Dynamic t a
393instance (Reflex t, Default a) => Default (Dynamic t a) where
396-- | 'MonadSample' designates monads that can read the current value of a
397-- 'Behavior'. This includes both 'PullM' and 'PushM'.
398class (Applicative m, Monad m) => MonadSample t m | m -> t where
399 -- | Get the current value in the 'Behavior'
400 sample :: Behavior t a -> m a
402-- | 'MonadHold' designates monads that can create new 'Behavior's based on
403-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
404-- is required to create any stateful computations with Reflex.
405class MonadSample t m => MonadHold t m where
406 -- | Create a new 'Behavior' whose value will initially be equal to the given
407 -- value and will be updated whenever the given 'Event' occurs. The update
408 -- takes effect immediately after the 'Event' occurs; if the occurrence that
409 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
410 -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new
412 hold :: a -> Event t a -> m (Behavior t a)
413 -- | Create a 'Dynamic' value using the given initial value that changes every
414 -- time the 'Event' occurs.
415 holdDyn :: a -> Event t a -> m (Dynamic t a)
416 -- | Create an 'Incremental' value using the given initial value that changes
417 -- every time the 'Event' occurs.
418 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
420-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
421-- key. This is much more efficient than filtering for each key with
423newtype EventSelector t k = EventSelector
424 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
425 -- determined by the type of the key, so this can be used to fan-out
426 -- 'Event's whose sub-'Event's have different types.
428 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
429 -- (but equivalent to) using 'fmapMaybe' to select only the relevant
430 -- occurrences of an 'Event'.
431 select :: forall a. k a -> Event t a
434--------------------------------------------------------------------------------
436--------------------------------------------------------------------------------
438instance MonadSample t m => MonadSample t (ReaderT r m) where
439 sample = lift . sample
441instance MonadHold t m => MonadHold t (ReaderT r m) where
442 hold a0 = lift . hold a0
443 holdDyn a0 = lift . holdDyn a0
444 holdIncremental a0 = lift . holdIncremental a0
446instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
447 sample = lift . sample
449instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
450 hold a0 = lift . hold a0
451 holdDyn a0 = lift . holdDyn a0
452 holdIncremental a0 = lift . holdIncremental a0
454instance MonadSample t m => MonadSample t (StateT s m) where
455 sample = lift . sample
457instance MonadHold t m => MonadHold t (StateT s m) where
458 hold a0 = lift . hold a0
459 holdDyn a0 = lift . holdDyn a0
460 holdIncremental a0 = lift . holdIncremental a0
462instance MonadSample t m => MonadSample t (ExceptT e m) where
463 sample = lift . sample
465instance MonadHold t m => MonadHold t (ExceptT e m) where
466 hold a0 = lift . hold a0
467 holdDyn a0 = lift . holdDyn a0
468 holdIncremental a0 = lift . holdIncremental a0
470instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
471 sample = lift . sample
473instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
474 hold a0 = lift . hold a0
475 holdDyn a0 = lift . holdDyn a0
476 holdIncremental a0 = lift . holdIncremental a0
478instance MonadSample t m => MonadSample t (ContT r m) where
479 sample = lift . sample
481instance MonadHold t m => MonadHold t (ContT r m) where
482 hold a0 = lift . hold a0
483 holdDyn a0 = lift . holdDyn a0
484 holdIncremental a0 = lift . holdIncremental a0
486--------------------------------------------------------------------------------
487-- Convenience functions
488--------------------------------------------------------------------------------
490-- | Create an 'Event' from another 'Event'. The provided function can sample
491-- 'Behavior's and hold 'Event's.
492pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
493pushAlways f = push (fmap Just . f)
495-- | Flipped version of 'fmap'.
496ffor :: Functor f => f a -> (a -> b) -> f b
499instance Reflex t => Applicative (Behavior t) where
501 f <*> x = pull $ sample f `ap` sample x
505instance Reflex t => Apply (Behavior t) where
508instance Reflex t => Bind (Behavior t) where
511instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
513 fromRational = pure . fromRational
516instance Reflex t => Functor (Behavior t) where
517 fmap f = pull . fmap f . sample
519instance (Reflex t, IsString a) => IsString (Behavior t a) where
520 fromString = pure . fromString
522instance Reflex t => Monad (Behavior t) where
523 a >>= f = pull $ sample a >>= sample . f
524 -- 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.
526 fail = error "Monad (Behavior t) does not support fail"
528instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
529 mempty = constant mempty
530 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
531 mconcat = pull . fmap mconcat . mapM sample
533instance (Reflex t, Num a) => Num (Behavior t a) where
538 fromInteger = pure . fromInteger
542instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
543 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
544 sconcat = pull . fmap sconcat . mapM sample
545#if MIN_VERSION_semigroups(0,17,0)
546 stimes n = fmap $ stimes n
548 times1p n = fmap $ times1p n
551-- | Flipped version of 'fmapMaybe'.
552fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b
553fforMaybe = flip fmapMaybe
555-- | Filter 'f a' using the provided predicate.
556-- Relies on 'fforMaybe'.
557ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
558ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
560-- | Left-biased event union (prefers left event on simultaneous
562instance Reflex t => Alt (Event t) where
563 ev1 <!> ev2 = leftmost [ev1, ev2]
565-- | 'Event' intersection (convenient interface to 'coincidence').
566instance Reflex t => Apply (Event t) where
567 evf <.> evx = coincidence (fmap (<$> evx) evf)
569-- | 'Event' intersection (convenient interface to 'coincidence').
570instance Reflex t => Bind (Event t) where
571 evx >>- f = coincidence (f <$> evx)
574instance Reflex t => Functor (Event t) where
576 fmap f = fmapMaybe $ Just . f
578instance Reflex t => FunctorMaybe (Event t) where
579 {-# INLINE fmapMaybe #-}
580 fmapMaybe f = push $ return . f
582-- | Never: @'zero' = 'never'@.
583instance Reflex t => Plus (Event t) where
586-- | Replace each occurrence value of the 'Event' with the value of the
587-- 'Behavior' at the time of that occurrence.
588tag :: Reflex t => Behavior t b -> Event t a -> Event t b
589tag b = pushAlways $ \_ -> sample b
591-- | Create a new 'Event' that combines occurences of supplied 'Event' with the
592-- current value of the 'Behavior'.
593attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
594attach = attachWith (,)
596-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
597-- combining it with the current value of the 'Behavior'.
598attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
599attachWith f = attachWithMaybe $ \a b -> Just $ f a b
601-- | Create a new 'Event' by combining each occurence with the current value of
602-- the 'Behavior'. The occurrence is discarded if the combining function returns
604attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
605attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
607-- | Create a new 'Event' that only occurs only once, on the first occurence of
608-- the supplied 'Event'.
609headE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
611 rec be <- hold e $ fmap (const never) e'
615-- | Create a new 'Event' that occurs on all but the first occurence of the
617tailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
618tailE e = snd <$> headTailE e
620-- | Create a tuple of two 'Event's with the first one occuring only the first
621-- time the supplied 'Event' occurs and the second occuring on all but the first
623headTailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a, Event t a)
626 be <- hold never $ fmap (const e) eHead
627 return (eHead, switch be)
629-- | Split the supplied 'Event' into two individual 'Event's occuring at the
630-- same time with the respective values from the tuple.
631splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
632splitE e = (fmap fst e, fmap snd e)
634-- | Print the supplied 'String' and the value of the 'Event' on each
635-- occurence. This should /only/ be used for debugging.
637-- Note: As with Debug.Trace.trace, the message will only be printed if the
638-- 'Event' is actually used.
639traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
640traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
642-- | Print the output of the supplied function on each occurence of the
643-- 'Event'. This should /only/ be used for debugging.
645-- Note: As with Debug.Trace.trace, the message will only be printed if the
646-- 'Event' is actually used.
647traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
648traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
650instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
651 (<>) = alignWith (mergeThese (<>))
652 sconcat = fmap sconcat . mergeList . toList
653#if MIN_VERSION_semigroups(0,17,0)
654 stimes n = fmap $ stimes n
656 times1p n = fmap $ times1p n
659instance (Semigroup a, Reflex t) => Monoid (Event t a) where
662 mconcat = fmap sconcat . mergeList
664-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
665-- list occurs. If multiple occur at the same time they are folded from the left
666-- with the given function.
667{-# INLINE mergeWith #-}
668mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
669mergeWith = mergeWith' id
671{-# INLINE mergeWith' #-}
672mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
673mergeWith' f g es = fmap (Prelude.foldl1 g . map (\(Const2 _ :=> Identity v) -> f v) . DMap.toList)
675 . DMap.fromDistinctAscList
676 . map (\(k, v) -> Const2 k :=> v)
677 $ zip [0 :: Int ..] es
679-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
680-- list occurs. If multiple occur at the same time the value is the value of the
682{-# INLINE leftmost #-}
683leftmost :: Reflex t => [Event t a] -> Event t a
684leftmost = mergeWith const
686-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
687-- list occurs and has a list of the values of all 'Event's occuring at that
689mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
691mergeList es = mergeWithFoldCheap' id es
693unsafeMapIncremental :: (Reflex t, Patch p, Patch p') => (PatchTarget p -> PatchTarget p') -> (p -> p') -> Incremental t p -> Incremental t p'
694unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
696-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
697-- occurs if at least one of them occurs and has a map of values of all 'Event's
698-- occuring at that time.
699mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
700mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
702-- | Create a merge whose parents can change over time
703mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
704mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
706-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
707mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
708mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
710-- | Split the event into separate events for 'Left' and 'Right' values.
711fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
713 let justLeft = either Just (const Nothing)
714 justRight = either (const Nothing) Just
715 in (fmapMaybe justLeft e, fmapMaybe justRight e)
717-- | Split the event into separate events for 'This' and 'That' values,
718-- allowing them to fire simultaneously when the input value is 'These'.
719fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
721 let this (This x) = Just x
722 this (These x _) = Just x
724 that (That y) = Just y
725 that (These _ y) = Just y
727 in (fmapMaybe this e, fmapMaybe that e)
729-- | Split the event into an 'EventSelector' that allows efficient selection of
730-- the individual 'Event's.
731fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
732fanMap = fan . fmap mapToDMap
734-- | Switches to the new event whenever it receives one. Whenever a new event
735-- is provided, if it is firing, its value will be the resulting event's value;
736-- if it is not firing, but the old one is, the old one's value will be used.
737switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
738switchPromptly ea0 eea = do
740 let eLag = switch bea
741 eCoincidences = coincidence eea
742 return $ leftmost [eCoincidences, eLag]
744-- | 'switch'es to a new event whenever it receives one. At the moment of
745-- switching, the old event will be ignored if it fires, and the new one will be
746-- used if it fires; this is the opposite of 'switch', which will use only the
748switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
749switchPromptOnly e0 e' = do
750 eLag <- switch <$> hold e0 e'
751 return $ coincidence $ leftmost [e', eLag <$ eLag]
753instance Reflex t => Align (Event t) where
755 align = alignEventWithMaybe Just
757-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
758-- the 'Behavior' is true at the time of occurence.
759gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
760gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
762-- | Create a new behavior given a starting behavior and switch to a the behvior
763-- carried by the event when it fires.
764switcher :: (Reflex t, MonadHold t m)
765 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
766switcher b eb = pull . (sample <=< sample) <$> hold b eb
768-- | Combine two 'Dynamic's. The result will change whenever either (or both)
769-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
770zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
771zipDyn = zipDynWith (,)
773-- | Combine two 'Dynamic's with a combining function. The result will change
774-- whenever either (or both) input 'Dynamic' changes.
775-- More efficient than liftA2.
776zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
778 let eab = align (updated da) (updated db)
779 ec = flip push eab $ \o -> do
782 b <- sample $ current db
785 a <- sample $ current da
787 These a b -> return (a, b)
788 return $ Just $ f a b
789 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
791instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
792 mconcat = distributeListOverDynWith mconcat
793 mempty = constDyn mempty
794 mappend = zipDynWith mappend
796-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
797-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
798-- through the use of multiple uses of 'zipWithDyn' or 'Applicative' operators.
799distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
800distributeDMapOverDynPure dm = case DMap.toList dm of
801 [] -> constDyn DMap.empty
802 [k :=> v] -> fmap (DMap.singleton k . Identity) v
804 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
805 edmPre = merge $ DMap.map updated dm
806 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
807 olds <- sample $ current result
808 return $ DMap.unionWithKey (\_ _ new -> new) olds news
811-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
812distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
813distributeListOverDyn = distributeListOverDynWith id
815-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
816distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
817distributeListOverDynWith f = fmap (f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]
819-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
820-- unless the second supplied 'Event' occurs simultaneously.
821difference :: Reflex t => Event t a -> Event t b -> Event t a
822difference = alignEventWithMaybe $ \case
826alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
827alignEventWithMaybe f ea eb =
828 fmapMaybe (f <=< dmapToThese)
830 $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
833--------------------------------------------------------------------------------
835--------------------------------------------------------------------------------
837-- | An 'Accumulator' type can be built by accumulating occurrences of an
839class Reflex t => Accumulator t f | f -> t where
840 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
841 accum f = accumMaybe $ \v o -> Just $ f v o
842 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
843 accumM f = accumMaybeM $ \v o -> Just <$> f v o
844 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
845 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
846 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
847 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
848 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
849 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
850 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
851 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
852 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
853 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
855-- | Accumulate occurrences of an 'Event', producing an output occurrence each
856-- time. Discard the underlying 'Accumulator'.
857mapAccum_ :: 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)
859 (_ :: Behavior t a, result) <- mapAccum f z e
862-- | Accumulate occurrences of an 'Event', possibly producing an output
863-- occurrence each time. Discard the underlying 'Accumulator'.
864mapAccumMaybe_ :: 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)
865mapAccumMaybe_ f z e = do
866 (_ :: Behavior t a, result) <- mapAccumMaybe f z e
869-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
870-- an output occurrence each time. Discard the underlying 'Accumulator'.
871mapAccumM_ :: 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)
873 (_ :: Behavior t a, result) <- mapAccumM f z e
876-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
877-- producing an output occurrence each time. Discard the underlying
879mapAccumMaybeM_ :: 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)
880mapAccumMaybeM_ f z e = do
881 (_ :: Behavior t a, result) <- mapAccumMaybeM f z e
884instance Reflex t => Accumulator t (Dynamic t) where
885 accumMaybeM f z e = do
886 rec let e' = flip push e $ \o -> do
887 v <- sample $ current d'
891 mapAccumMaybeM f z e = do
892 rec let e' = flip push e $ \o -> do
893 v <- sample $ current d'
895 return $ case result of
896 (Nothing, Nothing) -> Nothing
898 d' <- holdDyn z $ fmapMaybe fst e'
899 return (d', fmapMaybe snd e')
901instance Reflex t => Accumulator t (Behavior t) where
902 accumMaybeM f z e = current <$> accumMaybeM f z e
903 mapAccumMaybeM f z e = first current <$> mapAccumMaybeM f z e
905instance Reflex t => Accumulator t (Event t) where
906 accumMaybeM f z e = updated <$> accumMaybeM f z e
907 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
909-- | Create a new 'Event' by combining each occurence with the next value of the
910-- list using the supplied function. If the list runs out of items, all
911-- subsequent 'Event' occurrences will be ignored.
912zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
913zipListWithEvent f l e = do
914 let f' a b = case a of
915 h:t -> (Just t, Just $ f h b)
916 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
917 mapAccumMaybe_ f' l e
919-- | A 'Monad' that supports adjustment over time. After an action has been
920-- run, if the given events fire, it will adjust itself so that its net effect
921-- is as though it had originally been run with the new value. Note that there
922-- is some issue here with persistent side-effects: obviously, IO (and some
923-- other side-effects) cannot be undone, so it is up to the instance implementer
924-- to determine what the best meaning for this class is in such cases.
925class (Reflex t, Monad m) => MonadAdjust t m | m -> t where
926 runWithReplace :: m a -> Event t (m b) -> m (a, Event t b)
927 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'))
928 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'))
930instance (Reflex t, MonadAdjust t m) => MonadAdjust t (ReaderT r m) where
931 runWithReplace a0 a' = do
933 lift $ runWithReplace (runReaderT a0 r) $ fmap (`runReaderT` r) a'
934 traverseDMapWithKeyWithAdjust f dm0 dm' = do
936 lift $ traverseDMapWithKeyWithAdjust (\k v -> runReaderT (f k v) r) dm0 dm'
937 traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = do
939 lift $ traverseDMapWithKeyWithAdjustWithMove (\k v -> runReaderT (f k v) r) dm0 dm'
941sequenceDMapWithAdjust :: (GCompare k, MonadAdjust t m) => DMap k m -> Event t (PatchDMap k m) -> m (DMap k Identity, Event t (PatchDMap k Identity))
942sequenceDMapWithAdjust = traverseDMapWithKeyWithAdjust $ \_ -> fmap Identity
944sequenceDMapWithAdjustWithMove :: (GCompare k, MonadAdjust t m) => DMap k m -> Event t (PatchDMapWithMove k m) -> m (DMap k Identity, Event t (PatchDMapWithMove k Identity))
945sequenceDMapWithAdjustWithMove = traverseDMapWithKeyWithAdjustWithMove $ \_ -> fmap Identity
947mapMapWithAdjustWithMove :: forall t m k v v'. (MonadAdjust t m, Ord k) => (k -> v -> m v') -> Map k v -> Event t (PatchMapWithMove k v) -> m (Map k v', Event t (PatchMapWithMove k v'))
948mapMapWithAdjustWithMove f m0 m' = do
949 (out0 :: DMap (Const2 k v) (Constant v'), out') <- traverseDMapWithKeyWithAdjustWithMove (\(Const2 k) (Identity v) -> Constant <$> f k v) (mapToDMap m0) (const2PatchDMapWithMoveWith Identity <$> m')
950 return (dmapToMapWith (\(Constant v') -> v') out0, patchDMapWithMoveToPatchMapWithMoveWith (\(Constant v') -> v') <$> out')
956{-# INLINE pushAlwaysCheap #-}
957pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
958pushAlwaysCheap f = pushCheap (fmap Just . f)
960{-# INLINE fmapMaybeCheap #-}
961fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
962fmapMaybeCheap f = pushCheap $ return . f
964{-# INLINE fforMaybeCheap #-}
965fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
966fforMaybeCheap = flip fmapMaybeCheap
968{-# INLINE fforCheap #-}
969fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
970fforCheap = flip fmapCheap
972{-# INLINE fmapCheap #-}
973fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
974fmapCheap f = pushCheap $ return . Just . f
976{-# INLINE tagCheap #-}
977tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
978tagCheap b = pushAlwaysCheap $ \_ -> sample b
980{-# INLINE mergeWithCheap #-}
981mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
982mergeWithCheap = mergeWithCheap' id
984{-# INLINE mergeWithCheap' #-}
985mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
986mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
988{-# INLINE mergeWithFoldCheap' #-}
989mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
990mergeWithFoldCheap' f es =
991 fmapCheap (f . (\(h : t) -> h :| t) . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList)
993 . DMap.fromDistinctAscList
994 . map (\(k, v) -> Const2 k :=> v)
995 $ zip [0 :: Int ..] es
997--------------------------------------------------------------------------------
998-- Deprecated functions
999--------------------------------------------------------------------------------
1001-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
1002-- occurs. If both occur at the same time they are combined using 'mappend'.
1003{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}
1004appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
1005appendEvents = alignWith $ mergeThese mappend
1007-- | Alias for 'headE'
1008{-# DEPRECATED onceE "Use 'headE' instead" #-}
1009onceE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
1012-- | Run both sides of a 'These' monadically, combining the results.
1013{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
1014#ifdef USE_TEMPLATE_HASKELL
1015{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
1017sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
1018sequenceThese t = case t of
1019 This ma -> fmap This ma
1020 These ma mb -> liftM2 These ma mb
1021 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