1{-# LANGUAGE ConstraintKinds #-}
3{-# LANGUAGE DefaultSignatures #-}
4{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE FunctionalDependencies #-}
8{-# LANGUAGE LambdaCase #-}
9{-# LANGUAGE MultiParamTypeClasses #-}
10{-# LANGUAGE NoMonomorphismRestriction #-}
11{-# LANGUAGE RankNTypes #-}
12{-# LANGUAGE RecursiveDo #-}
13{-# LANGUAGE RoleAnnotations #-}
14{-# LANGUAGE ScopedTypeVariables #-}
15{-# LANGUAGE TypeFamilies #-}
16{-# LANGUAGE TypeOperators #-}
17{-# LANGUAGE UndecidableInstances #-}
18#ifdef USE_REFLEX_OPTIMIZER
19{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
21#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
22{-# LANGUAGE EmptyDataDecls #-}
23{-# OPTIONS_GHC -Wno-redundant-constraints #-}
26-- | This module contains the Reflex interface, as well as a variety of
27-- convenience functions for working with 'Event's, 'Behavior's, and other
39 -- ** 'fan'-related types
41 , EventSelectorInt (..)
42 -- ** 'Incremental'-related types
43 -- * Convenience functions
46 -- ** Combining 'Event's
50 , mergeMapIncrementalWithMove
55 -- ** Breaking up 'Event's
64 -- ** Switching between 'Event's
67 -- ** Using 'Event's to sample 'Behavior's
72 -- ** Blocking an 'Event' based on a 'Behavior'
74 -- ** Combining 'Dynamic's
75 , distributeDMapOverDynPure
76 , distributeListOverDyn
77 , distributeListOverDynWith
80 -- ** Accumulating state
104 , numberOccurrencesFrom
105 , numberOccurrencesFrom_
112 -- * Debugging functions
115 -- * Unsafe functions
117 , unsafeMapIncremental
126 , sequenceDMapWithAdjust
127 , sequenceDMapWithAdjustWithMove
128 , mapMapWithAdjustWithMove
129 -- * Miscellaneous convenience functions
131 -- * Deprecated functions
144 -- * Slow, but general, implementations
146#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
167 , unsafeBuildIncremental
169 , mergeIncrementalWithMove
172 , incrementalToDynamic
179import Control.Applicative
180import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
181import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
182import Control.Monad.State.Strict hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
183import Control.Monad.Trans.Cont (ContT ())
184import Control.Monad.Trans.Except (ExceptT ())
185import Control.Monad.Trans.RWS (RWST ())
186import Control.Monad.Trans.Writer (WriterT ())
191import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
192import qualified Data.Dependent.Map as DMap
195import Data.Functor.Bind hiding (join)
196import qualified Data.Functor.Bind as Bind
197import Data.Functor.Constant
198import Data.Functor.Misc
199import Data.Functor.Plus
200import Data.IntMap.Strict (IntMap)
201import qualified Data.IntMap.Strict as IntMap
202import Data.List.NonEmpty (NonEmpty (..))
205import Data.Monoid hiding (Alt, (<>))
206import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
209import Data.Traversable
210import Data.Type.Coercion
211import Reflex.FunctorMaybe
213import Data.FastMutableIntMap (PatchIntMap)
215#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
216import Reflex.Spider.Internal (EventM, Global, HasSpiderTimeline, SpiderHost (..), SpiderHostFrame (..),
217 SpiderPullM, SpiderPushM (..), behaviorHoldIdentity, dynamicConst,
218 dynamicCurrent, dynamicDynIdentity, dynamicHold, dynamicHoldIdentity,
219 dynamicUpdated, newMapDyn, readBehaviorTracked, readBehaviorUntracked,
220 runFrame, runSpiderHostFrame)
221import qualified Reflex.Spider.Internal
222import qualified Reflex.Spider.Internal as S
226-- Note: must come last to silence warnings due to AMP on GHC < 7.10
227import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)
229import Debug.Trace (trace)
231#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
232#include "Spider/SpiderTimeline.include.hs"
235-- | The 'Reflex' class contains all the primitive functionality needed for
236-- Functional Reactive Programming (FRP). The @t@ type parameter indicates
237-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
238-- and the type of the timeline determines the FRP engine to be used. For most
239-- purposes, the 'Reflex.Spider' implementation is recommended.
240class ( MonadHold t (PushM t)
241 , MonadSample t (PullM t)
243 , Functor (Dynamic t)
244 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
246#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
247 , t ~ SpiderTimeline Global
250 -- | A container for a value that can change over time. 'Behavior's can be
251 -- sampled at will, but it is not possible to be notified when they change
252 data Behavior t :: * -> *
253 -- | A stream of occurrences. During any given frame, an 'Event' is either
254 -- occurring or not occurring; if it is occurring, it will contain a value of
255 -- the given type (its "occurrence type")
256 data Event t :: * -> *
257 -- | A container for a value that can change over time and allows
258 -- notifications on changes. Basically a combination of a 'Behavior' and an
259 -- 'Event', with a rule that the 'Behavior' will change if and only if the
261 data Dynamic t :: * -> *
262 -- | An 'Incremental' is a more general form of a 'Dynamic'.
263 -- Instead of always fully replacing the value, only parts of it can be patched.
264 -- This is only needed for performance critical code via `mergeIncremental` to make small
265 -- changes to large values.
266 data Incremental t :: * -> *
267 -- | A monad for doing complex push-based calculations efficiently
268 type PushM t :: * -> *
269 -- | A monad for doing complex pull-based calculations efficiently
270 type PullM t :: * -> *
271#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
272 -- | An 'Event' with no occurrences
274 -- | Create a 'Behavior' that always has the given value
275 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
276 -- | Create an 'Event' from another 'Event'; the provided function can sample
277 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
278 -- (Just) or non-occurring (Nothing) result
279 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
280 -- | 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.
281 pushCheap :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
282 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
283 -- recomputed whenever any of the read 'Behavior's changes
284 pull :: PullM t a -> Behavior t a
285 -- | Merge a collection of events; the resulting 'Event' will only occur if at
286 -- least one input event is occuring, and will contain all of the input keys
287 -- that are occurring simultaneously
288 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
289 -- | Efficiently fan-out an event to many destinations. This function should
290 -- be partially applied, and then the result applied repeatedly to create
292 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
293 -- | Create an 'Event' that will occur whenever the currently-selected input
295 switch :: Behavior t (Event t a) -> Event t a
296 -- | Create an 'Event' that will occur whenever the input event is occurring
297 -- and its occurrence value, another 'Event', is also occurring
298 coincidence :: Event t (Event t a) -> Event t a
299 -- | Extract the 'Behavior' of a 'Dynamic'.
300 current :: Dynamic t a -> Behavior t a
301 -- | Extract the 'Event' of the 'Dynamic'.
302 updated :: Dynamic t a -> Event t a
303 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
304 -- recent firing of the given 'Event', if any.
305 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
306 -- | Create a new 'Incremental'. The given 'PullM''s value must always change
307 -- in the same way that the accumulated application of patches would change
309 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
310 -- | Create a merge whose parents can change over time
311 mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
312 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
313 mergeIncrementalWithMove :: GCompare k => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
314 -- | Extract the 'Behavior' component of an 'Incremental'
315 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
316 -- | Extract the 'Event' component of an 'Incremental'
317 updatedIncremental :: Patch p => Incremental t p -> Event t p
318 -- | Convert an 'Incremental' to a 'Dynamic'
319 incrementalToDynamic :: Patch p => Incremental t p -> Dynamic t (PatchTarget p)
320 -- | Construct a 'Coercion' for a 'Behavior' given an 'Coercion' for its
322 behaviorCoercion :: Coercion a b -> Coercion (Behavior t a) (Behavior t b)
323 -- | Construct a 'Coercion' for an 'Event' given an 'Coercion' for its
325 eventCoercion :: Coercion a b -> Coercion (Event t a) (Event t b)
326 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
328 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
329 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
330 fanInt :: Event t (IntMap a) -> EventSelectorInt t a
333--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on
334mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
335mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never
337#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
338instance t ~ SpiderTimeline Global => Reflex t where
339 newtype Behavior t a = SpiderBehavior { unSpiderBehavior :: Reflex.Spider.Internal.Behavior Global a }
340 newtype Event t a = SpiderEvent { unSpiderEvent :: Reflex.Spider.Internal.Event Global a }
341 newtype Dynamic t a = SpiderDynamic { unSpiderDynamic :: Reflex.Spider.Internal.Dynamic Global (Identity a) } -- deriving (Functor, Applicative, Monad)
342 newtype Incremental t p = SpiderIncremental { unSpiderIncremental :: Reflex.Spider.Internal.Dynamic Global p }
343 type PullM t = SpiderPullM Global
344 type PushM t = SpiderPushM Global
345never :: Reflex t => Event t a
346constant :: Reflex t => a -> Behavior t a
347push :: Reflex t => (a -> PushM t (Maybe b)) -> Event t a -> Event t b
348pushCheap :: Reflex t => (a -> PushM t (Maybe b)) -> Event t a -> Event t b
349pull :: Reflex t => PullM t a -> Behavior t a
350merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)
351fan :: (Reflex t, GCompare k) => Event t (DMap k Identity) -> EventSelector t k
352switch :: Reflex t => Behavior t (Event t a) -> Event t a
353coincidence :: Reflex t => Event t (Event t a) -> Event t a
354current :: Reflex t => Dynamic t a -> Behavior t a
355updated :: Reflex t => Dynamic t a -> Event t a
356unsafeBuildDynamic :: Reflex t => PullM t a -> Event t a -> Dynamic t a
357unsafeBuildIncremental :: (Reflex t, Patch p) => PullM t (PatchTarget p) -> Event t p -> Incremental t p
358mergeIncremental :: (Reflex t, GCompare k) => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
359mergeIncrementalWithMove :: (Reflex t, GCompare k) => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
360currentIncremental :: (Reflex t, Patch p) => Incremental t p -> Behavior t (PatchTarget p)
361updatedIncremental :: (Reflex t, Patch p) => Incremental t p -> Event t p
362incrementalToDynamic :: (Reflex t, Patch p) => Incremental t p -> Dynamic t (PatchTarget p)
363behaviorCoercion :: Reflex t => Coercion a b -> Coercion (Behavior t a) (Behavior t b)
364eventCoercion :: Reflex t => Coercion a b -> Coercion (Event t a) (Event t b)
365dynamicCoercion :: Reflex t => Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
367never = SpiderEvent S.eventNever
368{-# INLINE constant #-}
369constant = SpiderBehavior . S.behaviorConst
371push f = SpiderEvent . S.push (coerce f) . unSpiderEvent
372{-# INLINE pushCheap #-}
373pushCheap f = SpiderEvent . S.pushCheap (coerce f) . unSpiderEvent
375pull = SpiderBehavior . S.pull . coerce
377merge = SpiderEvent . S.merge . S.dynamicConst . (coerce :: DMap k (Event (SpiderTimeline x)) -> DMap k (S.Event x))
379fan e = EventSelector $ SpiderEvent . S.select (S.fan (unSpiderEvent e))
381switch = SpiderEvent . S.switch . (coerce :: S.Behavior x (Event (SpiderTimeline x) a) -> S.Behavior x (S.Event x a)) . unSpiderBehavior
382{-# INLINE coincidence #-}
383coincidence = SpiderEvent . S.coincidence . (coerce :: S.Event x (Event (SpiderTimeline x) a) -> S.Event x (S.Event x a)) . unSpiderEvent
384{-# INLINE current #-}
385current = SpiderBehavior . S.dynamicCurrent . unSpiderDynamic
386{-# INLINE updated #-}
387updated = coerceEvent . SpiderEvent . dynamicUpdated . unSpiderDynamic
388{-# INLINE unsafeBuildDynamic #-}
389unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ S.unsafeBuildDynamic (coerce readV0) $ coerce $ unSpiderEvent v'
390{-# INLINE unsafeBuildIncremental #-}
391unsafeBuildIncremental readV0 dv = SpiderIncremental $ S.dynamicDyn $ S.unsafeBuildDynamic (coerce readV0) $ unSpiderEvent dv
392{-# INLINE mergeIncremental #-}
393mergeIncremental = SpiderEvent . S.merge . (unsafeCoerce :: S.Dynamic x (PatchDMap k (Event (SpiderTimeline x))) -> S.Dynamic x (PatchDMap k (S.Event x))) . unSpiderIncremental
394{-# INLINE mergeIncrementalWithMove #-}
395mergeIncrementalWithMove = SpiderEvent . S.mergeWithMove . (unsafeCoerce :: S.Dynamic x (PatchDMapWithMove k (Event (SpiderTimeline x))) -> S.Dynamic x (PatchDMapWithMove k (S.Event x))) . unSpiderIncremental
396{-# INLINE currentIncremental #-}
397currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental
398{-# INLINE updatedIncremental #-}
399updatedIncremental = SpiderEvent . dynamicUpdated . unSpiderIncremental
400{-# INLINE incrementalToDynamic #-}
401incrementalToDynamic (SpiderIncremental i) = SpiderDynamic $ dynamicDynIdentity $ S.unsafeBuildDynamic (readBehaviorUntracked $ dynamicCurrent i) $ flip S.push (dynamicUpdated i) $ \p -> do
402 c <- readBehaviorUntracked $ dynamicCurrent i
403 return $ Identity <$> apply p c
404eventCoercion Coercion = Coercion
405behaviorCoercion Coercion = Coercion
406dynamicCoercion = unsafeCoerce
409-- | Coerce a 'Behavior' between representationally-equivalent value types
410coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b
411coerceBehavior = coerceWith $ behaviorCoercion Coercion
413-- | Coerce an 'Event' between representationally-equivalent occurrence types
414coerceEvent :: (Reflex t, Coercible a b) => Event t a -> Event t b
415coerceEvent = coerceWith $ eventCoercion Coercion
417-- | Coerce a 'Dynamic' between representationally-equivalent value types
418coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
419coerceDynamic = coerceWith $ dynamicCoercion Coercion
421-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
422-- _must_ change when and only when the 'Event' fires, such that the
423-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
424-- if this is not the case, the resulting 'Dynamic' will behave
425-- nondeterministically.
426unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
427unsafeDynamic = unsafeBuildDynamic . sample
429-- | Construct a 'Dynamic' value that never changes
430constDyn :: Reflex t => a -> Dynamic t a
433instance (Reflex t, Default a) => Default (Dynamic t a) where
436-- | 'MonadSample' designates monads that can read the current value of a
437-- 'Behavior'. This includes both 'PullM' and 'PushM'.
438class (Applicative m, Monad m) => MonadSample t m | m -> t where
439 -- | Get the current value in the 'Behavior'
440 sample :: Behavior t a -> m a
442-- | 'MonadHold' designates monads that can create new 'Behavior's based on
443-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
444-- is required to create any stateful computations with Reflex.
445class MonadSample t m => MonadHold t m where
446 -- | Create a new 'Behavior' whose value will initially be equal to the given
447 -- value and will be updated whenever the given 'Event' occurs. The update
448 -- takes effect immediately after the 'Event' occurs; if the occurrence that
449 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
450 -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new
452 hold :: a -> Event t a -> m (Behavior t a)
453 default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)
454 hold v0 = lift . hold v0
455 -- | Create a 'Dynamic' value using the given initial value that changes every
456 -- time the 'Event' occurs.
457 holdDyn :: a -> Event t a -> m (Dynamic t a)
458 default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)
459 holdDyn v0 = lift . holdDyn v0
460 -- | Create an 'Incremental' value using the given initial value that changes
461 -- every time the 'Event' occurs.
462 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
463 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
464 holdIncremental v0 = lift . holdIncremental v0
465 buildDynamic :: PullM t a -> Event t a -> m (Dynamic t a)
467 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
468 buildDynamic getV0 = lift . buildDynamic getV0
470 -- | Create a new 'Event' that only occurs only once, on the first occurence of
471 -- the supplied 'Event'.
472 headE :: Event t a -> m (Event t a)
475slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
477 rec be <- hold e $ fmapCheap (const never) e'
481-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
482-- key. This is much more efficient than filtering for each key with
484newtype EventSelector t k = EventSelector
485 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
486 -- determined by the type of the key, so this can be used to fan-out
487 -- 'Event's whose sub-'Event's have different types.
489 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
490 -- (but equivalent to) using 'fmapMaybe' to select only the relevant
491 -- occurrences of an 'Event'.
492 select :: forall a. k a -> Event t a
495newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }
497--------------------------------------------------------------------------------
499--------------------------------------------------------------------------------
501instance MonadSample t m => MonadSample t (ReaderT r m) where
502 sample = lift . sample
504instance MonadHold t m => MonadHold t (ReaderT r m) where
505 hold a0 = lift . hold a0
506 holdDyn a0 = lift . holdDyn a0
507 holdIncremental a0 = lift . holdIncremental a0
508 buildDynamic a0 = lift . buildDynamic a0
511instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
512 sample = lift . sample
514instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
515 hold a0 = lift . hold a0
516 holdDyn a0 = lift . holdDyn a0
517 holdIncremental a0 = lift . holdIncremental a0
518 buildDynamic a0 = lift . buildDynamic a0
521instance MonadSample t m => MonadSample t (StateT s m) where
522 sample = lift . sample
524instance MonadHold t m => MonadHold t (StateT s m) where
525 hold a0 = lift . hold a0
526 holdDyn a0 = lift . holdDyn a0
527 holdIncremental a0 = lift . holdIncremental a0
528 buildDynamic a0 = lift . buildDynamic a0
531instance MonadSample t m => MonadSample t (ExceptT e m) where
532 sample = lift . sample
534instance MonadHold t m => MonadHold t (ExceptT e m) where
535 hold a0 = lift . hold a0
536 holdDyn a0 = lift . holdDyn a0
537 holdIncremental a0 = lift . holdIncremental a0
538 buildDynamic a0 = lift . buildDynamic a0
541instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
542 sample = lift . sample
544instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
545 hold a0 = lift . hold a0
546 holdDyn a0 = lift . holdDyn a0
547 holdIncremental a0 = lift . holdIncremental a0
548 buildDynamic a0 = lift . buildDynamic a0
551instance MonadSample t m => MonadSample t (ContT r m) where
552 sample = lift . sample
554instance MonadHold t m => MonadHold t (ContT r m) where
555 hold a0 = lift . hold a0
556 holdDyn a0 = lift . holdDyn a0
557 holdIncremental a0 = lift . holdIncremental a0
558 buildDynamic a0 = lift . buildDynamic a0
561--------------------------------------------------------------------------------
562-- Convenience functions
563--------------------------------------------------------------------------------
565-- | Create an 'Event' from another 'Event'. The provided function can sample
566-- 'Behavior's and hold 'Event's.
567pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
568pushAlways f = push (fmap Just . f)
570-- | Flipped version of 'fmap'.
571ffor :: Functor f => f a -> (a -> b) -> f b
574instance Reflex t => Applicative (Behavior t) where
576 f <*> x = pull $ sample f `ap` sample x
580instance Reflex t => Apply (Behavior t) where
583instance Reflex t => Bind (Behavior t) where
586instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
588 fromRational = pure . fromRational
591instance Reflex t => Functor (Behavior t) where
592 fmap f = pull . fmap f . sample
594instance (Reflex t, IsString a) => IsString (Behavior t a) where
595 fromString = pure . fromString
597instance Reflex t => Monad (Behavior t) where
598 a >>= f = pull $ sample a >>= sample . f
599 -- 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.
601 fail = error "Monad (Behavior t) does not support fail"
603instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
604 mempty = constant mempty
605 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
606 mconcat = pull . fmap mconcat . mapM sample
608instance (Reflex t, Num a) => Num (Behavior t a) where
613 fromInteger = pure . fromInteger
617instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
618 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
619 sconcat = pull . fmap sconcat . mapM sample
620#if MIN_VERSION_semigroups(0,17,0)
621 stimes n = fmap $ stimes n
623 times1p n = fmap $ times1p n
626-- | Flipped version of 'fmapMaybe'.
627fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b
628fforMaybe = flip fmapMaybe
630-- | Filter 'f a' using the provided predicate.
631-- Relies on 'fforMaybe'.
632ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
633ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
635-- | Filter 'Left's from 'f (Either a b)' into 'a'.
636filterLeft :: FunctorMaybe f => f (Either a b) -> f a
637filterLeft = fmapMaybe (either Just (const Nothing))
639-- | Filter 'Right's from 'f (Either a b)' into 'b'.
640filterRight :: FunctorMaybe f => f (Either a b) -> f b
641filterRight = fmapMaybe (either (const Nothing) Just)
643-- | Left-biased event union (prefers left event on simultaneous
645instance Reflex t => Alt (Event t) where
646 ev1 <!> ev2 = leftmost [ev1, ev2]
648-- | 'Event' intersection (convenient interface to 'coincidence').
649instance Reflex t => Apply (Event t) where
650 evf <.> evx = coincidence (fmap (<$> evx) evf)
652-- | 'Event' intersection (convenient interface to 'coincidence').
653instance Reflex t => Bind (Event t) where
654 evx >>- f = coincidence (f <$> evx)
657instance Reflex t => Functor (Event t) where
659 fmap f = fmapMaybe $ Just . f
661 x <$ e = fmapCheap (const x) e
663instance Reflex t => FunctorMaybe (Event t) where
664 {-# INLINE fmapMaybe #-}
665 fmapMaybe f = push $ return . f
667-- | Never: @'zero' = 'never'@.
668instance Reflex t => Plus (Event t) where
671-- | Replace each occurrence value of the 'Event' with the value of the
672-- 'Behavior' at the time of that occurrence.
673tag :: Reflex t => Behavior t b -> Event t a -> Event t b
674tag b = pushAlways $ \_ -> sample b
676-- | Create a new 'Event' that combines occurences of supplied 'Event' with the
677-- current value of the 'Behavior'.
678attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
679attach = attachWith (,)
681-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
682-- combining it with the current value of the 'Behavior'.
683attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
684attachWith f = attachWithMaybe $ \a b -> Just $ f a b
686-- | Create a new 'Event' by combining each occurence with the current value of
687-- the 'Behavior'. The occurrence is discarded if the combining function returns
689attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
690attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
692-- | Create a new 'Event' that occurs on all but the first occurence of the
694tailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
695tailE e = snd <$> headTailE e
697-- | Create a tuple of two 'Event's with the first one occuring only the first
698-- time the supplied 'Event' occurs and the second occuring on all but the first
700headTailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a, Event t a)
703 be <- hold never $ fmap (const e) eHead
704 return (eHead, switch be)
706-- | Starting at the current time, fire all the occurrences of the 'Event' for
707-- which the given predicate returns 'True'. When 'False' is returned, do not
708-- fire, and permanently stop firing, even if 'True' values are encountered
710takeWhileE :: forall t m a. (Reflex t, MonadFix m, MonadHold t m) => (a -> Bool) -> Event t a -> m (Event t a)
712 rec let (eFalse, eTrue) = fanEither $ ffor e' $ \a -> if f a
719-- | Split the supplied 'Event' into two individual 'Event's occuring at the
720-- same time with the respective values from the tuple.
721splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
722splitE e = (fmap fst e, fmap snd e)
724-- | Print the supplied 'String' and the value of the 'Event' on each
725-- occurence. This should /only/ be used for debugging.
727-- Note: As with Debug.Trace.trace, the message will only be printed if the
728-- 'Event' is actually used.
729traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
730traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
732-- | Print the output of the supplied function on each occurence of the
733-- 'Event'. This should /only/ be used for debugging.
735-- Note: As with Debug.Trace.trace, the message will only be printed if the
736-- 'Event' is actually used.
737traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
738traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
740instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
741 (<>) = alignWith (mergeThese (<>))
742 sconcat = fmap sconcat . mergeList . toList
743#if MIN_VERSION_semigroups(0,17,0)
744 stimes n = fmap $ stimes n
746 times1p n = fmap $ times1p n
749instance (Semigroup a, Reflex t) => Monoid (Event t a) where
752 mconcat = fmap sconcat . mergeList
754-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
755-- list occurs. If multiple occur at the same time they are folded from the left
756-- with the given function.
757{-# INLINE mergeWith #-}
758mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
759mergeWith = mergeWith' id
761{-# INLINE mergeWith' #-}
762mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
763mergeWith' f g es = fmap (Prelude.foldl1 g . fmap f)
765 . IntMap.fromDistinctAscList
766 $ zip [0 :: Int ..] es
768-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
769-- list occurs. If multiple occur at the same time the value is the value of the
771{-# INLINE leftmost #-}
772leftmost :: Reflex t => [Event t a] -> Event t a
773leftmost = mergeWith const
775-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
776-- list occurs and has a list of the values of all 'Event's occuring at that
778mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
780mergeList es = mergeWithFoldCheap' id es
782unsafeMapIncremental :: (Reflex t, Patch p, Patch p') => (PatchTarget p -> PatchTarget p') -> (p -> p') -> Incremental t p -> Incremental t p'
783unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
785-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
786-- occurs if at least one of them occurs and has a map of values of all 'Event's
787-- occuring at that time.
788mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
789mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
791-- | Create a merge whose parents can change over time
792mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
793mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
795-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
796mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
797mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
799-- | Split the event into separate events for 'Left' and 'Right' values.
800fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
802 let justLeft = either Just (const Nothing)
803 justRight = either (const Nothing) Just
804 in (fmapMaybe justLeft e, fmapMaybe justRight e)
806-- | Split the event into separate events for 'This' and 'That' values,
807-- allowing them to fire simultaneously when the input value is 'These'.
808fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
810 let this (This x) = Just x
811 this (These x _) = Just x
813 that (That y) = Just y
814 that (These _ y) = Just y
816 in (fmapMaybe this e, fmapMaybe that e)
818-- | Split the event into an 'EventSelector' that allows efficient selection of
819-- the individual 'Event's.
820fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
821fanMap = fan . fmap mapToDMap
823-- | Switches to the new event whenever it receives one. Whenever a new event
824-- is provided, if it is firing, its value will be the resulting event's value;
825-- if it is not firing, but the old one is, the old one's value will be used.
826switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
827switchPromptly ea0 eea = do
829 let eLag = switch bea
830 eCoincidences = coincidence eea
831 return $ leftmost [eCoincidences, eLag]
833-- | 'switch'es to a new event whenever it receives one. At the moment of
834-- switching, the old event will be ignored if it fires, and the new one will be
835-- used if it fires; this is the opposite of 'switch', which will use only the
837switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
838switchPromptOnly e0 e' = do
839 eLag <- switch <$> hold e0 e'
840 return $ coincidence $ leftmost [e', eLag <$ eLag]
842instance Reflex t => Align (Event t) where
844 align = alignEventWithMaybe Just
846-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
847-- the 'Behavior' is true at the time of occurence.
848gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
849gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
851-- | Create a new behavior given a starting behavior and switch to a the behvior
852-- carried by the event when it fires.
853switcher :: (Reflex t, MonadHold t m)
854 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
855switcher b eb = pull . (sample <=< sample) <$> hold b eb
857instance (Reflex t, IsString a) => IsString (Dynamic t a) where
858 fromString = pure . fromString
860-- | Combine two 'Dynamic's. The result will change whenever either (or both)
861-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
862zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
863zipDyn = zipDynWith (,)
865-- | Combine two 'Dynamic's with a combining function. The result will change
866-- whenever either (or both) input 'Dynamic' changes.
867-- More efficient than liftA2.
868zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
870 let eab = align (updated da) (updated db)
871 ec = flip push eab $ \o -> do
874 b <- sample $ current db
877 a <- sample $ current da
879 These a b -> return (a, b)
880 return $ Just $ f a b
881 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
883instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
884 mconcat = distributeListOverDynWith mconcat
885 mempty = constDyn mempty
886 mappend = zipDynWith mappend
888-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
889-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
890-- through the use of multiple uses of 'zipWithDyn' or 'Applicative' operators.
891distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
892distributeDMapOverDynPure dm = case DMap.toList dm of
893 [] -> constDyn DMap.empty
894 [k :=> v] -> fmap (DMap.singleton k . Identity) v
896 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
897 edmPre = merge $ DMap.map updated dm
898 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
899 olds <- sample $ current result
900 return $ DMap.unionWithKey (\_ _ new -> new) olds news
903-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
904distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
905distributeListOverDyn = distributeListOverDynWith id
907-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
908distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
909distributeListOverDynWith f = fmap (f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]
911-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
912-- unless the second supplied 'Event' occurs simultaneously.
913difference :: Reflex t => Event t a -> Event t b -> Event t a
914difference = alignEventWithMaybe $ \case
918alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
919alignEventWithMaybe f ea eb =
920 fmapMaybe (f <=< dmapToThese)
922 $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
925--------------------------------------------------------------------------------
927--------------------------------------------------------------------------------
929-- | An 'Accumulator' type can be built by accumulating occurrences of an
931#if __GLASGOW_HASKELL__ < 802
932{-# WARNING accum "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
933{-# WARNING accumM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
934{-# WARNING accumMaybe "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
935{-# WARNING accumMaybeM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
937class Reflex t => Accumulator t f | f -> t where
938 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
939 accum f = accumMaybe $ \v o -> Just $ f v o
940 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
941 accumM f = accumMaybeM $ \v o -> Just <$> f v o
942 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
943 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
944 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
945 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
946 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
947 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
948 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
949 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
950 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
951 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
953accumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Dynamic t a)
954accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o
955accumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Dynamic t a)
956accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o
957accumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Dynamic t a)
958accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o
959accumMaybeMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Dynamic t a)
960accumMaybeMDyn f z e = do
961 rec let e' = flip push e $ \o -> do
962 v <- sample $ current d'
966mapAccumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
967mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o
968mapAccumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
969mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o
970mapAccumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
971mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o
972mapAccumMaybeMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
973mapAccumMaybeMDyn f z e = do
974 rec let e' = flip push e $ \o -> do
975 v <- sample $ current d'
977 return $ case result of
978 (Nothing, Nothing) -> Nothing
980 d' <- holdDyn z $ fmapMaybe fst e'
981 return (d', fmapMaybe snd e')
984accumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Behavior t a)
985accumB f = accumMaybeB $ \v o -> Just $ f v o
986{-# INLINE accumMB #-}
987accumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Behavior t a)
988accumMB f = accumMaybeMB $ \v o -> Just <$> f v o
989{-# INLINE accumMaybeB #-}
990accumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Behavior t a)
991accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o
992{-# INLINE accumMaybeMB #-}
993accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)
994accumMaybeMB f z e = do
995 rec let e' = flip push e $ \o -> do
1000{-# INLINE mapAccumB #-}
1001mapAccumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)
1002mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o
1003{-# INLINE mapAccumMB #-}
1004mapAccumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)
1005mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o
1006{-# INLINE mapAccumMaybeB #-}
1007mapAccumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)
1008mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o
1010{-# INLINE mapAccumMaybeMB #-}
1011mapAccumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)
1012mapAccumMaybeMB f z e = do
1013 rec let e' = flip push e $ \o -> do
1016 return $ case result of
1017 (Nothing, Nothing) -> Nothing
1019 d' <- hold z $ fmapMaybe fst e'
1020 return (d', fmapMaybe snd e')
1022-- | Accumulate occurrences of an 'Event', producing an output occurrence each
1023-- time. Discard the underlying 'Accumulator'.
1024{-# INLINE mapAccum_ #-}
1025mapAccum_ :: 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)
1027 (_, result) <- mapAccumB f z e
1030-- | Accumulate occurrences of an 'Event', possibly producing an output
1031-- occurrence each time. Discard the underlying 'Accumulator'.
1032{-# INLINE mapAccumMaybe_ #-}
1033mapAccumMaybe_ :: 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)
1034mapAccumMaybe_ f z e = do
1035 (_, result) <- mapAccumMaybeB f z e
1038-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
1039-- an output occurrence each time. Discard the underlying 'Accumulator'.
1040{-# INLINE mapAccumM_ #-}
1041mapAccumM_ :: 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)
1042mapAccumM_ f z e = do
1043 (_, result) <- mapAccumMB f z e
1046-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
1047-- producing an output occurrence each time. Discard the underlying
1049{-# INLINE mapAccumMaybeM_ #-}
1050mapAccumMaybeM_ :: 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)
1051mapAccumMaybeM_ f z e = do
1052 (_, result) <- mapAccumMaybeMB f z e
1055instance Reflex t => Accumulator t (Dynamic t) where
1056 accumMaybeM = accumMaybeMDyn
1057 mapAccumMaybeM = mapAccumMaybeMDyn
1059instance Reflex t => Accumulator t (Behavior t) where
1060 accumMaybeM = accumMaybeMB
1061 mapAccumMaybeM = mapAccumMaybeMB
1063instance Reflex t => Accumulator t (Event t) where
1064 accumMaybeM f z e = updated <$> accumMaybeM f z e
1065 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
1067-- | Create a new 'Event' by combining each occurence with the next value of the
1068-- list using the supplied function. If the list runs out of items, all
1069-- subsequent 'Event' occurrences will be ignored.
1070zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
1071zipListWithEvent f l e = do
1072 let f' a b = case a of
1073 h:t -> (Just t, Just $ f h b)
1074 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
1075 mapAccumMaybe_ f' l e
1077-- | Assign a number to each occurence of the given 'Event', starting from 0
1078{-# INLINE numberOccurrences #-}
1079numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
1080numberOccurrences = numberOccurrencesFrom 0
1082-- | Assign a number to each occurence of the given 'Event'
1083{-# INLINE numberOccurrencesFrom #-}
1084numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
1085numberOccurrencesFrom = mapAccum_ (\n a -> (n + 1, (n, a)))
1087-- | Assign a number to each occurence of the given 'Event'; discard the occurrences' values
1088{-# INLINE numberOccurrencesFrom_ #-}
1089numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
1090numberOccurrencesFrom_ = mapAccum_ (\n _ -> (n + 1, n))
1092-- | This is used to sample the value of a 'Behavior' using an 'Event'.
1094-- The '<@>' operator is intended to be used in conjunction with
1095-- the 'Applicative' instance for 'Behavior'.
1097-- This is useful when we want to combine the values of one 'Event' and
1098-- the value of several 'Behavior's at the time the 'Event' is firing.
1102-- > f :: a -> b -> c -> d
1103-- > b1 :: Behavior t a
1104-- > b2 :: Behavior t b
1109-- > f <$> b1 <*> b2 <@> e :: Event t d
1111-- in order to apply the function 'f' to the relevant values.
1113-- The alternative would be something like:
1115-- > attachWith (\(x1, x2) y -> f x1 x2 y) ((,) <$> b1 <*> b2) e :: Event t d
1117-- or a variation involing a custom data type to hold the combination of
1118-- 'Behavior's even when that combination might only ever be used by 'f'.
1120-- A more suggestive example might be:
1122-- > handleMouse <$> bPlayerState <*> bMousePosition <@> eMouseClick :: Event t (GameState -> GameState)
1124(<@>) :: Reflex t => Behavior t (a -> b) -> Event t a -> Event t b
1125(<@>) b = push $ \x -> do
1127 return . Just . f $ x
1130-- | An version of '<@>' that does not use the value of the 'Event'.
1132-- Alternatively, it is 'tag' in operator form.
1134-- This is useful when we want to combine the values of several
1135-- 'Behavior's at particular points in time using an 'Applicative'
1140-- > g :: a -> b -> d
1141-- > b1 :: Behavior t a
1142-- > b2 :: Behavior t b
1145-- where 'e' is firing at the points in time of interest.
1147-- Then we can use '<@':
1149-- > g <$> b1 <*> b2 <@ e :: Event t d
1151-- to combine the values of 'b1' and 'b2' at each of those points of time,
1152-- with the function 'g' being used to combine the values.
1154-- This is the same as '<@>' except that the 'Event' is being used only
1155-- to act as a trigger.
1156(<@) :: (Reflex t) => Behavior t b -> Event t a -> Event t b
1164-- | A 'Monad' that supports adjustment over time. After an action has been
1165-- run, if the given events fire, it will adjust itself so that its net effect
1166-- is as though it had originally been run with the new value. Note that there
1167-- is some issue here with persistent side-effects: obviously, IO (and some
1168-- other side-effects) cannot be undone, so it is up to the instance implementer
1169-- to determine what the best meaning for this class is in such cases.
1170class (Reflex t, Monad m) => Adjustable t m | m -> t where
1171 runWithReplace :: m a -> Event t (m b) -> m (a, Event t b)
1172 traverseIntMapWithKeyWithAdjust :: (IntMap.Key -> v -> m v') -> IntMap v -> Event t (PatchIntMap v) -> m (IntMap v', Event t (PatchIntMap v'))
1173 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'))
1174 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'))
1176instance Adjustable t m => Adjustable t (ReaderT r m) where
1177 runWithReplace a0 a' = do
1179 lift $ runWithReplace (runReaderT a0 r) $ fmap (`runReaderT` r) a'
1180 traverseIntMapWithKeyWithAdjust f dm0 dm' = do
1182 lift $ traverseIntMapWithKeyWithAdjust (\k v -> runReaderT (f k v) r) dm0 dm'
1183 traverseDMapWithKeyWithAdjust f dm0 dm' = do
1185 lift $ traverseDMapWithKeyWithAdjust (\k v -> runReaderT (f k v) r) dm0 dm'
1186 traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = do
1188 lift $ traverseDMapWithKeyWithAdjustWithMove (\k v -> runReaderT (f k v) r) dm0 dm'
1190sequenceDMapWithAdjust :: (GCompare k, Adjustable t m) => DMap k m -> Event t (PatchDMap k m) -> m (DMap k Identity, Event t (PatchDMap k Identity))
1191sequenceDMapWithAdjust = traverseDMapWithKeyWithAdjust $ \_ -> fmap Identity
1193sequenceDMapWithAdjustWithMove :: (GCompare k, Adjustable t m) => DMap k m -> Event t (PatchDMapWithMove k m) -> m (DMap k Identity, Event t (PatchDMapWithMove k Identity))
1194sequenceDMapWithAdjustWithMove = traverseDMapWithKeyWithAdjustWithMove $ \_ -> fmap Identity
1196mapMapWithAdjustWithMove :: forall t m k v v'. (Adjustable 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'))
1197mapMapWithAdjustWithMove f m0 m' = do
1198 (out0 :: DMap (Const2 k v) (Constant v'), out') <- traverseDMapWithKeyWithAdjustWithMove (\(Const2 k) (Identity v) -> Constant <$> f k v) (mapToDMap m0) (const2PatchDMapWithMoveWith Identity <$> m')
1199 return (dmapToMapWith (\(Constant v') -> v') out0, patchDMapWithMoveToPatchMapWithMoveWith (\(Constant v') -> v') <$> out')
1205{-# INLINE pushAlwaysCheap #-}
1206pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
1207pushAlwaysCheap f = pushCheap (fmap Just . f)
1209{-# INLINE fmapMaybeCheap #-}
1210fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b
1211fmapMaybeCheap f = pushCheap $ return . f
1213{-# INLINE fforMaybeCheap #-}
1214fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b
1215fforMaybeCheap = flip fmapMaybeCheap
1217{-# INLINE fforCheap #-}
1218fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b
1219fforCheap = flip fmapCheap
1221{-# INLINE fmapCheap #-}
1222fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b
1223fmapCheap f = pushCheap $ return . Just . f
1225{-# INLINE tagCheap #-}
1226tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
1227tagCheap b = pushAlwaysCheap $ \_ -> sample b
1229{-# INLINE mergeWithCheap #-}
1230mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
1231mergeWithCheap = mergeWithCheap' id
1233{-# INLINE mergeWithCheap' #-}
1234mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
1235mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
1237{-# INLINE mergeWithFoldCheap' #-}
1238mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
1239mergeWithFoldCheap' f es =
1240 fmapCheap (f . (\(h : t) -> h :| t) . IntMap.elems)
1242 . IntMap.fromDistinctAscList
1243 $ zip [0 :: Int ..] es
1245--------------------------------------------------------------------------------
1246-- Deprecated functions
1247--------------------------------------------------------------------------------
1249{-# DEPRECATED MonadAdjust "Use Adjustable instead" #-}
1250type MonadAdjust = Adjustable
1252-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
1253-- occurs. If both occur at the same time they are combined using 'mappend'.
1254{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}
1255appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
1256appendEvents = alignWith $ mergeThese mappend
1258-- | Alias for 'headE'
1259{-# DEPRECATED onceE "Use 'headE' instead" #-}
1260onceE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
1263-- | Run both sides of a 'These' monadically, combining the results.
1264{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
1265#ifdef USE_TEMPLATE_HASKELL
1266{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
1268sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
1269sequenceThese t = case t of
1270 This ma -> fmap This ma
1271 These ma mb -> liftM2 These ma mb
1272 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