2{-# LANGUAGE DefaultSignatures #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FunctionalDependencies #-}
7{-# LANGUAGE LambdaCase #-}
8{-# LANGUAGE MultiParamTypeClasses #-}
9{-# LANGUAGE NoMonomorphismRestriction #-}
10{-# LANGUAGE RankNTypes #-}
11{-# LANGUAGE RecursiveDo #-}
12{-# LANGUAGE RoleAnnotations #-}
13{-# LANGUAGE ScopedTypeVariables #-}
14{-# LANGUAGE TypeFamilies #-}
15{-# LANGUAGE TypeOperators #-}
16{-# LANGUAGE UndecidableInstances #-}
17#ifdef USE_REFLEX_OPTIMIZER
18{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
20#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
21{-# LANGUAGE EmptyDataDecls #-}
22{-# OPTIONS_GHC -Wno-redundant-constraints #-}
25-- | This module contains the Reflex interface, as well as a variety of
26-- convenience functions for working with 'Event's, 'Behavior's, and other
38 -- ** 'fan'-related types
40 , EventSelectorInt (..)
41 -- ** 'Incremental'-related types
42 -- * Convenience functions
45 -- ** Combining 'Event's
49 , mergeMapIncrementalWithMove
54 -- ** Breaking up 'Event's
63 -- ** Switching between 'Event's
66 -- ** Using 'Event's to sample 'Behavior's
71 -- ** Blocking an 'Event' based on a 'Behavior'
73 -- ** Combining 'Dynamic's
74 , distributeDMapOverDynPure
75 , distributeListOverDyn
76 , distributeListOverDynWith
79 -- ** Accumulating state
103 , numberOccurrencesFrom
104 , numberOccurrencesFrom_
111 -- * Debugging functions
114 -- * Unsafe functions
116 , unsafeMapIncremental
121 -- * Miscellaneous convenience functions
124 , sequenceDMapWithAdjust
125 , sequenceDMapWithAdjustWithMove
126 , mapMapWithAdjustWithMove
127 -- * Deprecated functions
139 -- * Slow, but general, implementations
141#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
162 , unsafeBuildIncremental
164 , mergeIncrementalWithMove
167 , incrementalToDynamic
174import Control.Applicative
175import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
176import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
177import Control.Monad.State.Strict hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
178import Control.Monad.Trans.Cont (ContT ())
179import Control.Monad.Trans.Except (ExceptT ())
180import Control.Monad.Trans.RWS (RWST ())
181import Control.Monad.Trans.Writer (WriterT ())
186import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
187import qualified Data.Dependent.Map as DMap
190import Data.Functor.Bind hiding (join)
191import qualified Data.Functor.Bind as Bind
192import Data.Functor.Constant
193import Data.Functor.Misc
194import Data.Functor.Plus
195import Data.IntMap.Strict (IntMap)
196import qualified Data.IntMap.Strict as IntMap
197import Data.List.NonEmpty (NonEmpty (..))
200import Data.Monoid hiding (Alt, (<>))
201import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
204import Data.Traversable
205import Data.Type.Coercion
206import Reflex.FunctorMaybe
208import Data.FastMutableIntMap (PatchIntMap)
210#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
211import Reflex.Spider.Internal (EventM, Global, HasSpiderTimeline, SpiderHost (..), SpiderHostFrame (..),
212 SpiderPullM, SpiderPushM (..), behaviorHoldIdentity, dynamicConst,
213 dynamicCurrent, dynamicDynIdentity, dynamicHold, dynamicHoldIdentity,
214 dynamicUpdated, newMapDyn, readBehaviorTracked, readBehaviorUntracked,
215 runFrame, runSpiderHostFrame)
216import qualified Reflex.Spider.Internal
217import qualified Reflex.Spider.Internal as S
221-- Note: must come last to silence warnings due to AMP on GHC < 7.10
222import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)
224import Debug.Trace (trace)
226#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
227#include "Spider/SpiderTimeline.include.hs"
230-- | The 'Reflex' class contains all the primitive functionality needed for
231-- Functional Reactive Programming (FRP). The @t@ type parameter indicates
232-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
233-- and the type of the timeline determines the FRP engine to be used. For most
234-- purposes, the 'Reflex.Spider' implementation is recommended.
235class ( MonadHold t (PushM t)
236 , MonadSample t (PullM t)
238 , Functor (Dynamic t)
239 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
241#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
242 , t ~ SpiderTimeline Global
245 -- | A container for a value that can change over time. 'Behavior's can be
246 -- sampled at will, but it is not possible to be notified when they change
247 data Behavior t :: * -> *
248 -- | A stream of occurrences. During any given frame, an 'Event' is either
249 -- occurring or not occurring; if it is occurring, it will contain a value of
250 -- the given type (its "occurrence type")
251 data Event t :: * -> *
252 -- | A container for a value that can change over time and allows
253 -- notifications on changes. Basically a combination of a 'Behavior' and an
254 -- 'Event', with a rule that the 'Behavior' will change if and only if the
256 data Dynamic t :: * -> *
257 -- | An 'Incremental' is a more general form of a 'Dynamic'.
258 -- Instead of always fully replacing the value, only parts of it can be patched.
259 -- This is only needed for performance critical code via `mergeIncremental` to make small
260 -- changes to large values.
261 data Incremental t :: * -> *
262 -- | A monad for doing complex push-based calculations efficiently
263 type PushM t :: * -> *
264 -- | A monad for doing complex pull-based calculations efficiently
265 type PullM t :: * -> *
266#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
267 -- | An 'Event' with no occurrences
269 -- | Create a 'Behavior' that always has the given value
270 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
271 -- | Create an 'Event' from another 'Event'; the provided function can sample
272 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
273 -- (Just) or non-occurring (Nothing) result
274 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
275 -- | 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.
276 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
277 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
278 -- recomputed whenever any of the read 'Behavior's changes
279 pull :: PullM t a -> Behavior t a
280 -- | Merge a collection of events; the resulting 'Event' will only occur if at
281 -- least one input event is occuring, and will contain all of the input keys
282 -- that are occurring simultaneously
283 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
284 -- | Efficiently fan-out an event to many destinations. This function should
285 -- be partially applied, and then the result applied repeatedly to create
287 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
288 -- | Create an 'Event' that will occur whenever the currently-selected input
290 switch :: Behavior t (Event t a) -> Event t a
291 -- | Create an 'Event' that will occur whenever the input event is occurring
292 -- and its occurrence value, another 'Event', is also occurring
293 coincidence :: Event t (Event t a) -> Event t a
294 -- | Extract the 'Behavior' of a 'Dynamic'.
295 current :: Dynamic t a -> Behavior t a
296 -- | Extract the 'Event' of the 'Dynamic'.
297 updated :: Dynamic t a -> Event t a
298 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
299 -- recent firing of the given 'Event', if any.
300 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
301 -- | Create a new 'Incremental'. The given 'PullM''s value must always change
302 -- in the same way that the accumulated application of patches would change
304 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
305 -- | Create a merge whose parents can change over time
306 mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
307 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
308 mergeIncrementalWithMove :: GCompare k => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
309 -- | Extract the 'Behavior' component of an 'Incremental'
310 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
311 -- | Extract the 'Event' component of an 'Incremental'
312 updatedIncremental :: Patch p => Incremental t p -> Event t p
313 -- | Convert an 'Incremental' to a 'Dynamic'
314 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
315 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
317 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
318 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
320 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
321 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
323 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
324 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
325 fanInt :: Event t (IntMap a) -> EventSelectorInt t a
328--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on
329mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
330mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never
332#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
333instance t ~ SpiderTimeline Global => Reflex t where
334 newtype Behavior t a = SpiderBehavior { unSpiderBehavior :: Reflex.Spider.Internal.Behavior Global a }
335 newtype Event t a = SpiderEvent { unSpiderEvent :: Reflex.Spider.Internal.Event Global a }
336 newtype Dynamic t a = SpiderDynamic { unSpiderDynamic :: Reflex.Spider.Internal.Dynamic Global (Identity a) } -- deriving (Functor, Applicative, Monad)
337 newtype Incremental t p = SpiderIncremental { unSpiderIncremental :: Reflex.Spider.Internal.Dynamic Global p }
338 type PullM t = SpiderPullM Global
339 type PushM t = SpiderPushM Global
340never :: Reflex t => Event t a
341constant :: Reflex t => a -> Behavior t a
342push :: Reflex t => (a -> PushM t (Maybe b)) -> Event t a -> Event t b
343pushCheap :: Reflex t => (a -> PushM t (Maybe b)) -> Event t a -> Event t b
344pull :: Reflex t => PullM t a -> Behavior t a
345merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)
346fan :: (Reflex t, GCompare k) => Event t (DMap k Identity) -> EventSelector t k
347switch :: Reflex t => Behavior t (Event t a) -> Event t a
348coincidence :: Reflex t => Event t (Event t a) -> Event t a
349current :: Reflex t => Dynamic t a -> Behavior t a
350updated :: Reflex t => Dynamic t a -> Event t a
351unsafeBuildDynamic :: Reflex t => PullM t a -> Event t a -> Dynamic t a
352unsafeBuildIncremental :: (Reflex t, Patch p) => PullM t (PatchTarget p) -> Event t p -> Incremental t p
353mergeIncremental :: (Reflex t, GCompare k) => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
354mergeIncrementalWithMove :: (Reflex t, GCompare k) => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
355currentIncremental :: (Reflex t, Patch p) => Incremental t p -> Behavior t (PatchTarget p)
356updatedIncremental :: (Reflex t, Patch p) => Incremental t p -> Event t p
357incrementalToDynamic :: (Reflex t, Patch p) => Incremental t p -> Dynamic t (PatchTarget p)
358behaviorCoercion :: Reflex t => Coercion a b -> Coercion (Behavior t a) (Behavior t b)
359eventCoercion :: Reflex t => Coercion a b -> Coercion (Event t a) (Event t b)
360dynamicCoercion :: Reflex t => Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
362never = SpiderEvent S.eventNever
363{-# INLINE constant #-}
364constant = SpiderBehavior . S.behaviorConst
366push f = SpiderEvent . S.push (coerce f) . unSpiderEvent
367{-# INLINE pushCheap #-}
368pushCheap f = SpiderEvent . S.pushCheap (coerce f) . unSpiderEvent
370pull = SpiderBehavior . S.pull . coerce
372merge = SpiderEvent . S.merge . S.dynamicConst . (coerce :: DMap k (Event (SpiderTimeline x)) -> DMap k (S.Event x))
374fan e = EventSelector $ SpiderEvent . S.select (S.fan (unSpiderEvent e))
376switch = SpiderEvent . S.switch . (coerce :: S.Behavior x (Event (SpiderTimeline x) a) -> S.Behavior x (S.Event x a)) . unSpiderBehavior
377{-# INLINE coincidence #-}
378coincidence = SpiderEvent . S.coincidence . (coerce :: S.Event x (Event (SpiderTimeline x) a) -> S.Event x (S.Event x a)) . unSpiderEvent
379{-# INLINE current #-}
380current = SpiderBehavior . S.dynamicCurrent . unSpiderDynamic
381{-# INLINE updated #-}
382updated = coerceEvent . SpiderEvent . dynamicUpdated . unSpiderDynamic
383{-# INLINE unsafeBuildDynamic #-}
384unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ S.unsafeBuildDynamic (coerce readV0) $ coerce $ unSpiderEvent v'
385{-# INLINE unsafeBuildIncremental #-}
386unsafeBuildIncremental readV0 dv = SpiderIncremental $ S.dynamicDyn $ S.unsafeBuildDynamic (coerce readV0) $ unSpiderEvent dv
387{-# INLINE mergeIncremental #-}
388mergeIncremental = SpiderEvent . S.merge . (unsafeCoerce :: S.Dynamic x (PatchDMap k (Event (SpiderTimeline x))) -> S.Dynamic x (PatchDMap k (S.Event x))) . unSpiderIncremental
389{-# INLINE mergeIncrementalWithMove #-}
390mergeIncrementalWithMove = SpiderEvent . S.mergeWithMove . (unsafeCoerce :: S.Dynamic x (PatchDMapWithMove k (Event (SpiderTimeline x))) -> S.Dynamic x (PatchDMapWithMove k (S.Event x))) . unSpiderIncremental
391{-# INLINE currentIncremental #-}
392currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental
393{-# INLINE updatedIncremental #-}
394updatedIncremental = SpiderEvent . dynamicUpdated . unSpiderIncremental
395{-# INLINE incrementalToDynamic #-}
396incrementalToDynamic (SpiderIncremental i) = SpiderDynamic $ dynamicDynIdentity $ S.unsafeBuildDynamic (readBehaviorUntracked $ dynamicCurrent i) $ flip S.push (dynamicUpdated i) $ \p -> do
397 c <- readBehaviorUntracked $ dynamicCurrent i
398 return $ Identity <$> apply p c
399eventCoercion Coercion = Coercion
400behaviorCoercion Coercion = Coercion
401dynamicCoercion = unsafeCoerce
404-- | Coerce a 'Behavior' between representationally-equivalent value types
405coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
406coerceBehavior = coerceWith $ behaviorCoercion Coercion
408-- | Coerce an 'Event' between representationally-equivalent occurrence types
409coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
410coerceEvent = coerceWith $ eventCoercion Coercion
412-- | Coerce a 'Dynamic' between representationally-equivalent value types
413coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
414coerceDynamic = coerceWith $ dynamicCoercion Coercion
416-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
417-- _must_ change when and only when the 'Event' fires, such that the
418-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
419-- if this is not the case, the resulting 'Dynamic' will behave
420-- nondeterministically.
421unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
422unsafeDynamic = unsafeBuildDynamic . sample
424-- | Construct a 'Dynamic' value that never changes
425constDyn :: Reflex t => a -> Dynamic t a
428instance (Reflex t, Default a) => Default (Dynamic t a) where
431-- | 'MonadSample' designates monads that can read the current value of a
432-- 'Behavior'. This includes both 'PullM' and 'PushM'.
433class (Applicative m, Monad m) => MonadSample t m | m -> t where
434 -- | Get the current value in the 'Behavior'
435 sample :: Behavior t a -> m a
437-- | 'MonadHold' designates monads that can create new 'Behavior's based on
438-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
439-- is required to create any stateful computations with Reflex.
440class MonadSample t m => MonadHold t m where
441 -- | Create a new 'Behavior' whose value will initially be equal to the given
442 -- value and will be updated whenever the given 'Event' occurs. The update
443 -- takes effect immediately after the 'Event' occurs; if the occurrence that
444 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
445 -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new
447 hold :: a -> Event t a -> m (Behavior t a)
448 default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)
449 hold v0 = lift . hold v0
450 -- | Create a 'Dynamic' value using the given initial value that changes every
451 -- time the 'Event' occurs.
452 holdDyn :: a -> Event t a -> m (Dynamic t a)
453 default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)
454 holdDyn v0 = lift . holdDyn v0
455 -- | Create an 'Incremental' value using the given initial value that changes
456 -- every time the 'Event' occurs.
457 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
458 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
459 holdIncremental v0 = lift . holdIncremental v0
460 buildDynamic :: PullM t a -> Event t a -> m (Dynamic t a)
462 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
463 buildDynamic getV0 = lift . buildDynamic getV0
465 -- | Create a new 'Event' that only occurs only once, on the first occurence of
466 -- the supplied 'Event'.
467 headE :: Event t a -> m (Event t a)
470slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
472 rec be <- hold e $ fmapCheap (const never) e'
476-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
477-- key. This is much more efficient than filtering for each key with
479newtype EventSelector t k = EventSelector
480 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
481 -- determined by the type of the key, so this can be used to fan-out
482 -- 'Event's whose sub-'Event's have different types.
484 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
485 -- (but equivalent to) using 'fmapMaybe' to select only the relevant
486 -- occurrences of an 'Event'.
487 select :: forall a. k a -> Event t a
490newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }
492--------------------------------------------------------------------------------
494--------------------------------------------------------------------------------
496instance MonadSample t m => MonadSample t (ReaderT r m) where
497 sample = lift . sample
499instance MonadHold t m => MonadHold t (ReaderT r m) where
500 hold a0 = lift . hold a0
501 holdDyn a0 = lift . holdDyn a0
502 holdIncremental a0 = lift . holdIncremental a0
503 buildDynamic a0 = lift . buildDynamic a0
506instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
507 sample = lift . sample
509instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
510 hold a0 = lift . hold a0
511 holdDyn a0 = lift . holdDyn a0
512 holdIncremental a0 = lift . holdIncremental a0
513 buildDynamic a0 = lift . buildDynamic a0
516instance MonadSample t m => MonadSample t (StateT s m) where
517 sample = lift . sample
519instance MonadHold t m => MonadHold t (StateT s m) where
520 hold a0 = lift . hold a0
521 holdDyn a0 = lift . holdDyn a0
522 holdIncremental a0 = lift . holdIncremental a0
523 buildDynamic a0 = lift . buildDynamic a0
526instance MonadSample t m => MonadSample t (ExceptT e m) where
527 sample = lift . sample
529instance MonadHold t m => MonadHold t (ExceptT e m) where
530 hold a0 = lift . hold a0
531 holdDyn a0 = lift . holdDyn a0
532 holdIncremental a0 = lift . holdIncremental a0
533 buildDynamic a0 = lift . buildDynamic a0
536instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
537 sample = lift . sample
539instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
540 hold a0 = lift . hold a0
541 holdDyn a0 = lift . holdDyn a0
542 holdIncremental a0 = lift . holdIncremental a0
543 buildDynamic a0 = lift . buildDynamic a0
546instance MonadSample t m => MonadSample t (ContT r m) where
547 sample = lift . sample
549instance MonadHold t m => MonadHold t (ContT r m) where
550 hold a0 = lift . hold a0
551 holdDyn a0 = lift . holdDyn a0
552 holdIncremental a0 = lift . holdIncremental a0
553 buildDynamic a0 = lift . buildDynamic a0
556--------------------------------------------------------------------------------
557-- Convenience functions
558--------------------------------------------------------------------------------
560-- | Create an 'Event' from another 'Event'. The provided function can sample
561-- 'Behavior's and hold 'Event's.
562pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
563pushAlways f = push (fmap Just . f)
565-- | Flipped version of 'fmap'.
566ffor :: Functor f => f a -> (a -> b) -> f b
569instance Reflex t => Applicative (Behavior t) where
571 f <*> x = pull $ sample f `ap` sample x
575instance Reflex t => Apply (Behavior t) where
578instance Reflex t => Bind (Behavior t) where
581instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
583 fromRational = pure . fromRational
586instance Reflex t => Functor (Behavior t) where
587 fmap f = pull . fmap f . sample
589instance (Reflex t, IsString a) => IsString (Behavior t a) where
590 fromString = pure . fromString
592instance Reflex t => Monad (Behavior t) where
593 a >>= f = pull $ sample a >>= sample . f
594 -- 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.
596 fail = error "Monad (Behavior t) does not support fail"
598instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
599 mempty = constant mempty
600 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
601 mconcat = pull . fmap mconcat . mapM sample
603instance (Reflex t, Num a) => Num (Behavior t a) where
608 fromInteger = pure . fromInteger
612instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
613 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
614 sconcat = pull . fmap sconcat . mapM sample
615#if MIN_VERSION_semigroups(0,17,0)
616 stimes n = fmap $ stimes n
618 times1p n = fmap $ times1p n
621-- | Flipped version of 'fmapMaybe'.
622fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b
623fforMaybe = flip fmapMaybe
625-- | Filter 'f a' using the provided predicate.
626-- Relies on 'fforMaybe'.
627ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
628ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
630-- | Left-biased event union (prefers left event on simultaneous
632instance Reflex t => Alt (Event t) where
633 ev1 <!> ev2 = leftmost [ev1, ev2]
635-- | 'Event' intersection (convenient interface to 'coincidence').
636instance Reflex t => Apply (Event t) where
637 evf <.> evx = coincidence (fmap (<$> evx) evf)
639-- | 'Event' intersection (convenient interface to 'coincidence').
640instance Reflex t => Bind (Event t) where
641 evx >>- f = coincidence (f <$> evx)
644instance Reflex t => Functor (Event t) where
646 fmap f = fmapMaybe $ Just . f
648 x <$ e = fmapCheap (const x) e
650instance Reflex t => FunctorMaybe (Event t) where
651 {-# INLINE fmapMaybe #-}
652 fmapMaybe f = push $ return . f
654-- | Never: @'zero' = 'never'@.
655instance Reflex t => Plus (Event t) where
658-- | Replace each occurrence value of the 'Event' with the value of the
659-- 'Behavior' at the time of that occurrence.
660tag :: Reflex t => Behavior t b -> Event t a -> Event t b
661tag b = pushAlways $ \_ -> sample b
663-- | Create a new 'Event' that combines occurences of supplied 'Event' with the
664-- current value of the 'Behavior'.
665attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
666attach = attachWith (,)
668-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
669-- combining it with the current value of the 'Behavior'.
670attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
671attachWith f = attachWithMaybe $ \a b -> Just $ f a b
673-- | Create a new 'Event' by combining each occurence with the current value of
674-- the 'Behavior'. The occurrence is discarded if the combining function returns
676attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
677attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
679-- | Create a new 'Event' that occurs on all but the first occurence of the
681tailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
682tailE e = snd <$> headTailE e
684-- | Create a tuple of two 'Event's with the first one occuring only the first
685-- time the supplied 'Event' occurs and the second occuring on all but the first
687headTailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a, Event t a)
690 be <- hold never $ fmap (const e) eHead
691 return (eHead, switch be)
693-- | Starting at the current time, fire all the occurrences of the 'Event' for
694-- which the given predicate returns 'True'. When 'False' is returned, do not
695-- fire, and permanently stop firing, even if 'True' values are encountered
697takeWhileE :: forall t m a. (Reflex t, MonadFix m, MonadHold t m) => (a -> Bool) -> Event t a -> m (Event t a)
699 rec let (eFalse, eTrue) = fanEither $ ffor e' $ \a -> if f a
706-- | Split the supplied 'Event' into two individual 'Event's occuring at the
707-- same time with the respective values from the tuple.
708splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
709splitE e = (fmap fst e, fmap snd e)
711-- | Print the supplied 'String' and the value of the 'Event' on each
712-- occurence. This should /only/ be used for debugging.
714-- Note: As with Debug.Trace.trace, the message will only be printed if the
715-- 'Event' is actually used.
716traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
717traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
719-- | Print the output of the supplied function on each occurence of the
720-- 'Event'. This should /only/ be used for debugging.
722-- Note: As with Debug.Trace.trace, the message will only be printed if the
723-- 'Event' is actually used.
724traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
725traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
727instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
728 (<>) = alignWith (mergeThese (<>))
729 sconcat = fmap sconcat . mergeList . toList
730#if MIN_VERSION_semigroups(0,17,0)
731 stimes n = fmap $ stimes n
733 times1p n = fmap $ times1p n
736instance (Semigroup a, Reflex t) => Monoid (Event t a) where
739 mconcat = fmap sconcat . mergeList
741-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
742-- list occurs. If multiple occur at the same time they are folded from the left
743-- with the given function.
744{-# INLINE mergeWith #-}
745mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
746mergeWith = mergeWith' id
748{-# INLINE mergeWith' #-}
749mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
750mergeWith' f g es = fmap (Prelude.foldl1 g . fmap f)
752 . IntMap.fromDistinctAscList
753 $ zip [0 :: Int ..] es
755-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
756-- list occurs. If multiple occur at the same time the value is the value of the
758{-# INLINE leftmost #-}
759leftmost :: Reflex t => [Event t a] -> Event t a
760leftmost = mergeWith const
762-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
763-- list occurs and has a list of the values of all 'Event's occuring at that
765mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
767mergeList es = mergeWithFoldCheap' id es
769unsafeMapIncremental :: (Reflex t, Patch p, Patch p') => (PatchTarget p -> PatchTarget p') -> (p -> p') -> Incremental t p -> Incremental t p'
770unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
772-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
773-- occurs if at least one of them occurs and has a map of values of all 'Event's
774-- occuring at that time.
775mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
776mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
778-- | Create a merge whose parents can change over time
779mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
780mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
782-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
783mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
784mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
786-- | Split the event into separate events for 'Left' and 'Right' values.
787fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
789 let justLeft = either Just (const Nothing)
790 justRight = either (const Nothing) Just
791 in (fmapMaybe justLeft e, fmapMaybe justRight e)
793-- | Split the event into separate events for 'This' and 'That' values,
794-- allowing them to fire simultaneously when the input value is 'These'.
795fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
797 let this (This x) = Just x
798 this (These x _) = Just x
800 that (That y) = Just y
801 that (These _ y) = Just y
803 in (fmapMaybe this e, fmapMaybe that e)
805-- | Split the event into an 'EventSelector' that allows efficient selection of
806-- the individual 'Event's.
807fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
808fanMap = fan . fmap mapToDMap
810-- | Switches to the new event whenever it receives one. Whenever a new event
811-- is provided, if it is firing, its value will be the resulting event's value;
812-- if it is not firing, but the old one is, the old one's value will be used.
813switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
814switchPromptly ea0 eea = do
816 let eLag = switch bea
817 eCoincidences = coincidence eea
818 return $ leftmost [eCoincidences, eLag]
820-- | 'switch'es to a new event whenever it receives one. At the moment of
821-- switching, the old event will be ignored if it fires, and the new one will be
822-- used if it fires; this is the opposite of 'switch', which will use only the
824switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
825switchPromptOnly e0 e' = do
826 eLag <- switch <$> hold e0 e'
827 return $ coincidence $ leftmost [e', eLag <$ eLag]
829instance Reflex t => Align (Event t) where
831 align = alignEventWithMaybe Just
833-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
834-- the 'Behavior' is true at the time of occurence.
835gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
836gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
838-- | Create a new behavior given a starting behavior and switch to a the behvior
839-- carried by the event when it fires.
840switcher :: (Reflex t, MonadHold t m)
841 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
842switcher b eb = pull . (sample <=< sample) <$> hold b eb
844-- | Combine two 'Dynamic's. The result will change whenever either (or both)
845-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
846zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
847zipDyn = zipDynWith (,)
849-- | Combine two 'Dynamic's with a combining function. The result will change
850-- whenever either (or both) input 'Dynamic' changes.
851-- More efficient than liftA2.
852zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
854 let eab = align (updated da) (updated db)
855 ec = flip push eab $ \o -> do
858 b <- sample $ current db
861 a <- sample $ current da
863 These a b -> return (a, b)
864 return $ Just $ f a b
865 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
867instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
868 mconcat = distributeListOverDynWith mconcat
869 mempty = constDyn mempty
870 mappend = zipDynWith mappend
872-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
873-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
874-- through the use of multiple uses of 'zipWithDyn' or 'Applicative' operators.
875distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
876distributeDMapOverDynPure dm = case DMap.toList dm of
877 [] -> constDyn DMap.empty
878 [k :=> v] -> fmap (DMap.singleton k . Identity) v
880 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
881 edmPre = merge $ DMap.map updated dm
882 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
883 olds <- sample $ current result
884 return $ DMap.unionWithKey (\_ _ new -> new) olds news
887-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
888distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
889distributeListOverDyn = distributeListOverDynWith id
891-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
892distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
893distributeListOverDynWith f = fmap (f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]
895-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
896-- unless the second supplied 'Event' occurs simultaneously.
897difference :: Reflex t => Event t a -> Event t b -> Event t a
898difference = alignEventWithMaybe $ \case
902alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
903alignEventWithMaybe f ea eb =
904 fmapMaybe (f <=< dmapToThese)
906 $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
909--------------------------------------------------------------------------------
911--------------------------------------------------------------------------------
913-- | An 'Accumulator' type can be built by accumulating occurrences of an
915#if __GLASGOW_HASKELL__ < 802
916{-# WARNING accum "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
917{-# WARNING accumM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
918{-# WARNING accumMaybe "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
919{-# WARNING accumMaybeM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
921class Reflex t => Accumulator t f | f -> t where
922 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
923 accum f = accumMaybe $ \v o -> Just $ f v o
924 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
925 accumM f = accumMaybeM $ \v o -> Just <$> f v o
926 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
927 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
928 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
929 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
930 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
931 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
932 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
933 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
934 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
935 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
937accumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Dynamic t a)
938accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o
939accumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Dynamic t a)
940accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o
941accumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Dynamic t a)
942accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o
943accumMaybeMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Dynamic t a)
944accumMaybeMDyn f z e = do
945 rec let e' = flip push e $ \o -> do
946 v <- sample $ current d'
950mapAccumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
951mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o
952mapAccumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
953mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o
954mapAccumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
955mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o
956mapAccumMaybeMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
957mapAccumMaybeMDyn f z e = do
958 rec let e' = flip push e $ \o -> do
959 v <- sample $ current d'
961 return $ case result of
962 (Nothing, Nothing) -> Nothing
964 d' <- holdDyn z $ fmapMaybe fst e'
965 return (d', fmapMaybe snd e')
968accumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Behavior t a)
969accumB f = accumMaybeB $ \v o -> Just $ f v o
970{-# INLINE accumMB #-}
971accumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Behavior t a)
972accumMB f = accumMaybeMB $ \v o -> Just <$> f v o
973{-# INLINE accumMaybeB #-}
974accumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Behavior t a)
975accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o
976{-# INLINE accumMaybeMB #-}
977accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)
978accumMaybeMB f z e = do
979 rec let e' = flip push e $ \o -> do
984{-# INLINE mapAccumB #-}
985mapAccumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)
986mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o
987{-# INLINE mapAccumMB #-}
988mapAccumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)
989mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o
990{-# INLINE mapAccumMaybeB #-}
991mapAccumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)
992mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o
994{-# INLINE mapAccumMaybeMB #-}
995mapAccumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)
996mapAccumMaybeMB f z e = do
997 rec let e' = flip push e $ \o -> do
1000 return $ case result of
1001 (Nothing, Nothing) -> Nothing
1003 d' <- hold z $ fmapMaybe fst e'
1004 return (d', fmapMaybe snd e')
1006-- | Accumulate occurrences of an 'Event', producing an output occurrence each
1007-- time. Discard the underlying 'Accumulator'.
1008{-# INLINE mapAccum_ #-}
1009mapAccum_ :: 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)
1011 (_, result) <- mapAccumB f z e
1014-- | Accumulate occurrences of an 'Event', possibly producing an output
1015-- occurrence each time. Discard the underlying 'Accumulator'.
1016{-# INLINE mapAccumMaybe_ #-}
1017mapAccumMaybe_ :: 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)
1018mapAccumMaybe_ f z e = do
1019 (_, result) <- mapAccumMaybeB f z e
1022-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
1023-- an output occurrence each time. Discard the underlying 'Accumulator'.
1024{-# INLINE mapAccumM_ #-}
1025mapAccumM_ :: 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)
1026mapAccumM_ f z e = do
1027 (_, result) <- mapAccumMB f z e
1030-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
1031-- producing an output occurrence each time. Discard the underlying
1033{-# INLINE mapAccumMaybeM_ #-}
1034mapAccumMaybeM_ :: 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)
1035mapAccumMaybeM_ f z e = do
1036 (_, result) <- mapAccumMaybeMB f z e
1039instance Reflex t => Accumulator t (Dynamic t) where
1040 accumMaybeM = accumMaybeMDyn
1041 mapAccumMaybeM = mapAccumMaybeMDyn
1043instance Reflex t => Accumulator t (Behavior t) where
1044 accumMaybeM = accumMaybeMB
1045 mapAccumMaybeM = mapAccumMaybeMB
1047instance Reflex t => Accumulator t (Event t) where
1048 accumMaybeM f z e = updated <$> accumMaybeM f z e
1049 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
1051-- | Create a new 'Event' by combining each occurence with the next value of the
1052-- list using the supplied function. If the list runs out of items, all
1053-- subsequent 'Event' occurrences will be ignored.
1054zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
1055zipListWithEvent f l e = do
1056 let f' a b = case a of
1057 h:t -> (Just t, Just $ f h b)
1058 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
1059 mapAccumMaybe_ f' l e
1061-- | Assign a number to each occurence of the given 'Event', starting from 0
1062{-# INLINE numberOccurrences #-}
1063numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
1064numberOccurrences = numberOccurrencesFrom 0
1066-- | Assign a number to each occurence of the given 'Event'
1067{-# INLINE numberOccurrencesFrom #-}
1068numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
1069numberOccurrencesFrom = mapAccum_ (\n a -> (n + 1, (n, a)))
1071-- | Assign a number to each occurence of the given 'Event'; discard the occurrences' values
1072{-# INLINE numberOccurrencesFrom_ #-}
1073numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
1074numberOccurrencesFrom_ = mapAccum_ (\n _ -> (n + 1, n))
1076-- | This is used to sample the value of a 'Behavior' using an 'Event'.
1078-- The '<@>' operator is intended to be used in conjunction with
1079-- the 'Applicative' instance for 'Behavior'.
1081-- This is useful when we want to combine the values of one 'Event' and
1082-- the value of several 'Behavior's at the time the 'Event' is firing.
1086-- > f :: a -> b -> c -> d
1087-- > b1 :: Behavior t a
1088-- > b2 :: Behavior t b
1093-- > f <$> b1 <*> b2 <@> e :: Event t d
1095-- in order to apply the function 'f' to the relevant values.
1097-- The alternative would be something like:
1099-- > attachWith (\(x1, x2) y -> f x1 x2 y) ((,) <$> b1 <*> b2) e :: Event t d
1101-- or a variation involing a custom data type to hold the combination of
1102-- 'Behavior's even when that combination might only ever be used by 'f'.
1104-- A more suggestive example might be:
1106-- > handleMouse <$> bPlayerState <*> bMousePosition <@> eMouseClick :: Event t (GameState -> GameState)
1108(<@>) :: Reflex t => Behavior t (a -> b) -> Event t a -> Event t b
1109(<@>) b = push $ \x -> do
1111 return . Just . f $ x
1114-- | An version of '<@>' that does not use the value of the 'Event'.
1116-- Alternatively, it is 'tag' in operator form.
1118-- This is useful when we want to combine the values of several
1119-- 'Behavior's at particular points in time using an 'Applicative'
1124-- > g :: a -> b -> d
1125-- > b1 :: Behavior t a
1126-- > b2 :: Behavior t b
1129-- where 'e' is firing at the points in time of interest.
1131-- Then we can use '<@':
1133-- > g <$> b1 <*> b2 <@ e :: Event t d
1135-- to combine the values of 'b1' and 'b2' at each of those points of time,
1136-- with the function 'g' being used to combine the values.
1138-- This is the same as '<@>' except that the 'Event' is being used only
1139-- to act as a trigger.
1140(<@) :: (Reflex t) => Behavior t b -> Event t a -> Event t b
1144-- | A 'Monad' that supports adjustment over time. After an action has been
1145-- run, if the given events fire, it will adjust itself so that its net effect
1146-- is as though it had originally been run with the new value. Note that there
1147-- is some issue here with persistent side-effects: obviously, IO (and some
1148-- other side-effects) cannot be undone, so it is up to the instance implementer
1149-- to determine what the best meaning for this class is in such cases.
1150class (Reflex t, Monad m) => MonadAdjust t m | m -> t where
1151 runWithReplace :: m a -> Event t (m b) -> m (a, Event t b)
1152 traverseIntMapWithKeyWithAdjust :: (IntMap.Key -> v -> m v') -> IntMap v -> Event t (PatchIntMap v) -> m (IntMap v', Event t (PatchIntMap v'))
1153 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'))
1154 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'))
1156instance MonadAdjust t m => MonadAdjust t (ReaderT r m) where
1157 runWithReplace a0 a' = do
1159 lift $ runWithReplace (runReaderT a0 r) $ fmap (`runReaderT` r) a'
1160 traverseIntMapWithKeyWithAdjust f dm0 dm' = do
1162 lift $ traverseIntMapWithKeyWithAdjust (\k v -> runReaderT (f k v) r) dm0 dm'
1163 traverseDMapWithKeyWithAdjust f dm0 dm' = do
1165 lift $ traverseDMapWithKeyWithAdjust (\k v -> runReaderT (f k v) r) dm0 dm'
1166 traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = do
1168 lift $ traverseDMapWithKeyWithAdjustWithMove (\k v -> runReaderT (f k v) r) dm0 dm'
1170sequenceDMapWithAdjust :: (GCompare k, MonadAdjust t m) => DMap k m -> Event t (PatchDMap k m) -> m (DMap k Identity, Event t (PatchDMap k Identity))
1171sequenceDMapWithAdjust = traverseDMapWithKeyWithAdjust $ \_ -> fmap Identity
1173sequenceDMapWithAdjustWithMove :: (GCompare k, MonadAdjust t m) => DMap k m -> Event t (PatchDMapWithMove k m) -> m (DMap k Identity, Event t (PatchDMapWithMove k Identity))
1174sequenceDMapWithAdjustWithMove = traverseDMapWithKeyWithAdjustWithMove $ \_ -> fmap Identity
1176mapMapWithAdjustWithMove :: 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'))
1177mapMapWithAdjustWithMove f m0 m' = do
1178 (out0 :: DMap (Const2 k v) (Constant v'), out') <- traverseDMapWithKeyWithAdjustWithMove (\(Const2 k) (Identity v) -> Constant <$> f k v) (mapToDMap m0) (const2PatchDMapWithMoveWith Identity <$> m')
1179 return (dmapToMapWith (\(Constant v') -> v') out0, patchDMapWithMoveToPatchMapWithMoveWith (\(Constant v') -> v') <$> out')
1185{-# INLINE pushAlwaysCheap #-}
1186pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
1187pushAlwaysCheap f = pushCheap (fmap Just . f)
1189{-# INLINE fmapMaybeCheap #-}
1190fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1191fmapMaybeCheap f = pushCheap $ return . f
1193{-# INLINE fforMaybeCheap #-}
1194fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
1195fforMaybeCheap = flip fmapMaybeCheap
1197{-# INLINE fforCheap #-}
1198fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
1199fforCheap = flip fmapCheap
1201{-# INLINE fmapCheap #-}
1202fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
1203fmapCheap f = pushCheap $ return . Just . f
1205{-# INLINE tagCheap #-}
1206tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
1207tagCheap b = pushAlwaysCheap $ \_ -> sample b
1209{-# INLINE mergeWithCheap #-}
1210mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
1211mergeWithCheap = mergeWithCheap' id
1213{-# INLINE mergeWithCheap' #-}
1214mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
1215mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
1217{-# INLINE mergeWithFoldCheap' #-}
1218mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
1219mergeWithFoldCheap' f es =
1220 fmapCheap (f . (\(h : t) -> h :| t) . IntMap.elems)
1222 . IntMap.fromDistinctAscList
1223 $ zip [0 :: Int ..] es
1225--------------------------------------------------------------------------------
1226-- Deprecated functions
1227--------------------------------------------------------------------------------
1229-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
1230-- occurs. If both occur at the same time they are combined using 'mappend'.
1231{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}
1232appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
1233appendEvents = alignWith $ mergeThese mappend
1235-- | Alias for 'headE'
1236{-# DEPRECATED onceE "Use 'headE' instead" #-}
1237onceE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
1240-- | Run both sides of a 'These' monadically, combining the results.
1241{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
1242#ifdef USE_TEMPLATE_HASKELL
1243{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
1245sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
1246sequenceThese t = case t of
1247 This ma -> fmap This ma
1248 These ma mb -> liftM2 These ma mb
1249 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