diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2013, Erlend Hamberg + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Erlend Hamberg nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/fswatcher.cabal b/fswatcher.cabal new file mode 100644 --- /dev/null +++ b/fswatcher.cabal @@ -0,0 +1,31 @@ +name: fswatcher +category: Tools +build-type: Simple +version: 0.1 +synopsis: Watch a file/directory and run a command it is 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 + directory is changed. +license: BSD3 +License-file: LICENSE +author: Erlend Hamberg +maintainer: ehamberg@gmail.com +stability: experimental +tested-with: GHC==7.6.3 +homepage: http://www.github.com/ehamberg/fswatcher/ +cabal-version: >= 1.6 + + +Executable fswatcher + build-depends: base >= 4 && < 5 + , unix >= 2.5 + , process >= 1.1 + , fsnotify >= 0.0.4 + , system-filepath >= 0.4 + , directory >= 1.2 + ghc-options: -Wall + main-is: fswatcher.hs + +source-repository head + type: git + location: git://github.com/ehamberg/fswatcher.git diff --git a/fswatcher.hs b/fswatcher.hs new file mode 100644 --- /dev/null +++ b/fswatcher.hs @@ -0,0 +1,77 @@ +import System.IO (hPutStrLn, stderr) +import System.Posix.Files (getFileStatus, isDirectory) +import System.Environment (getArgs, getProgName) +import System.Directory (canonicalizePath) +import Filesystem.Path (directory) +import Data.String (fromString) +import System.FSNotify (Event (..), WatchManager, startManager, stopManager, watchTree, watchDir) +import System.Exit (ExitCode (..), exitSuccess, exitFailure) +import System.Process (createProcess, proc, waitForProcess) +import Control.Monad (void, when) +import System.Posix.Signals (installHandler, Handler(Catch), sigINT, sigTERM) +import Control.Concurrent (forkIO, killThread) +import Control.Concurrent.MVar + +data FileType = File | Directory deriving Eq + +-- watches a file or directory and whenever a “modified” event is registered +-- puts a () in the “run” trigger. `tryPutMVar` is used to avoid re-running the +-- command many times if the file/dir is changed > 1 time while the command is +-- running. +watch :: FileType -> WatchManager -> String -> MVar () -> IO () +watch filetype m path trigger = + let watchFun = case filetype of + Directory -> watchTree m (fromString path) (const True) + File -> watchDir m (directory $ fromString path) isThisFile + in watchFun (\_ -> void $ tryPutMVar trigger ()) + + where isThisFile (Modified p _) = p == fromString path + isThisFile _ = False + +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 completed with exitcode " ++ show n + runCmd cmd args trigger + +main :: IO () +main = do + argv <- getArgs + when (length argv < 2) $ getProgName >>= usage >> exitFailure + + let [path,cmd] = take 2 argv + let args = drop 2 argv + + 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 + + runTrigger <- newEmptyMVar + runThread <- forkIO $ runCmd cmd args runTrigger + watch filetype m canonicalPath runTrigger + putStr $ "Started to watch " ++ path + putStrLn $ if canonicalPath == path then "" else " [→ " ++ canonicalPath ++ "]" + + _ <- readMVar interrupted + putStrLn "\nStopping." + stopManager m + killThread runThread + exitSuccess + where usage n = hPutStrLn stderr $ "Usage: " ++ n + ++ " " + ++ " [arguments for command]"