{-# LANGUAGE OverloadedStrings #-}
module SOS where
import ANSIColors
import System.FSNotify
import System.Process
import System.Exit
import System.Posix.Signals
import System.Posix.Daemon
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
import qualified Prelude
-- | 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]
}
pIdFile :: Prelude.FilePath
pIdFile = "sos.pid"
logFile :: Prelude.FilePath
logFile = "sos.log"
steelOverseer :: FilePath -> [String] -> [String] -> Bool -> IO ()
steelOverseer dir cmds exts isDaemon = do
unless isDaemon $ putStrLn "Hit enter to quit.\n"
wm <- startManager
mvar <- newEmptyMVar
let predicate = actionPredicateForRegexes exts
action = performCommand mvar cmds
watchTree wm dir predicate action
unless isDaemon $ do
_ <- getLine
cleanup wm mvar
when isDaemon $ do
-- Install a sigkill handler to cleanup when the daemon is killed.
_ <- installHandler sigQUIT (Catch $ cleanup wm mvar) Nothing
forever $ threadDelay 1000000
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
isDaemon <- isRunning pIdFile
when isDaemon $ brutalKill pIdFile
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."