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 ScopedTypeVariables #-}
13{-# LANGUAGE TypeFamilies #-}
14{-# LANGUAGE TypeOperators #-}
15{-# LANGUAGE UndecidableInstances #-}
17module Reflex.Class where
19import Control.Applicative
20import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
21import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
22import Control.Monad.State.Strict hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
23import Control.Monad.Trans.Cont (ContT ())
24import Control.Monad.Trans.Except (ExceptT ())
25import Control.Monad.Trans.RWS (RWST ())
26import Control.Monad.Trans.Writer (WriterT ())
29import Data.Dependent.Map (DMap, DSum (..), GCompare (..), GOrdering (..))
30import qualified Data.Dependent.Map as DMap
31import Data.Dependent.Sum (ShowTag (..))
33import qualified Data.Functor.Bind as Bind
34import Data.Functor.Bind hiding (join)
35import Data.Functor.Compose
36import Data.Functor.Constant
37import Data.Functor.Misc
38import Data.Functor.Plus
39import Data.GADT.Compare ((:~:) (..), GEq (..))
40import Data.GADT.Show (GShow (..))
41import Data.List.NonEmpty (NonEmpty (..))
44import Data.Monoid hiding (Alt, (<>))
45import Data.Semigroup (Semigroup, sconcat, stimes, stimesIdempotentMonoid, (<>))
48import Data.Traversable
50-- Note: must come last to silence warnings due to AMP on GHC < 7.10
51import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)
53import Debug.Trace (trace)
55class ( MonadHold t (PushM t)
56 , MonadSample t (PullM t)
59 , Functor (Behavior t)
61 , Applicative (Dynamic t) -- Necessary for GHC <=7.8
64 -- | A container for a value that can change over time. Behaviors can be sampled at will, but it is not possible to be notified when they change
65 data Behavior t :: * -> *
66 -- | A stream of occurrences. During any given frame, an Event is either occurring or not occurring; if it is occurring, it will contain a value of the given type (its "occurrence type")
67 data Event t :: * -> *
68 -- | A container for a value that can change over time and allows notifications on changes.
69 -- Basically a combination of a 'Behavior' and an 'Event', with a rule that the Behavior will
70 -- change if and only if the Event fires.
71 data Dynamic t :: * -> *
72 -- | A container for a value that can change over time and allows notifications on changes.
73 -- Basically a combination of a 'Behavior' and an 'Event', with a rule that the Behavior will
74 -- change if and only if the Event fires.
75 data Incremental t :: (* -> *) -> * -> *
76 -- | An Event with no occurrences
78 -- | Create a Behavior that always has the given value
79 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 Behaviors doesn't have a negative performance impact
80 -- | Create an Event from another Event; the provided function can sample Behaviors and hold Events, and use the results to produce a occurring (Just) or non-occurring (Nothing) result
81 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
82 -- | A monad for doing complex push-based calculations efficiently
83 type PushM t :: * -> *
84 -- | Create a Behavior by reading from other Behaviors; the result will be recomputed whenever any of the read Behaviors changes
85 pull :: PullM t a -> Behavior t a
86 -- | A monad for doing complex pull-based calculations efficiently
87 type PullM t :: * -> *
88 -- | Merge a collection of events; the resulting Event will only occur if at least one input event is occuring, and will contain all of the input keys that are occurring simultaneously
89 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
90 -- | Efficiently fan-out an event to many destinations. This function should be partially applied, and then the result applied repeatedly to create child events
91 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
92 -- | Create an Event that will occur whenever the currently-selected input Event occurs
93 switch :: Behavior t (Event t a) -> Event t a
94 -- | Create an Event that will occur whenever the input event is occurring and its occurrence value, another Event, is also occurring
95 coincidence :: Event t (Event t a) -> Event t a
96 -- | Extract the 'Behavior' of a 'Dynamic'.
97 current :: Dynamic t a -> Behavior t a
98 -- | Extract the 'Event' of the 'Dynamic'.
99 updated :: Dynamic t a -> Event t a
100 -- | Create a new 'Dynamic'. The given PullM must always return the most recent firing of the given Event, if any.
101 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
102 -- | Create a new 'Incremental'. The given PullM's value must always change in the same way that the accumulated application of patches would change that value.
103 unsafeBuildIncremental :: Patch p => PullM t a -> Event t (p a) -> Incremental t p a
104 -- | Create a merge whose parents can change over time
105 mergeIncremental :: GCompare k => Incremental t PatchDMap (DMap k (Event t)) -> Event t (DMap k Identity)
106 -- | Extract the 'Behavior' component of an 'Incremental'
107 currentIncremental :: Patch p => Incremental t p a -> Behavior t a
108 -- | Extract the 'Event' component of an 'Incremental'
109 updatedIncremental :: Patch p => Incremental t p a -> Event t (p a)
110 -- | Convert an 'Incremental' to a 'Dynamic'
111 incrementalToDynamic :: Patch p => Incremental t p a -> Dynamic t a
114 apply :: p a -> a -> Maybe a -- Return Nothing if no change is necessary
116instance Patch Identity where
117 apply (Identity a) _ = Just a
119data PatchDMap a where
120 PatchDMap :: GCompare k => DMap k (Compose Maybe v) -> PatchDMap (DMap k v)
122instance GCompare k => Semigroup (PatchDMap (DMap k v)) where
123 PatchDMap a <> PatchDMap b = PatchDMap $ a `mappend` b --TODO: Add a semigroup instance for DMap
124 -- PatchDMap is idempotent, so stimes n is id for every n
125#if MIN_VERSION_semigroups(0,17,0)
126 stimes = stimesIdempotentMonoid
128 times1p n x = case compare n 0 of
129 LT -> error "stimesIdempotentMonoid: negative multiplier"
134instance GCompare k => Monoid (PatchDMap (DMap k v)) where
135 mempty = PatchDMap mempty
138instance Patch PatchDMap where
139 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?
140 where insertions = DMap.mapMaybeWithKey (const $ getCompose) diff
141 deletions = DMap.mapMaybeWithKey (const $ nothingToJust . getCompose) diff
142 nothingToJust = \case
143 Nothing -> Just $ Constant ()
146unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
147unsafeDynamic = unsafeBuildDynamic . sample
149constDyn :: Reflex t => a -> Dynamic t a
152class (Applicative m, Monad m) => MonadSample t m | m -> t where
153 -- | Get the current value in the Behavior
154 sample :: Behavior t a -> m a
156class MonadSample t m => MonadHold t m where
157 -- | Create a new Behavior whose value will initially be equal to the given value and will be updated whenever the given Event occurs. The update takes effect immediately after the Event occurs; if the occurrence that sets the Behavior (or one that is simultaneous with it) is used to sample the Behavior, it will see the *old* value of the Behavior, not the new one.
158 hold :: a -> Event t a -> m (Behavior t a)
159 -- | Create a 'Dynamic' value using the given initial value that changes every
160 -- time the 'Event' occurs.
161 holdDyn :: a -> Event t a -> m (Dynamic t a)
162 -- | Create an 'Incremental' value using the given initial value that changes every
163 -- time the 'Event' occurs.
164 holdIncremental :: Patch p => a -> Event t (p a) -> m (Incremental t p a)
166newtype EventSelector t k = EventSelector { select :: forall a. k a -> Event t a }
168--------------------------------------------------------------------------------
170--------------------------------------------------------------------------------
172instance MonadSample t m => MonadSample t (ReaderT r m) where
173 sample = lift . sample
175instance MonadHold t m => MonadHold t (ReaderT r m) where
176 hold a0 = lift . hold a0
177 holdDyn a0 = lift . holdDyn a0
178 holdIncremental a0 = lift . holdIncremental a0
180instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
181 sample = lift . sample
183instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
184 hold a0 = lift . hold a0
185 holdDyn a0 = lift . holdDyn a0
186 holdIncremental a0 = lift . holdIncremental a0
188instance MonadSample t m => MonadSample t (StateT s m) where
189 sample = lift . sample
191instance MonadHold t m => MonadHold t (StateT s m) where
192 hold a0 = lift . hold a0
193 holdDyn a0 = lift . holdDyn a0
194 holdIncremental a0 = lift . holdIncremental a0
196instance MonadSample t m => MonadSample t (ExceptT e m) where
197 sample = lift . sample
199instance MonadHold t m => MonadHold t (ExceptT e m) where
200 hold a0 = lift . hold a0
201 holdDyn a0 = lift . holdDyn a0
202 holdIncremental a0 = lift . holdIncremental a0
204instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
205 sample = lift . sample
207instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
208 hold a0 = lift . hold a0
209 holdDyn a0 = lift . holdDyn a0
210 holdIncremental a0 = lift . holdIncremental a0
212instance MonadSample t m => MonadSample t (ContT r m) where
213 sample = lift . sample
215instance MonadHold t m => MonadHold t (ContT r m) where
216 hold a0 = lift . hold a0
217 holdDyn a0 = lift . holdDyn a0
218 holdIncremental a0 = lift . holdIncremental a0
220--------------------------------------------------------------------------------
221-- Convenience functions
222--------------------------------------------------------------------------------
224-- | Create an Event from another Event.
225-- The provided function can sample 'Behavior's and hold 'Event's.
226pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
227pushAlways f = push (fmap Just . f)
229-- | Flipped version of 'fmap'.
230ffor :: Functor f => f a -> (a -> b) -> f b
233instance Reflex t => Applicative (Behavior t) where
235 f <*> x = pull $ sample f `ap` sample x
239instance Reflex t => Apply (Behavior t) where
242instance Reflex t => Bind (Behavior t) where
245instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
247 fromRational = pure . fromRational
250instance Reflex t => Functor (Behavior t) where
251 fmap f = pull . fmap f . sample
253instance (Reflex t, IsString a) => IsString (Behavior t a) where
254 fromString = pure . fromString
256instance Reflex t => Monad (Behavior t) where
257 a >>= f = pull $ sample a >>= sample . f
258 -- 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 Behaviors other than by using sample, I don't think it's possible to write (>>) to be more efficient than the (>>=) above.
260 fail = error "Monad (Behavior t) does not support fail"
262instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
263 mempty = constant mempty
264 mappend a b = pull $ liftM2 mappend (sample a) (sample b)
265 mconcat = pull . fmap mconcat . mapM sample
267instance (Reflex t, Num a) => Num (Behavior t a) where
272 fromInteger = pure . fromInteger
276instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
277 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
278 sconcat = pull . fmap sconcat . mapM sample
279#if MIN_VERSION_semigroups(0,17,0)
280 stimes n = fmap $ stimes n
282 times1p n = fmap $ times1p n
285--TODO: See if there's a better class in the standard libraries already
286-- | A class for values that combines filtering and mapping using 'Maybe'.
287class FunctorMaybe f where
288 -- | Combined mapping and filtering function.
289 fmapMaybe :: (a -> Maybe b) -> f a -> f b
291instance FunctorMaybe [] where
292 fmapMaybe f = catMaybes . fmap f
294-- | Flipped version of 'fmapMaybe'.
295fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b
296fforMaybe = flip fmapMaybe
298-- | Filter 'f a' using the provided predicate.
299-- Relies on 'fforMaybe'.
300ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
301ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
303-- | Left-biased event union (prefers left event on simultaneous
305instance Reflex t => Alt (Event t) where
306 ev1 <!> ev2 = leftmost [ev1, ev2]
308-- | Event intersection (convenient interface to 'coincidence').
309instance Reflex t => Apply (Event t) where
310 evf <.> evx = coincidence (fmap (<$> evx) evf)
312-- | Event intersection (convenient interface to 'coincidence').
313instance Reflex t => Bind (Event t) where
314 evx >>- f = coincidence (f <$> evx)
317instance Reflex t => Functor (Event t) where
318 fmap f = fmapMaybe $ Just . f
320instance Reflex t => FunctorMaybe (Event t) where
321 fmapMaybe f = push $ return . f
323-- | Never: @'zero' = 'never'@.
324instance Reflex t => Plus (Event t) where
327-- | Replace each occurrence value of the 'Event' with the value of the
328-- 'Behavior' at the time of that occurrence.
329tag :: Reflex t => Behavior t b -> Event t a -> Event t b
330tag b = pushAlways $ \_ -> sample b
332-- | Create a new 'Event' that combines occurences of supplied 'Event'
333-- with the current value of the 'Behavior'.
334attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
335attach = attachWith (,)
337-- | Create a new 'Event' that occurs when the supplied 'Event' occurs
338-- by combining it with the current value of the 'Behavior'.
339attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
340attachWith f = attachWithMaybe $ \a b -> Just $ f a b
342-- | Create a new 'Event' by combining each occurence with the current
343-- value of the 'Behavior'. The occurrence is discarded if the combining function
345attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
346attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
348-- | Alias for 'headE'
349onceE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
352-- | Create a new 'Event' that only occurs on the first occurence of
353-- the supplied 'Event'.
354headE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
356 rec be <- hold e $ fmap (const never) e'
361-- | Create a new 'Event' that occurs on all but the first occurence
362-- of the supplied 'Event'.
363tailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
364tailE e = snd <$> headTailE e
366-- | Create a tuple of two 'Event's with the first one occuring only
367-- the first time the supplied 'Event' occurs and the second occuring
368-- on all but the first occurence.
369headTailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a, Event t a)
372 be <- hold never $ fmap (const e) eHead
373 return (eHead, switch be)
375-- | Split the supplied 'Event' into two individual 'Event's occuring
376-- at the same time with the respective values from the tuple.
377splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
378splitE e = (fmap fst e, fmap snd e)
380-- | Print the supplied 'String' and the value of the 'Event' on each
381-- occurence. This should /only/ be used for debugging.
383-- Note: As with Debug.Trace.trace, the message will only be printed if
384-- the 'Event' is actually used.
385traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
386traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
388-- | Print the output of the supplied function on each occurence of
389-- the 'Event'. This should /only/ be used for debugging.
391-- Note: As with Debug.Trace.trace, the message will only be printed if
392-- the 'Event' is actually used.
393traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
394traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
396-- | Tag type for 'Either' to use it as a 'DSum'.
397data EitherTag l r a where
398 LeftTag :: EitherTag l r l
399 RightTag :: EitherTag l r r
401instance GEq (EitherTag l r) where
402 geq a b = case (a, b) of
403 (LeftTag, LeftTag) -> Just Refl
404 (RightTag, RightTag) -> Just Refl
407instance GCompare (EitherTag l r) where
408 gcompare a b = case (a, b) of
409 (LeftTag, LeftTag) -> GEQ
410 (LeftTag, RightTag) -> GLT
411 (RightTag, LeftTag) -> GGT
412 (RightTag, RightTag) -> GEQ
414instance GShow (EitherTag l r) where
415 gshowsPrec _ a = case a of
416 LeftTag -> showString "LeftTag"
417 RightTag -> showString "RightTag"
419instance (Show l, Show r) => ShowTag (EitherTag l r) Identity where
420 showTaggedPrec t n (Identity a) = case t of
421 LeftTag -> showsPrec n a
422 RightTag -> showsPrec n a
424-- | Convert 'Either' to a 'DSum'. Inverse of 'dsumToEither'.
425eitherToDSum :: Either a b -> DSum (EitherTag a b) Identity
427 Left a -> (LeftTag :=> Identity a)
428 Right b -> (RightTag :=> Identity b)
430-- | Convert 'DSum' to 'Either'. Inverse of 'eitherToDSum'.
431dsumToEither :: DSum (EitherTag a b) Identity -> Either a b
433 (LeftTag :=> Identity a) -> Left a
434 (RightTag :=> Identity b) -> Right b
436-- | Extract the values of a 'DMap' of 'EitherTag's.
437dmapToThese :: DMap (EitherTag a b) Identity -> Maybe (These a b)
438dmapToThese m = case (DMap.lookup LeftTag m, DMap.lookup RightTag m) of
439 (Nothing, Nothing) -> Nothing
440 (Just (Identity a), Nothing) -> Just $ This a
441 (Nothing, Just (Identity b)) -> Just $ That b
442 (Just (Identity a), Just (Identity b)) -> Just $ These a b
444-- | Create a new 'Event' that occurs if at least one of the supplied
445-- 'Event's occurs. If both occur at the same time they are combined
447appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
448appendEvents e1 e2 = mergeThese mappend <$> align e1 e2
450{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
451{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
452sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
453sequenceThese t = case t of
454 This ma -> liftM This ma
455 These ma mb -> liftM2 These ma mb
456 That mb -> liftM That mb
458instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
459 (<>) = alignWith (mergeThese (<>))
460 sconcat = fmap sconcat . mergeList . toList
461#if MIN_VERSION_semigroups(0,17,0)
462 stimes n = fmap $ stimes n
464 times1p n = fmap $ times1p n
467instance (Semigroup a, Reflex t) => Monoid (Event t a) where
470 mconcat = fmap sconcat . mergeList
472-- | Create a new 'Event' that occurs if at least one of the 'Event's
473-- in the list occurs. If multiple occur at the same time they are
474-- folded from the left with the given function.
475mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
476mergeWith f es = fmap (Prelude.foldl1 f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList)
478 . DMap.fromDistinctAscList
479 . map (\(k, v) -> Const2 k :=> v)
480 $ zip [0 :: Int ..] es
482-- | Create a new 'Event' that occurs if at least one of the 'Event's
483-- in the list occurs. If multiple occur at the same time the value is
484-- the value of the leftmost event.
485leftmost :: Reflex t => [Event t a] -> Event t a
486leftmost = mergeWith const
488-- | Create a new 'Event' that occurs if at least one of the 'Event's
489-- in the list occurs and has a list of the values of all 'Event's
490-- occuring at that time.
491mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
493mergeList es = mergeWith (<>) $ map (fmap (:|[])) es
495-- | Create a new 'Event' combining the map of 'Event's into an
496-- 'Event' that occurs if at least one of them occurs and has a map of
497-- values of all 'Event's occuring at that time.
498mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
499mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
501-- | Split the event into an 'EventSelector' that allows efficient
502-- selection of the individual 'Event's.
503fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
504fanMap = fan . fmap mapToDMap
506-- | Switches to the new event whenever it receives one; the new event is used immediately, on the same frame that it is switched to
507switchPromptly :: forall t m a. (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
508switchPromptly ea0 eea = do
510 let eLag = switch bea
511 eCoincidences = coincidence eea
512 return $ leftmost [eCoincidences, eLag]
514instance Reflex t => Align (Event t) where
516 align ea eb = fmapMaybe dmapToThese $ merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
518-- | Create a new 'Event' that only occurs if the supplied 'Event'
519-- occurs and the 'Behavior' is true at the time of occurence.
520gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
521gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
523-- | Create a new behavior given a starting behavior and switch to a the
524-- behvior carried by the event when it fires.
525switcher :: (Reflex t, MonadHold t m)
526 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
527switcher b eb = pull . (sample <=< sample) <$> hold b eb
529zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
531 let eab = align (updated da) (updated db)
532 ec = flip push eab $ \o -> do
535 b <- sample $ current db
538 a <- sample $ current da
540 These a b -> return (a, b)
541 return $ Just $ f a b
542 in unsafeBuildDynamic (f <$> sample (current da) <*> sample (current db)) ec
544instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
545 mconcat = fmap (mconcat . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]
546 mempty = constDyn mempty
547 mappend = zipDynWith mappend
549distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
550distributeDMapOverDynPure dm = case DMap.toList dm of
551 [] -> constDyn DMap.empty
552 [k :=> v] -> fmap (DMap.singleton k . Identity) v
554 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
555 edmPre = merge $ rewrapDMap updated dm
556 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
557 olds <- sample $ current result
558 return $ DMap.unionWithKey (\_ _ new -> new) olds news
561class Reflex t => Accumulator t f | f -> t where
562 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
563 accum f = accumMaybe $ \v o -> Just $ f v o
564 accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
565 accumM f = accumMaybeM $ \v o -> Just <$> f v o
566 accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
567 accumMaybe f = accumMaybeM $ \v o -> return $ f v o
568 accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
569 mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
570 mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
571 mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
572 mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
573 mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
574 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
575 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
577mapAccum_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Event t c)
579 (_ :: Behavior t a, result) <- mapAccum f z e
582mapAccumMaybe_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
583mapAccumMaybe_ f z e = do
584 (_ :: Behavior t a, result) <- mapAccumMaybe f z e
587mapAccumM_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Event t c)
589 (_ :: Behavior t a, result) <- mapAccumM f z e
592mapAccumMaybeM_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
593mapAccumMaybeM_ f z e = do
594 (_ :: Behavior t a, result) <- mapAccumMaybeM f z e
597instance Reflex t => Accumulator t (Dynamic t) where
598 accumMaybeM f z e = do
599 rec let e' = flip push e $ \o -> do
600 v <- sample $ current d'
604 mapAccumMaybeM f z e = do
605 rec let e' = flip push e $ \o -> do
606 v <- sample $ current d'
608 return $ case result of
609 (Nothing, Nothing) -> Nothing
611 d' <- holdDyn z $ fmapMaybe fst e'
612 return (d', fmapMaybe snd e')
614instance Reflex t => Accumulator t (Behavior t) where
615 accumMaybeM f z e = current <$> accumMaybeM f z e
616 mapAccumMaybeM f z e = first current <$> mapAccumMaybeM f z e
618instance Reflex t => Accumulator t (Event t) where
619 accumMaybeM f z e = updated <$> accumMaybeM f z e
620 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
622-- | Create a new 'Event' by combining each occurence with the next value
623-- of the list using the supplied function. If the list runs out of items,
624-- all subsequent 'Event' occurrences will be ignored.
625zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
626zipListWithEvent f l e = do
627 let f' a b = case a of
628 h:t -> (Just t, Just $ f h b)
629 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
630 mapAccumMaybe_ f' l e
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