diff --git a/fswatcher.cabal b/fswatcher.cabal --- a/fswatcher.cabal +++ b/fswatcher.cabal @@ -1,7 +1,7 @@ name: fswatcher category: Tools build-type: Simple -version: 0.2.2 +version: 0.3.0 synopsis: Watch a file/directory and run a command when it's modified description: A simple program that watches a file or a directory and runs a given command whenever the file or a file within the @@ -9,14 +9,13 @@ license: BSD3 License-file: LICENSE author: Erlend Hamberg -maintainer: ehamberg@gmail.com +maintainer: erlend@hamberg.no stability: experimental -tested-with: GHC==7.6.3, GHC==8.4.4 +tested-with: GHC==8.10.3 homepage: http://www.github.com/ehamberg/fswatcher/ -cabal-version: >= 1.6 - +cabal-version: >= 1.10 -Executable fswatcher +executable fswatcher build-depends: base >= 4 && < 5 , unix >= 2.5 , process >= 1.1 @@ -26,10 +25,11 @@ , optparse-applicative >= 0.11 , regex-pcre-builtin >= 0.94 ghc-options: -Wall - hs-source-dirs: src - main-is: fswatcher.hs - other-modules: Opts - , Pipeline + hs-source-dirs: src + main-is: fswatcher.hs + default-language: Haskell2010 + other-modules: Opts + , Pipeline source-repository head type: git diff --git a/src/Opts.hs b/src/Opts.hs --- a/src/Opts.hs +++ b/src/Opts.hs @@ -2,18 +2,18 @@ import Options.Applicative -data WatchOpt = WatchOpt { watchPath :: String - , includePath :: String -- ^ an reg exp to include particular files when watching dir - , excludePath :: String -- ^ an reg exp to exclude particular files when watching dir +data WatchOpt = WatchOpt { watchPaths :: [String] + , includePath :: String -- ^ a regex to include particular files when watching dir + , excludePath :: String -- ^ a regex to exclude particular files when watching dir , throttlingDelay :: Int -- ^ milliseconds to wait for duplicate events , actionCmd :: [String] } deriving (Show) watchOpt :: Parser WatchOpt watchOpt = WatchOpt - <$> strOption (long "path" - <> metavar "PATH" - <> help "directory / file to watch" ) + <$> some (strOption (long "path" + <> metavar "PATH" + <> help "directory / file to watch" )) <*> strOption (long "include" <> value [] <> metavar "INCLUDE" diff --git a/src/fswatcher.hs b/src/fswatcher.hs --- a/src/fswatcher.hs +++ b/src/fswatcher.hs @@ -7,7 +7,9 @@ import System.Directory (canonicalizePath, getCurrentDirectory) import Filesystem.Path ((), directory) import Filesystem.Path.CurrentOS (decodeString, encodeString) +import Data.Foldable (for_) import Data.String (fromString) +import Data.Traversable (for) import System.FSNotify (Event (..), StopListening, WatchManager, startManager, stopManager, watchTree, watchDir, eventPath) import System.Exit (ExitCode (..), exitSuccess) @@ -25,19 +27,25 @@ data FileType = File | Directory deriving Eq +data FileDetails = FileDetails { givenPath :: FilePath + , expandedPath :: FilePath + , filetype :: FileType + } deriving Eq + -- Watches a file or directory and whenever a “modified” event is registered we -- put () in the MVar that acts as a run trigger. `tryPutMVar` is used to avoid -- re-running the command many times if the file/dir is changed more than once -- while the command is already running. -watch :: FileType -> WatchManager -> String -> MVar () -> WatchOpt -> IO StopListening -watch filetype m path trigger opt = - let watchFun = case filetype of +watch :: WatchManager -> MVar () -> WatchOpt -> FileDetails -> IO StopListening +watch m trigger opt fileDetails = do + let path = expandedPath fileDetails + let watchFun = case filetype fileDetails of Directory -> watchTree m path (matchFiles opt) File -> watchDir m (encodeString $ directory $ decodeString path) isThisFile in watchFun (\_ -> void $ tryPutMVar trigger ()) where isThisFile :: Event -> Bool - isThisFile (Modified p _ _) = p == fromString path + isThisFile (Modified p _ _) = p == fromString (expandedPath fileDetails) isThisFile _ = False matchFiles :: WatchOpt -> Event -> Bool matchFiles wo event = let p = eventPath event @@ -61,7 +69,7 @@ runWatch :: WatchOpt -> IO () runWatch opt = do - let path = watchPath opt + let paths = watchPaths opt let cmd = head $ actionCmd opt let args = drop 1 $ actionCmd opt @@ -73,12 +81,15 @@ _ <- installHandler sigINT (Catch $ putMVar interrupted ()) Nothing _ <- installHandler sigTERM (Catch $ putMVar interrupted ()) Nothing - canonicalPath <- canonicalizePath path + allFileDetails <- for paths $ \path -> do + canonicalPath <- canonicalizePath path - -- Check if path is a file or directory. - s <- getFileStatus canonicalPath - let filetype = if isDirectory s then Directory else File + -- Check if path is a file or directory. + s <- getFileStatus canonicalPath + let ft = if isDirectory s then Directory else File + pure (FileDetails path canonicalPath ft) + -- Check if throttling was requested. let delay = throttlingDelay opt let pipeline = if delay > 0 then throttle delay else id @@ -86,23 +97,26 @@ inputMVar <- newEmptyMVar (pipelineThreads, outputMVar) <- runPipeline pipeline inputMVar runThread <- forkIO $ runCmd cmd args outputMVar - stopWatcher <- watch filetype m canonicalPath inputMVar opt + stopWatchers <- sequence_ <$> traverse (watch m inputMVar opt) allFileDetails let allThreads = runThread : pipelineThreads -- Calculate the full path in order to print the "real" file when watching a -- path with one or more symlinks. currDir <- getCurrentDirectory - let fullPath = fromString currDir fromString path - putStr $ "Started to watch " ++ path - putStrLn $ if fromString canonicalPath == fullPath - then "" - else " (→ " ++ canonicalPath ++ ")" + for_ allFileDetails $ \fileDetails -> do + let path = givenPath fileDetails + let canonicalPath = expandedPath fileDetails + let fullPath = fromString currDir fromString path + putStr $ "Started to watch " ++ path + putStrLn $ if fromString canonicalPath == fullPath + then "" + else " (→ " ++ canonicalPath ++ ")" putStrLn "Press ^C to stop." _ <- readMVar interrupted putStrLn "\nStopping." - stopWatcher + stopWatchers stopManager m mapM_ killThread allThreads exitSuccess