Debounce instead of delay

src/AFRP.hs

@@ -28,6 +28,7 @@ module AFRP
   , rollup
   , sliding
   , fixed
+  , debounce
   ) where
 
 import Control.Category (Category(..), (>>>))
@@ -150,9 +151,9 @@ mapAccumRequest f x extract = go x
       let next = f t b a
       in pure (extract next, go next)
 
-data DelayState a = DelayState
-  { pending :: [(UTCTime, a)]
-  , output  :: Event a
+data DelayState x a = DelayState
+  { pending :: x
+  , output  :: !(Event a)
   }
 
 
@@ -178,6 +179,21 @@ delayEvent delay =
            _ ->
                  DelayState queued Tick
 
+debounce :: NominalDiffTime -> Mealy eff (Event a) (Event a)
+debounce delay =
+  mapAccumRequest step initial output
+  where
+    initial = DelayState Nothing Tick
+    step req st input =
+      let now = requestTime req
+          held = case input of
+                      Tick -> pending st
+                      Event x -> Just (delay `addUTCTime` now, x)
+      in case held of
+              Just (due, x)
+                | due <= now -> DelayState Nothing (Event x)
+              _ -> DelayState held Tick
+
 changes :: Eq a => Mealy eff a (Event a)
 changes = mapAccum go Nothing (maybe Tick snd)
   where
@@ -230,7 +246,14 @@ duration = mapAccumRequest go (Nothing @(UTCTime, NominalDiffTime)) (maybe 0 snd
 
 
 
-rollup :: Int -> Int -> Mealy eff (Event a) (Event [a])
+-- | Rollup, hold back bursty messages
+--
+-- Consider a case where you have a  bursty set of data. You care to get an immediate response,
+-- but don't want to spam the output
+rollup
+  :: Int -- ^ How many items to pass through before burst protection
+  -> Int -- ` How many seconds to collect the bursty data
+  -> Mealy eff (Event a) (Event [a])
 rollup limit seconds = mapAccumRequest go (Left Tick) (either id (\(_, _, _, ev) -> ev))
   where
     e a = Endo ([a] ++)

src/HomeAssistant/Controller/Bedroom.hs

@@ -133,8 +133,9 @@ waitFor n = duration >>> arr (> n) >>> edge
 
 delayedDoor :: HASS (Event Value) (Event DoorState)
 delayedDoor = door
-  >>> (AFRP.hold Open &&& AFRP.delayEvent 15)
-  >>> AFRP.sample
+  >>> AFRP.debounce 15
+  >>> AFRP.hold Open
+  >>> AFRP.changes
   >>> traceEvent
 
 humidifierController :: HASS (Event Value) ()