steeloverseer (empty) → 0.1.0.1
raw patch · 5 files changed
+259/−0 lines, 5 filesdep +basedep +fsnotifydep +pipessetup-changed
Dependencies added: base, fsnotify, pipes, process, stm, system-filepath, text, time
Files
- LICENSE +31/−0
- Setup.hs +2/−0
- src/Main.hs +59/−0
- src/SOS.hs +129/−0
- steeloverseer.cabal +38/−0
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2013, Schell Scivally+ +All rights reserved.+ +Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:+ + * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ + * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.+ + * Neither the name of Schell Scivally nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.+ +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Main.hs view
@@ -0,0 +1,59 @@+{-#LANGUAGE RecordWildCards #-}+module Main where++import System.Environment (getArgs )+import System.Console.GetOpt +import Data.List+import Control.Monad++import Prelude hiding (FilePath)++import SOS++main :: IO ()+main = do+ args <- getArgs+ case getOpt Permute options args of+ ( [], _, []) -> error $ usageInfo header options+ ( opts, _, []) -> startWithOpts $ foldl (flip id) defaultOptions opts+ ( _, _, msgs) -> error $ concat msgs ++ usageInfo header options++data Options = Options { optShowVersion :: Bool+ , optCommands :: [String]+ , optExtensions :: [String]+ } deriving (Show, Eq)++defaultOptions :: Options+defaultOptions = Options { optShowVersion = False+ , optCommands = []+ , optExtensions = []+ }++options :: [OptDescr (Options -> Options)]+options = [ Option "v" ["version"]+ (NoArg (\opts -> opts { optShowVersion = True }))+ "show version info"+ , 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"+ ]+ +header :: String+header = "Usage: sos [v] -c command -e file_extension"++version :: String+version = intercalate "\n" [ "\nSteel Overseer 0.1.0.1"+ , " by Schell Scivally" + , ""+ ]++startWithOpts :: Options -> IO ()+startWithOpts opts = do+ let Options{..} = opts+ haveOptions = not (null optCommands) && not (null optExtensions)+ when optShowVersion $ putStrLn version+ when haveOptions $ steelOverseer optCommands optExtensions +
+ src/SOS.hs view
@@ -0,0 +1,129 @@+module SOS where++import ANSIColors++import System.FSNotify+import System.Process+import System.Exit+import Control.Monad+import Control.Concurrent+import Data.Maybe++import Filesystem.Path.CurrentOS as OS+import Data.Text as T+import Data.List as L++import System.IO ( Handle )++import Prelude hiding ( FilePath )++type RunningProcess = IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)++-- | A tuple 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.+type SOSState = ([Event], [String], Maybe ProcessHandle)++steelOverseer :: [String] -> [String] -> IO ()+steelOverseer cmds exts = do+ putStrLn $ startMsg cmds exts+ wm <- startManager+ mvar <- newEmptyMVar+ let predicate = actionPredicateForExts $ L.map T.pack exts+ action = performCommand mvar cmds in+ watchTree wm curdir predicate action++ _ <- getLine++ mState <- tryTakeMVar mvar++ case mState of+ Just (_, _, Just pid) -> terminatePID pid+ _ -> return ()+ + stopManager wm+ putStrLn $ colorString ANSIGreen "Bye!"++curdir :: OS.FilePath+curdir = fromText $ T.pack "."++actionPredicateForExts :: [Text] -> Event -> Bool +actionPredicateForExts exts event = let maybeExt = extension $ eventPath event in+ case maybeExt of+ Just ext -> ext `elem` exts+ Nothing -> False ++performCommand :: MVar SOSState -> [String] -> Event -> IO ()+performCommand mvar cmds event = do+ cyanPrint event+ mEvProc <- tryTakeMVar mvar+ eventsAndProcess <- case mEvProc of+ Nothing -> do + -- This is the first file to change and there is no running process. + startWriteProcess mvar cmds 1000000+ return ([event], cmds, Nothing)++ Just ([], _, Just pid) -> do+ -- There is a hanging process.+ mExCode <- getProcessExitCode pid+ when (isNothing mExCode) $ terminatePID pid+ startWriteProcess mvar cmds 1000000+ return ([event], cmds, Nothing)++ Just (events, leftoverCmds, Nothing) -> + -- SOS is waiting the 1sec delay for events before running the process. + return (event:events, leftoverCmds, Nothing)++ Just enp -> return enp++ putMVar mvar eventsAndProcess++startWriteProcess :: MVar SOSState -> [String] -> Int -> IO () +startWriteProcess mvar [] _ = do+ _ <- tryTakeMVar mvar+ putStrLn $ colorString ANSIGreen "Done."++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+ Nothing -> putMVar mvar ([], cmds, Just pId)+ + Just (_, _, _) -> void $ forkIO $ do+ putMVar mvar ([], cmds, Just pId)+ exitCode <- waitForProcess pId+ case exitCode of + ExitSuccess -> do+ cyanPrint exitCode+ startWriteProcess mvar cmds 0+ _ -> redPrint exitCode++terminatePID :: ProcessHandle -> IO ()+terminatePID pid = do+ 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
@@ -0,0 +1,38 @@+-- Initial steeloverseer.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: steeloverseer+version: 0.1.0.1+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+license-file: LICENSE+author: Schell Scivally+maintainer: efsubenovex@gmail.com+stability: alpha+bug-reports: https://github.com/schell/steeloverseer/issues+copyright: Schell Scivally 2013+category: Development+build-type: Simple+cabal-version: >=1.8+-- source+source-repository head+ type: git+ location: git://github.com/schell/steeloverseer.git++executable sos+ ghc-options: -Wall -threaded+ hs-source-dirs: src+ main-is: Main.hs+ other-modules: SOS+ build-depends: base >=4.5 && < 5,+ fsnotify >=0.0.11,+ system-filepath >=0.4.7,+ process >= 1.1.0.2,+ text >=0.11.2.3,+ time >=1.4,+ pipes >=3.2,+ stm >=2.4+