steeloverseer 1.1.0.1 → 1.1.0.2

raw patch · 3 files changed

+154/−1 lines, 3 filesdep ~basedep ~fsnotify

Dependency ranges changed: base, fsnotify

Files

• src/ANSIColors.hs +39/−0
• src/Sos.hs +113/−0
• steeloverseer.cabal +2/−1

@@ -0,0 +1,39 @@+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+

@@ -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."+

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                steeloverseer-version:             1.1.0.1+version:             1.1.0.2 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,6 +24,7 @@   ghc-options:         -Wall -threaded   hs-source-dirs:      src   main-is:             Main.hs+  other-modules:       Sos, ANSIColors   build-depends:       base >=4.5 && <4.8,                        fsnotify >=0.0.11,                        system-filepath >=0.4.7,