From 2664ca67c0cdc75ab0da1e23386afd19513b0042 Mon Sep 17 00:00:00 2001
From: Mats Rauhala <mats.rauhala@iki.fi>
Date: Tue, 25 Aug 2026 10:47:38 +0300
Subject: [PATCH] Debounce instead of delay

---
 src/AFRP.hs                             | 31 +++++++++++++++++++++----
 src/HomeAssistant/Controller/Bedroom.hs |  5 ++--
 2 files changed, 30 insertions(+), 6 deletions(-)

diff --git a/src/AFRP.hs b/src/AFRP.hs
index 0a0402a..fe8f2b4 100644
--- a/src/AFRP.hs
+++ b/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] ++)
diff --git a/src/HomeAssistant/Controller/Bedroom.hs b/src/HomeAssistant/Controller/Bedroom.hs
index a08a2b4..38d0378 100644
--- a/src/HomeAssistant/Controller/Bedroom.hs
+++ b/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) ()