Watch.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Filesystem watching using fsnotify
module Rib.Watch
  ( onTreeChange,
  )
where

import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (race)
import Control.Concurrent.Chan
import Relude
import System.FSNotify (Event (..), watchTreeChan, withManager)

-- | Recursively monitor the contents of the given path and invoke the given IO
-- action for every event triggered.
--
-- If multiple events fire rapidly, the IO action is invoked only once, taking
-- those multiple events as its argument.
onTreeChange :: FilePath -> ([Event] -> IO ()) -> IO ()
onTreeChange fp f = do
  withManager $ \mgr -> do
    eventCh <- newChan
    void $ watchTreeChan mgr fp (const True) eventCh
    forever $ do
      firstEvent <- readChan eventCh
      events <- debounce 100 [firstEvent] $ readChan eventCh
      f events

debounce :: Int -> [event] -> IO event -> IO [event]
debounce millies events f = do
  -- Race the readEvent against the timelimit.
  race f (threadDelay (1000 * millies)) >>= \case
    Left event ->
      -- If the read event finishes first try again.
      debounce millies (events <> [event]) f
    Right () ->
      -- Otherwise continue
      return events