steeloverseer 0.5.0.1 → 1.0.1.0
raw patch · 5 files changed
+136/−150 lines, 5 filesdep +ansi-terminaldep +filepathdep −daemonsdep −system-filepathdep −textdep ~basedep ~fsnotify
Dependencies added: ansi-terminal, filepath
Dependencies removed: daemons, system-filepath, text
Dependency ranges changed: base, fsnotify
Files
- README.md +66/−0
- src/ANSIColors.hs +0/−39
- src/Main.hs +8/−38
- src/SOS.hs +54/−63
- steeloverseer.cabal +8/−10
+ README.md view
@@ -0,0 +1,66 @@+Steel Overseer+==============+> +>+> The world is already run by all manner of machines. One day, they'll remind us of that fact. +> +> -Sargis Haz, artificer ++[](https://travis-ci.org/schell/steeloverseer)++It is+-----+A development tool that runs commands when certain files are updated, added or+deleted.++Steeloverseer watches files whose names match a regular expression and then +runs a series of commands when those files are updated. ++Specifically+------------+A filesystem event occurs when a file is added, deleted or updated. +If this event happens on a file that matches one of the patterns provided with +the `-p PATTERN` flag then steeloverseer will run the commands provided +with the `-c COMMAND` flag. These commands will be performed in serial until +one hangs, fails or all exit successfully.++You can provide multiple patterns and multiple commands, ie:++ sos -c "git status" -c "echo hi world" -p "hs" -p "md"++You can seperately specify the directory to run in with `-d DIRECTORY`. The +default is `.`.+ +This will execute `git status` followed by `echo hi world` +whenever files matching "hs" or "md" are changed. `-d DIRECTORY` +is not provided above, so it's assumed to be `./`.++Also, since `-p PATTERN` are regular expressions we can do the same as above with:++ sos -c "git status" -c "echo hi world" -p "hs|md"+ +Of course this would run whenever any match on "hs|md" is found, +for instance on the filepath `/Users/home/mdman/file.txt`.+For extensions it may make sense to use the endline matcher:++ sos -c "git status" -c "echo hi world" -p "hs$|md$"++Installation+------------+Using cabal, `cabal install steeloverseer`.++Usage+-----+ sos: Usage: sos [v] -c command -p pattern+ -v --version show version info+ -c COMMAND --command=COMMAND add command to run on file event+ -p PATTERN --pattern=PATTERN add pattern to match on file path+ -d DIRECTORY --directory=DIRECTORY set directory to watch for changes (default is ./)++++Future+------+Project `.sosrc` file for specifying multiple sos commands while working on a project (@see issue #4)++[Art above by Chris Rahn for Wizards of the Coast](http://gatherer.wizards.com/Pages/Card/Details.aspx?multiverseid=205036 "Steel Overseer")
− src/ANSIColors.hs
@@ -1,39 +0,0 @@-module ANSIColors where--data ANSIColor = ANSIBlack | ANSIRed | ANSIGreen | ANSIYellow | ANSIBlue | ANSIMagenta | ANSICyan | ANSIWhite | ANSINone- deriving (Ord, Eq)--instance Show ANSIColor where- show ANSINone = "\27[0m" - show c = "\27[" ++ show cn ++ "m"- where cn = 30 + colorNum c --colorNum :: ANSIColor -> Int-colorNum c = length $ takeWhile (/= c) ansibow --ansibow :: [ANSIColor]-ansibow = [ ANSIBlack- , ANSIRed- , ANSIGreen- , ANSIYellow- , ANSIBlue- , ANSIMagenta- , ANSICyan- , ANSIWhite - ]--colorString :: ANSIColor -> String -> String-colorString c s = show c ++ s ++ show ANSINone --greenPrint :: (Show a) => a -> IO ()-greenPrint = colorPrint ANSIGreen--cyanPrint :: (Show a) => a -> IO ()-cyanPrint = colorPrint ANSICyan --redPrint :: (Show a) => a -> IO ()-redPrint = colorPrint ANSIRed --colorPrint :: (Show a) => ANSIColor -> a -> IO ()-colorPrint c = putStrLn . colorString c . show-
src/Main.hs view
@@ -2,13 +2,8 @@ module Main where import System.Environment (getArgs)-import System.Console.GetOpt -import System.Posix.Daemon-import Data.List+import System.Console.GetOpt import Control.Monad-import Filesystem.Path.CurrentOS hiding (concat, null)-import Data.Text as T hiding (foldl, concat, intercalate, null)-import Prelude hiding (FilePath) import SOS main :: IO ()@@ -23,17 +18,13 @@ , optCommands :: [String] , optPatterns :: [String] , optDirectory :: FilePath- , optIsDaemon :: Bool- , optDaemonCmd :: String } deriving (Show, Eq) defaultOptions :: Options defaultOptions = Options { optShowVersion = False , optCommands = [] , optPatterns = []- , optDirectory = fromText $ T.pack "."- , optIsDaemon = False- , optDaemonCmd = "start" + , optDirectory = "." } options :: [OptDescr (Options -> Options)]@@ -45,45 +36,24 @@ "Add command to run on file event." , Option "p" ["pattern"] (ReqArg (\e opts -> opts { optPatterns = optPatterns opts ++ [e] }) "pattern")- "Add pattern to match on file path." + "Add pattern to match on file path." , Option "d" ["directory"]- (ReqArg (\d opts -> opts { optDirectory = decodeString d }) "directory")+ (ReqArg (\d opts -> opts { optDirectory = d }) "directory") "Set directory to watch for changes (default is ./)."- , Option "b" ["daemon"]- (ReqArg (\s opts -> opts { optIsDaemon = True, optDaemonCmd = s }) "start|stop")- "Attempt to run in the background as a daemon. When a previous daemon is running from your working directory this option will kill that process." ]- + header :: String header = "Usage: sos [vb] -c command -p pattern" version :: String-version = "\nSteel Overseer 1.0.0.0\n"+version = "\nSteel Overseer 1.1.0.4\n" startWithOpts :: Options -> IO () startWithOpts opts = do let Options{..} = opts haveOptions = not (null optPatterns) patternsValid = and $ fmap (not . null) optPatterns- daemonValid = optDaemonCmd == "start" || optDaemonCmd == "stop" when optShowVersion $ putStrLn version unless patternsValid $ error "One or more patterns are empty."- unless daemonValid $ error "The argument to -b,--daemon must be one of start or stop."- didKill <- if optIsDaemon && optDaemonCmd == "stop"- then do shouldKillPrev <- isRunning pIdFile- if shouldKillPrev- then do putStrLn "Killing previous steeloverseer daemon..."- killAndWait pIdFile - putStrLn "Done."- else putStrLn "There is no previous daemon to kill."- return shouldKillPrev- else return False- let runSteelOverseer = steelOverseer optDirectory optCommands optPatterns optIsDaemon- when (haveOptions && patternsValid && daemonValid) $ - if not optIsDaemon - then runSteelOverseer - else unless didKill $ do- putStrLn "Running in the background as a daemon, logging output to sos.log."- runDetached (Just pIdFile) (ToFile logFile) runSteelOverseer--+ let runSteelOverseer = steelOverseer optDirectory optCommands optPatterns+ when (haveOptions && patternsValid) runSteelOverseer
src/SOS.hs view
@@ -1,87 +1,59 @@-{-# LANGUAGE OverloadedStrings #-} module SOS where --import ANSIColors-import System.FSNotify-import System.Process-import System.Exit-import System.Posix.Signals-import System.Posix.Daemon-import Control.Monad-import Control.Concurrent-import Data.Maybe-import Text.Regex.TDFA-import Filesystem.Path.CurrentOS as OS-import Prelude hiding ( FilePath )-import qualified Data.Text as T-import qualified Prelude+import System.FSNotify+import System.Process+import System.Exit+import System.FilePath+import System.Console.ANSI+import Control.Monad+import Control.Concurrent+import Data.Maybe+import Text.Regex.TDFA+import Prelude hiding ( FilePath ) --- | A structure to hold our changed file events, --- list of commands to run and possibly the currently running process, +-- | A structure to hold our changed file events,+-- list of commands to run and possibly the currently running process, -- in case it's one that hasn't terminated.-data SOSState = SOSIdle +data SOSState = SOSIdle | SOSPending { accumulatedEvents :: [Event] } | SOSRunning { runningProccess :: ProcessHandle , pendingCommands :: [String] } -pIdFile :: Prelude.FilePath-pIdFile = "sos.pid"--logFile :: Prelude.FilePath-logFile = "sos.log"--steelOverseer :: FilePath -> [String] -> [String] -> Bool -> IO ()-steelOverseer dir cmds exts isDaemon = do- unless isDaemon $ putStrLn "Hit enter to quit.\n" +-- | Starts sos in a `dir` watching `ptns` to execute `cmds`.+steelOverseer :: FilePath -> [String] -> [String] -> IO ()+steelOverseer dir cmds ptns = do+ putStrLn "Hit enter to quit.\n" wm <- startManager mvar <- newEmptyMVar - let predicate = actionPredicateForRegexes exts+ let predicate = actionPredicateForRegexes ptns action = performCommand mvar cmds- watchTree wm dir predicate action-- unless isDaemon $ do - _ <- getLine- cleanup wm mvar- - when isDaemon $ do- -- Install a sigkill handler to cleanup when the daemon is killed.- _ <- installHandler sigQUIT (Catch $ cleanup wm mvar) Nothing - forever $ threadDelay 1000000 + _ <- watchTree wm dir predicate action+ _ <- getLine+ cleanup wm mvar +-- | Cleans up sos on close. cleanup :: WatchManager -> MVar SOSState -> IO () cleanup wm mvar = do putStrLn "Cleaning up." mState <- tryTakeMVar mvar case mState of- Just (SOSRunning pid _) -> terminatePID pid + Just (SOSRunning pid _) -> terminatePID pid _ -> return () stopManager wm - isDaemon <- isRunning pIdFile - when isDaemon $ brutalKill pIdFile- actionPredicateForRegexes :: [String] -> Event -> Bool-actionPredicateForRegexes ptns event = or (fmap (filepath =~) ptns :: [Bool])- where filepath = case toText $ eventPath event of- Left f -> T.unpack f- Right f -> T.unpack f--actionPredicateForExts :: [String] -> Event -> Bool -actionPredicateForExts exts event = let maybeExt = extension $ eventPath event in- case fmap T.unpack maybeExt of- Just ext -> ext `elem` exts- Nothing -> False +actionPredicateForRegexes ptns event =+ or (fmap (eventPath event =~) ptns :: [Bool]) performCommand :: MVar SOSState -> [String] -> Event -> IO () performCommand mvar cmds event = do cyanPrint event mSosState <- tryTakeMVar mvar sosState <- case mSosState of- Nothing -> do - -- This is the first file to change and there is no running process. + Nothing -> do+ -- This is the first file to change and there is no running process. startWriteProcess mvar cmds 1000000 return $ SOSPending [event] @@ -93,31 +65,36 @@ return $ SOSPending [event] Just (SOSPending events) ->- -- SOS is waiting the 1sec delay for events before running the process. + -- SOS is waiting the 1sec delay for events before running the process. return $ SOSPending $ event:events Just state -> return state putMVar mvar sosState -startWriteProcess :: MVar SOSState -> [String] -> Int -> IO () +startWriteProcess :: MVar SOSState -> [String] -> Int -> IO () startWriteProcess mvar [] _ = do _ <- tryTakeMVar mvar return () startWriteProcess mvar (cmd:cmds) delay = void $ forkIO $ do threadDelay delay- putStrLn $ colorString ANSIGreen "\n> " ++ cmd ++ "\n"++ setSGR [SetColor Foreground Dull Green]+ putStr "\n> "+ setSGR [Reset]+ putStrLn cmd+ pId <- runCommand cmd mEvProcCurrent <- tryTakeMVar mvar case mEvProcCurrent of -- This shouldn't ever happen. Nothing -> putMVar mvar $ SOSRunning pId cmds- + Just _ -> void $ forkIO $ do- putMVar mvar $ SOSRunning pId cmds + putMVar mvar $ SOSRunning pId cmds exitCode <- waitForProcess pId- case exitCode of + case exitCode of ExitSuccess -> do greenPrint exitCode startWriteProcess mvar cmds 0@@ -125,6 +102,20 @@ terminatePID :: ProcessHandle -> IO () terminatePID pid = do- terminateProcess pid - putStrLn $ colorString ANSIRed "Terminated hanging process."+ terminateProcess pid+ putStrLnColor Red "Terminated hanging process." +cyanPrint :: Show a => a -> IO ()+cyanPrint = putStrLnColor Cyan . show++redPrint :: Show a => a -> IO ()+redPrint = putStrLnColor Red . show++greenPrint :: Show a => a -> IO ()+greenPrint = putStrLnColor Green . show++putStrLnColor :: Color -> String -> IO ()+putStrLnColor c s = do+ setSGR [SetColor Foreground Dull c]+ putStrLn s+ setSGR [Reset]
steeloverseer.cabal view
@@ -2,9 +2,9 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: steeloverseer-version: 0.5.0.1+version: 1.0.1.0 synopsis: A file watcher.-description: A command line tool that responds to filesystem events. Allows the user to automatically execute commands after files are added or updated. Watches files using regular expressions. Can be invoked interactively or as a daemon.+description: A command line tool that responds to filesystem events. Allows the user to automatically execute commands after files are added or updated. Watches files using regular expressions. license: BSD3 license-file: LICENSE author: Schell Scivally@@ -15,6 +15,7 @@ category: Development build-type: Simple cabal-version: >=1.8+extra-source-files: README.md source-repository head type: git@@ -24,15 +25,12 @@ ghc-options: -Wall -threaded hs-source-dirs: src main-is: Main.hs- other-modules: SOS, ANSIColors- build-depends: base >=4.5 && < 5,- fsnotify >=0.0.11,- system-filepath >=0.4.7,+ other-modules: SOS+ build-depends: base >=4.5 && <4.9,+ fsnotify >=0.2 && < 0.3,+ filepath >= 1.4 && < 1.5,+ ansi-terminal >= 0.6 && < 0.7, process >= 1.1.0.2,- text >=0.11.2.3, time >=1.4, regex-tdfa >=1.1.8,- daemons >=0.2.1, unix >=2.6.0.1--