angel 0.3.2 → 0.3.3
raw patch · 4 files changed
+47/−36 lines, 4 files
Files
- Angel/Config.hs +27/−11
- Angel/Data.hs +8/−12
- Angel/Job.hs +10/−11
- angel.cabal +2/−2
Angel/Config.hs view
@@ -1,5 +1,6 @@ module Angel.Config where +import Data.Maybe (isJust) import Control.Exception (try, SomeException) import qualified Data.Map as M import Control.Monad (when, mapM_)@@ -28,38 +29,53 @@ return $! HM.foldlWithKey' addToMap M.empty $ cfg where addToMap :: SpecKey -> Name -> Value -> SpecKey- addToMap m key value =+ addToMap m + (split "." . T.unpack -> [basekey, localkey])+ value = let !newprog = case M.lookup basekey m of Just prog -> modifyProg prog localkey value Nothing -> modifyProg defaultProgram{name=basekey} localkey value in M.insert basekey newprog m- where- (basekey:localkey:[]) = split "." (T.unpack key)+ addToMap m _ _ = m checkConfigValues :: SpecKey -> IO SpecKey checkConfigValues progs = (mapM_ checkProgram $ M.elems progs) >> (return progs) where- checkProgram p = void $ when (exec p == "") $ error $ name p ++ " does not have an 'exec' specification"+ checkProgram p = void $ when (exec p == Nothing) $ error $ name p ++ " does not have an 'exec' specification" modifyProg :: Program -> String -> Value -> Program-modifyProg prog "exec" (String s) = prog{exec = (T.unpack s)}+modifyProg prog "exec" (String s) | isJust (exec prog) = + error $ "redefinition of '" ++ (name prog) ++ ".exec'"+ | otherwise = + prog{exec = Just (T.unpack s)} modifyProg prog "exec" _ = error "wrong type for field 'exec'; string required" -modifyProg prog "delay" (Number n) | n < 0 = error "delay value must be >= 0"- | otherwise = prog{delay = round n}+modifyProg prog "delay" (Number n) | isJust (delay prog) =+ error $ "redefinition of '" ++ (name prog) ++ ".prog'"+ | n < 0 = error "delay value must be >= 0"+ | otherwise = prog{delay = Just $ round n} modifyProg prog "delay" _ = error "wrong type for field 'delay'; integer" -modifyProg prog "stdout" (String s) = prog{stdout = (T.unpack s)}+modifyProg prog "stdout" (String s) | isJust (stdout prog) =+ error $ "redefinition of '" ++ (name prog) ++ ".stdout'"+ | otherwise = + prog{stdout = Just (T.unpack s)} modifyProg prog "stdout" _ = error "wrong type for field 'stdout'; string required" -modifyProg prog "stderr" (String s) = prog{stderr = (T.unpack s)}+modifyProg prog "stderr" (String s) | isJust (stderr prog) = + error $ "redefinition of '" ++ (name prog) ++ ".stderr'"+ | otherwise =+ prog{stderr = Just (T.unpack s)} modifyProg prog "stderr" _ = error "wrong type for field 'stderr'; string required" -modifyProg prog "directory" (String s) = prog{workingDir = (Just $ T.unpack s)}+modifyProg prog "directory" (String s) | isJust (workingDir prog) = + error $ "redefinition of '" ++ (name prog) ++ ".directory'"+ | otherwise =+ prog{workingDir = (Just $ T.unpack s)} modifyProg prog "directory" _ = error "wrong type for field 'directory'; string required" -modifyProg prog n _ = error $ "unrecognized field: " ++ n+modifyProg prog n _ = prog -- |invoke the parser to process the file at configPath
Angel/Data.hs view
@@ -24,10 +24,10 @@ -- |read from the config file data Program = Program { name :: String,- exec :: String,- delay :: Int,- stdout :: String,- stderr :: String,+ exec :: Maybe String,+ delay :: Maybe Int,+ stdout :: Maybe String,+ stderr :: Maybe String, workingDir :: Maybe FilePath } deriving (Show, Eq, Ord) @@ -36,11 +36,7 @@ -- |a template for an empty program; the variable set to "" -- |are required, and must be overridden in the config file-defaultProgram = Program{- name="",- exec="",- delay=5,- stdout="/dev/null",- stderr="/dev/null",- workingDir = Nothing-}+defaultProgram = Program "" Nothing Nothing Nothing Nothing Nothing+defaultDelay = 5 :: Int+defaultStdout = "/dev/null"+defaultStderr = "/dev/null"
Angel/Job.hs view
@@ -1,7 +1,7 @@ module Angel.Job where import Data.String.Utils (split, strip)-import Data.Maybe (isJust, fromJust)+import Data.Maybe (isJust, fromJust, fromMaybe) import System.Process (createProcess, proc, waitForProcess, ProcessHandle) import System.Process (terminateProcess, CreateProcess(..), StdStream(..)) import Control.Concurrent@@ -34,7 +34,7 @@ (do (attachOut, attachErr) <- makeFiles my_spec cfg - let (cmd, args) = cmdSplit $ exec my_spec+ let (cmd, args) = cmdSplit $ (fromJust $ exec my_spec) (_, _, _, p) <- createProcess (proc cmd args){ std_out = attachOut,@@ -57,7 +57,7 @@ else do log "WAITING"- sleepSecs $ delay my_spec+ sleepSecs $ (fromMaybe defaultDelay $ delay my_spec) log "RESTART" supervise sharedGroupConfig id )@@ -79,14 +79,13 @@ running=M.delete id (running wcfg) } - makeFiles my_spec cfg = do - attachOut <- case stdout my_spec of- "" -> return Inherit- other -> UseHandle `fmap` getFile other cfg- - attachErr <- case stderr my_spec of- "" -> return Inherit- other -> UseHandle `fmap` getFile other cfg+ makeFiles my_spec cfg = do+ let useout = fromMaybe defaultStdout $ stdout my_spec+ attachOut <- UseHandle `fmap` getFile useout cfg++ let useerr = fromMaybe defaultStderr $ stderr my_spec+ attachErr <- UseHandle `fmap` getFile useerr cfg+ return $ (attachOut, attachErr)
angel.cabal view
@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version: 0.3.2+Version: 0.3.3 -- A short (one-line) description of the package. -- Synopsis: @@ -92,6 +92,6 @@ -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. -- Build-tools: - Extensions: OverloadedStrings,ScopedTypeVariables,BangPatterns+ Extensions: OverloadedStrings,ScopedTypeVariables,BangPatterns,ViewPatterns Ghc-Options: -threaded