@@ -9,6 +9,7 @@
9{-# LANGUAGE LambdaCase #-}
9{-# LANGUAGE LambdaCase #-}
10{-# LANGUAGE MultiParamTypeClasses #-}
10{-# LANGUAGE MultiParamTypeClasses #-}
11{-# LANGUAGE NoMonomorphismRestriction #-}
11{-# LANGUAGE NoMonomorphismRestriction #-}
12+{-# LANGUAGE PolyKinds #-}
12{-# LANGUAGE RankNTypes #-}
13{-# LANGUAGE RankNTypes #-}
13{-# LANGUAGE RecursiveDo #-}
14{-# LANGUAGE RecursiveDo #-}
14{-# LANGUAGE RoleAnnotations #-}
15{-# LANGUAGE RoleAnnotations #-}
@@ -43,9 +44,13 @@ module Reflex.Class
43 -- ** Combining 'Event's
44 -- ** Combining 'Event's
44 , leftmost
45 , leftmost
45 , mergeMap
46 , mergeMap
46 , mergeMapIncremental
48 , mergeMapIncremental
47 , mergeMapIncrementalWithMove
49 , mergeMapIncrementalWithMove
48 , mergeIntMapIncremental
50 , mergeIntMapIncremental
51+ , coincidencePatchMap
52+ , coincidencePatchMapWithMove
53+ , coincidencePatchIntMap
49 , mergeList
54 , mergeList
50 , mergeWith
55 , mergeWith
51 , difference
56 , difference
@@ -59,12 +64,16 @@ module Reflex.Class
59 , EitherTag (..)
64 , EitherTag (..)
60 , eitherToDSum
65 , eitherToDSum
61 , dsumToEither
66 , dsumToEither
62 -- ** Collapsing 'Event . Event'
69 -- ** Collapsing 'Event . Event'
63 , switchHold
70 , switchHold
64 , switchHoldPromptly
71 , switchHoldPromptly
65 , switchHoldPromptOnly
72 , switchHoldPromptOnly
73+ , switchHoldPromptOnlyIncremental
66 -- ** Using 'Event's to sample 'Behavior's
74 -- ** Using 'Event's to sample 'Behavior's
69 , attachWith
78 , attachWith
70 , attachWithMaybe
79 , attachWithMaybe
@@ -98,6 +107,14 @@ module Reflex.Class
98 , mapAccumM_
107 , mapAccumM_
99 , mapAccumMaybe_
108 , mapAccumMaybe_
100 , mapAccumMaybeM_
109 , mapAccumMaybeM_
112+ , accumMaybeIncremental
113+ , accumMaybeMIncremental
114+ , mapAccumIncremental
115+ , mapAccumMIncremental
116+ , mapAccumMaybeIncremental
117+ , mapAccumMaybeMIncremental
101 , zipListWithEvent
118 , zipListWithEvent
102 , numberOccurrences
119 , numberOccurrences
103 , numberOccurrencesFrom
120 , numberOccurrencesFrom
@@ -107,6 +124,9 @@ module Reflex.Class
108 , headTailE
125 , headTailE
109 , takeWhileE
126 , takeWhileE
129+ , takeDropWhileJustE
110 , switcher
130 , switcher
111 -- * Debugging functions
131 -- * Debugging functions
112 , traceEvent
132 , traceEvent
@@ -120,15 +140,11 @@ module Reflex.Class
120 , ffilter
140 , ffilter
121 , filterLeft
141 , filterLeft
122 , filterRight
142 , filterRight
125− , sequenceDMapWithAdjust
126− , sequenceDMapWithAdjustWithMove
127− , mapMapWithAdjustWithMove
128 -- * Miscellaneous convenience functions
143 -- * Miscellaneous convenience functions
130 -- * Deprecated functions
147 -- * Deprecated functions
132 , appendEvents
148 , appendEvents
134 , sequenceThese
150 , sequenceThese
@@ -158,12 +174,14 @@ import Data.Align
158import Data.Bifunctor
174import Data.Bifunctor
159import Data.Coerce
175import Data.Coerce
160import Data.Default
176import Data.Default
161−import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
177+import Data.Dependent.Map (DMap, DSum (..))
162import qualified Data.Dependent.Map as DMap
178import qualified Data.Dependent.Map as DMap
179+import Data.Functor.Compose
180+import Data.Functor.Product
181+import Data.GADT.Compare (GEq (..), GCompare (..), (:~:) (..))
163import Data.FastMutableIntMap (PatchIntMap)
182import Data.FastMutableIntMap (PatchIntMap)
164import Data.Foldable
183import Data.Foldable
165import Data.Functor.Bind
184import Data.Functor.Bind
166−import Data.Functor.Constant
167import Data.Functor.Misc
185import Data.Functor.Misc
168import Data.Functor.Plus
186import Data.Functor.Plus
169import Data.IntMap.Strict (IntMap)
187import Data.IntMap.Strict (IntMap)
@@ -171,11 +189,14 @@ import qualified Data.IntMap.Strict as IntMap
171import Data.List.NonEmpty (NonEmpty (..))
189import Data.List.NonEmpty (NonEmpty (..))
172import Data.Map (Map)
190import Data.Map (Map)
173import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
191import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
192+import Data.Some (Some)
193+import qualified Data.Some as Some
174import Data.String
194import Data.String
175import Data.These
195import Data.These
176import Data.Type.Coercion
196import Data.Type.Coercion
177import Reflex.FunctorMaybe
197import Reflex.FunctorMaybe
178import Reflex.Patch
198import Reflex.Patch
199+import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
180import Debug.Trace (trace)
201import Debug.Trace (trace)
@@ -226,7 +247,7 @@ class ( MonadHold t (PushM t)
226 -- recomputed whenever any of the read 'Behavior's changes
247 -- recomputed whenever any of the read 'Behavior's changes
227 pull :: PullM t a -> Behavior t a
248 pull :: PullM t a -> Behavior t a
228 -- | Merge a collection of events; the resulting 'Event' will only occur if at
249 -- | 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
230 -- that are occurring simultaneously
251 -- that are occurring simultaneously
231 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
252 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
232 -- | Efficiently fan-out an event to many destinations. This function should
253 -- | Efficiently fan-out an event to many destinations. This function should
@@ -332,15 +353,44 @@ class MonadSample t m => MonadHold t m where
332 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
353 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
333 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
354 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
334 holdIncremental v0 = lift . holdIncremental v0
355 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)
337 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
358 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
338 buildDynamic getV0 = lift . buildDynamic getV0
359 buildDynamic getV0 = lift . buildDynamic getV0
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
341 -- the supplied 'Event'.
362 -- the supplied 'Event'.
342 headE :: Event t a -> m (Event t a)
363 headE :: Event t a -> m (Event t a)
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'
376+ d' <- holdIncremental z e'
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'
389+ return $ case result of
390+ (Nothing, Nothing) -> Nothing
392+ d' <- holdIncremental z $ fmapMaybe fst e'
393+ return (d', fmapMaybe snd e')
345slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
395slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
346slowHeadE e = do
396slowHeadE e = do
@@ -441,6 +491,14 @@ pushAlways f = push (fmap Just . f)
441ffor :: Functor f => f a -> (a -> b) -> f b
491ffor :: Functor f => f a -> (a -> b) -> f b
442ffor = flip fmap
492ffor = flip fmap
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
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
444instance Reflex t => Applicative (Behavior t) where
502instance Reflex t => Applicative (Behavior t) where
445 pure = constant
503 pure = constant
446 f <*> x = pull $ sample f `ap` sample x
504 f <*> x = pull $ sample f `ap` sample x
@@ -543,6 +601,12 @@ instance Reflex t => Plus (Event t) where
543tag :: Reflex t => Behavior t b -> Event t a -> Event t b
601tag :: Reflex t => Behavior t b -> Event t a -> Event t b
544tag b = pushAlways $ \_ -> sample b
602tag b = pushAlways $ \_ -> sample b
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
546-- | Create a new 'Event' that combines occurrences of supplied 'Event' with the
610-- | Create a new 'Event' that combines occurrences of supplied 'Event' with the
547-- current value of the 'Behavior'.
611-- current value of the 'Behavior'.
548attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
612attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
@@ -566,33 +630,98 @@ tailE e = snd <$> headTailE e
567-- | Create a tuple of two 'Event's with the first one occurring only the first
631-- | Create a tuple of two 'Event's with the first one occurring only the first
568-- time the supplied 'Event' occurs and the second occurring on all but the first
632-- time the supplied 'Event' occurs and the second occurring on all but the first
569−-- occurence.
633+-- occurrence.
570headTailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a, Event t a)
634headTailE :: (Reflex t, MonadHold t m) => Event t a -> m (Event t a, Event t a)
571headTailE e = do
635headTailE e = do
572 eHead <- headE e
636 eHead <- headE e
573 be <- hold never $ fmap (const e) eHead
637 be <- hold never $ fmap (const e) eHead
574 return (eHead, switch be)
638 return (eHead, switch be)
640+-- | Take the streak of occurrences starting at the current time for which the
641+-- event returns 'True'.
576−-- | Starting at the current time, fire all the occurrences of the 'Event' for
643+-- 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
644+-- which the given predicate returns 'True'. When 'False' first is returned,
578−-- fire, and permanently stop firing, even if 'True' values are encountered
645+-- do not fire, and permanently stop firing, even if 'True' values would have
579−-- later.
646+-- been encountered later.
580−takeWhileE :: forall t m a. (Reflex t, MonadFix m, MonadHold t m) => (a -> Bool) -> Event t a -> m (Event t a)
649+ . (Reflex t, MonadFix m, MonadHold t m)
581−takeWhileE f e = do
650+ => (a -> Bool)
653+takeWhileE f = takeWhileJustE $ \v -> guard (f v) $> v
655+-- | Take the streak of occurrences starting at the current time for which the
656+-- event returns 'Just b'.
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.
664+ . (Reflex t, MonadFix m, MonadHold t m)
668+takeWhileJustE f e = do
582− rec let (eFalse, eTrue) = fanEither $ ffor e' $ \a -> if f a
669+ rec let (eBad, eTrue) = fanEither $ ffor e' $ \a -> case f a of
584− else Left never
670+ Nothing -> Left never
585− be <- hold e eFalse
671+ Just b -> Right b
586− let e' = switch be
672+ eFirstBad <- headE eBad
673+ e' <- switchHold e eFirstBad
587 return eTrue
674 return eTrue
676+-- | Drop the streak of occurrences starting at the current time for which the
677+-- event returns 'True'.
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.
685+ . (Reflex t, MonadFix m, MonadHold t m)
689+dropWhileE f e = snd <$> takeDropWhileJustE (\v -> guard (f v) $> v) e
691+-- | Both take and drop the streak of occurrences starting at the current time
692+-- for which the event returns 'Just b'.
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.
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
705+ . (Reflex t, MonadFix m, MonadHold t m)
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
713+ eFirstBad <- headE eBad
714+ e' <- switchHold e (never <$ eFirstBad)
715+ eRest <- switchHoldPromptOnly never (e <$ eFirstBad)
716+ return (eGood, eRest)
589−-- | Split the supplied 'Event' into two individual 'Event's occuring at the
718+-- | Split the supplied 'Event' into two individual 'Event's occurring at the
590-- same time with the respective values from the tuple.
719-- same time with the respective values from the tuple.
591splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
720splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
592splitE e = (fmap fst e, fmap snd e)
721splitE e = (fmap fst e, fmap snd e)
594-- | Print the supplied 'String' and the value of the 'Event' on each
723-- | 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.
597-- Note: As with Debug.Trace.trace, the message will only be printed if the
726-- Note: As with Debug.Trace.trace, the message will only be printed if the
598-- 'Event' is actually used.
727-- 'Event' is actually used.
@@ -654,10 +783,14 @@ unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIn
655-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
784-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
656-- occurs if at least one of them occurs and has a map of values of all 'Event's
785-- 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.
658mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
787mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
659mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
788mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
790+-- | Like 'mergeMap' but for 'IntMap'.
791+mergeIntMap :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
792+mergeIntMap = fmap dmapToIntMap . merge . intMapWithFunctorToDMap
661-- | Create a merge whose parents can change over time
794-- | Create a merge whose parents can change over time
662mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
795mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
663mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
796mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
@@ -736,17 +869,65 @@ switchHoldPromptOnly e0 e' = do
736 eLag <- switch <$> hold e0 e'
869 eLag <- switch <$> hold e0 e'
737 return $ coincidence $ leftmost [e', eLag <$ eLag]
870 return $ coincidence $ leftmost [e', eLag <$ eLag]
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]
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]
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 }
898+switchHoldPromptOnlyIncremental
899+ :: forall t m p pt w
902+ , Patch (p (Event t w))
903+ , PatchTarget (p (Event t w)) ~ pt (Event t w)
905+ , PatchTarget (p w) ~ pt w
908+ => (Incremental t (p (Event t w)) -> Event t (pt w))
909+ -> (Event t (p (Event t w)) -> Event t (p 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
917+ That new -> new `applyAlways` mempty
918+ These old new -> new `applyAlways` old
739instance Reflex t => Align (Event t) where
920instance Reflex t => Align (Event t) where
740 nil = never
921 nil = never
741 align = alignEventWithMaybe Just
922 align = alignEventWithMaybe Just
743-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
924-- | 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.
745gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
926gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
746gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
927gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
748−-- | Create a new behavior given a starting behavior and switch to a the behvior
929+-- | Create a new behavior given a starting behavior and switch to the behavior
749−-- carried by the event when it fires.
930+-- carried by the event when it fires.
750switcher :: (Reflex t, MonadHold t m)
931switcher :: (Reflex t, MonadHold t m)
751 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
932 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
752switcher b eb = pull . (sample <=< sample) <$> hold b eb
933switcher b eb = pull . (sample <=< sample) <$> hold b eb
@@ -826,6 +1007,44 @@ alignEventWithMaybe f ea eb =
827 $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
1008 $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
1011+ :: forall t m k v 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
1025+ takeWhileJustE f kv'
1029+ :: forall t m k v 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
1044+ newInner <- filterEventKey newKey kv'
1045+ return $ Just $ newKey :=> Pair newVal (Compose newInner)
1046+ eInitial <- filterEventKey k0 kv'
1047+ return (eInitial, update)
830--------------------------------------------------------------------------------
1049--------------------------------------------------------------------------------
831-- Accumulator
1050-- Accumulator
@@ -969,7 +1188,7 @@ instance Reflex t => Accumulator t (Event t) where
969 accumMaybeM f z e = updated <$> accumMaybeM f z e
1188 accumMaybeM f z e = updated <$> accumMaybeM f z e
970 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
1189 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
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
973-- list using the supplied function. If the list runs out of items, all
1192-- list using the supplied function. If the list runs out of items, all
974-- subsequent 'Event' occurrences will be ignored.
1193-- subsequent 'Event' occurrences will be ignored.
975zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
1194zipListWithEvent :: (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
979 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
1198 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
980 mapAccumMaybe_ f' l e
1199 mapAccumMaybe_ f' l e
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
983{-# INLINE numberOccurrences #-}
1202{-# INLINE numberOccurrences #-}
984numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
1203numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))
985numberOccurrences = numberOccurrencesFrom 0
1204numberOccurrences = numberOccurrencesFrom 0
987−-- | Assign a number to each occurence of the given 'Event'
1206+-- | Assign a number to each occurrence of the given 'Event'
988{-# INLINE numberOccurrencesFrom #-}
1207{-# INLINE numberOccurrencesFrom #-}
989numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
1208numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))
990numberOccurrencesFrom = mapAccum_ (\n a -> let !next = n + 1 in (next, (n, a)))
1209numberOccurrencesFrom = mapAccum_ (\n a -> let !next = n + 1 in (next, (n, a)))
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
993{-# INLINE numberOccurrencesFrom_ #-}
1212{-# INLINE numberOccurrencesFrom_ #-}
994numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
1213numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)
995numberOccurrencesFrom_ = mapAccum_ (\n _ -> let !next = n + 1 in (next, n))
1214numberOccurrencesFrom_ = mapAccum_ (\n _ -> let !next = n + 1 in (next, n))
@@ -1062,47 +1281,6 @@ infixl 4 <@>
1062(<@) = tag
1281(<@) = tag
1063infixl 4 <@
1282infixl 4 <@
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'))
1081−instance Adjustable t m => Adjustable t (ReaderT r m) where
1082− runWithReplace a0 a' = do
1084− lift $ runWithReplace (runReaderT a0 r) $ fmap (`runReaderT` r) a'
1085− traverseIntMapWithKeyWithAdjust f dm0 dm' = do
1087− lift $ traverseIntMapWithKeyWithAdjust (\k v -> runReaderT (f k v) r) dm0 dm'
1088− traverseDMapWithKeyWithAdjust f dm0 dm' = do
1090− lift $ traverseDMapWithKeyWithAdjust (\k v -> runReaderT (f k v) r) dm0 dm'
1091− traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = do
1093− lift $ traverseDMapWithKeyWithAdjustWithMove (\k v -> runReaderT (f k v) r) dm0 dm'
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
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
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')
1106------------------
1284------------------
1107-- Cheap Functions
1285-- Cheap Functions
1108------------------
1286------------------
@@ -1151,9 +1329,6 @@ mergeWithFoldCheap' f es =
1151-- Deprecated functions
1329-- Deprecated functions
1152--------------------------------------------------------------------------------
1330--------------------------------------------------------------------------------
1154−{-# DEPRECATED MonadAdjust "Use Adjustable instead" #-}
1155−type MonadAdjust = Adjustable
1157-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
1332-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
1158-- occurs. If both occur at the same time they are combined using 'mappend'.
1333-- occurs. If both occur at the same time they are combined using 'mappend'.
1159{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}
1334{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}