ae182c5 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Add batchOccurrences

ae182c5Ryan Trinkle10 years ago

src/Reflex/Dom/Time.hs+22

compare with develop

unifiedsplit

@@ -17,7 +17,11 @@ import qualified Control.Concurrent.Thread.Delay as Concurrent

17import Control.Monad

18import Control.Monad.Fix

19import Control.Monad.IO.Class

20+import Data.Align

20import Data.Fixed

21import Data.Fixed

22+import Data.Sequence (Seq, (|>))

23+import qualified Data.Sequence as Seq

24+import Data.These

21import Data.Time.Clock

25import Data.Time.Clock

22import Data.Typeable

26import Data.Typeable

23import System.Random

27import System.Random

@@ -194,3 +198,21 @@ debounce dt e = do

194 let tagged = attachPromptlyDynWith (,) n e

198 let tagged = attachPromptlyDynWith (,) n e

195 delayed <- delay dt tagged

199 delayed <- delay dt tagged

196 return $ attachWithMaybe (\n' (t, v) -> if n' == t then Just v else Nothing) (current n) delayed

200 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