fswatcher 0.2.1 → 0.2.2
raw patch · 8 files changed
+199/−199 lines, 8 filesdep ~fsnotifysetup-changed
Dependency ranges changed: fsnotify
Files
- Opts.hs +0/−30
- Pipeline.hs +0/−50
- Setup.hs +0/−2
- fswatcher.cabal +4/−3
- fswatcher.hs +0/−114
- src/Opts.hs +30/−0
- src/Pipeline.hs +50/−0
- src/fswatcher.hs +115/−0
− Opts.hs
@@ -1,30 +0,0 @@-module Opts where--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- , 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" )- <*> strOption (long "include"- <> value []- <> metavar "INCLUDE"- <> help "pattern for including files")- <*> strOption (long "exclude"- <> value []- <> metavar "EXCLUDE"- <> help "pattern for excluding files")- <*> option auto (long "throttle"- <> value 0- <> metavar "MILLIS"- <> help "milliseconds to wait for duplicate events")- <*> (many . strArgument) (metavar "COMMAND"- <> help "command to run" )
− Pipeline.hs
@@ -1,50 +0,0 @@--- poor man's streaming library, using threads communicating with MVars-module Pipeline where--import Prelude hiding (id, (.))--import Control.Category-import Control.Concurrent (ThreadId, forkIO, threadDelay)-import Control.Concurrent.MVar-import Control.Monad---newtype Pipeline a b = Pipeline {- -- launches zero or more threads, forming a pipeline which takes from- -- the 'MVar a' and puts to the 'MVar b'.- runPipeline :: MVar a -> IO ([ThreadId], MVar b)-}--instance Category Pipeline where- id = Pipeline $ \inputMVar -> return ([], inputMVar)- s2 . s1 = Pipeline $ \inputMVar -> do- (threads1, intermediateMVar) <- runPipeline s1 inputMVar- (threads2, outputMVar) <- runPipeline s2 intermediateMVar- return (threads1 ++ threads2, outputMVar)---mkPipeline :: (a -> IO b) -> Pipeline a b-mkPipeline f = Pipeline $ \inputMVar -> do- outputMVar <- newEmptyMVar- threadId <- forkIO $ forever $ do- x <- takeMVar inputMVar- y <- f x- putMVar outputMVar y- return ([threadId], outputMVar)----- ignore duplicate events, defined as events closer than 'delay'--- milliseconds apart-throttle :: Int -> Pipeline () ()-throttle delay = Pipeline $ \inputMVar -> do- intermediateMVar <- newEmptyMVar- outputMVar <- newEmptyMVar- absorberThreadId <- forkIO $ forever $ do- () <- takeMVar inputMVar- void $ tryPutMVar intermediateMVar () -- don't block if the next thread is sleeping- sleepingThreadId <- forkIO $ forever $ do- () <- takeMVar intermediateMVar- threadDelay (1000 * delay)- _ <- tryTakeMVar intermediateMVar -- drop any event received while sleeping- putMVar outputMVar ()- return ([absorberThreadId, sleepingThreadId], outputMVar)
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
fswatcher.cabal view
@@ -1,7 +1,7 @@ name: fswatcher category: Tools build-type: Simple-version: 0.2.1+version: 0.2.2 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@@ -11,7 +11,7 @@ author: Erlend Hamberg maintainer: ehamberg@gmail.com stability: experimental-tested-with: GHC==7.6.3+tested-with: GHC==7.6.3, GHC==8.4.4 homepage: http://www.github.com/ehamberg/fswatcher/ cabal-version: >= 1.6 @@ -20,12 +20,13 @@ build-depends: base >= 4 && < 5 , unix >= 2.5 , process >= 1.1- , fsnotify >= 0.1+ , fsnotify >= 0.3 && < 0.4 , system-filepath >= 0.4 , directory >= 1.2 , optparse-applicative >= 0.11 , regex-pcre-builtin >= 0.94 ghc-options: -Wall+ hs-source-dirs: src main-is: fswatcher.hs other-modules: Opts , Pipeline
− fswatcher.hs
@@ -1,114 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--import Prelude hiding (id, (.))--import System.IO (hPutStrLn, stderr)-import System.Posix.Files (getFileStatus, isDirectory)-import System.Directory (canonicalizePath, getCurrentDirectory)-import Filesystem.Path ((</>), directory)-import Filesystem.Path.CurrentOS (decodeString, encodeString)-import Data.String (fromString)-import System.FSNotify (Event (..), StopListening, WatchManager, startManager,- stopManager, watchTree, watchDir, eventPath)-import System.Exit (ExitCode (..), exitSuccess)-import System.Process (createProcess, proc, waitForProcess)-import Control.Category-import Control.Monad (void)-import System.Posix.Signals (installHandler, Handler(Catch), sigINT, sigTERM)-import Control.Concurrent (forkIO, killThread)-import Control.Concurrent.MVar-import Text.Regex.PCRE-import Options.Applicative--import Opts-import Pipeline--data FileType = File | Directory 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- Directory -> watchTree m path (matchFiles opt)- File -> watchDir m (encodeString $ directory $ decodeString path) isThisFile- in watchFun (\_ -> void $ tryPutMVar trigger ())-- where isThisFile (Modified p _) = p == fromString path- isThisFile _ = False- matchFiles :: WatchOpt -> Event -> Bool- matchFiles wo event = let p = eventPath event- includes = includePath wo- excludes = excludePath wo- in- (null includes || p =~ includePath wo)- && (null excludes || not (p =~ excludePath wo))--runCmd :: String -> [String] -> MVar () -> IO ()-runCmd cmd args trigger = do- _ <- takeMVar trigger- putStrLn $ "Running " ++ cmd ++ " " ++ unwords args ++ "..."- (_, _, _, ph) <- createProcess (proc cmd args)- exitCode <- waitForProcess ph- hPutStrLn stderr $ case exitCode of- ExitSuccess -> "Process completed successfully"- ExitFailure n -> "Process returned " ++ show n- runCmd cmd args trigger--runWatch :: WatchOpt -> IO ()-runWatch opt = do-- let path = watchPath opt- let cmd = head $ actionCmd opt- let args = drop 1 $ actionCmd opt-- m <- startManager-- -- Create an empty MVar and install INT/TERM handlers that will fill it.- -- We will wait for one of these signals before cleaning up and exiting.- interrupted <- newEmptyMVar- _ <- installHandler sigINT (Catch $ putMVar interrupted ()) Nothing- _ <- installHandler sigTERM (Catch $ putMVar interrupted ()) Nothing-- 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 throttling was requested.- let delay = throttlingDelay opt- let pipeline = if delay > 0 then throttle delay else id-- inputMVar <- newEmptyMVar- (pipelineThreads, outputMVar) <- runPipeline pipeline inputMVar- runThread <- forkIO $ runCmd cmd args outputMVar- stopWatcher <- watch filetype m canonicalPath inputMVar opt- - 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 ++ ")"- putStrLn "Press ^C to stop."-- _ <- readMVar interrupted- putStrLn "\nStopping."- stopWatcher- stopManager m- mapM_ killThread allThreads- exitSuccess--main :: IO ()-main = execParser opts >>= runWatch- where- opts = info (helper <*> watchOpt)- ( fullDesc- <> progDesc "monitors a file or a directory for changes and runs a given command.")
+ src/Opts.hs view
@@ -0,0 +1,30 @@+module Opts where++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+ , 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" )+ <*> strOption (long "include"+ <> value []+ <> metavar "INCLUDE"+ <> help "pattern for including files")+ <*> strOption (long "exclude"+ <> value []+ <> metavar "EXCLUDE"+ <> help "pattern for excluding files")+ <*> option auto (long "throttle"+ <> value 0+ <> metavar "MILLIS"+ <> help "milliseconds to wait for duplicate events")+ <*> (some . strArgument) (metavar "COMMAND"+ <> help "command to run" )
+ src/Pipeline.hs view
@@ -0,0 +1,50 @@+-- poor man's streaming library, using threads communicating with MVars+module Pipeline where++import Prelude hiding (id, (.))++import Control.Category+import Control.Concurrent (ThreadId, forkIO, threadDelay)+import Control.Concurrent.MVar+import Control.Monad+++newtype Pipeline a b = Pipeline {+ -- launches zero or more threads, forming a pipeline which takes from+ -- the 'MVar a' and puts to the 'MVar b'.+ runPipeline :: MVar a -> IO ([ThreadId], MVar b)+}++instance Category Pipeline where+ id = Pipeline $ \inputMVar -> return ([], inputMVar)+ s2 . s1 = Pipeline $ \inputMVar -> do+ (threads1, intermediateMVar) <- runPipeline s1 inputMVar+ (threads2, outputMVar) <- runPipeline s2 intermediateMVar+ return (threads1 ++ threads2, outputMVar)+++mkPipeline :: (a -> IO b) -> Pipeline a b+mkPipeline f = Pipeline $ \inputMVar -> do+ outputMVar <- newEmptyMVar+ threadId <- forkIO $ forever $ do+ x <- takeMVar inputMVar+ y <- f x+ putMVar outputMVar y+ return ([threadId], outputMVar)+++-- ignore duplicate events, defined as events closer than 'delay'+-- milliseconds apart+throttle :: Int -> Pipeline () ()+throttle delay = Pipeline $ \inputMVar -> do+ intermediateMVar <- newEmptyMVar+ outputMVar <- newEmptyMVar+ absorberThreadId <- forkIO $ forever $ do+ () <- takeMVar inputMVar+ void $ tryPutMVar intermediateMVar () -- don't block if the next thread is sleeping+ sleepingThreadId <- forkIO $ forever $ do+ () <- takeMVar intermediateMVar+ threadDelay (1000 * delay)+ _ <- tryTakeMVar intermediateMVar -- drop any event received while sleeping+ putMVar outputMVar ()+ return ([absorberThreadId, sleepingThreadId], outputMVar)
+ src/fswatcher.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE OverloadedStrings #-}++import Prelude hiding (id, (.))++import System.IO (hPutStrLn, stderr)+import System.Posix.Files (getFileStatus, isDirectory)+import System.Directory (canonicalizePath, getCurrentDirectory)+import Filesystem.Path ((</>), directory)+import Filesystem.Path.CurrentOS (decodeString, encodeString)+import Data.String (fromString)+import System.FSNotify (Event (..), StopListening, WatchManager, startManager,+ stopManager, watchTree, watchDir, eventPath)+import System.Exit (ExitCode (..), exitSuccess)+import System.Process (createProcess, proc, waitForProcess)+import Control.Category+import Control.Monad (void)+import System.Posix.Signals (installHandler, Handler(Catch), sigINT, sigTERM)+import Control.Concurrent (forkIO, killThread)+import Control.Concurrent.MVar+import Text.Regex.PCRE+import Options.Applicative++import Opts+import Pipeline++data FileType = File | Directory 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+ 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 _ = False+ matchFiles :: WatchOpt -> Event -> Bool+ matchFiles wo event = let p = eventPath event+ includes = includePath wo+ excludes = excludePath wo+ in+ (null includes || p =~ includePath wo)+ && (null excludes || not (p =~ excludePath wo))++runCmd :: String -> [String] -> MVar () -> IO ()+runCmd cmd args trigger = do+ _ <- takeMVar trigger+ putStrLn $ "Running " ++ cmd ++ " " ++ unwords args ++ "..."+ (_, _, _, ph) <- createProcess (proc cmd args)+ exitCode <- waitForProcess ph+ hPutStrLn stderr $ case exitCode of+ ExitSuccess -> "Process completed successfully"+ ExitFailure n -> "Process returned " ++ show n+ runCmd cmd args trigger++runWatch :: WatchOpt -> IO ()+runWatch opt = do++ let path = watchPath opt+ let cmd = head $ actionCmd opt+ let args = drop 1 $ actionCmd opt++ m <- startManager++ -- Create an empty MVar and install INT/TERM handlers that will fill it.+ -- We will wait for one of these signals before cleaning up and exiting.+ interrupted <- newEmptyMVar+ _ <- installHandler sigINT (Catch $ putMVar interrupted ()) Nothing+ _ <- installHandler sigTERM (Catch $ putMVar interrupted ()) Nothing++ 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 throttling was requested.+ let delay = throttlingDelay opt+ let pipeline = if delay > 0 then throttle delay else id++ inputMVar <- newEmptyMVar+ (pipelineThreads, outputMVar) <- runPipeline pipeline inputMVar+ runThread <- forkIO $ runCmd cmd args outputMVar+ stopWatcher <- watch filetype m canonicalPath inputMVar opt++ 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 ++ ")"+ putStrLn "Press ^C to stop."++ _ <- readMVar interrupted+ putStrLn "\nStopping."+ stopWatcher+ stopManager m+ mapM_ killThread allThreads+ exitSuccess++main :: IO ()+main = execParser opts >>= runWatch+ where+ opts = info (helper <*> watchOpt)+ ( fullDesc+ <> progDesc "monitors a file or a directory for changes and runs a given command.")