2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FunctionalDependencies #-}
6{-# LANGUAGE LambdaCase #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE NoMonomorphismRestriction #-}
9{-# LANGUAGE RankNTypes #-}
10{-# LANGUAGE RecursiveDo #-}
11{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE TypeFamilies #-}
13{-# LANGUAGE TypeOperators #-}
14{-# LANGUAGE UndecidableInstances #-}
16-- | This module contains the Reflex interface, as well as a variety of
17-- convenience functions for working with 'Event's, 'Behavior's, and other
24 -- ** 'fan'-related types
26 -- ** 'Incremental'-related types
29 -- * Convenience functions
32 -- ** Combining 'Event's
37 -- ** Breaking up 'Event's
46 -- ** Switching between 'Event's
48 -- ** Using 'Event's to sample 'Behavior's
53 -- ** Blocking an 'Event' based on a 'Behavior'
55 -- ** Combining 'Dynamic's
56 , distributeDMapOverDynPure
57 , distributeListOverDyn
58 , distributeListOverDynWith
61 -- ** Accumulating state
72 -- * Debugging functions
81 -- * Miscellaneous convenience functions
83 -- * Deprecated functions
89import Control.Applicative
90import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
91import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
92import Control.Monad.State.Strict hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
93import Control.Monad.Trans.Cont (ContT ())
94import Control.Monad.Trans.Except (ExceptT ())
95import Control.Monad.Trans.RWS (RWST ())
96import Control.Monad.Trans.Writer (WriterT ())
99import Data.Dependent.Map (DMap, DSum (..), GCompare (..), GOrdering (..))
100import qualified Data.Dependent.Map as DMap
101import Data.Dependent.Sum (ShowTag (..))
104import Data.Functor.Bind hiding (join)
105import qualified Data.Functor.Bind as Bind
106import Data.Functor.Compose
107import Data.Functor.Constant
108import Data.Functor.Misc
109import Data.Functor.Plus
110import Data.GADT.Compare ((:~:) (..), GEq (..))
111import Data.GADT.Show (GShow (..))
112import Data.List.NonEmpty (NonEmpty (..))
115import Data.Monoid hiding (Alt, (<>))
116import Data.Semigroup (Semigroup, sconcat, stimes, stimesIdempotentMonoid, (<>))
119import Data.Traversable
121-- Note: must come last to silence warnings due to AMP on GHC < 7.10
122import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)
124import Debug.Trace (trace)
126-- | The 'Reflex' class contains all the primitive functionality needed for
127-- Functional Reactive Programming (FRP). The @t@ type parameter indicates
128-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
129-- and the type of the timeline determines the FRP engine to be used. For most
130-- purposes, the 'Reflex.Spider' implementation is recommended.
131class ( MonadHold t (PushM t)
132 , MonadSample t (PullM t)
135 , Functor (Behavior t)
136 , Functor (Dynamic t)
137 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
140 -- | A container for a value that can change over time. 'Behavior's can be
141 -- sampled at will, but it is not possible to be notified when they change
142 data Behavior t :: * -> *
143 -- | A stream of occurrences. During any given frame, an 'Event' is either
144 -- occurring or not occurring; if it is occurring, it will contain a value of
145 -- the given type (its "occurrence type")
146 data Event t :: * -> *
147 -- | A container for a value that can change over time and allows
148 -- notifications on changes. Basically a combination of a 'Behavior' and an
149 -- 'Event', with a rule that the 'Behavior' will change if and only if the
151 data Dynamic t :: * -> *
152 -- | A container for a value that can change over time and allows
153 -- notifications on changes. Basically a combination of a 'Behavior' and an
154 -- 'Event', with a rule that the 'Behavior' will change if and only if the
156 data Incremental t :: (* -> *) -> * -> *
157 -- | An 'Event' with no occurrences
159 -- | Create a 'Behavior' that always has the given value
160 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
161 -- | Create an 'Event' from another 'Event'; the provided function can sample
162 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
163 -- (Just) or non-occurring (Nothing) result
164 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
165 -- | A monad for doing complex push-based calculations efficiently
166 type PushM t :: * -> *
167 -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
168 -- recomputed whenever any of the read 'Behavior's changes
169 pull :: PullM t a -> Behavior t a
170 -- | A monad for doing complex pull-based calculations efficiently
171 type PullM t :: * -> *
172 -- | Merge a collection of events; the resulting 'Event' will only occur if at
173 -- least one input event is occuring, and will contain all of the input keys
174 -- that are occurring simultaneously
175 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
176 -- | Efficiently fan-out an event to many destinations. This function should
177 -- be partially applied, and then the result applied repeatedly to create
179 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
180 -- | Create an 'Event' that will occur whenever the currently-selected input
182 switch :: Behavior t (Event t a) -> Event t a
183 -- | Create an 'Event' that will occur whenever the input event is occurring
184 -- and its occurrence value, another 'Event', is also occurring
185 coincidence :: Event t (Event t a) -> Event t a
186 -- | Extract the 'Behavior' of a 'Dynamic'.
187 current :: Dynamic t a -> Behavior t a
188 -- | Extract the 'Event' of the 'Dynamic'.
189 updated :: Dynamic t a -> Event t a
190 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
191 -- recent firing of the given 'Event', if any.
192 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
193 -- | Create a new 'Incremental'. The given 'PullM''s value must always change
194 -- in the same way that the accumulated application of patches would change
196 unsafeBuildIncremental :: Patch p => PullM t a -> Event t (p a) -> Incremental t p a
197 -- | Create a merge whose parents can change over time
198 mergeIncremental :: GCompare k => Incremental t PatchDMap (DMap k (Event t)) -> Event t (DMap k Identity)
199 -- | Extract the 'Behavior' component of an 'Incremental'
200 currentIncremental :: Patch p => Incremental t p a -> Behavior t a
201 -- | Extract the 'Event' component of an 'Incremental'
202 updatedIncremental :: Patch p => Incremental t p a -> Event t (p a)
203 -- | Convert an 'Incremental' to a 'Dynamic'
204 incrementalToDynamic :: Patch p => Incremental t p a -> Dynamic t a
206-- | A 'Patch' type represents a kind of change made to a datastructure.
208 -- | Apply the patch @p a@ to the value @a@. If no change is needed, return
210 apply :: p a -> a -> Maybe a
212instance Patch Identity where
213 apply (Identity a) _ = Just a
215-- | A set of changes to a 'DMap'. Only DMap types are allowed for @a@.
216data PatchDMap a where
217 PatchDMap :: GCompare k => DMap k (Compose Maybe v) -> PatchDMap (DMap k v)
219instance GCompare k => Semigroup (PatchDMap (DMap k v)) where
220 PatchDMap a <> PatchDMap b = PatchDMap $ a `mappend` b --TODO: Add a semigroup instance for DMap
221 -- PatchDMap is idempotent, so stimes n is id for every n
222#if MIN_VERSION_semigroups(0,17,0)
223 stimes = stimesIdempotentMonoid
225 times1p n x = case compare n 0 of
226 LT -> error "stimesIdempotentMonoid: negative multiplier"
231instance GCompare k => Monoid (PatchDMap (DMap k v)) where
232 mempty = PatchDMap mempty
235instance Patch PatchDMap where
236 apply (PatchDMap diff) old = Just $! insertions `DMap.union` (old `DMap.difference` deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?
237 where insertions = DMap.mapMaybeWithKey (const $ getCompose) diff
238 deletions = DMap.mapMaybeWithKey (const $ nothingToJust . getCompose) diff
239 nothingToJust = \case
240 Nothing -> Just $ Constant ()
243-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
244-- _must_ change when and only when the 'Event' fires, such that the
245-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
246-- if this is not the case, the resulting 'Dynamic' will behave
247-- nondeterministically.
248unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
249unsafeDynamic = unsafeBuildDynamic . sample
251-- | Construct a 'Dynamic' value that never changes
252constDyn :: Reflex t => a -> Dynamic t a
255-- | 'MonadSample' designates monads that can read the current value of a
256-- 'Behavior'. This includes both 'PullM' and 'PushM'.
257class (Applicative m, Monad m) => MonadSample t m | m -> t where
258 -- | Get the current value in the 'Behavior'
259 sample :: Behavior t a -> m a
261-- | 'MonadHold' designates monads that can create new 'Behavior's based on
262-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
263-- is required to create any stateful computations with Reflex.
264class MonadSample t m => MonadHold t m where
265 -- | Create a new 'Behavior' whose value will initially be equal to the given
266 -- value and will be updated whenever the given 'Event' occurs. The update
267 -- takes effect immediately after the 'Event' occurs; if the occurrence that
268 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
269 -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new
271 hold :: a -> Event t a -> m (Behavior t a)
272 -- | Create a 'Dynamic' value using the given initial value that changes every
273 -- time the 'Event' occurs.
274 holdDyn :: a -> Event t a -> m (Dynamic t a)
275 -- | Create an 'Incremental' value using the given initial value that changes
276 -- every time the 'Event' occurs.
277 holdIncremental :: Patch p => a -> Event t (p a) -> m (Incremental t p a)
279-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
280-- key. This is much more efficient than filtering for each key with
282newtype EventSelector t k = EventSelector
283 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
284 -- determined by the type of the key, so this can be used to fan-out
285 -- 'Event's whose sub-'Event's have different types.
287 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
288 -- (but equivalent to) using 'fmapMaybe' to select only the relevant
289 -- occurrences of an 'Event'.
290 select :: forall a. k a -> Event t a
293--------------------------------------------------------------------------------
295--------------------------------------------------------------------------------
297instance MonadSample t m => MonadSample t (ReaderT r m) where
298 sample = lift . sample
300instance MonadHold t m => MonadHold t (ReaderT r m) where
301 hold a0 = lift . hold a0
302 holdDyn a0 = lift . holdDyn a0
303 holdIncremental a0 = lift . holdIncremental a0
305instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
306 sample = lift . sample
308instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
309 hold a0 = lift . hold a0
310 holdDyn a0 = lift . holdDyn a0
311 holdIncremental a0 = lift . holdIncremental a0
313instance MonadSample t m => MonadSample t (StateT s m) where
314 sample = lift . sample
316instance MonadHold t m => MonadHold t (StateT s m) where
317 hold a0 = lift . hold a0
318 holdDyn a0 = lift . holdDyn a0
319 holdIncremental a0 = lift . holdIncremental a0
321instance MonadSample t m => MonadSample t (ExceptT e m) where
322 sample = lift . sample
324instance MonadHold t m => MonadHold t (ExceptT e m) where
325 hold a0 = lift . hold a0
326 holdDyn a0 = lift . holdDyn a0
327 holdIncremental a0 = lift . holdIncremental a0
329instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
330 sample = lift . sample
332instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
333 hold a0 = lift . hold a0
334 holdDyn a0 = lift . holdDyn a0
335 holdIncremental a0 = lift . holdIncremental a0
337instance MonadSample t m => MonadSample t (ContT r m) where
338 sample = lift . sample
340instance MonadHold t m => MonadHold t (ContT r m) where
341 hold a0 = lift . hold a0
342 holdDyn a0 = lift . holdDyn a0
343 holdIncremental a0 = lift . holdIncremental a0
345--------------------------------------------------------------------------------
346-- Convenience functions
347--------------------------------------------------------------------------------
349-- | Create an 'Event' from another 'Event'. The provided function can sample
350-- 'Behavior's and hold 'Event's.
351pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
352pushAlways f = push (fmap Just . f)
354-- | Flipped version of 'fmap'.
355ffor :: Functor f => f a -> (a -> b) -> f b
358instance Reflex t => Applicative (Behavior t) where
360 f <*> x = pull $ sample f `ap` sample x
364instance Reflex t => Apply (Behavior t) where
367instance Reflex t => Bind (Behavior t) where
370instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
372 fromRational = pure . fromRational
375instance Reflex t => Functor (Behavior t) where
376 fmap f = pull . fmap f . sample
378instance (Reflex t, IsString a) => IsString (Behavior t a) where
379 fromString = pure . fromString
381instance Reflex t => Monad (Behavior t) where
382 a >>= f = pull $ sample a >>= sample . f
383 -- 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.
385 fail = error "Monad (Behavior t) does not support fail"
387instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
388 mempty = constant mempty
389 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
390 mconcat = pull . fmap mconcat . mapM sample
392instance (Reflex t, Num a) => Num (Behavior t a) where
397 fromInteger = pure . fromInteger
401instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
402 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
403 sconcat = pull . fmap sconcat . mapM sample
404#if MIN_VERSION_semigroups(0,17,0)
405 stimes n = fmap $ stimes n
407 times1p n = fmap $ times1p n
410--TODO: See if there's a better class in the standard libraries already
411-- | A class for values that combines filtering and mapping using 'Maybe'.
412class FunctorMaybe f where
413 -- | Combined mapping and filtering function.
414 fmapMaybe :: (a -> Maybe b) -> f a -> f b
416instance FunctorMaybe [] where
417 fmapMaybe f = catMaybes . fmap f
419-- | Flipped version of 'fmapMaybe'.
420fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b
421fforMaybe = flip fmapMaybe
423-- | Filter 'f a' using the provided predicate.
424-- Relies on 'fforMaybe'.
425ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
426ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
428-- | Left-biased event union (prefers left event on simultaneous
430instance Reflex t => Alt (Event t) where
431 ev1 <!> ev2 = leftmost [ev1, ev2]
433-- | 'Event' intersection (convenient interface to 'coincidence').
434instance Reflex t => Apply (Event t) where
435 evf <.> evx = coincidence (fmap (<$> evx) evf)
437-- | 'Event' intersection (convenient interface to 'coincidence').
438instance Reflex t => Bind (Event t) where
439 evx >>- f = coincidence (f <$> evx)
442instance Reflex t => Functor (Event t) where
443 fmap f = fmapMaybe $ Just . f
445instance Reflex t => FunctorMaybe (Event t) where
446 fmapMaybe f = push $ return . f
448-- | Never: @'zero' = 'never'@.
449instance Reflex t => Plus (Event t) where
452-- | Replace each occurrence value of the 'Event' with the value of the
453-- 'Behavior' at the time of that occurrence.
454tag :: Reflex t => Behavior t b -> Event t a -> Event t b
455tag b = pushAlways $ \_ -> sample b
457-- | Create a new 'Event' that combines occurences of supplied 'Event' with the
458-- current value of the 'Behavior'.
459attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
460attach = attachWith (,)
462-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
463-- combining it with the current value of the 'Behavior'.
464attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
465attachWith f = attachWithMaybe $ \a b -> Just $ f a b
467-- | Create a new 'Event' by combining each occurence with the current value of
468-- the 'Behavior'. The occurrence is discarded if the combining function returns
470attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
471attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
473-- | Create a new 'Event' that only occurs only once, on the first occurence of
474-- the supplied 'Event'.
475headE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
477 rec be <- hold e $ fmap (const never) e'
482-- | Create a new 'Event' that occurs on all but the first occurence of the
484tailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
485tailE e = snd <$> headTailE e
487-- | Create a tuple of two 'Event's with the first one occuring only the first
488-- time the supplied 'Event' occurs and the second occuring on all but the first
490headTailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a, Event t a)
493 be <- hold never $ fmap (const e) eHead
494 return (eHead, switch be)
496-- | Split the supplied 'Event' into two individual 'Event's occuring at the
497-- same time with the respective values from the tuple.
498splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
499splitE e = (fmap fst e, fmap snd e)
501-- | Print the supplied 'String' and the value of the 'Event' on each
502-- occurence. This should /only/ be used for debugging.
504-- Note: As with Debug.Trace.trace, the message will only be printed if the
505-- 'Event' is actually used.
506traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
507traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
509-- | Print the output of the supplied function on each occurence of the
510-- 'Event'. This should /only/ be used for debugging.
512-- Note: As with Debug.Trace.trace, the message will only be printed if the
513-- 'Event' is actually used.
514traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
515traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
517-- | Tag type for 'Either' to use it as a 'DSum'.
518data EitherTag l r a where
519 LeftTag :: EitherTag l r l
520 RightTag :: EitherTag l r r
522instance GEq (EitherTag l r) where
523 geq a b = case (a, b) of
524 (LeftTag, LeftTag) -> Just Refl
525 (RightTag, RightTag) -> Just Refl
528instance GCompare (EitherTag l r) where
529 gcompare a b = case (a, b) of
530 (LeftTag, LeftTag) -> GEQ
531 (LeftTag, RightTag) -> GLT
532 (RightTag, LeftTag) -> GGT
533 (RightTag, RightTag) -> GEQ
535instance GShow (EitherTag l r) where
536 gshowsPrec _ a = case a of
537 LeftTag -> showString "LeftTag"
538 RightTag -> showString "RightTag"
540instance (Show l, Show r) => ShowTag (EitherTag l r) Identity where
541 showTaggedPrec t n (Identity a) = case t of
542 LeftTag -> showsPrec n a
543 RightTag -> showsPrec n a
545-- | Convert 'Either' to a 'DSum'. Inverse of 'dsumToEither'.
546eitherToDSum :: Either a b -> DSum (EitherTag a b) Identity
548 Left a -> (LeftTag :=> Identity a)
549 Right b -> (RightTag :=> Identity b)
551-- | Convert 'DSum' to 'Either'. Inverse of 'eitherToDSum'.
552dsumToEither :: DSum (EitherTag a b) Identity -> Either a b
554 (LeftTag :=> Identity a) -> Left a
555 (RightTag :=> Identity b) -> Right b
557-- | Extract the values of a 'DMap' of 'EitherTag's.
558dmapToThese :: DMap (EitherTag a b) Identity -> Maybe (These a b)
559dmapToThese m = case (DMap.lookup LeftTag m, DMap.lookup RightTag m) of
560 (Nothing, Nothing) -> Nothing
561 (Just (Identity a), Nothing) -> Just $ This a
562 (Nothing, Just (Identity b)) -> Just $ That b
563 (Just (Identity a), Just (Identity b)) -> Just $ These a b
565instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
566 (<>) = alignWith (mergeThese (<>))
567 sconcat = fmap sconcat . mergeList . toList
568#if MIN_VERSION_semigroups(0,17,0)
569 stimes n = fmap $ stimes n
571 times1p n = fmap $ times1p n
574instance (Semigroup a, Reflex t) => Monoid (Event t a) where
577 mconcat = fmap sconcat . mergeList
579-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
580-- list occurs. If multiple occur at the same time they are folded from the left
581-- with the given function.
582mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
583mergeWith f es = fmap (Prelude.foldl1 f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList)
585 . DMap.fromDistinctAscList
586 . map (\(k, v) -> Const2 k :=> v)
587 $ zip [0 :: Int ..] es
589-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
590-- list occurs. If multiple occur at the same time the value is the value of the
592leftmost :: Reflex t => [Event t a] -> Event t a
593leftmost = mergeWith const
595-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
596-- list occurs and has a list of the values of all 'Event's occuring at that
598mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
600mergeList es = mergeWith (<>) $ map (fmap (:|[])) es
602-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
603-- occurs if at least one of them occurs and has a map of values of all 'Event's
604-- occuring at that time.
605mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
606mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
608-- | Split the event into separate events for 'Left' and 'Right' values.
609fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
611 let justLeft = either Just (const Nothing)
612 justRight = either (const Nothing) Just
613 in (fmapMaybe justLeft e, fmapMaybe justRight e)
615-- | Split the event into separate events for 'This' and 'That' values,
616-- allowing them to fire simultaneously when the input value is 'These'.
617fanThese :: Reflex t => Event t (These a b) -> (Event t a, Event t b)
619 let this (This x) = Just x
620 this (These x _) = Just x
622 that (That y) = Just y
623 that (These _ y) = Just y
625 in (fmapMaybe this e, fmapMaybe that e)
627-- | Split the event into an 'EventSelector' that allows efficient selection of
628-- the individual 'Event's.
629fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
630fanMap = fan . fmap mapToDMap
632-- | Switches to the new event whenever it receives one; the new event is used
633-- immediately, on the same frame that it is switched to
634switchPromptly :: forall t m a. (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
635switchPromptly ea0 eea = do
637 let eLag = switch bea
638 eCoincidences = coincidence eea
639 return $ leftmost [eCoincidences, eLag]
641instance Reflex t => Align (Event t) where
643 align ea eb = fmapMaybe dmapToThese $ merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
645-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
646-- the 'Behavior' is true at the time of occurence.
647gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
648gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
650-- | Create a new behavior given a starting behavior and switch to a the behvior
651-- carried by the event when it fires.
652switcher :: (Reflex t, MonadHold t m)
653 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
654switcher b eb = pull . (sample <=< sample) <$> hold b eb
656-- | Combine two 'Dynamic's. The result will change whenever either (or both)
657-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
658zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
659zipDyn = zipDynWith (,)
661-- | Combine two 'Dynamic's with a combining function. The result will change
662-- whenever either (or both) input 'Dynamic' changes.
663zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
665 let eab = align (updated da) (updated db)
666 ec = flip push eab $ \o -> do
669 b <- sample $ current db
672 a <- sample $ current da
674 These a b -> return (a, b)
675 return $ Just $ f a b
676 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
678instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
679 mconcat = distributeListOverDynWith mconcat
680 mempty = constDyn mempty
681 mappend = zipDynWith mappend
683-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
684-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
685-- through the use of multiple uses of 'zipWithDyn' or 'Applicative' operators.
686distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
687distributeDMapOverDynPure dm = case DMap.toList dm of
688 [] -> constDyn DMap.empty
689 [k :=> v] -> fmap (DMap.singleton k . Identity) v
691 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
692 edmPre = merge $ DMap.map updated dm
693 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
694 olds <- sample $ current result
695 return $ DMap.unionWithKey (\_ _ new -> new) olds news
698-- | Convert a list of 'Dynamic's into a 'Dynamic' list.
699distributeListOverDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
700distributeListOverDyn = distributeListOverDynWith id
702-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's
703distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
704distributeListOverDynWith f = fmap (f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]
707--------------------------------------------------------------------------------
709--------------------------------------------------------------------------------
711-- | An 'Accumulator' type can be built by accumulating occurrences of an
713class Reflex t => Accumulator t f | f -> t where
714 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
715 accum f = accumMaybe $ \v o -> Just $ f v o
716 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
717 accumM f = accumMaybeM $ \v o -> Just <$> f v o
718 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
719 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
720 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
721 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
722 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
723 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
724 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
725 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
726 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
727 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
729-- | Accumulate occurrences of an 'Event', producing an output occurrence each
730-- time. Discard the underlying 'Accumulator'.
731mapAccum_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Event t c)
733 (_ :: Behavior t a, result) <- mapAccum f z e
736-- | Accumulate occurrences of an 'Event', possibly producing an output
737-- occurrence each time. Discard the underlying 'Accumulator'.
738mapAccumMaybe_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
739mapAccumMaybe_ f z e = do
740 (_ :: Behavior t a, result) <- mapAccumMaybe f z e
743-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
744-- an output occurrence each time. Discard the underlying 'Accumulator'.
745mapAccumM_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Event t c)
747 (_ :: Behavior t a, result) <- mapAccumM f z e
750-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
751-- producing an output occurrence each time. Discard the underlying
753mapAccumMaybeM_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
754mapAccumMaybeM_ f z e = do
755 (_ :: Behavior t a, result) <- mapAccumMaybeM f z e
758instance Reflex t => Accumulator t (Dynamic t) where
759 accumMaybeM f z e = do
760 rec let e' = flip push e $ \o -> do
761 v <- sample $ current d'
765 mapAccumMaybeM f z e = do
766 rec let e' = flip push e $ \o -> do
767 v <- sample $ current d'
769 return $ case result of
770 (Nothing, Nothing) -> Nothing
772 d' <- holdDyn z $ fmapMaybe fst e'
773 return (d', fmapMaybe snd e')
775instance Reflex t => Accumulator t (Behavior t) where
776 accumMaybeM f z e = current <$> accumMaybeM f z e
777 mapAccumMaybeM f z e = first current <$> mapAccumMaybeM f z e
779instance Reflex t => Accumulator t (Event t) where
780 accumMaybeM f z e = updated <$> accumMaybeM f z e
781 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
783-- | Create a new 'Event' by combining each occurence with the next value of the
784-- list using the supplied function. If the list runs out of items, all
785-- subsequent 'Event' occurrences will be ignored.
786zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
787zipListWithEvent f l e = do
788 let f' a b = case a of
789 h:t -> (Just t, Just $ f h b)
790 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
791 mapAccumMaybe_ f' l e
793--------------------------------------------------------------------------------
794-- Deprecated functions
795--------------------------------------------------------------------------------
797-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
798-- occurs. If both occur at the same time they are combined using 'mappend'.
799{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}
800appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
801appendEvents = alignWith $ mergeThese mappend
803-- | Alias for 'headE'
804{-# DEPRECATED onceE "Use 'headE' instead" #-}
805onceE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
808{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
809{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
810sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
811sequenceThese t = case t of
812 This ma -> liftM This ma
813 These ma mb -> liftM2 These ma mb
814 That mb -> liftM 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