fswatcher 0.2.2 → 0.3.0
raw patch · 3 files changed
+46/−32 lines, 3 files
Files
- fswatcher.cabal +10/−10
- src/Opts.hs +6/−6
- src/fswatcher.hs +30/−16
fswatcher.cabal view
@@ -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
src/Opts.hs view
@@ -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"
src/fswatcher.hs view
@@ -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