Simple AVar-based Debouncer

Debouncer.purs

module Debouncer
  ( Debouncer
  , Task
  , new
  , defaultDelay
  , run
  ) where

import Control.Applicative as Applicative
import Control.Bind (bind, discard, pure)
import Control.Bind as Bind
import Data.Either (Either(..))
import Data.Eq ((==))
import Data.Function (($))
import Data.Unit (Unit, unit)
import Effect (Effect)
import Effect.AVar (AVar)
import Effect.AVar as AVar
import Effect.Aff (Aff, Milliseconds(..))
import Effect.Aff as Aff
import Effect.Aff.AVar as AffAVar
import Effect.Console as Console
import Effect.Exception (Error)
import Effect.Exception as Exception

newtype Debouncer :: Type -> Type
newtype Debouncer a = Debouncer
  { ref :: AVar (Aff Unit)
  , delayMillis :: Milliseconds
  }

type Task :: Type -> Type
type Task a =
  { action :: Aff a
  , callback :: a -> Effect Unit
  }

new :: forall a. Milliseconds -> Effect (Debouncer a)
new delayMillis = do
  ref <- AVar.new $ pure unit
  pure $ Debouncer { ref, delayMillis }

defaultDelay :: Milliseconds
defaultDelay = Milliseconds 1200.0

run :: forall a. Debouncer a -> Task a -> Effect Unit
run (Debouncer { ref, delayMillis }) { action, callback } = do
  Aff.runAff_ (handler callback) do
    -- 1. Kill the previous task instance if it's still queued.
    Bind.join $ AffAVar.take ref
    -- 2. Fork the current task instance.
    fiber <- Aff.forkAff do
      Aff.delay delayMillis
      action
    -- 3. Store an effect that, when called, will kill the current task instance.
    AffAVar.put (Aff.killFiber killedByDebouncer fiber) ref
    -- 4. Wait until the task completes or was killed.
    Aff.joinFiber fiber

handler
  :: forall a
   . (a -> Effect Unit)
  -> Either Error a
  -> Effect Unit
handler callback = case _ of
  Left err -> do
    Applicative.unless (isKilledByDebouncerError err) do
      Console.error "Debounced action failed with unexpected error"
      Exception.throwException err
  Right x -> callback x

isKilledByDebouncerError :: Error -> Boolean
isKilledByDebouncerError err = Exception.message err == killedByDebouncerMsg

killedByDebouncer :: Error
killedByDebouncer = Exception.error killedByDebouncerMsg

killedByDebouncerMsg :: String
killedByDebouncerMsg = "Killed by debouncer"