diff --git a/src/ANSIColors.hs b/src/ANSIColors.hs --- a/src/ANSIColors.hs +++ b/src/ANSIColors.hs @@ -24,3 +24,16 @@ 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 + diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,13 +1,13 @@ {-#LANGUAGE RecordWildCards #-} module Main where -import System.Environment (getArgs ) +import System.Environment (getArgs) import System.Console.GetOpt import Data.List import Control.Monad - -import Prelude hiding (FilePath) - +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 () @@ -20,13 +20,15 @@ data Options = Options { optShowVersion :: Bool , optCommands :: [String] - , optExtensions :: [String] + , optPatterns :: [String] + , optDirectory :: FilePath } deriving (Show, Eq) defaultOptions :: Options defaultOptions = Options { optShowVersion = False , optCommands = [] - , optExtensions = [] + , optPatterns = [] + , optDirectory = fromText $ T.pack "." } options :: [OptDescr (Options -> Options)] @@ -36,16 +38,19 @@ , Option "c" ["command"] (ReqArg (\c opts -> opts { optCommands = optCommands opts ++ [c] }) "COMMAND") "add command to run on file event" - , Option "e" ["extension"] - (ReqArg (\e opts -> opts { optExtensions = optExtensions opts ++ [e] }) "EXTENSION") - "add file extension to watch for events" + , Option "p" ["pattern"] + (ReqArg (\e opts -> opts { optPatterns = optPatterns opts ++ [e] }) "PATTERN") + "add pattern to match on file path" + , Option "d" ["directory"] + (ReqArg (\d opts -> opts { optDirectory = decodeString d }) "DIRECTORY") + "set directory to watch for changes (default is ./)" ] header :: String -header = "Usage: sos [v] -c command -e file_extension" +header = "Usage: sos [v] -c command -p pattern" version :: String -version = intercalate "\n" [ "\nSteel Overseer 0.1.0.2" +version = intercalate "\n" [ "\nSteel Overseer 0.2.0.0" , " by Schell Scivally" , "" ] @@ -53,7 +58,9 @@ startWithOpts :: Options -> IO () startWithOpts opts = do let Options{..} = opts - haveOptions = not (null optCommands) && not (null optExtensions) + haveOptions = not (null optPatterns) + patternsValid = and $ fmap (not . null) optPatterns when optShowVersion $ putStrLn version - when haveOptions $ steelOverseer optCommands optExtensions + unless patternsValid $ error "One or more patterns are empty." + when (haveOptions && patternsValid) $ steelOverseer optDirectory optCommands optPatterns diff --git a/src/SOS.hs b/src/SOS.hs --- a/src/SOS.hs +++ b/src/SOS.hs @@ -8,6 +8,7 @@ import Control.Monad import Control.Concurrent import Data.Maybe +import Text.Regex.TDFA import Filesystem.Path.CurrentOS as OS import Data.Text as T @@ -24,14 +25,14 @@ -- in case it's one that hasn't terminated. type SOSState = ([Event], [String], Maybe ProcessHandle) -steelOverseer :: [String] -> [String] -> IO () -steelOverseer cmds exts = do - putStrLn $ startMsg cmds exts +steelOverseer :: FilePath -> [String] -> [String] -> IO () +steelOverseer dir cmds exts = do + putStrLn "Hit enter to quit.\n" wm <- startManager mvar <- newEmptyMVar - let predicate = actionPredicateForExts $ L.map T.pack exts + let predicate = actionPredicateForRegexes exts action = performCommand mvar cmds in - watchTree wm curdir predicate action + watchTree wm dir predicate action _ <- getLine @@ -42,14 +43,16 @@ _ -> return () stopManager wm - putStrLn $ colorString ANSIGreen "Bye!" -curdir :: OS.FilePath -curdir = fromText $ T.pack "." +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 :: [Text] -> Event -> Bool +actionPredicateForExts :: [String] -> Event -> Bool actionPredicateForExts exts event = let maybeExt = extension $ eventPath event in - case maybeExt of + case fmap T.unpack maybeExt of Just ext -> ext `elem` exts Nothing -> False @@ -81,7 +84,7 @@ startWriteProcess :: MVar SOSState -> [String] -> Int -> IO () startWriteProcess mvar [] _ = do _ <- tryTakeMVar mvar - putStrLn $ colorString ANSIGreen "Done." + return () startWriteProcess mvar (cmd:cmds) delay = void $ forkIO $ do threadDelay delay @@ -96,7 +99,7 @@ exitCode <- waitForProcess pId case exitCode of ExitSuccess -> do - cyanPrint exitCode + greenPrint exitCode startWriteProcess mvar cmds 0 _ -> redPrint exitCode @@ -105,25 +108,3 @@ terminateProcess pid putStrLn $ colorString ANSIRed "Terminated hanging process." -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 - -startMsg :: [String] -> [String] -> String -startMsg cmds exts = L.foldl (++) "" [ "Starting steeloverseer to perform " - , L.intercalate ", " $ quote cmds - , " when files of type " - , L.intercalate ", " $ quote exts - , " change in the current directory.\n" - , "Hit enter to quit.\n" - ] - - where quote = L.map (\s-> "\""++s++"\"") diff --git a/steeloverseer.cabal b/steeloverseer.cabal --- a/steeloverseer.cabal +++ b/steeloverseer.cabal @@ -2,19 +2,16 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: steeloverseer -version: 0.1.0.2 -synopsis: A tool that runs a list of commands after files change on disk. -description: A command line tool that responds to changes in certain files by running - specific commands. Similar to the codemonitor project but simpler and - (hopefully) cross platform. -license: MIT +version: 0.2.0.0 +synopsis: A file watcher. +description: A command line tool that responds to filesystem events. Users can provide regular expressions to match on filepaths and shell commands to execute in serial when matches are found. Displays text using a subset of available primary colors. +license: BSD3 license-file: LICENSE author: Schell Scivally maintainer: efsubenovex@gmail.com stability: alpha bug-reports: https://github.com/schell/steeloverseer/issues homepage: https://github.com/schell/steeloverseer -copyright: Schell Scivally 2013 category: Development build-type: Simple cabal-version: >=1.8 @@ -35,5 +32,6 @@ text >=0.11.2.3, time >=1.4, pipes >=3.2, - stm >=2.4 + stm >=2.4, + regex-tdfa >=1.1.8