steeloverseer 1.1.0.2 → 1.1.0.3
raw patch · 4 files changed
+116/−116 lines, 4 files
Files
- src/Main.hs +1/−1
- src/SOS.hs +113/−0
- src/Sos.hs +0/−113
- steeloverseer.cabal +2/−2
src/Main.hs view
@@ -50,7 +50,7 @@ header = "Usage: sos [vb] -c command -p pattern" version :: String-version = "\nSteel Overseer 1.1.0.0\n"+version = "\nSteel Overseer 1.1.0.3\n" startWithOpts :: Options -> IO () startWithOpts opts = do
+ src/SOS.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE OverloadedStrings #-}+module SOS where+++import ANSIColors+import System.FSNotify+import System.Process+import System.Exit+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++-- | 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+ | SOSPending { accumulatedEvents :: [Event] }+ | SOSRunning { runningProccess :: ProcessHandle+ , pendingCommands :: [String]+ }++-- | 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 ptns+ action = performCommand mvar cmds+ _ <- 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+ _ -> return ()+ stopManager wm++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++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.+ startWriteProcess mvar cmds 1000000+ return $ SOSPending [event]++ Just (SOSRunning pid _) -> do+ -- There is a hanging process.+ mExCode <- getProcessExitCode pid+ when (isNothing mExCode) $ terminatePID pid+ startWriteProcess mvar cmds 1000000+ return $ SOSPending [event]++ Just (SOSPending events) ->+ -- 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 [] _ = do+ _ <- tryTakeMVar mvar+ return ()++startWriteProcess mvar (cmd:cmds) delay = void $ forkIO $ do+ threadDelay delay+ putStrLn $ colorString ANSIGreen "\n> " ++ cmd ++ "\n"+ 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+ exitCode <- waitForProcess pId+ case exitCode of+ ExitSuccess -> do+ greenPrint exitCode+ startWriteProcess mvar cmds 0+ _ -> redPrint exitCode++terminatePID :: ProcessHandle -> IO ()+terminatePID pid = do+ terminateProcess pid+ putStrLn $ colorString ANSIRed "Terminated hanging process."+
− src/Sos.hs
@@ -1,113 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module SOS where---import ANSIColors-import System.FSNotify-import System.Process-import System.Exit-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---- | 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- | SOSPending { accumulatedEvents :: [Event] }- | SOSRunning { runningProccess :: ProcessHandle- , pendingCommands :: [String]- }---- | 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 ptns- action = performCommand mvar cmds- _ <- 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- _ -> return ()- stopManager wm--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--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.- startWriteProcess mvar cmds 1000000- return $ SOSPending [event]-- Just (SOSRunning pid _) -> do- -- There is a hanging process.- mExCode <- getProcessExitCode pid- when (isNothing mExCode) $ terminatePID pid- startWriteProcess mvar cmds 1000000- return $ SOSPending [event]-- Just (SOSPending events) ->- -- 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 [] _ = do- _ <- tryTakeMVar mvar- return ()--startWriteProcess mvar (cmd:cmds) delay = void $ forkIO $ do- threadDelay delay- putStrLn $ colorString ANSIGreen "\n> " ++ cmd ++ "\n"- 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- exitCode <- waitForProcess pId- case exitCode of- ExitSuccess -> do- greenPrint exitCode- startWriteProcess mvar cmds 0- _ -> redPrint exitCode--terminatePID :: ProcessHandle -> IO ()-terminatePID pid = do- terminateProcess pid- putStrLn $ colorString ANSIRed "Terminated hanging process."-
steeloverseer.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: steeloverseer-version: 1.1.0.2+version: 1.1.0.3 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. license: BSD3@@ -24,7 +24,7 @@ ghc-options: -Wall -threaded hs-source-dirs: src main-is: Main.hs- other-modules: Sos, ANSIColors+ other-modules: SOS, ANSIColors build-depends: base >=4.5 && <4.8, fsnotify >=0.0.11, system-filepath >=0.4.7,