packages feed

steeloverseer 0.1.0.2 → 0.2.0.0

raw patch · 4 files changed

+54/−55 lines, 4 filesdep +regex-tdfa

Dependencies added: regex-tdfa

Files

src/ANSIColors.hs view
@@ -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+
src/Main.hs view
@@ -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       
src/SOS.hs view
@@ -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++"\"")
steeloverseer.cabal view
@@ -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