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
37 -- ** 'fan'-related types
39 -- ** 'Incremental'-related types
40 -- * Convenience functions
43 -- ** Combining 'Event's
47 , mergeMapIncrementalWithMove
52 -- ** Breaking up 'Event's
61 -- ** Switching between 'Event's
64 -- ** Using 'Event's to sample 'Behavior's
69 -- ** Blocking an 'Event' based on a 'Behavior'
71 -- ** Combining 'Dynamic's
72 , distributeDMapOverDynPure
73 , distributeListOverDyn
74 , distributeListOverDynWith
77 -- ** Accumulating state
85 , numberOccurrencesFrom
93 -- * Debugging functions
98 , unsafeMapIncremental
103 -- * Miscellaneous convenience functions
106 , sequenceDMapWithAdjust
107 , sequenceDMapWithAdjustWithMove
108 , mapMapWithAdjustWithMove
109 -- * Deprecated functions
121#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
142 , unsafeBuildIncremental
144 , mergeIncrementalWithMove
147 , incrementalToDynamic
154import Control.Applicative
155import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
156import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
157import Control.Monad.State.Strict hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
158import Control.Monad.Trans.Cont (ContT ())
159import Control.Monad.Trans.Except (ExceptT ())
160import Control.Monad.Trans.RWS (RWST ())
161import Control.Monad.Trans.Writer (WriterT ())
166import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
167import qualified Data.Dependent.Map as DMap
170import Data.Functor.Bind hiding (join)
171import qualified Data.Functor.Bind as Bind
172import Data.Functor.Constant
173import Data.Functor.Misc
174import Data.Functor.Plus
175import Data.List.NonEmpty (NonEmpty (..))
178import Data.Monoid hiding (Alt, (<>))
179import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
182import Data.Traversable
183import Data.Type.Coercion
184import Reflex.FunctorMaybe
187#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
188import Reflex.Spider.Internal (EventM, Global, HasSpiderTimeline, SpiderHost (..), SpiderHostFrame (..),
189 SpiderPullM, SpiderPushM (..), behaviorHoldIdentity, dynamicConst,
190 dynamicCurrent, dynamicDynIdentity, dynamicHold, dynamicHoldIdentity,
191 dynamicUpdated, newMapDyn, readBehaviorTracked, readBehaviorUntracked,
192 runFrame, runSpiderHostFrame)
193import qualified Reflex.Spider.Internal
194import qualified Reflex.Spider.Internal as S
198-- Note: must come last to silence warnings due to AMP on GHC < 7.10
199import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)
201import Debug.Trace (trace)
203#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
204#include "Spider/SpiderTimeline.include.hs"
207-- | The 'Reflex' class contains all the primitive functionality needed for
208-- Functional Reactive Programming (FRP). The @t@ type parameter indicates
209-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
210-- and the type of the timeline determines the FRP engine to be used. For most
211-- purposes, the 'Reflex.Spider' implementation is recommended.
212class ( MonadHold t (PushM t)
213 , MonadSample t (PullM t)
215 , Functor (Dynamic t)
216 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
218#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
219 , t ~ SpiderTimeline Global
222 -- | A container for a value that can change over time. 'Behavior's can be
223 -- sampled at will, but it is not possible to be notified when they change
224 data Behavior t :: * -> *
225 -- | A stream of occurrences. During any given frame, an 'Event' is either
226 -- occurring or not occurring; if it is occurring, it will contain a value of
227 -- the given type (its "occurrence type")
228 data Event t :: * -> *
229 -- | A container for a value that can change over time and allows
230 -- notifications on changes. Basically a combination of a 'Behavior' and an
231 -- 'Event', with a rule that the 'Behavior' will change if and only if the
233 data Dynamic t :: * -> *
234 -- | An 'Incremental' is a more general form of a 'Dynamic'.
235 -- Instead of always fully replacing the value, only parts of it can be patched.
236 -- This is only needed for performance critical code via `mergeIncremental` to make small
237 -- changes to large values.
238 data Incremental t :: * -> *
239 -- | A monad for doing complex push-based calculations efficiently
240 type PushM t :: * -> *
241 -- | A monad for doing complex pull-based calculations efficiently
242 type PullM t :: * -> *
243#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
244 -- | An 'Event' with no occurrences
246 -- | Create a 'Behavior' that always has the given value
247 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
248 -- | Create an 'Event' from another 'Event'; the provided function can sample
249 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
250 -- (Just) or non-occurring (Nothing) result
251 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
252 -- | 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.
253 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
254 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
255 -- recomputed whenever any of the read 'Behavior's changes
256 pull :: PullM t a -> Behavior t a
257 -- | Merge a collection of events; the resulting 'Event' will only occur if at
258 -- least one input event is occuring, and will contain all of the input keys
259 -- that are occurring simultaneously
260 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
261 -- | Efficiently fan-out an event to many destinations. This function should
262 -- be partially applied, and then the result applied repeatedly to create
264 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
265 -- | Create an 'Event' that will occur whenever the currently-selected input
267 switch :: Behavior t (Event t a) -> Event t a
268 -- | Create an 'Event' that will occur whenever the input event is occurring
269 -- and its occurrence value, another 'Event', is also occurring
270 coincidence :: Event t (Event t a) -> Event t a
271 -- | Extract the 'Behavior' of a 'Dynamic'.
272 current :: Dynamic t a -> Behavior t a
273 -- | Extract the 'Event' of the 'Dynamic'.
274 updated :: Dynamic t a -> Event t a
275 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
276 -- recent firing of the given 'Event', if any.
277 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
278 -- | Create a new 'Incremental'. The given 'PullM''s value must always change
279 -- in the same way that the accumulated application of patches would change
281 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
282 -- | Create a merge whose parents can change over time
283 mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
284 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
285 mergeIncrementalWithMove :: GCompare k => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
286 -- | Extract the 'Behavior' component of an 'Incremental'
287 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
288 -- | Extract the 'Event' component of an 'Incremental'
289 updatedIncremental :: Patch p => Incremental t p -> Event t p
290 -- | Convert an 'Incremental' to a 'Dynamic'
291 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
292 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
294 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
295 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
297 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
298 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
300 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
303#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
304instance t ~ SpiderTimeline Global => Reflex t where
305 newtype Behavior t a = SpiderBehavior { unSpiderBehavior :: Reflex.Spider.Internal.Behavior Global a }
306 newtype Event t a = SpiderEvent { unSpiderEvent :: Reflex.Spider.Internal.Event Global a }
307 newtype Dynamic t a = SpiderDynamic { unSpiderDynamic :: Reflex.Spider.Internal.Dynamic Global (Identity a) } -- deriving (Functor, Applicative, Monad)
308 newtype Incremental t p = SpiderIncremental { unSpiderIncremental :: Reflex.Spider.Internal.Dynamic Global p }
309 type PullM t = SpiderPullM Global
310 type PushM t = SpiderPushM Global
311never :: Reflex t => Event t a
312constant :: Reflex t => a -> Behavior t a
313push :: Reflex t => (a -> PushM t (Maybe b)) -> Event t a -> Event t b
314pushCheap :: Reflex t => (a -> PushM t (Maybe b)) -> Event t a -> Event t b
315pull :: Reflex t => PullM t a -> Behavior t a
316merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)
317fan :: (Reflex t, GCompare k) => Event t (DMap k Identity) -> EventSelector t k
318switch :: Reflex t => Behavior t (Event t a) -> Event t a
319coincidence :: Reflex t => Event t (Event t a) -> Event t a
320current :: Reflex t => Dynamic t a -> Behavior t a
321updated :: Reflex t => Dynamic t a -> Event t a
322unsafeBuildDynamic :: Reflex t => PullM t a -> Event t a -> Dynamic t a
323unsafeBuildIncremental :: (Reflex t, Patch p) => PullM t (PatchTarget p) -> Event t p -> Incremental t p
324mergeIncremental :: (Reflex t, GCompare k) => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
325mergeIncrementalWithMove :: (Reflex t, GCompare k) => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
326currentIncremental :: (Reflex t, Patch p) => Incremental t p -> Behavior t (PatchTarget p)
327updatedIncremental :: (Reflex t, Patch p) => Incremental t p -> Event t p
328incrementalToDynamic :: (Reflex t, Patch p) => Incremental t p -> Dynamic t (PatchTarget p)
329behaviorCoercion :: Reflex t => Coercion a b -> Coercion (Behavior t a) (Behavior t b)
330eventCoercion :: Reflex t => Coercion a b -> Coercion (Event t a) (Event t b)
331dynamicCoercion :: Reflex t => Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
333never = SpiderEvent S.eventNever
334{-# INLINE constant #-}
335constant = SpiderBehavior . S.behaviorConst
337push f = SpiderEvent . S.push (coerce f) . unSpiderEvent
338{-# INLINE pushCheap #-}
339pushCheap f = SpiderEvent . S.pushCheap (coerce f) . unSpiderEvent
341pull = SpiderBehavior . S.pull . coerce
343merge = SpiderEvent . S.merge . S.dynamicConst . (coerce :: DMap k (Event (SpiderTimeline x)) -> DMap k (S.Event x))
345fan e = EventSelector $ SpiderEvent . S.select (S.fan (unSpiderEvent e))
347switch = SpiderEvent . S.switch . (coerce :: S.Behavior x (Event (SpiderTimeline x) a) -> S.Behavior x (S.Event x a)) . unSpiderBehavior
348{-# INLINE coincidence #-}
349coincidence = SpiderEvent . S.coincidence . (coerce :: S.Event x (Event (SpiderTimeline x) a) -> S.Event x (S.Event x a)) . unSpiderEvent
350{-# INLINE current #-}
351current = SpiderBehavior . S.dynamicCurrent . unSpiderDynamic
352{-# INLINE updated #-}
353updated = coerceEvent . SpiderEvent . dynamicUpdated . unSpiderDynamic
354{-# INLINE unsafeBuildDynamic #-}
355unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ S.unsafeBuildDynamic (coerce readV0) $ coerce $ unSpiderEvent v'
356{-# INLINE unsafeBuildIncremental #-}
357unsafeBuildIncremental readV0 dv = SpiderIncremental $ S.dynamicDyn $ S.unsafeBuildDynamic (coerce readV0) $ unSpiderEvent dv
358{-# INLINE mergeIncremental #-}
359mergeIncremental = SpiderEvent . S.merge . (unsafeCoerce :: S.Dynamic x (PatchDMap k (Event (SpiderTimeline x))) -> S.Dynamic x (PatchDMap k (S.Event x))) . unSpiderIncremental
360{-# INLINE mergeIncrementalWithMove #-}
361mergeIncrementalWithMove = SpiderEvent . S.mergeWithMove . (unsafeCoerce :: S.Dynamic x (PatchDMapWithMove k (Event (SpiderTimeline x))) -> S.Dynamic x (PatchDMapWithMove k (S.Event x))) . unSpiderIncremental
362{-# INLINE currentIncremental #-}
363currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental
364{-# INLINE updatedIncremental #-}
365updatedIncremental = SpiderEvent . dynamicUpdated . unSpiderIncremental
366{-# INLINE incrementalToDynamic #-}
367incrementalToDynamic (SpiderIncremental i) = SpiderDynamic $ dynamicDynIdentity $ S.unsafeBuildDynamic (readBehaviorUntracked $ dynamicCurrent i) $ flip S.push (dynamicUpdated i) $ \p -> do
368 c <- readBehaviorUntracked $ dynamicCurrent i
369 return $ Identity <$> apply p c
370eventCoercion Coercion = Coercion
371behaviorCoercion Coercion = Coercion
372dynamicCoercion = unsafeCoerce
375-- | Coerce a 'Behavior' between representationally-equivalent value types
376coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
377coerceBehavior = coerceWith $ behaviorCoercion Coercion
379-- | Coerce an 'Event' between representationally-equivalent occurrence types
380coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
381coerceEvent = coerceWith $ eventCoercion Coercion
383-- | Coerce a 'Dynamic' between representationally-equivalent value types
384coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
385coerceDynamic = coerceWith $ dynamicCoercion Coercion
387-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
388-- _must_ change when and only when the 'Event' fires, such that the
389-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
390-- if this is not the case, the resulting 'Dynamic' will behave
391-- nondeterministically.
392unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
393unsafeDynamic = unsafeBuildDynamic . sample
395-- | Construct a 'Dynamic' value that never changes
396constDyn :: Reflex t => a -> Dynamic t a
399instance (Reflex t, Default a) => Default (Dynamic t a) where
402-- | 'MonadSample' designates monads that can read the current value of a
403-- 'Behavior'. This includes both 'PullM' and 'PushM'.
404class (Applicative m, Monad m) => MonadSample t m | m -> t where
405 -- | Get the current value in the 'Behavior'
406 sample :: Behavior t a -> m a
408-- | 'MonadHold' designates monads that can create new 'Behavior's based on
409-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
410-- is required to create any stateful computations with Reflex.
411class MonadSample t m => MonadHold t m where
412 -- | Create a new 'Behavior' whose value will initially be equal to the given
413 -- value and will be updated whenever the given 'Event' occurs. The update
414 -- takes effect immediately after the 'Event' occurs; if the occurrence that
415 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
416 -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new
418 hold :: a -> Event t a -> m (Behavior t a)
419 default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)
420 hold v0 = lift . hold v0
421 -- | Create a 'Dynamic' value using the given initial value that changes every
422 -- time the 'Event' occurs.
423 holdDyn :: a -> Event t a -> m (Dynamic t a)
424 default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)
425 holdDyn v0 = lift . holdDyn v0
426 -- | Create an 'Incremental' value using the given initial value that changes
427 -- every time the 'Event' occurs.
428 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
429 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
430 holdIncremental v0 = lift . holdIncremental v0
431 buildDynamic :: PullM t a -> Event t a -> m (Dynamic t a)
432 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
433 buildDynamic getV0 = lift . buildDynamic getV0
435-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
436-- key. This is much more efficient than filtering for each key with
438newtype EventSelector t k = EventSelector
439 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
440 -- determined by the type of the key, so this can be used to fan-out
441 -- 'Event's whose sub-'Event's have different types.
443 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
444 -- (but equivalent to) using 'fmapMaybe' to select only the relevant
445 -- occurrences of an 'Event'.
446 select :: forall a. k a -> Event t a
449--------------------------------------------------------------------------------
451--------------------------------------------------------------------------------
453instance MonadSample t m => MonadSample t (ReaderT r m) where
454 sample = lift . sample
456instance MonadHold t m => MonadHold t (ReaderT r m) where
457 hold a0 = lift . hold a0
458 holdDyn a0 = lift . holdDyn a0
459 holdIncremental a0 = lift . holdIncremental a0
460 buildDynamic a0 = lift . buildDynamic a0
462instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
463 sample = lift . sample
465instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
466 hold a0 = lift . hold a0
467 holdDyn a0 = lift . holdDyn a0
468 holdIncremental a0 = lift . holdIncremental a0
469 buildDynamic a0 = lift . buildDynamic a0
471instance MonadSample t m => MonadSample t (StateT s m) where
472 sample = lift . sample
474instance MonadHold t m => MonadHold t (StateT s m) where
475 hold a0 = lift . hold a0
476 holdDyn a0 = lift . holdDyn a0
477 holdIncremental a0 = lift . holdIncremental a0
478 buildDynamic a0 = lift . buildDynamic a0
480instance MonadSample t m => MonadSample t (ExceptT e m) where
481 sample = lift . sample
483instance MonadHold t m => MonadHold t (ExceptT e m) where
484 hold a0 = lift . hold a0
485 holdDyn a0 = lift . holdDyn a0
486 holdIncremental a0 = lift . holdIncremental a0
488instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
489 sample = lift . sample
491instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
492 hold a0 = lift . hold a0
493 holdDyn a0 = lift . holdDyn a0
494 holdIncremental a0 = lift . holdIncremental a0
496instance MonadSample t m => MonadSample t (ContT r m) where
497 sample = lift . sample
499instance MonadHold t m => MonadHold t (ContT r m) where
500 hold a0 = lift . hold a0
501 holdDyn a0 = lift . holdDyn a0
502 holdIncremental a0 = lift . holdIncremental a0
504--------------------------------------------------------------------------------
505-- Convenience functions
506--------------------------------------------------------------------------------
508-- | Create an 'Event' from another 'Event'. The provided function can sample
509-- 'Behavior's and hold 'Event's.
510pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
511pushAlways f = push (fmap Just . f)
513-- | Flipped version of 'fmap'.
514ffor :: Functor f => f a -> (a -> b) -> f b
517instance Reflex t => Applicative (Behavior t) where
519 f <*> x = pull $ sample f `ap` sample x
523instance Reflex t => Apply (Behavior t) where
526instance Reflex t => Bind (Behavior t) where
529instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
531 fromRational = pure . fromRational
534instance Reflex t => Functor (Behavior t) where
535 fmap f = pull . fmap f . sample
537instance (Reflex t, IsString a) => IsString (Behavior t a) where
538 fromString = pure . fromString
540instance Reflex t => Monad (Behavior t) where
541 a >>= f = pull $ sample a >>= sample . f
542 -- 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.
544 fail = error "Monad (Behavior t) does not support fail"
546instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
547 mempty = constant mempty
548 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
549 mconcat = pull . fmap mconcat . mapM sample
551instance (Reflex t, Num a) => Num (Behavior t a) where
556 fromInteger = pure . fromInteger
560instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
561 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
562 sconcat = pull . fmap sconcat . mapM sample
563#if MIN_VERSION_semigroups(0,17,0)
564 stimes n = fmap $ stimes n
566 times1p n = fmap $ times1p n
569-- | Flipped version of 'fmapMaybe'.
570fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b
571fforMaybe = flip fmapMaybe
573-- | Filter 'f a' using the provided predicate.
574-- Relies on 'fforMaybe'.
575ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
576ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
578-- | Left-biased event union (prefers left event on simultaneous
580instance Reflex t => Alt (Event t) where
581 ev1 <!> ev2 = leftmost [ev1, ev2]
583-- | 'Event' intersection (convenient interface to 'coincidence').
584instance Reflex t => Apply (Event t) where
585 evf <.> evx = coincidence (fmap (<$> evx) evf)
587-- | 'Event' intersection (convenient interface to 'coincidence').
588instance Reflex t => Bind (Event t) where
589 evx >>- f = coincidence (f <$> evx)
592instance Reflex t => Functor (Event t) where
594 fmap f = fmapMaybe $ Just . f
596instance Reflex t => FunctorMaybe (Event t) where
597 {-# INLINE fmapMaybe #-}
598 fmapMaybe f = push $ return . f
600-- | Never: @'zero' = 'never'@.
601instance Reflex t => Plus (Event t) where
604-- | Replace each occurrence value of the 'Event' with the value of the
605-- 'Behavior' at the time of that occurrence.
606tag :: Reflex t => Behavior t b -> Event t a -> Event t b
607tag b = pushAlways $ \_ -> sample b
609-- | Create a new 'Event' that combines occurences of supplied 'Event' with the
610-- current value of the 'Behavior'.
611attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
612attach = attachWith (,)
614-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
615-- combining it with the current value of the 'Behavior'.
616attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
617attachWith f = attachWithMaybe $ \a b -> Just $ f a b
619-- | Create a new 'Event' by combining each occurence with the current value of
620-- the 'Behavior'. The occurrence is discarded if the combining function returns
622attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
623attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
625-- | Create a new 'Event' that only occurs only once, on the first occurence of
626-- the supplied 'Event'.
627headE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
629 rec be <- hold e $ fmap (const never) e'
633-- | Create a new 'Event' that occurs on all but the first occurence of the
635tailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
636tailE e = snd <$> headTailE e
638-- | Create a tuple of two 'Event's with the first one occuring only the first
639-- time the supplied 'Event' occurs and the second occuring on all but the first
641headTailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a, Event t a)
644 be <- hold never $ fmap (const e) eHead
645 return (eHead, switch be)
647-- | Starting at the current time, fire all the occurrences of the 'Event' for
648-- which the given predicate returns 'True'. When 'False' is returned, do not
649-- fire, and permanently stop firing, even if 'True' values are encountered
651takeWhileE :: forall t m a. (Reflex t, MonadFix m, MonadHold t m) => (a -> Bool) -> Event t a -> m (Event t a)
653 rec let (eFalse, eTrue) = fanEither $ ffor e' $ \a -> if f a
660-- | Split the supplied 'Event' into two individual 'Event's occuring at the
661-- same time with the respective values from the tuple.
662splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
663splitE e = (fmap fst e, fmap snd e)
665-- | Print the supplied 'String' and the value of the 'Event' on each
666-- occurence. This should /only/ be used for debugging.
668-- Note: As with Debug.Trace.trace, the message will only be printed if the
669-- 'Event' is actually used.
670traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
671traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
673-- | Print the output of the supplied function on each occurence of the
674-- 'Event'. This should /only/ be used for debugging.
676-- Note: As with Debug.Trace.trace, the message will only be printed if the
677-- 'Event' is actually used.
678traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
679traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
681instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
682 (<>) = alignWith (mergeThese (<>))
683 sconcat = fmap sconcat . mergeList . toList
684#if MIN_VERSION_semigroups(0,17,0)
685 stimes n = fmap $ stimes n
687 times1p n = fmap $ times1p n
690instance (Semigroup a, Reflex t) => Monoid (Event t a) where
693 mconcat = fmap sconcat . mergeList
695-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
696-- list occurs. If multiple occur at the same time they are folded from the left
697-- with the given function.
698{-# INLINE mergeWith #-}
699mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
700mergeWith = mergeWith' id
702{-# INLINE mergeWith' #-}
703mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
704mergeWith' f g es = fmap (Prelude.foldl1 g . map (\(Const2 _ :=> Identity v) -> f v) . DMap.toList)
706 . DMap.fromDistinctAscList
707 . map (\(k, v) -> Const2 k :=> v)
708 $ zip [0 :: Int ..] es
710-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
711-- list occurs. If multiple occur at the same time the value is the value of the
713{-# INLINE leftmost #-}
714leftmost :: Reflex t => [Event t a] -> Event t a
715leftmost = mergeWith const
717-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
718-- list occurs and has a list of the values of all 'Event's occuring at that
720mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
722mergeList es = mergeWithFoldCheap' id es
724unsafeMapIncremental :: (Reflex t, Patch p, Patch p') => (PatchTarget p -> PatchTarget p') -> (p -> p') -> Incremental t p -> Incremental t p'
725unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
727-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
728-- occurs if at least one of them occurs and has a map of values of all 'Event's
729-- occuring at that time.
730mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
731mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
733-- | Create a merge whose parents can change over time
734mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
735mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
737-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
738mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
739mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
741-- | Split the event into separate events for 'Left' and 'Right' values.
742fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
744 let justLeft = either Just (const Nothing)
745 justRight = either (const Nothing) Just
746 in (fmapMaybe justLeft e, fmapMaybe justRight e)
748-- | Split the event into separate events for 'This' and 'That' values,
749-- allowing them to fire simultaneously when the input value is 'These'.
750fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
752 let this (This x) = Just x
753 this (These x _) = Just x
755 that (That y) = Just y
756 that (These _ y) = Just y
758 in (fmapMaybe this e, fmapMaybe that e)
760-- | Split the event into an 'EventSelector' that allows efficient selection of
761-- the individual 'Event's.
762fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
763fanMap = fan . fmap mapToDMap
765-- | Switches to the new event whenever it receives one. Whenever a new event
766-- is provided, if it is firing, its value will be the resulting event's value;
767-- if it is not firing, but the old one is, the old one's value will be used.
768switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
769switchPromptly ea0 eea = do
771 let eLag = switch bea
772 eCoincidences = coincidence eea
773 return $ leftmost [eCoincidences, eLag]
775-- | 'switch'es to a new event whenever it receives one. At the moment of
776-- switching, the old event will be ignored if it fires, and the new one will be
777-- used if it fires; this is the opposite of 'switch', which will use only the
779switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
780switchPromptOnly e0 e' = do
781 eLag <- switch <$> hold e0 e'
782 return $ coincidence $ leftmost [e', eLag <$ eLag]
784instance Reflex t => Align (Event t) where
786 align = alignEventWithMaybe Just
788-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
789-- the 'Behavior' is true at the time of occurence.
790gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
791gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
793-- | Create a new behavior given a starting behavior and switch to a the behvior
794-- carried by the event when it fires.
795switcher :: (Reflex t, MonadHold t m)
796 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
797switcher b eb = pull . (sample <=< sample) <$> hold b eb
799-- | Combine two 'Dynamic's. The result will change whenever either (or both)
800-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
801zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
802zipDyn = zipDynWith (,)
804-- | Combine two 'Dynamic's with a combining function. The result will change
805-- whenever either (or both) input 'Dynamic' changes.
806-- More efficient than liftA2.
807zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
809 let eab = align (updated da) (updated db)
810 ec = flip push eab $ \o -> do
813 b <- sample $ current db
816 a <- sample $ current da
818 These a b -> return (a, b)
819 return $ Just $ f a b
820 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
822instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
823 mconcat = distributeListOverDynWith mconcat
824 mempty = constDyn mempty
825 mappend = zipDynWith mappend
827-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
828-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
829-- through the use of multiple uses of 'zipWithDyn' or 'Applicative' operators.
830distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
831distributeDMapOverDynPure dm = case DMap.toList dm of
832 [] -> constDyn DMap.empty
833 [k :=> v] -> fmap (DMap.singleton k . Identity) v
835 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
836 edmPre = merge $ DMap.map updated dm
837 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
838 olds <- sample $ current result
839 return $ DMap.unionWithKey (\_ _ new -> new) olds news
842-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
843distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
844distributeListOverDyn = distributeListOverDynWith id
846-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
847distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
848distributeListOverDynWith f = fmap (f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]
850-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
851-- unless the second supplied 'Event' occurs simultaneously.
852difference :: Reflex t => Event t a -> Event t b -> Event t a
853difference = alignEventWithMaybe $ \case
857alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
858alignEventWithMaybe f ea eb =
859 fmapMaybe (f <=< dmapToThese)
861 $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
864--------------------------------------------------------------------------------
866--------------------------------------------------------------------------------
868-- | An 'Accumulator' type can be built by accumulating occurrences of an
870class Reflex t => Accumulator t f | f -> t where
871 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
872 accum f = accumMaybe $ \v o -> Just $ f v o
873 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
874 accumM f = accumMaybeM $ \v o -> Just <$> f v o
875 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
876 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
877 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
878 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
879 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
880 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
881 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
882 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
883 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
884 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
886-- | Accumulate occurrences of an 'Event', producing an output occurrence each
887-- time. Discard the underlying 'Accumulator'.
888mapAccum_ :: 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)
890 (_ :: Behavior t a, result) <- mapAccum f z e
893-- | Accumulate occurrences of an 'Event', possibly producing an output
894-- occurrence each time. Discard the underlying 'Accumulator'.
895mapAccumMaybe_ :: 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)
896mapAccumMaybe_ f z e = do
897 (_ :: Behavior t a, result) <- mapAccumMaybe f z e
900-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
901-- an output occurrence each time. Discard the underlying 'Accumulator'.
902mapAccumM_ :: 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)
904 (_ :: Behavior t a, result) <- mapAccumM f z e
907-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
908-- producing an output occurrence each time. Discard the underlying
910mapAccumMaybeM_ :: 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)
911mapAccumMaybeM_ f z e = do
912 (_ :: Behavior t a, result) <- mapAccumMaybeM f z e
915instance Reflex t => Accumulator t (Dynamic t) where
916 accumMaybeM f z e = do
917 rec let e' = flip push e $ \o -> do
918 v <- sample $ current d'
922 mapAccumMaybeM f z e = do
923 rec let e' = flip push e $ \o -> do
924 v <- sample $ current d'
926 return $ case result of
927 (Nothing, Nothing) -> Nothing
929 d' <- holdDyn z $ fmapMaybe fst e'
930 return (d', fmapMaybe snd e')
932instance Reflex t => Accumulator t (Behavior t) where
933 accumMaybeM f z e = current <$> accumMaybeM f z e
934 mapAccumMaybeM f z e = first current <$> mapAccumMaybeM f z e
936instance Reflex t => Accumulator t (Event t) where
937 accumMaybeM f z e = updated <$> accumMaybeM f z e
938 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
940-- | Create a new 'Event' by combining each occurence with the next value of the
941-- list using the supplied function. If the list runs out of items, all
942-- subsequent 'Event' occurrences will be ignored.
943zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
944zipListWithEvent f l e = do
945 let f' a b = case a of
946 h:t -> (Just t, Just $ f h b)
947 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
948 mapAccumMaybe_ f' l e
950-- | Assign a number to each occurence of the given 'Event', starting from 0
951numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
952numberOccurrences = numberOccurrencesFrom 0
954-- | Assign a number to each occurence of the given 'Event'
955numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
956numberOccurrencesFrom = mapAccum_ (\n a -> (n + 1, (n, a)))
958-- | This is used to sample the value of a 'Behavior' using an 'Event'.
960-- The '<@>' operator is intended to be used in conjunction with
961-- the 'Applicative' instance for 'Behavior'.
963-- This is useful when we want to combine the values of one 'Event' and
964-- the value of several 'Behavior's at the time the 'Event' is firing.
968-- > f :: a -> b -> c -> d
969-- > b1 :: Behavior t a
970-- > b2 :: Behavior t b
975-- > f <$> b1 <*> b2 <@> e :: Event t d
977-- in order to apply the function 'f' to the relevant values.
979-- The alternative would be something like:
981-- > attachWith (\(x1, x2) y -> f x1 x2 y) ((,) <$> b1 <*> b2) e :: Event t d
983-- or a variation involing a custom data type to hold the combination of
984-- 'Behavior's even when that combination might only ever be used by 'f'.
986-- A more suggestive example might be:
988-- > handleMouse <$> bPlayerState <*> bMousePosition <@> eMouseClick :: Event t (GameState -> GameState)
990(<@>) :: Reflex t => Behavior t (a -> b) -> Event t a -> Event t b
991(<@>) b = push $ \x -> do
993 return . Just . f $ x
996-- | An version of '<@>' that does not use the value of the 'Event'.
998-- Alternatively, it is 'tag' in operator form.
1000-- This is useful when we want to combine the values of several
1001-- 'Behavior's at particular points in time using an 'Applicative'
1006-- > g :: a -> b -> d
1007-- > b1 :: Behavior t a
1008-- > b2 :: Behavior t b
1011-- where 'e' is firing at the points in time of interest.
1013-- Then we can use '<@':
1015-- > g <$> b1 <*> b2 <@ e :: Event t d
1017-- to combine the values of 'b1' and 'b2' at each of those points of time,
1018-- with the function 'g' being used to combine the values.
1020-- This is the same as '<@>' except that the 'Event' is being used only
1021-- to act as a trigger.
1022(<@) :: (Reflex t) => Behavior t b -> Event t a -> Event t b
1026-- | A 'Monad' that supports adjustment over time. After an action has been
1027-- run, if the given events fire, it will adjust itself so that its net effect
1028-- is as though it had originally been run with the new value. Note that there
1029-- is some issue here with persistent side-effects: obviously, IO (and some
1030-- other side-effects) cannot be undone, so it is up to the instance implementer
1031-- to determine what the best meaning for this class is in such cases.
1032class (Reflex t, Monad m) => MonadAdjust t m | m -> t where
1033 runWithReplace :: m a -> Event t (m b) -> m (a, Event t b)
1034 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'))
1035 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'))
1037instance MonadAdjust t m => MonadAdjust t (ReaderT r m) where
1038 runWithReplace a0 a' = do
1040 lift $ runWithReplace (runReaderT a0 r) $ fmap (`runReaderT` r) a'
1041 traverseDMapWithKeyWithAdjust f dm0 dm' = do
1043 lift $ traverseDMapWithKeyWithAdjust (\k v -> runReaderT (f k v) r) dm0 dm'
1044 traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = do
1046 lift $ traverseDMapWithKeyWithAdjustWithMove (\k v -> runReaderT (f k v) r) dm0 dm'
1048sequenceDMapWithAdjust :: (GCompare k, MonadAdjust t m) => DMap k m -> Event t (PatchDMap k m) -> m (DMap k Identity, Event t (PatchDMap k Identity))
1049sequenceDMapWithAdjust = traverseDMapWithKeyWithAdjust $ \_ -> fmap Identity
1051sequenceDMapWithAdjustWithMove :: (GCompare k, MonadAdjust t m) => DMap k m -> Event t (PatchDMapWithMove k m) -> m (DMap k Identity, Event t (PatchDMapWithMove k Identity))
1052sequenceDMapWithAdjustWithMove = traverseDMapWithKeyWithAdjustWithMove $ \_ -> fmap Identity
1054mapMapWithAdjustWithMove :: 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'))
1055mapMapWithAdjustWithMove f m0 m' = do
1056 (out0 :: DMap (Const2 k v) (Constant v'), out') <- traverseDMapWithKeyWithAdjustWithMove (\(Const2 k) (Identity v) -> Constant <$> f k v) (mapToDMap m0) (const2PatchDMapWithMoveWith Identity <$> m')
1057 return (dmapToMapWith (\(Constant v') -> v') out0, patchDMapWithMoveToPatchMapWithMoveWith (\(Constant v') -> v') <$> out')
1063{-# INLINE pushAlwaysCheap #-}
1064pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
1065pushAlwaysCheap f = pushCheap (fmap Just . f)
1067{-# INLINE fmapMaybeCheap #-}
1068fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1069fmapMaybeCheap f = pushCheap $ return . f
1071{-# INLINE fforMaybeCheap #-}
1072fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
1073fforMaybeCheap = flip fmapMaybeCheap
1075{-# INLINE fforCheap #-}
1076fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
1077fforCheap = flip fmapCheap
1079{-# INLINE fmapCheap #-}
1080fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
1081fmapCheap f = pushCheap $ return . Just . f
1083{-# INLINE tagCheap #-}
1084tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
1085tagCheap b = pushAlwaysCheap $ \_ -> sample b
1087{-# INLINE mergeWithCheap #-}
1088mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
1089mergeWithCheap = mergeWithCheap' id
1091{-# INLINE mergeWithCheap' #-}
1092mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
1093mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
1095{-# INLINE mergeWithFoldCheap' #-}
1096mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
1097mergeWithFoldCheap' f es =
1098 fmapCheap (f . (\(h : t) -> h :| t) . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList)
1100 . DMap.fromDistinctAscList
1101 . map (\(k, v) -> Const2 k :=> v)
1102 $ zip [0 :: Int ..] es
1104--------------------------------------------------------------------------------
1105-- Deprecated functions
1106--------------------------------------------------------------------------------
1108-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
1109-- occurs. If both occur at the same time they are combined using 'mappend'.
1110{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}
1111appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
1112appendEvents = alignWith $ mergeThese mappend
1114-- | Alias for 'headE'
1115{-# DEPRECATED onceE "Use 'headE' instead" #-}
1116onceE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
1119-- | Run both sides of a 'These' monadically, combining the results.
1120{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
1121#ifdef USE_TEMPLATE_HASKELL
1122{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
1124sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
1125sequenceThese t = case t of
1126 This ma -> fmap This ma
1127 These ma mb -> liftM2 These ma mb
1128 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