debounce.purs

module Component.Utils.Debounced where

import Prelude

import Data.Either as E
import Data.Foldable (traverse_)
import Data.Maybe (Maybe(..))
import Effect.Aff.AVar as AVar
import Effect.Aff (Milliseconds, delay, forkAff, killFiber)
import Effect.Aff.Class (class MonadAff, liftAff)
import Effect.Class (liftEffect)
import Effect.Exception as Exn
import Effect.Ref as Ref
import Halogen as H
import Halogen.Query.EventSource as ES

newtype DebounceTrigger f g = DebounceTrigger ((forall a. Maybe (a -> f a)) -> g Unit)

runDebounceTrigger :: forall f g. DebounceTrigger f g -> (forall a. a -> f a) -> g Unit
runDebounceTrigger (DebounceTrigger dt) f = dt (Just f)

cancelDebounceTrigger :: forall f g. DebounceTrigger f g -> g Unit
cancelDebounceTrigger (DebounceTrigger dt) = dt Nothing

debouncedEventSource
  :: forall s f g p o m
   . MonadAff m
  => Milliseconds
  -> H.HalogenM s f g p o m (DebounceTrigger f m)
debouncedEventSource ms = do
  emitVar <- liftAff AVar.empty
  cancelRef <- liftEffect $ Ref.new Nothing
  let
    source :: ES.EventSource f m
    source = ES.EventSource $ pure
      { producer: ES.produceAff (liftAff <<< flip AVar.put emitVar)
      , done: pure unit
      }

    push :: DebounceTrigger f m
    push = DebounceTrigger $ \k -> liftAff do
      emit <- AVar.read emitVar
      liftEffect (Ref.read cancelRef) >>= traverse_ (killFiber $ Exn.error "Debounced")
      liftEffect <<< flip Ref.write cancelRef <<< Just =<< forkAff do
        case k of
          Nothing -> pure unit
          Just f -> do
            delay ms
            emit $ E.Left $ f ES.Listening

  H.subscribe source $> push