{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Rib.Watch
( onTreeChange,
)
where
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (race)
import Control.Concurrent.Chan
import Path
import Relude
import System.FSNotify (Event (..), watchTreeChan, withManager)
onTreeChange :: Path b t -> ([Event] -> IO ()) -> IO ()
onTreeChange fp f = do
withManager $ \mgr -> do
eventCh <- newChan
void $ watchTreeChan mgr (toFilePath 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 f (threadDelay (1000 * millies)) >>= \case
Left event ->
debounce millies (events <> [event]) f
Right () ->
return events