@@ -17,7 +17,11 @@ import qualified Control.Concurrent.Thread.Delay as Concurrent
1717import Control.Monad
1818import Control.Monad.Fix
1919import Control.Monad.IO.Class
20+import Data.Align
2021import Data.Fixed
22+import Data.Sequence (Seq, (|>))
23+import qualified Data.Sequence as Seq
24+import Data.These
2125import Data.Time.Clock
2226import Data.Typeable
2327import System.Random
@@ -194,3 +198,21 @@ debounce dt e = do
194198 let tagged = attachPromptlyDynWith (,) n e
195199 delayed <- delay dt tagged
196200 return $ attachWithMaybe (\n' (t, v) -> if n' == t then Just v else Nothing) (current n) delayed
201+
202+-- | When the given 'Event' occurs, wait the given amount of time and collect
203+-- all occurrences during that time. Then, fire the output 'Event' with the
204+-- collected output.
205+batchOccurrences :: (MonadFix m, MonadHold t m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m)) => NominalDiffTime -> Event t a -> m (Event t (Seq a))
206+batchOccurrences t newValues = do
207+ let f s x = (Just newState, out)
208+ where newState = case x of
209+ This a -> s |> a
210+ That _ -> mempty
211+ These a _ -> Seq.singleton a
212+ out = case x of
213+ This _ -> if Seq.null s then Just () else Nothing
214+ That _ -> Nothing
215+ These _ _ -> Just ()
216+ rec (buffer, toDelay) <- mapAccumMaybe f mempty $ align newValues delayed
217+ delayed <- delay t toDelay
218+ return $ tag buffer delayed