streamly-fsnotify-2.0: src/Streamly/FSNotify.hs

{- |
__Example__

Here is a program which watches @\/home\/georgefst\/c-project@ and any of its subdirectories for added or modified
C source files (which we take to be anything with a @.c@ extension). This program then writes that the event occurred,
to what file, and when, forever.

> {-# LANGUAGE GHC2021, BlockArguments, LambdaCase #-}
>
> import Data.Functor.Contravariant (Predicate (Predicate))
> import Streamly.Data.Fold qualified as SF
> import Streamly.Data.Stream.Prelude qualified as SP
> import System.FilePath (isExtensionOf, (</>))
>
> import Streamly.FSNotify
>
> isCSourceFile :: Predicate Event
> isCSourceFile = Predicate \e ->
>     "c" `isExtensionOf` eventPath e && eventIsDirectory e == IsFile
>
> notDeletion :: Predicate Event
> notDeletion = Predicate \case
>     Removed{} -> False
>     _ -> True
>
> srcPath :: FilePath
> srcPath = "/" </> "home" </> "gthomas" </> "c-project"
>
> main :: IO ()
> main = SP.fold (SF.drainMapM go) $ watchTree srcPath $ isCSourceFile <> notDeletion
>   where
>     go = \case
>         Added p t _ -> putStrLn $ "Created: " ++ show p ++ " at " ++ show t
>         Modified p t _ -> putStrLn $ "Modified: " ++ show p ++ " at " ++ show t
>         _ -> pure ()
-}
module Streamly.FSNotify (
    Event (..),
    EventIsDirectory (..),
    watchDir,
    watchTree,
) where

import Control.Concurrent.Chan (newChan, readChan)
import Control.Monad.Catch (MonadCatch)
import Control.Monad.IO.Class (liftIO)
import Data.Functor.Contravariant (Predicate (getPredicate))
import Streamly.Data.Stream.Prelude (MonadAsync, Stream)
import Streamly.Data.Stream.Prelude qualified as S
import Streamly.Data.StreamK qualified as SK
import Streamly.Internal.Data.StreamK qualified as SK
import System.FSNotify (
    ActionPredicate,
    Event (..),
    EventChannel,
    EventIsDirectory (..),
    StopListening,
    WatchManager,
    defaultConfig,
    startManagerConf,
    stopManager,
    watchDirChan,
    watchTreeChan,
 )

-- | Watch a given directory, but only at one level (thus, subdirectories will __not__ be watched recursively).
watchDir :: (MonadAsync m, MonadCatch m) => FilePath -> Predicate Event -> Stream m Event
watchDir = watch watchDirChan

-- | Watch a given directory recursively (thus, subdirectories will also have their contents watched).
watchTree :: (MonadAsync m, MonadCatch m) => FilePath -> Predicate Event -> Stream m Event
watchTree = watch watchTreeChan

watch ::
    (MonadAsync m, MonadCatch m) =>
    (WatchManager -> FilePath -> ActionPredicate -> EventChannel -> IO StopListening) ->
    FilePath ->
    Predicate Event ->
    Stream m Event
watch f p predicate = withInit
    do
        manager <- liftIO $ startManagerConf defaultConfig
        chan <- liftIO newChan
        stop <- liftIO $ f manager p (getPredicate predicate) chan
        pure (chan, liftIO $ stop >> liftIO (stopManager manager))
    \(chan, stop) -> S.finally stop $ S.repeatM $ liftIO $ readChan chan
  where
    -- TODO a few problems with this:
    -- it's vendored from `georgefst-utils`
    -- it's inelegant and inefficient (though inhibiting fusion isn't a major issue since we already have `finally`)
    -- it incurs a direct dependency on `streamly-core`
    withInit init_ stream =
        SK.toStream . SK.unCross $
            SK.mkCross . SK.fromStream . stream
                =<< SK.mkCross (SK.fromStream $ S.fromEffect init_)