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
107 , sequenceDMapWithAdjust
108 , sequenceDMapWithAdjustWithMove
109 , mapMapWithAdjustWithMove
110 -- * Deprecated functions
122#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
143 , unsafeBuildIncremental
145 , mergeIncrementalWithMove
148 , incrementalToDynamic
155import Control.Applicative
156import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
157import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
158import Control.Monad.State.Strict hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
159import Control.Monad.Trans.Cont (ContT ())
160import Control.Monad.Trans.Except (ExceptT ())
161import Control.Monad.Trans.RWS (RWST ())
162import Control.Monad.Trans.Writer (WriterT ())
167import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
168import qualified Data.Dependent.Map as DMap
171import Data.Functor.Bind hiding (join)
172import qualified Data.Functor.Bind as Bind
173import Data.Functor.Constant
174import Data.Functor.Misc
175import Data.Functor.Plus
176import Data.List.NonEmpty (NonEmpty (..))
179import Data.Monoid hiding (Alt, (<>))
180import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
183import Data.Traversable
184import Data.Type.Coercion
185import Reflex.FunctorMaybe
188#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
189import Reflex.Spider.Internal (EventM, Global, HasSpiderTimeline, SpiderHost (..), SpiderHostFrame (..),
190 SpiderPullM, SpiderPushM (..), behaviorHoldIdentity, dynamicConst,
191 dynamicCurrent, dynamicDynIdentity, dynamicHold, dynamicHoldIdentity,
192 dynamicUpdated, newMapDyn, readBehaviorTracked, readBehaviorUntracked,
193 runFrame, runSpiderHostFrame)
194import qualified Reflex.Spider.Internal
195import qualified Reflex.Spider.Internal as S
199-- Note: must come last to silence warnings due to AMP on GHC < 7.10
200import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)
202import Debug.Trace (trace)
204#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
205#include "Spider/SpiderTimeline.include.hs"
208-- | The 'Reflex' class contains all the primitive functionality needed for
209-- Functional Reactive Programming (FRP). The @t@ type parameter indicates
210-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
211-- and the type of the timeline determines the FRP engine to be used. For most
212-- purposes, the 'Reflex.Spider' implementation is recommended.
213class ( MonadHold t (PushM t)
214 , MonadSample t (PullM t)
216 , Functor (Dynamic t)
217 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
219#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
220 , t ~ SpiderTimeline Global
223 -- | A container for a value that can change over time. 'Behavior's can be
224 -- sampled at will, but it is not possible to be notified when they change
225 data Behavior t :: * -> *
226 -- | A stream of occurrences. During any given frame, an 'Event' is either
227 -- occurring or not occurring; if it is occurring, it will contain a value of
228 -- the given type (its "occurrence type")
229 data Event t :: * -> *
230 -- | A container for a value that can change over time and allows
231 -- notifications on changes. Basically a combination of a 'Behavior' and an
232 -- 'Event', with a rule that the 'Behavior' will change if and only if the
234 data Dynamic t :: * -> *
235 -- | An 'Incremental' is a more general form of a 'Dynamic'.
236 -- Instead of always fully replacing the value, only parts of it can be patched.
237 -- This is only needed for performance critical code via `mergeIncremental` to make small
238 -- changes to large values.
239 data Incremental t :: * -> *
240 -- | A monad for doing complex push-based calculations efficiently
241 type PushM t :: * -> *
242 -- | A monad for doing complex pull-based calculations efficiently
243 type PullM t :: * -> *
244#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
245 -- | An 'Event' with no occurrences
247 -- | Create a 'Behavior' that always has the given value
248 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
249 -- | Create an 'Event' from another 'Event'; the provided function can sample
250 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
251 -- (Just) or non-occurring (Nothing) result
252 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
253 -- | 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.
254 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
255 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
256 -- recomputed whenever any of the read 'Behavior's changes
257 pull :: PullM t a -> Behavior t a
258 -- | Merge a collection of events; the resulting 'Event' will only occur if at
259 -- least one input event is occuring, and will contain all of the input keys
260 -- that are occurring simultaneously
261 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
262 -- | Efficiently fan-out an event to many destinations. This function should
263 -- be partially applied, and then the result applied repeatedly to create
265 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
266 -- | Create an 'Event' that will occur whenever the currently-selected input
268 switch :: Behavior t (Event t a) -> Event t a
269 -- | Create an 'Event' that will occur whenever the input event is occurring
270 -- and its occurrence value, another 'Event', is also occurring
271 coincidence :: Event t (Event t a) -> Event t a
272 -- | Extract the 'Behavior' of a 'Dynamic'.
273 current :: Dynamic t a -> Behavior t a
274 -- | Extract the 'Event' of the 'Dynamic'.
275 updated :: Dynamic t a -> Event t a
276 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
277 -- recent firing of the given 'Event', if any.
278 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
279 -- | Create a new 'Incremental'. The given 'PullM''s value must always change
280 -- in the same way that the accumulated application of patches would change
282 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
283 -- | Create a merge whose parents can change over time
284 mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
285 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
286 mergeIncrementalWithMove :: GCompare k => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
287 -- | Extract the 'Behavior' component of an 'Incremental'
288 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
289 -- | Extract the 'Event' component of an 'Incremental'
290 updatedIncremental :: Patch p => Incremental t p -> Event t p
291 -- | Convert an 'Incremental' to a 'Dynamic'
292 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
293 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
295 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
296 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
298 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
299 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
301 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
304#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
305instance t ~ SpiderTimeline Global => Reflex t where
306 newtype Behavior t a = SpiderBehavior { unSpiderBehavior :: Reflex.Spider.Internal.Behavior Global a }
307 newtype Event t a = SpiderEvent { unSpiderEvent :: Reflex.Spider.Internal.Event Global a }
308 newtype Dynamic t a = SpiderDynamic { unSpiderDynamic :: Reflex.Spider.Internal.Dynamic Global (Identity a) } -- deriving (Functor, Applicative, Monad)
309 newtype Incremental t p = SpiderIncremental { unSpiderIncremental :: Reflex.Spider.Internal.Dynamic Global p }
310 type PullM t = SpiderPullM Global
311 type PushM t = SpiderPushM Global
312never :: Reflex t => Event t a
313constant :: Reflex t => a -> Behavior t a
314push :: Reflex t => (a -> PushM t (Maybe b)) -> Event t a -> Event t b
315pushCheap :: Reflex t => (a -> PushM t (Maybe b)) -> Event t a -> Event t b
316pull :: Reflex t => PullM t a -> Behavior t a
317merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)
318fan :: (Reflex t, GCompare k) => Event t (DMap k Identity) -> EventSelector t k
319switch :: Reflex t => Behavior t (Event t a) -> Event t a
320coincidence :: Reflex t => Event t (Event t a) -> Event t a
321current :: Reflex t => Dynamic t a -> Behavior t a
322updated :: Reflex t => Dynamic t a -> Event t a
323unsafeBuildDynamic :: Reflex t => PullM t a -> Event t a -> Dynamic t a
324unsafeBuildIncremental :: (Reflex t, Patch p) => PullM t (PatchTarget p) -> Event t p -> Incremental t p
325mergeIncremental :: (Reflex t, GCompare k) => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
326mergeIncrementalWithMove :: (Reflex t, GCompare k) => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
327currentIncremental :: (Reflex t, Patch p) => Incremental t p -> Behavior t (PatchTarget p)
328updatedIncremental :: (Reflex t, Patch p) => Incremental t p -> Event t p
329incrementalToDynamic :: (Reflex t, Patch p) => Incremental t p -> Dynamic t (PatchTarget p)
330behaviorCoercion :: Reflex t => Coercion a b -> Coercion (Behavior t a) (Behavior t b)
331eventCoercion :: Reflex t => Coercion a b -> Coercion (Event t a) (Event t b)
332dynamicCoercion :: Reflex t => Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
334never = SpiderEvent S.eventNever
335{-# INLINE constant #-}
336constant = SpiderBehavior . S.behaviorConst
338push f = SpiderEvent . S.push (coerce f) . unSpiderEvent
339{-# INLINE pushCheap #-}
340pushCheap f = SpiderEvent . S.pushCheap (coerce f) . unSpiderEvent
342pull = SpiderBehavior . S.pull . coerce
344merge = SpiderEvent . S.merge . S.dynamicConst . (coerce :: DMap k (Event (SpiderTimeline x)) -> DMap k (S.Event x))
346fan e = EventSelector $ SpiderEvent . S.select (S.fan (unSpiderEvent e))
348switch = SpiderEvent . S.switch . (coerce :: S.Behavior x (Event (SpiderTimeline x) a) -> S.Behavior x (S.Event x a)) . unSpiderBehavior
349{-# INLINE coincidence #-}
350coincidence = SpiderEvent . S.coincidence . (coerce :: S.Event x (Event (SpiderTimeline x) a) -> S.Event x (S.Event x a)) . unSpiderEvent
351{-# INLINE current #-}
352current = SpiderBehavior . S.dynamicCurrent . unSpiderDynamic
353{-# INLINE updated #-}
354updated = coerceEvent . SpiderEvent . dynamicUpdated . unSpiderDynamic
355{-# INLINE unsafeBuildDynamic #-}
356unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ S.unsafeBuildDynamic (coerce readV0) $ coerce $ unSpiderEvent v'
357{-# INLINE unsafeBuildIncremental #-}
358unsafeBuildIncremental readV0 dv = SpiderIncremental $ S.dynamicDyn $ S.unsafeBuildDynamic (coerce readV0) $ unSpiderEvent dv
359{-# INLINE mergeIncremental #-}
360mergeIncremental = SpiderEvent . S.merge . (unsafeCoerce :: S.Dynamic x (PatchDMap k (Event (SpiderTimeline x))) -> S.Dynamic x (PatchDMap k (S.Event x))) . unSpiderIncremental
361{-# INLINE mergeIncrementalWithMove #-}
362mergeIncrementalWithMove = SpiderEvent . S.mergeWithMove . (unsafeCoerce :: S.Dynamic x (PatchDMapWithMove k (Event (SpiderTimeline x))) -> S.Dynamic x (PatchDMapWithMove k (S.Event x))) . unSpiderIncremental
363{-# INLINE currentIncremental #-}
364currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental
365{-# INLINE updatedIncremental #-}
366updatedIncremental = SpiderEvent . dynamicUpdated . unSpiderIncremental
367{-# INLINE incrementalToDynamic #-}
368incrementalToDynamic (SpiderIncremental i) = SpiderDynamic $ dynamicDynIdentity $ S.unsafeBuildDynamic (readBehaviorUntracked $ dynamicCurrent i) $ flip S.push (dynamicUpdated i) $ \p -> do
369 c <- readBehaviorUntracked $ dynamicCurrent i
370 return $ Identity <$> apply p c
371eventCoercion Coercion = Coercion
372behaviorCoercion Coercion = Coercion
373dynamicCoercion = unsafeCoerce
376-- | Coerce a 'Behavior' between representationally-equivalent value types
377coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
378coerceBehavior = coerceWith $ behaviorCoercion Coercion
380-- | Coerce an 'Event' between representationally-equivalent occurrence types
381coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
382coerceEvent = coerceWith $ eventCoercion Coercion
384-- | Coerce a 'Dynamic' between representationally-equivalent value types
385coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
386coerceDynamic = coerceWith $ dynamicCoercion Coercion
388-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
389-- _must_ change when and only when the 'Event' fires, such that the
390-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
391-- if this is not the case, the resulting 'Dynamic' will behave
392-- nondeterministically.
393unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
394unsafeDynamic = unsafeBuildDynamic . sample
396-- | Construct a 'Dynamic' value that never changes
397constDyn :: Reflex t => a -> Dynamic t a
400instance (Reflex t, Default a) => Default (Dynamic t a) where
403-- | 'MonadSample' designates monads that can read the current value of a
404-- 'Behavior'. This includes both 'PullM' and 'PushM'.
405class (Applicative m, Monad m) => MonadSample t m | m -> t where
406 -- | Get the current value in the 'Behavior'
407 sample :: Behavior t a -> m a
409-- | 'MonadHold' designates monads that can create new 'Behavior's based on
410-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
411-- is required to create any stateful computations with Reflex.
412class MonadSample t m => MonadHold t m where
413 -- | Create a new 'Behavior' whose value will initially be equal to the given
414 -- value and will be updated whenever the given 'Event' occurs. The update
415 -- takes effect immediately after the 'Event' occurs; if the occurrence that
416 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
417 -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new
419 hold :: a -> Event t a -> m (Behavior t a)
420 default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)
421 hold v0 = lift . hold v0
422 -- | Create a 'Dynamic' value using the given initial value that changes every
423 -- time the 'Event' occurs.
424 holdDyn :: a -> Event t a -> m (Dynamic t a)
425 default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)
426 holdDyn v0 = lift . holdDyn v0
427 -- | Create an 'Incremental' value using the given initial value that changes
428 -- every time the 'Event' occurs.
429 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
430 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
431 holdIncremental v0 = lift . holdIncremental v0
432 buildDynamic :: PullM t a -> Event t a -> m (Dynamic t a)
433 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
434 buildDynamic getV0 = lift . buildDynamic getV0
436-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
437-- key. This is much more efficient than filtering for each key with
439newtype EventSelector t k = EventSelector
440 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
441 -- determined by the type of the key, so this can be used to fan-out
442 -- 'Event's whose sub-'Event's have different types.
444 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
445 -- (but equivalent to) using 'fmapMaybe' to select only the relevant
446 -- occurrences of an 'Event'.
447 select :: forall a. k a -> Event t a
450--------------------------------------------------------------------------------
452--------------------------------------------------------------------------------
454instance MonadSample t m => MonadSample t (ReaderT r m) where
455 sample = lift . sample
457instance MonadHold t m => MonadHold t (ReaderT r m) where
458 hold a0 = lift . hold a0
459 holdDyn a0 = lift . holdDyn a0
460 holdIncremental a0 = lift . holdIncremental a0
461 buildDynamic a0 = lift . buildDynamic a0
463instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
464 sample = lift . sample
466instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
467 hold a0 = lift . hold a0
468 holdDyn a0 = lift . holdDyn a0
469 holdIncremental a0 = lift . holdIncremental a0
470 buildDynamic a0 = lift . buildDynamic a0
472instance MonadSample t m => MonadSample t (StateT s m) where
473 sample = lift . sample
475instance MonadHold t m => MonadHold t (StateT s m) where
476 hold a0 = lift . hold a0
477 holdDyn a0 = lift . holdDyn a0
478 holdIncremental a0 = lift . holdIncremental a0
479 buildDynamic a0 = lift . buildDynamic a0
481instance MonadSample t m => MonadSample t (ExceptT e m) where
482 sample = lift . sample
484instance MonadHold t m => MonadHold t (ExceptT e m) where
485 hold a0 = lift . hold a0
486 holdDyn a0 = lift . holdDyn a0
487 holdIncremental a0 = lift . holdIncremental a0
489instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
490 sample = lift . sample
492instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
493 hold a0 = lift . hold a0
494 holdDyn a0 = lift . holdDyn a0
495 holdIncremental a0 = lift . holdIncremental a0
497instance MonadSample t m => MonadSample t (ContT r m) where
498 sample = lift . sample
500instance MonadHold t m => MonadHold t (ContT r m) where
501 hold a0 = lift . hold a0
502 holdDyn a0 = lift . holdDyn a0
503 holdIncremental a0 = lift . holdIncremental a0
505--------------------------------------------------------------------------------
506-- Convenience functions
507--------------------------------------------------------------------------------
509-- | Create an 'Event' from another 'Event'. The provided function can sample
510-- 'Behavior's and hold 'Event's.
511pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
512pushAlways f = push (fmap Just . f)
514-- | Flipped version of 'fmap'.
515ffor :: Functor f => f a -> (a -> b) -> f b
518instance Reflex t => Applicative (Behavior t) where
520 f <*> x = pull $ sample f `ap` sample x
524instance Reflex t => Apply (Behavior t) where
527instance Reflex t => Bind (Behavior t) where
530instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
532 fromRational = pure . fromRational
535instance Reflex t => Functor (Behavior t) where
536 fmap f = pull . fmap f . sample
538instance (Reflex t, IsString a) => IsString (Behavior t a) where
539 fromString = pure . fromString
541instance Reflex t => Monad (Behavior t) where
542 a >>= f = pull $ sample a >>= sample . f
543 -- 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.
545 fail = error "Monad (Behavior t) does not support fail"
547instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
548 mempty = constant mempty
549 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
550 mconcat = pull . fmap mconcat . mapM sample
552instance (Reflex t, Num a) => Num (Behavior t a) where
557 fromInteger = pure . fromInteger
561instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
562 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
563 sconcat = pull . fmap sconcat . mapM sample
564#if MIN_VERSION_semigroups(0,17,0)
565 stimes n = fmap $ stimes n
567 times1p n = fmap $ times1p n
570-- | Flipped version of 'fmapMaybe'.
571fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b
572fforMaybe = flip fmapMaybe
574-- | Filter 'f a' using the provided predicate.
575-- Relies on 'fforMaybe'.
576ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
577ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
579-- | Left-biased event union (prefers left event on simultaneous
581instance Reflex t => Alt (Event t) where
582 ev1 <!> ev2 = leftmost [ev1, ev2]
584-- | 'Event' intersection (convenient interface to 'coincidence').
585instance Reflex t => Apply (Event t) where
586 evf <.> evx = coincidence (fmap (<$> evx) evf)
588-- | 'Event' intersection (convenient interface to 'coincidence').
589instance Reflex t => Bind (Event t) where
590 evx >>- f = coincidence (f <$> evx)
593instance Reflex t => Functor (Event t) where
595 fmap f = fmapMaybe $ Just . f
597instance Reflex t => FunctorMaybe (Event t) where
598 {-# INLINE fmapMaybe #-}
599 fmapMaybe f = push $ return . f
601-- | Never: @'zero' = 'never'@.
602instance Reflex t => Plus (Event t) where
605-- | Replace each occurrence value of the 'Event' with the value of the
606-- 'Behavior' at the time of that occurrence.
607tag :: Reflex t => Behavior t b -> Event t a -> Event t b
608tag b = pushAlways $ \_ -> sample b
610-- | Create a new 'Event' that combines occurences of supplied 'Event' with the
611-- current value of the 'Behavior'.
612attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
613attach = attachWith (,)
615-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
616-- combining it with the current value of the 'Behavior'.
617attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
618attachWith f = attachWithMaybe $ \a b -> Just $ f a b
620-- | Create a new 'Event' by combining each occurence with the current value of
621-- the 'Behavior'. The occurrence is discarded if the combining function returns
623attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
624attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
626-- | Create a new 'Event' that only occurs only once, on the first occurence of
627-- the supplied 'Event'.
628headE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
630 rec be <- hold e $ fmap (const never) e'
634-- | Create a new 'Event' that occurs on all but the first occurence of the
636tailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
637tailE e = snd <$> headTailE e
639-- | Create a tuple of two 'Event's with the first one occuring only the first
640-- time the supplied 'Event' occurs and the second occuring on all but the first
642headTailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a, Event t a)
645 be <- hold never $ fmap (const e) eHead
646 return (eHead, switch be)
648-- | Starting at the current time, fire all the occurrences of the 'Event' for
649-- which the given predicate returns 'True'. When 'False' is returned, do not
650-- fire, and permanently stop firing, even if 'True' values are encountered
652takeWhileE :: forall t m a. (Reflex t, MonadFix m, MonadHold t m) => (a -> Bool) -> Event t a -> m (Event t a)
654 rec let (eFalse, eTrue) = fanEither $ ffor e' $ \a -> if f a
661-- | Split the supplied 'Event' into two individual 'Event's occuring at the
662-- same time with the respective values from the tuple.
663splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
664splitE e = (fmap fst e, fmap snd e)
666-- | Print the supplied 'String' and the value of the 'Event' on each
667-- occurence. This should /only/ be used for debugging.
669-- Note: As with Debug.Trace.trace, the message will only be printed if the
670-- 'Event' is actually used.
671traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
672traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
674-- | Print the output of the supplied function on each occurence of the
675-- 'Event'. This should /only/ be used for debugging.
677-- Note: As with Debug.Trace.trace, the message will only be printed if the
678-- 'Event' is actually used.
679traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
680traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
682instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
683 (<>) = alignWith (mergeThese (<>))
684 sconcat = fmap sconcat . mergeList . toList
685#if MIN_VERSION_semigroups(0,17,0)
686 stimes n = fmap $ stimes n
688 times1p n = fmap $ times1p n
691instance (Semigroup a, Reflex t) => Monoid (Event t a) where
694 mconcat = fmap sconcat . mergeList
696-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
697-- list occurs. If multiple occur at the same time they are folded from the left
698-- with the given function.
699{-# INLINE mergeWith #-}
700mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
701mergeWith = mergeWith' id
703{-# INLINE mergeWith' #-}
704mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
705mergeWith' _ _ [] = never
706mergeWith' f _ [e] = fmap f e
707mergeWith' f g es = fmap (Prelude.foldl1 g . map (\(Const2 _ :=> Identity v) -> f v) . DMap.toList)
709 . DMap.fromDistinctAscList
710 . map (\(k, v) -> Const2 k :=> v)
711 $ zip [0 :: Int ..] es
713-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
714-- list occurs. If multiple occur at the same time the value is the value of the
716{-# INLINE leftmost #-}
717leftmost :: Reflex t => [Event t a] -> Event t a
718leftmost = mergeWith const
720-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
721-- list occurs and has a list of the values of all 'Event's occuring at that
723mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
725mergeList es = mergeWithFoldCheap' id es
727unsafeMapIncremental :: (Reflex t, Patch p, Patch p') => (PatchTarget p -> PatchTarget p') -> (p -> p') -> Incremental t p -> Incremental t p'
728unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
730-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
731-- occurs if at least one of them occurs and has a map of values of all 'Event's
732-- occuring at that time.
733mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
734mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
736-- | Create a merge whose parents can change over time
737mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
738mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
740-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
741mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
742mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
744-- | Split the event into separate events for 'Left' and 'Right' values.
745fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
747 let justLeft = either Just (const Nothing)
748 justRight = either (const Nothing) Just
749 in (fmapMaybe justLeft e, fmapMaybe justRight e)
751-- | Split the event into separate events for 'This' and 'That' values,
752-- allowing them to fire simultaneously when the input value is 'These'.
753fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
755 let this (This x) = Just x
756 this (These x _) = Just x
758 that (That y) = Just y
759 that (These _ y) = Just y
761 in (fmapMaybe this e, fmapMaybe that e)
763-- | Split the event into an 'EventSelector' that allows efficient selection of
764-- the individual 'Event's.
765fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
766fanMap = fan . fmap mapToDMap
768-- | Switches to the new event whenever it receives one. Whenever a new event
769-- is provided, if it is firing, its value will be the resulting event's value;
770-- if it is not firing, but the old one is, the old one's value will be used.
771switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
772switchPromptly ea0 eea = do
774 let eLag = switch bea
775 eCoincidences = coincidence eea
776 return $ leftmost [eCoincidences, eLag]
778-- | 'switch'es to a new event whenever it receives one. At the moment of
779-- switching, the old event will be ignored if it fires, and the new one will be
780-- used if it fires; this is the opposite of 'switch', which will use only the
782switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
783switchPromptOnly e0 e' = do
784 eLag <- switch <$> hold e0 e'
785 return $ coincidence $ leftmost [e', eLag <$ eLag]
787instance Reflex t => Align (Event t) where
789 align = alignEventWithMaybe Just
791-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
792-- the 'Behavior' is true at the time of occurence.
793gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
794gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
796-- | Create a new behavior given a starting behavior and switch to a the behvior
797-- carried by the event when it fires.
798switcher :: (Reflex t, MonadHold t m)
799 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
800switcher b eb = pull . (sample <=< sample) <$> hold b eb
802-- | Combine two 'Dynamic's. The result will change whenever either (or both)
803-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
804zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
805zipDyn = zipDynWith (,)
807-- | Combine two 'Dynamic's with a combining function. The result will change
808-- whenever either (or both) input 'Dynamic' changes.
809-- More efficient than liftA2.
810zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
812 let eab = align (updated da) (updated db)
813 ec = flip push eab $ \o -> do
816 b <- sample $ current db
819 a <- sample $ current da
821 These a b -> return (a, b)
822 return $ Just $ f a b
823 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
825instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
826 mconcat = distributeListOverDynWith mconcat
827 mempty = constDyn mempty
828 mappend = zipDynWith mappend
830-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
831-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
832-- through the use of multiple uses of 'zipWithDyn' or 'Applicative' operators.
833distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
834distributeDMapOverDynPure dm = case DMap.toList dm of
835 [] -> constDyn DMap.empty
836 [k :=> v] -> fmap (DMap.singleton k . Identity) v
838 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
839 edmPre = merge $ DMap.map updated dm
840 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
841 olds <- sample $ current result
842 return $ DMap.unionWithKey (\_ _ new -> new) olds news
845-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
846distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
847distributeListOverDyn = distributeListOverDynWith id
849-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
850distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
851distributeListOverDynWith f = fmap (f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]
853-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
854-- unless the second supplied 'Event' occurs simultaneously.
855difference :: Reflex t => Event t a -> Event t b -> Event t a
856difference = alignEventWithMaybe $ \case
860alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
861alignEventWithMaybe f ea eb =
862 fmapMaybe (f <=< dmapToThese)
864 $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
867--------------------------------------------------------------------------------
869--------------------------------------------------------------------------------
871-- | An 'Accumulator' type can be built by accumulating occurrences of an
873class Reflex t => Accumulator t f | f -> t where
874 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
875 accum f = accumMaybe $ \v o -> Just $ f v o
876 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
877 accumM f = accumMaybeM $ \v o -> Just <$> f v o
878 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
879 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
880 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
881 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
882 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
883 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
884 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
885 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
886 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
887 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
889-- | Accumulate occurrences of an 'Event', producing an output occurrence each
890-- time. Discard the underlying 'Accumulator'.
891mapAccum_ :: 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)
893 (_ :: Behavior t a, result) <- mapAccum f z e
896-- | Accumulate occurrences of an 'Event', possibly producing an output
897-- occurrence each time. Discard the underlying 'Accumulator'.
898mapAccumMaybe_ :: 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)
899mapAccumMaybe_ f z e = do
900 (_ :: Behavior t a, result) <- mapAccumMaybe f z e
903-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
904-- an output occurrence each time. Discard the underlying 'Accumulator'.
905mapAccumM_ :: 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)
907 (_ :: Behavior t a, result) <- mapAccumM f z e
910-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
911-- producing an output occurrence each time. Discard the underlying
913mapAccumMaybeM_ :: 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)
914mapAccumMaybeM_ f z e = do
915 (_ :: Behavior t a, result) <- mapAccumMaybeM f z e
918instance Reflex t => Accumulator t (Dynamic t) where
919 accumMaybeM f z e = do
920 rec let e' = flip push e $ \o -> do
921 v <- sample $ current d'
925 mapAccumMaybeM f z e = do
926 rec let e' = flip push e $ \o -> do
927 v <- sample $ current d'
929 return $ case result of
930 (Nothing, Nothing) -> Nothing
932 d' <- holdDyn z $ fmapMaybe fst e'
933 return (d', fmapMaybe snd e')
935instance Reflex t => Accumulator t (Behavior t) where
936 accumMaybeM f z e = current <$> accumMaybeM f z e
937 mapAccumMaybeM f z e = first current <$> mapAccumMaybeM f z e
939instance Reflex t => Accumulator t (Event t) where
940 accumMaybeM f z e = updated <$> accumMaybeM f z e
941 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
943-- | Create a new 'Event' by combining each occurence with the next value of the
944-- list using the supplied function. If the list runs out of items, all
945-- subsequent 'Event' occurrences will be ignored.
946zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
947zipListWithEvent f l e = do
948 let f' a b = case a of
949 h:t -> (Just t, Just $ f h b)
950 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
951 mapAccumMaybe_ f' l e
953-- | Assign a number to each occurence of the given 'Event', starting from 0
954numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
955numberOccurrences = numberOccurrencesFrom 0
957-- | Assign a number to each occurence of the given 'Event'
958numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
959numberOccurrencesFrom = mapAccum_ (\n a -> (n + 1, (n, a)))
961-- | This is used to sample the value of a 'Behavior' using an 'Event'.
963-- The '<@>' operator is intended to be used in conjunction with
964-- the 'Applicative' instance for 'Behavior'.
966-- This is useful when we want to combine the values of one 'Event' and
967-- the value of several 'Behavior's at the time the 'Event' is firing.
971-- > f :: a -> b -> c -> d
972-- > b1 :: Behavior t a
973-- > b2 :: Behavior t b
978-- > f <$> b1 <*> b2 <@> e :: Event t d
980-- in order to apply the function 'f' to the relevant values.
982-- The alternative would be something like:
984-- > attachWith (\(x1, x2) y -> f x1 x2 y) ((,) <$> b1 <*> b2) e :: Event t d
986-- or a variation involing a custom data type to hold the combination of
987-- 'Behavior's even when that combination might only ever be used by 'f'.
989-- A more suggestive example might be:
991-- > handleMouse <$> bPlayerState <*> bMousePosition <@> eMouseClick :: Event t (GameState -> GameState)
993(<@>) :: Reflex t => Behavior t (a -> b) -> Event t a -> Event t b
994(<@>) b = push $ \x -> do
996 return . Just . f $ x
999-- | An version of '<@>' that does not use the value of the 'Event'.
1001-- Alternatively, it is 'tag' in operator form.
1003-- This is useful when we want to combine the values of several
1004-- 'Behavior's at particular points in time using an 'Applicative'
1009-- > g :: a -> b -> d
1010-- > b1 :: Behavior t a
1011-- > b2 :: Behavior t b
1014-- where 'e' is firing at the points in time of interest.
1016-- Then we can use '<@':
1018-- > g <$> b1 <*> b2 <@ e :: Event t d
1020-- to combine the values of 'b1' and 'b2' at each of those points of time,
1021-- with the function 'g' being used to combine the values.
1023-- This is the same as '<@>' except that the 'Event' is being used only
1024-- to act as a trigger.
1025(<@) :: (Reflex t) => Behavior t b -> Event t a -> Event t b
1029runWithReplace :: MonadAdjust t m => m a -> Event t (m b) -> m (a, Event t b)
1030runWithReplace = mapMWithReplace id id
1032-- | A 'Monad' that supports adjustment over time. After an action has been
1033-- run, if the given events fire, it will adjust itself so that its net effect
1034-- is as though it had originally been run with the new value. Note that there
1035-- is some issue here with persistent side-effects: obviously, IO (and some
1036-- other side-effects) cannot be undone, so it is up to the instance implementer
1037-- to determine what the best meaning for this class is in such cases.
1038class (Reflex t, Monad m) => MonadAdjust t m | m -> t where
1039 mapMWithReplace :: (a -> m b) -> (a' -> m b') -> a -> Event t a' -> m (b, Event t b')
1040 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'))
1041 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'))
1043instance MonadAdjust t m => MonadAdjust t (ReaderT r m) where
1044 mapMWithReplace f g a0 a' = do
1046 lift $ mapMWithReplace ((`runReaderT` r) . f) ((`runReaderT` r) . g) a0 a'
1047 traverseDMapWithKeyWithAdjust f dm0 dm' = do
1049 lift $ traverseDMapWithKeyWithAdjust (\k v -> runReaderT (f k v) r) dm0 dm'
1050 traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = do
1052 lift $ traverseDMapWithKeyWithAdjustWithMove (\k v -> runReaderT (f k v) r) dm0 dm'
1054sequenceDMapWithAdjust :: (GCompare k, MonadAdjust t m) => DMap k m -> Event t (PatchDMap k m) -> m (DMap k Identity, Event t (PatchDMap k Identity))
1055sequenceDMapWithAdjust = traverseDMapWithKeyWithAdjust $ \_ -> fmap Identity
1057sequenceDMapWithAdjustWithMove :: (GCompare k, MonadAdjust t m) => DMap k m -> Event t (PatchDMapWithMove k m) -> m (DMap k Identity, Event t (PatchDMapWithMove k Identity))
1058sequenceDMapWithAdjustWithMove = traverseDMapWithKeyWithAdjustWithMove $ \_ -> fmap Identity
1060mapMapWithAdjustWithMove :: 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'))
1061mapMapWithAdjustWithMove f m0 m' = do
1062 (out0 :: DMap (Const2 k v) (Constant v'), out') <- traverseDMapWithKeyWithAdjustWithMove (\(Const2 k) (Identity v) -> Constant <$> f k v) (mapToDMap m0) (const2PatchDMapWithMoveWith Identity <$> m')
1063 return (dmapToMapWith (\(Constant v') -> v') out0, patchDMapWithMoveToPatchMapWithMoveWith (\(Constant v') -> v') <$> out')
1069{-# INLINE pushAlwaysCheap #-}
1070pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
1071pushAlwaysCheap f = pushCheap (fmap Just . f)
1073{-# INLINE fmapMaybeCheap #-}
1074fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1075fmapMaybeCheap f = pushCheap $ return . f
1077{-# INLINE fforMaybeCheap #-}
1078fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
1079fforMaybeCheap = flip fmapMaybeCheap
1081{-# INLINE fforCheap #-}
1082fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
1083fforCheap = flip fmapCheap
1085{-# INLINE fmapCheap #-}
1086fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
1087fmapCheap f = pushCheap $ return . Just . f
1089{-# INLINE tagCheap #-}
1090tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
1091tagCheap b = pushAlwaysCheap $ \_ -> sample b
1093{-# INLINE mergeWithCheap #-}
1094mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
1095mergeWithCheap = mergeWithCheap' id
1097{-# INLINE mergeWithCheap' #-}
1098mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
1099mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
1101{-# INLINE mergeWithFoldCheap' #-}
1102mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
1103mergeWithFoldCheap' _ [] = never
1104mergeWithFoldCheap' f [e] = fmapCheap (f . (:|[])) e
1105mergeWithFoldCheap' f es =
1106 fmapCheap (f . (\(h : t) -> h :| t) . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList)
1108 . DMap.fromDistinctAscList
1109 . map (\(k, v) -> Const2 k :=> v)
1110 $ zip [0 :: Int ..] es
1112--------------------------------------------------------------------------------
1113-- Deprecated functions
1114--------------------------------------------------------------------------------
1116-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
1117-- occurs. If both occur at the same time they are combined using 'mappend'.
1118{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}
1119appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
1120appendEvents = alignWith $ mergeThese mappend
1122-- | Alias for 'headE'
1123{-# DEPRECATED onceE "Use 'headE' instead" #-}
1124onceE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
1127-- | Run both sides of a 'These' monadically, combining the results.
1128{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
1129#ifdef USE_TEMPLATE_HASKELL
1130{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
1132sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
1133sequenceThese t = case t of
1134 This ma -> fmap This ma
1135 These ma mb -> liftM2 These ma mb
1136 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