module Data.Conduit.FSNotify
(
sourceFileChanges
, FileChangeSettings
, mkFileChangeSettings
, setWatchConfig
, setRelative
, setRecursive
, setPredicate
, FS.Event (..)
, FS.eventTime
, FS.eventPath
, FS.WatchConfig (..)
, FS.Debounce (..)
) where
import Control.Exception (assert)
import Data.Conduit
import Control.Monad.Trans.Resource (MonadResource)
import Control.Monad.IO.Class (liftIO)
import Control.Monad (forever)
import qualified System.FSNotify as FS
import System.Directory (canonicalizePath)
import Control.Concurrent.Chan
import Data.List (stripPrefix)
import System.FilePath (addTrailingPathSeparator)
data FileChangeSettings = FileChangeSettings
{ fcsDir :: !FilePath
, fcsWatchConfig :: !FS.WatchConfig
, fcsRelative :: !Bool
, fcsRecursive :: !Bool
, fcsPredicate :: !(FS.Event -> Bool)
}
setWatchConfig :: FS.WatchConfig -> FileChangeSettings -> FileChangeSettings
setWatchConfig x fcs = fcs { fcsWatchConfig = x }
setRelative :: Bool -> FileChangeSettings -> FileChangeSettings
setRelative x fcs = fcs { fcsRelative = x }
setRecursive :: Bool -> FileChangeSettings -> FileChangeSettings
setRecursive x fcs = fcs { fcsRecursive = x }
setPredicate :: (FS.Event -> Bool) -> FileChangeSettings -> FileChangeSettings
setPredicate x fcs = fcs { fcsPredicate = x }
mkFileChangeSettings :: FilePath
-> FileChangeSettings
mkFileChangeSettings dir = FileChangeSettings
{ fcsDir = dir
, fcsWatchConfig = FS.defaultConfig
, fcsRelative = True
, fcsRecursive = True
, fcsPredicate = const True
}
sourceFileChanges :: MonadResource m
=> FileChangeSettings
-> Producer m FS.Event
sourceFileChanges FileChangeSettings {..} =
bracketP (FS.startManagerConf fcsWatchConfig) FS.stopManager $ \man -> do
root' <- liftIO $ canonicalizePath fcsDir
chan <- liftIO newChan
let watchChan = if fcsRecursive then FS.watchTreeChan else FS.watchDirChan
bracketP (watchChan man root' fcsPredicate chan) id $ const $ forever $ do
event <- liftIO $ readChan chan
if fcsRelative
then do
let fp = FS.eventPath event
case stripPrefix (addTrailingPathSeparator root') fp of
Nothing -> assert False $ return ()
Just suffix
| null suffix -> return ()
| otherwise -> yield $
case event of
FS.Added _ time -> FS.Added suffix time
FS.Modified _ time -> FS.Modified suffix time
FS.Removed _ time -> FS.Removed suffix time
else yield event