@@ -9,6 +9,7 @@
99{-# LANGUAGE LambdaCase #-}
1010{-# LANGUAGE MultiParamTypeClasses #-}
1111{-# LANGUAGE NoMonomorphismRestriction #-}
12+{-# LANGUAGE PolyKinds #-}
1213{-# LANGUAGE RankNTypes #-}
1314{-# LANGUAGE RecursiveDo #-}
1415{-# LANGUAGE RoleAnnotations #-}
@@ -43,9 +44,13 @@ module Reflex.Class
4344 -- ** Combining 'Event's
4445 , leftmost
4546 , mergeMap
47+ , mergeIntMap
4648 , mergeMapIncremental
4749 , mergeMapIncrementalWithMove
4850 , mergeIntMapIncremental
51+ , coincidencePatchMap
52+ , coincidencePatchMapWithMove
53+ , coincidencePatchIntMap
4954 , mergeList
5055 , mergeWith
5156 , difference
@@ -59,12 +64,16 @@ module Reflex.Class
5964 , EitherTag (..)
6065 , eitherToDSum
6166 , dsumToEither
67+ , factorEvent
68+ , filterEventKey
6269 -- ** Collapsing 'Event . Event'
6370 , switchHold
6471 , switchHoldPromptly
6572 , switchHoldPromptOnly
73+ , switchHoldPromptOnlyIncremental
6674 -- ** Using 'Event's to sample 'Behavior's
6775 , tag
76+ , tagMaybe
6877 , attach
6978 , attachWith
7079 , attachWithMaybe
@@ -98,6 +107,14 @@ module Reflex.Class
98107 , mapAccumM_
99108 , mapAccumMaybe_
100109 , mapAccumMaybeM_
110+ , accumIncremental
111+ , accumMIncremental
112+ , accumMaybeIncremental
113+ , accumMaybeMIncremental
114+ , mapAccumIncremental
115+ , mapAccumMIncremental
116+ , mapAccumMaybeIncremental
117+ , mapAccumMaybeMIncremental
101118 , zipListWithEvent
102119 , numberOccurrences
103120 , numberOccurrencesFrom
@@ -107,6 +124,9 @@ module Reflex.Class
107124 , tailE
108125 , headTailE
109126 , takeWhileE
127+ , takeWhileJustE
128+ , dropWhileE
129+ , takeDropWhileJustE
110130 , switcher
111131 -- * Debugging functions
112132 , traceEvent
@@ -120,15 +140,11 @@ module Reflex.Class
120140 , ffilter
121141 , filterLeft
122142 , filterRight
123− -- * 'Adjustable'
124− , Adjustable(..)
125− , sequenceDMapWithAdjust
126− , sequenceDMapWithAdjustWithMove
127− , mapMapWithAdjustWithMove
128143 -- * Miscellaneous convenience functions
129144 , ffor
145+ , ffor2
146+ , ffor3
130147 -- * Deprecated functions
131− , MonadAdjust
132148 , appendEvents
133149 , onceE
134150 , sequenceThese
@@ -158,12 +174,14 @@ import Data.Align
158174import Data.Bifunctor
159175import Data.Coerce
160176import Data.Default
161−import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
177+import Data.Dependent.Map (DMap, DSum (..))
162178import qualified Data.Dependent.Map as DMap
179+import Data.Functor.Compose
180+import Data.Functor.Product
181+import Data.GADT.Compare (GEq (..), GCompare (..), (:~:) (..))
163182import Data.FastMutableIntMap (PatchIntMap)
164183import Data.Foldable
165184import Data.Functor.Bind
166−import Data.Functor.Constant
167185import Data.Functor.Misc
168186import Data.Functor.Plus
169187import Data.IntMap.Strict (IntMap)
@@ -171,11 +189,14 @@ import qualified Data.IntMap.Strict as IntMap
171189import Data.List.NonEmpty (NonEmpty (..))
172190import Data.Map (Map)
173191import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
192+import Data.Some (Some)
193+import qualified Data.Some as Some
174194import Data.String
175195import Data.These
176196import Data.Type.Coercion
177197import Reflex.FunctorMaybe
178198import Reflex.Patch
199+import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
179200
180201import Debug.Trace (trace)
181202
@@ -226,7 +247,7 @@ class ( MonadHold t (PushM t)
226247 -- recomputed whenever any of the read 'Behavior's changes
227248 pull :: PullM t a -> Behavior t a
228249 -- | Merge a collection of events; the resulting 'Event' will only occur if at
229− -- least one input event is occuring, and will contain all of the input keys
250+ -- least one input event is occurring, and will contain all of the input keys
230251 -- that are occurring simultaneously
231252 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
232253 -- | Efficiently fan-out an event to many destinations. This function should
@@ -332,15 +353,44 @@ class MonadSample t m => MonadHold t m where
332353 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
333354 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
334355 holdIncremental v0 = lift . holdIncremental v0
335− buildDynamic :: PullM t a -> Event t a -> m (Dynamic t a)
356+ buildDynamic :: PushM t a -> Event t a -> m (Dynamic t a)
336357 {-
337358 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
338359 buildDynamic getV0 = lift . buildDynamic getV0
339360 -}
340− -- | Create a new 'Event' that only occurs only once, on the first occurence of
361+ -- | Create a new 'Event' that only occurs only once, on the first occurrence of
341362 -- the supplied 'Event'.
342363 headE :: Event t a -> m (Event t a)
343364
365+accumIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> p) -> PatchTarget p -> Event t b -> m (Incremental t p)
366+accumIncremental f = accumMaybeIncremental $ \v o -> Just $ f v o
367+accumMIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> PushM t p) -> PatchTarget p -> Event t b -> m (Incremental t p)
368+accumMIncremental f = accumMaybeMIncremental $ \v o -> Just <$> f v o
369+accumMaybeIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> Maybe p) -> PatchTarget p -> Event t b -> m (Incremental t p)
370+accumMaybeIncremental f = accumMaybeMIncremental $ \v o -> return $ f v o
371+accumMaybeMIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> PushM t (Maybe p)) -> PatchTarget p -> Event t b -> m (Incremental t p)
372+accumMaybeMIncremental f z e = do
373+ rec let e' = flip push e $ \o -> do
374+ v <- sample $ currentIncremental d'
375+ f v o
376+ d' <- holdIncremental z e'
377+ return d'
378+mapAccumIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> (p, c)) -> PatchTarget p -> Event t b -> m (Incremental t p, Event t c)
379+mapAccumIncremental f = mapAccumMaybeIncremental $ \v o -> bimap Just Just $ f v o
380+mapAccumMIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> PushM t (p, c)) -> PatchTarget p -> Event t b -> m (Incremental t p, Event t c)
381+mapAccumMIncremental f = mapAccumMaybeMIncremental $ \v o -> bimap Just Just <$> f v o
382+mapAccumMaybeIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> (Maybe p, Maybe c)) -> PatchTarget p -> Event t b -> m (Incremental t p, Event t c)
383+mapAccumMaybeIncremental f = mapAccumMaybeMIncremental $ \v o -> return $ f v o
384+mapAccumMaybeMIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> PushM t (Maybe p, Maybe c)) -> PatchTarget p -> Event t b -> m (Incremental t p, Event t c)
385+mapAccumMaybeMIncremental f z e = do
386+ rec let e' = flip push e $ \o -> do
387+ v <- sample $ currentIncremental d'
388+ result <- f v o
389+ return $ case result of
390+ (Nothing, Nothing) -> Nothing
391+ _ -> Just result
392+ d' <- holdIncremental z $ fmapMaybe fst e'
393+ return (d', fmapMaybe snd e')
344394
345395slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
346396slowHeadE e = do
@@ -441,6 +491,14 @@ pushAlways f = push (fmap Just . f)
441491ffor :: Functor f => f a -> (a -> b) -> f b
442492ffor = flip fmap
443493
494+-- | Rotated version of 'liftA2'.
495+ffor2 :: Applicative f => f a -> f b -> (a -> b -> c) -> f c
496+ffor2 a b f = liftA2 f a b
497+
498+-- | Rotated version of 'liftA3'.
499+ffor3 :: Applicative f => f a -> f b -> f c -> (a -> b -> c -> d) -> f d
500+ffor3 a b c f = liftA3 f a b c
501+
444502instance Reflex t => Applicative (Behavior t) where
445503 pure = constant
446504 f <*> x = pull $ sample f `ap` sample x
@@ -543,6 +601,12 @@ instance Reflex t => Plus (Event t) where
543601tag :: Reflex t => Behavior t b -> Event t a -> Event t b
544602tag b = pushAlways $ \_ -> sample b
545603
604+-- | Replace each occurrence value of the 'Event' with the value of the
605+-- 'Behavior' at that time; if it is 'Just', fire with the contained value; if
606+-- it is 'Nothing', drop the occurrence.
607+tagMaybe :: Reflex t => Behavior t (Maybe b) -> Event t a -> Event t b
608+tagMaybe b = push $ \_ -> sample b
609+
546610-- | Create a new 'Event' that combines occurrences of supplied 'Event' with the
547611-- current value of the 'Behavior'.
548612attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
@@ -566,33 +630,98 @@ tailE e = snd <$> headTailE e
566630
567631-- | Create a tuple of two 'Event's with the first one occurring only the first
568632-- time the supplied 'Event' occurs and the second occurring on all but the first
569−-- occurence.
633+-- occurrence.
570634headTailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a, Event t a)
571635headTailE e = do
572636 eHead <- headE e
573637 be <- hold never $ fmap (const e) eHead
574638 return (eHead, switch be)
575639
576−-- | Starting at the current time, fire all the occurrences of the 'Event' for
577−-- which the given predicate returns 'True'. When 'False' is returned, do not
578−-- fire, and permanently stop firing, even if 'True' values are encountered
579−-- later.
580−takeWhileE :: forall t m a. (Reflex t, MonadFix m, MonadHold t m) => (a -> Bool) -> Event t a -> m (Event t a)
581−takeWhileE f e = do
582− rec let (eFalse, eTrue) = fanEither $ ffor e' $ \a -> if f a
583− then Right a
584− else Left never
585− be <- hold e eFalse
586− let e' = switch be
640+-- | Take the streak of occurrences starting at the current time for which the
641+-- event returns 'True'.
642+--
643+-- Starting at the current time, fire all the occurrences of the 'Event' for
644+-- which the given predicate returns 'True'. When 'False' first is returned,
645+-- do not fire, and permanently stop firing, even if 'True' values would have
646+-- been encountered later.
647+takeWhileE
648+ :: forall t m a
649+ . (Reflex t, MonadFix m, MonadHold t m)
650+ => (a -> Bool)
651+ -> Event t a
652+ -> m (Event t a)
653+takeWhileE f = takeWhileJustE $ \v -> guard (f v) $> v
654+
655+-- | Take the streak of occurrences starting at the current time for which the
656+-- event returns 'Just b'.
657+--
658+-- Starting at the current time, fire all the occurrences of the 'Event' for
659+-- which the given predicate returns 'Just b'. When 'Nothing' first is returned,
660+-- do not fire, and permanently stop firing, even if 'Just b' values would have
661+-- been encountered later.
662+takeWhileJustE
663+ :: forall t m a b
664+ . (Reflex t, MonadFix m, MonadHold t m)
665+ => (a -> Maybe b)
666+ -> Event t a
667+ -> m (Event t b)
668+takeWhileJustE f e = do
669+ rec let (eBad, eTrue) = fanEither $ ffor e' $ \a -> case f a of
670+ Nothing -> Left never
671+ Just b -> Right b
672+ eFirstBad <- headE eBad
673+ e' <- switchHold e eFirstBad
587674 return eTrue
588675
589−-- | Split the supplied 'Event' into two individual 'Event's occuring at the
676+-- | Drop the streak of occurrences starting at the current time for which the
677+-- event returns 'True'.
678+--
679+-- Starting at the current time, do not fire all the occurrences of the 'Event'
680+-- for which the given predicate returns 'True'. When 'False' is first
681+-- returned, do fire, and permanently continue firing, even if 'True' values
682+-- would have been encountered later.
683+dropWhileE
684+ :: forall t m a
685+ . (Reflex t, MonadFix m, MonadHold t m)
686+ => (a -> Bool)
687+ -> Event t a
688+ -> m (Event t a)
689+dropWhileE f e = snd <$> takeDropWhileJustE (\v -> guard (f v) $> v) e
690+
691+-- | Both take and drop the streak of occurrences starting at the current time
692+-- for which the event returns 'Just b'.
693+--
694+-- For the left event, starting at the current time, fire all the occurrences
695+-- of the 'Event' for which the given function returns 'Just b'. When
696+-- 'Nothing' is returned, do not fire, and permanently stop firing, even if
697+-- 'Just b' values would have been encountered later.
698+--
699+-- For the right event, do not fire until the first occurrence where the given
700+-- function returns 'Nothing', and fire that one and all subsequent
701+-- occurrences. Even if the function would have again returned 'Just b', keep
702+-- on firing.
703+takeDropWhileJustE
704+ :: forall t m a b
705+ . (Reflex t, MonadFix m, MonadHold t m)
706+ => (a -> Maybe b)
707+ -> Event t a
708+ -> m (Event t b, Event t a)
709+takeDropWhileJustE f e = do
710+ rec let (eBad, eGood) = fanEither $ ffor e' $ \a -> case f a of
711+ Nothing -> Left ()
712+ Just b -> Right b
713+ eFirstBad <- headE eBad
714+ e' <- switchHold e (never <$ eFirstBad)
715+ eRest <- switchHoldPromptOnly never (e <$ eFirstBad)
716+ return (eGood, eRest)
717+
718+-- | Split the supplied 'Event' into two individual 'Event's occurring at the
590719-- same time with the respective values from the tuple.
591720splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
592721splitE e = (fmap fst e, fmap snd e)
593722
594723-- | Print the supplied 'String' and the value of the 'Event' on each
595−-- occurence. This should /only/ be used for debugging.
724+-- occurrence. This should /only/ be used for debugging.
596725--
597726-- Note: As with Debug.Trace.trace, the message will only be printed if the
598727-- 'Event' is actually used.
@@ -654,10 +783,14 @@ unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIn
654783
655784-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
656785-- occurs if at least one of them occurs and has a map of values of all 'Event's
657−-- occuring at that time.
786+-- occurring at that time.
658787mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
659788mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
660789
790+-- | Like 'mergeMap' but for 'IntMap'.
791+mergeIntMap :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
792+mergeIntMap = fmap dmapToIntMap . merge . intMapWithFunctorToDMap
793+
661794-- | Create a merge whose parents can change over time
662795mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
663796mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
@@ -736,17 +869,65 @@ switchHoldPromptOnly e0 e' = do
736869 eLag <- switch <$> hold e0 e'
737870 return $ coincidence $ leftmost [e', eLag <$ eLag]
738871
872+-- | When the given outer event fires, condense the inner events into the contained patch. Non-firing inner events will be replaced with deletions.
873+coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)
874+coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ ffor e $ \(PatchMap m) -> mergeMap $ ffor m $ \case
875+ Nothing -> fmapCheap (const Nothing) e
876+ Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
877+
878+-- | See 'coincicencePatchMap'
879+coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)
880+coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ ffor e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case
881+ Nothing -> fmapCheap (const Nothing) e
882+ Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
883+
884+-- | See 'coincicencePatchMap'
885+coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)
886+coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ ffor e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
887+ PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->
888+ ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
889+ PatchMapWithMove.From_Move k -> fforCheap e $ \_ ->
890+ ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }
891+ PatchMapWithMove.From_Insert ev -> leftmost
892+ [ fforCheap ev $ \v ->
893+ ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }
894+ , fforCheap e $ \_ ->
895+ ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
896+ ]
897+
898+switchHoldPromptOnlyIncremental
899+ :: forall t m p pt w
900+ . ( Reflex t
901+ , MonadHold t m
902+ , Patch (p (Event t w))
903+ , PatchTarget (p (Event t w)) ~ pt (Event t w)
904+ , Patch (p w)
905+ , PatchTarget (p w) ~ pt w
906+ , Monoid (pt w)
907+ )
908+ => (Incremental t (p (Event t w)) -> Event t (pt w))
909+ -> (Event t (p (Event t w)) -> Event t (p w))
910+ -> pt (Event t w)
911+ -> Event t (p (Event t w))
912+ -> m (Event t (pt w))
913+switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch e0 e' = do
914+ lag <- mergePatchIncremental <$> holdIncremental e0 e'
915+ pure $ ffor (align lag (coincidencePatch e')) $ \case
916+ This old -> old
917+ That new -> new `applyAlways` mempty
918+ These old new -> new `applyAlways` old
919+
739920instance Reflex t => Align (Event t) where
740921 nil = never
741922 align = alignEventWithMaybe Just
742923
743924-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
744−-- the 'Behavior' is true at the time of occurence.
925+-- the 'Behavior' is true at the time of occurrence.
745926gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
746927gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
747928
748−-- | Create a new behavior given a starting behavior and switch to a the behvior
749−-- carried by the event when it fires.
929+-- | Create a new behavior given a starting behavior and switch to the behavior
930+-- carried by the event when it fires.
750931switcher :: (Reflex t, MonadHold t m)
751932 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
752933switcher b eb = pull . (sample <=< sample) <$> hold b eb
@@ -826,6 +1007,44 @@ alignEventWithMaybe f ea eb =
8261007 $ merge
8271008 $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
8281009
1010+filterEventKey
1011+ :: forall t m k v a.
1012+ ( Reflex t
1013+ , MonadFix m
1014+ , MonadHold t m
1015+ , GEq k
1016+ )
1017+ => k a
1018+ -> Event t (DSum k v)
1019+ -> m (Event t (v a))
1020+filterEventKey k kv' = do
1021+ let f :: DSum k v -> Maybe (v a)
1022+ f (newK :=> newV) = case newK `geq` k of
1023+ Just Refl -> Just newV
1024+ Nothing -> Nothing
1025+ takeWhileJustE f kv'
1026+
1027+
1028+factorEvent
1029+ :: forall t m k v a.
1030+ ( Reflex t
1031+ , MonadFix m
1032+ , MonadHold t m
1033+ , GEq k
1034+ )
1035+ => k a
1036+ -> Event t (DSum k v)
1037+ -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))
1038+factorEvent k0 kv' = do
1039+ key :: Behavior t (Some k) <- hold (Some.This k0) $ fmapCheap (\(k :=> _) -> Some.This k) kv'
1040+ let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case
1041+ Some.This oldKey -> case newKey `geq` oldKey of
1042+ Just Refl -> return Nothing
1043+ Nothing -> do
1044+ newInner <- filterEventKey newKey kv'
1045+ return $ Just $ newKey :=> Pair newVal (Compose newInner)
1046+ eInitial <- filterEventKey k0 kv'
1047+ return (eInitial, update)
8291048
8301049--------------------------------------------------------------------------------
8311050-- Accumulator
@@ -969,7 +1188,7 @@ instance Reflex t => Accumulator t (Event t) where
9691188 accumMaybeM f z e = updated <$> accumMaybeM f z e
9701189 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
9711190
972−-- | Create a new 'Event' by combining each occurence with the next value of the
1191+-- | Create a new 'Event' by combining each occurrence with the next value of the
9731192-- list using the supplied function. If the list runs out of items, all
9741193-- subsequent 'Event' occurrences will be ignored.
9751194zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
@@ -979,17 +1198,17 @@ zipListWithEvent f l e = do
9791198 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
9801199 mapAccumMaybe_ f' l e
9811200
982−-- | Assign a number to each occurence of the given 'Event', starting from 0
1201+-- | Assign a number to each occurrence of the given 'Event', starting from 0
9831202{-# INLINE numberOccurrences #-}
9841203numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
9851204numberOccurrences = numberOccurrencesFrom 0
9861205
987−-- | Assign a number to each occurence of the given 'Event'
1206+-- | Assign a number to each occurrence of the given 'Event'
9881207{-# INLINE numberOccurrencesFrom #-}
9891208numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
9901209numberOccurrencesFrom = mapAccum_ (\n a -> let !next = n + 1 in (next, (n, a)))
9911210
992−-- | Assign a number to each occurence of the given 'Event'; discard the occurrences' values
1211+-- | Assign a number to each occurrence of the given 'Event'; discard the occurrences' values
9931212{-# INLINE numberOccurrencesFrom_ #-}
9941213numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
9951214numberOccurrencesFrom_ = mapAccum_ (\n _ -> let !next = n + 1 in (next, n))
@@ -1062,47 +1281,6 @@ infixl 4 <@>
10621281(<@) = tag
10631282infixl 4 <@
10641283
1065−------------------
1066−-- Adjustable
1067−------------------
1068−
1069−-- | A 'Monad' that supports adjustment over time. After an action has been
1070−-- run, if the given events fire, it will adjust itself so that its net effect
1071−-- is as though it had originally been run with the new value. Note that there
1072−-- is some issue here with persistent side-effects: obviously, IO (and some
1073−-- other side-effects) cannot be undone, so it is up to the instance implementer
1074−-- to determine what the best meaning for this class is in such cases.
1075−class (Reflex t, Monad m) => Adjustable t m | m -> t where
1076− runWithReplace :: m a -> Event t (m b) -> m (a, Event t b)
1077− traverseIntMapWithKeyWithAdjust :: (IntMap.Key -> v -> m v') -> IntMap v -> Event t (PatchIntMap v) -> m (IntMap v', Event t (PatchIntMap v'))
1078− 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'))
1079− 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'))
1080−
1081−instance Adjustable t m => Adjustable t (ReaderT r m) where
1082− runWithReplace a0 a' = do
1083− r <- ask
1084− lift $ runWithReplace (runReaderT a0 r) $ fmap (`runReaderT` r) a'
1085− traverseIntMapWithKeyWithAdjust f dm0 dm' = do
1086− r <- ask
1087− lift $ traverseIntMapWithKeyWithAdjust (\k v -> runReaderT (f k v) r) dm0 dm'
1088− traverseDMapWithKeyWithAdjust f dm0 dm' = do
1089− r <- ask
1090− lift $ traverseDMapWithKeyWithAdjust (\k v -> runReaderT (f k v) r) dm0 dm'
1091− traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = do
1092− r <- ask
1093− lift $ traverseDMapWithKeyWithAdjustWithMove (\k v -> runReaderT (f k v) r) dm0 dm'
1094−
1095−sequenceDMapWithAdjust :: (GCompare k, Adjustable t m) => DMap k m -> Event t (PatchDMap k m) -> m (DMap k Identity, Event t (PatchDMap k Identity))
1096−sequenceDMapWithAdjust = traverseDMapWithKeyWithAdjust $ \_ -> fmap Identity
1097−
1098−sequenceDMapWithAdjustWithMove :: (GCompare k, Adjustable t m) => DMap k m -> Event t (PatchDMapWithMove k m) -> m (DMap k Identity, Event t (PatchDMapWithMove k Identity))
1099−sequenceDMapWithAdjustWithMove = traverseDMapWithKeyWithAdjustWithMove $ \_ -> fmap Identity
1100−
1101−mapMapWithAdjustWithMove :: 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'))
1102−mapMapWithAdjustWithMove f m0 m' = do
1103− (out0 :: DMap (Const2 k v) (Constant v'), out') <- traverseDMapWithKeyWithAdjustWithMove (\(Const2 k) (Identity v) -> Constant <$> f k v) (mapToDMap m0) (const2PatchDMapWithMoveWith Identity <$> m')
1104− return (dmapToMapWith (\(Constant v') -> v') out0, patchDMapWithMoveToPatchMapWithMoveWith (\(Constant v') -> v') <$> out')
1105−
11061284------------------
11071285-- Cheap Functions
11081286------------------
@@ -1151,9 +1329,6 @@ mergeWithFoldCheap' f es =
11511329-- Deprecated functions
11521330--------------------------------------------------------------------------------
11531331
1154−{-# DEPRECATED MonadAdjust "Use Adjustable instead" #-}
1155−type MonadAdjust = Adjustable
1156−
11571332-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
11581333-- occurs. If both occur at the same time they are combined using 'mappend'.
11591334{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}