{- |
__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 Streamly.Data.Fold qualified as SF
> import Streamly.Data.Stream.Prelude qualified as SP
> import System.FilePath (isExtensionOf, (</>))
>
> import Streamly.FSNotify
>
> isCSourceFile :: Event -> Bool
> isCSourceFile e =
>     "c" `isExtensionOf` eventPath e && eventIsDirectory e == IsFile
>
> srcPath :: FilePath
> srcPath = "/" </> "home" </> "georgefst" </> "c-project"
>
> main :: IO ()
> main = SP.fold (SF.drainMapM go) $ watchTree srcPath
>   where
>     go = \case
>         e | not (isCSourceFile e) -> pure ()
>         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 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 -> Stream m Event
watchDir :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> Stream m Event
watchDir = forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
(WatchManager
 -> FilePath -> ActionPredicate -> EventChannel -> IO StopListening)
-> FilePath -> Stream m Event
watch WatchManager
-> FilePath -> ActionPredicate -> EventChannel -> IO StopListening
watchDirChan

-- | Watch a given directory recursively (thus, subdirectories will also have their contents watched).
watchTree :: (MonadAsync m, MonadCatch m) => FilePath -> Stream m Event
watchTree :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> Stream m Event
watchTree = forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
(WatchManager
 -> FilePath -> ActionPredicate -> EventChannel -> IO StopListening)
-> FilePath -> Stream m Event
watch WatchManager
-> FilePath -> ActionPredicate -> EventChannel -> IO StopListening
watchTreeChan

watch ::
    (MonadAsync m, MonadCatch m) =>
    (WatchManager -> FilePath -> ActionPredicate -> EventChannel -> IO StopListening) ->
    FilePath ->
    Stream m Event
watch :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
(WatchManager
 -> FilePath -> ActionPredicate -> EventChannel -> IO StopListening)
-> FilePath -> Stream m Event
watch WatchManager
-> FilePath -> ActionPredicate -> EventChannel -> IO StopListening
f FilePath
p = forall {m :: * -> *} {a} {a}.
Monad m =>
m a -> (a -> Stream m a) -> Stream m a
withInit
    do
        WatchManager
manager <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ WatchConfig -> IO WatchManager
startManagerConf WatchConfig
defaultConfig
        EventChannel
chan <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (Chan a)
newChan
        StopListening
stop <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ WatchManager
-> FilePath -> ActionPredicate -> EventChannel -> IO StopListening
f WatchManager
manager FilePath
p (forall a b. a -> b -> a
const Bool
True) EventChannel
chan
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (EventChannel
chan, forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ StopListening
stop forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (WatchManager -> StopListening
stopManager WatchManager
manager))
    \(EventChannel
chan, m ()
stop) -> forall (m :: * -> *) b a.
(MonadAsync m, MonadCatch m) =>
m b -> Stream m a -> Stream m a
S.finally m ()
stop forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => m a -> Stream m a
S.repeatM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Chan a -> IO a
readChan EventChannel
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 :: m a -> (a -> Stream m a) -> Stream m a
withInit m a
init_ a -> Stream m a
stream =
        forall (m :: * -> *) a. Applicative m => StreamK m a -> Stream m a
SK.toStream forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. CrossStreamK m a -> StreamK m a
SK.unCross forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. StreamK m a -> CrossStreamK m a
SK.mkCross forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => Stream m a -> StreamK m a
SK.fromStream forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Stream m a
stream
                forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. StreamK m a -> CrossStreamK m a
SK.mkCross (forall (m :: * -> *) a. Monad m => Stream m a -> StreamK m a
SK.fromStream forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Applicative m => m a -> Stream m a
S.fromEffect m a
init_)