angel 0.2.1 → 0.3
raw patch · 3 files changed
+57/−93 lines, 3 filesdep +configuratordep +textdep +unordered-containersdep −parsecdep ~base
Dependencies added: configurator, text, unordered-containers
Dependencies removed: parsec
Dependency ranges changed: base
Files
- Angel/Config.hs +51/−16
- Angel/Parse.hs +0/−74
- angel.cabal +6/−3
Angel/Config.hs view
@@ -1,37 +1,71 @@ module Angel.Config where +import Control.Exception (try, SomeException) import qualified Data.Map as M+import Control.Monad (when, mapM_, void) import Control.Concurrent.STM import Control.Concurrent.STM.TVar (readTVar, writeTVar)-import Text.ParserCombinators.Parsec.Error (ParseError)+import Data.Configurator (load, getMap, Worth(..))+import Data.Configurator.Types (Config, Value(..), Name)+import qualified Data.HashMap.Lazy as HM+import Data.String.Utils (split)+import Data.List (foldl')+import qualified Data.Text as T -import Angel.Parse (parseConfig) import Angel.Job (syncSupervisors) import Angel.Data import Angel.Log (logger) import Angel.Util (waitForWake) +import Debug.Trace (trace)+ -- |produce a mapping of name -> program for every program-buildConfigMap :: Spec -> SpecKey-buildConfigMap cfg = M.fromList [(name p, p) | p <- cfg]+buildConfigMap :: HM.HashMap Name Value -> IO SpecKey+buildConfigMap cfg = + return $! HM.foldlWithKey' addToMap M.empty $ cfg+ where+ addToMap :: SpecKey -> Name -> Value -> SpecKey+ addToMap m key 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) +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"++modifyProg :: Program -> String -> Value -> Program+modifyProg prog "exec" (String s) = prog{exec = (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 = (fromIntegral n)}+modifyProg prog "delay" _ = error "wrong type for field 'delay'; integer"++modifyProg prog "stdout" (String s) = prog{stdout = (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" _ = error "wrong type for field 'stderr'; string required"++modifyProg prog n _ = error $ "unrecognized field: " ++ n++ -- |invoke the parser to process the file at configPath -- |produce a SpecKey processConfig :: String -> IO (Either String SpecKey) processConfig configPath = do - mc <- catch ( do- c <- readFile configPath - return $ Just c- ) (\e-> return Nothing)+ mconf <- try $ load [Required configPath] >>= getMap >>= buildConfigMap >>= checkConfigValues - res <- case mc of - Just c -> do- let cfg = parseConfig c- case cfg of- Left e -> return $ Left $ show e- Right cfg -> do return $ Right $ buildConfigMap cfg- Nothing -> return $ Left ("could not read config file at " ++ configPath)- return res+ case mconf of+ Right config -> return $ Right config+ Left (e :: SomeException) -> return $ Left $ show e+ -- |given a new SpecKey just parsed from the file, update the -- |shared state TVar@@ -51,6 +85,7 @@ log $ " <<<< Config Error >>>>\n" ++ e log " <<<< Config Error: Skipping reload >>>>" Right spec -> do + print spec atomically $ updateSpecConfig sharedGroupConfig spec syncSupervisors sharedGroupConfig waitForWake wakeSig
− Angel/Parse.hs
@@ -1,74 +0,0 @@--- |Parse Angel configuration files--a parsec parser-module Angel.Parse where--import Data.String.Utils (strip)-import Text.ParserCombinators.Parsec-import Data.Maybe (isJust)-import Data.Either (Either(..))-import Control.Monad (foldM)--import Angel.Data--type Kw = Maybe (String, String)--reqInt = manyTill (oneOf ['0'..'9']) (char '\n') <?> "integer"-configString = manyTill anyChar $ char '\n'--configLine :: GenParser Char st Kw-configLine = do - name <- manyTill (noneOf "[") (char ' ')- val <- case name of - "exec" -> configString- "delay" -> reqInt- "stdout" -> configString- "stderr" -> configString- "directory" -> configString- otherwise -> fail $ "unknown config verb '" ++ name ++ "'"- return $ Just (strip name, strip val)--commentLine :: GenParser Char st Kw-commentLine = do - manyTill (oneOf " \t") $ char '#'- manyTill anyChar $ char '\n'- return Nothing--emptyLine :: GenParser Char st Kw-emptyLine = manyTill (oneOf " \t\r") (char '\n') >> return Nothing--header = do - char '[' <?> "start program id"- name <- manyTill anyChar $ char ']'- manyTill (oneOf " \t\r") $ char '\n'- return name--program = do - given_id <- header- kw <- many $ (emptyLine <|> commentLine <|> configLine)- let real_kw = filter isJust kw- let prg = defaultProgram{name=given_id}- prg <- foldM setAttr prg real_kw- mapM_ (check_set prg) [("exec", exec), ("name", name)] - return prg-- where - - setAttr prg (Just (n, v)) = case n of - "exec" -> return prg{exec=v}- "delay" -> return prg{delay=(read v)::Int}- "stdout" -> return prg{stdout=v}- "stderr" -> return prg{stderr=v}- "directory" -> return prg { workingDir = Just v }- otherwise -> fail $ "unknown config keyword " ++ n- setAttr _ _ = fail "non-just in setAttr argument??"-- check_set prg (name, f) = if f prg == f defaultProgram - then fail $ name ++ " must be set for all programs" - else return ()--configFile :: GenParser Char st Spec-configFile = do - many $ (emptyLine <|> commentLine)- return =<< manyTill program eof--parseConfig :: String -> Either ParseError Spec-parseConfig input = parse configFile "(config)" input
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.2.1+Version: 0.3 -- A short (one-line) description of the package. -- Synopsis: @@ -70,12 +70,14 @@ Build-depends: process >= 1.0 Build-depends: mtl Build-depends: MissingH- Build-depends: parsec+ Build-depends: configurator >= 0.1 Build-depends: stm >= 2.0 Build-depends: containers >= 0.3+ Build-depends: unordered-containers >= 0.1.4 Build-depends: unix >= 2.4 Build-depends: old-time Build-depends: old-locale+ Build-depends: text>=0.11 -- Modules not exported by this package.@@ -85,10 +87,11 @@ Angel.Files, Angel.Job, Angel.Log,- Angel.Parse, Angel.Util -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. -- Build-tools: ++ Extensions: OverloadedStrings,ScopedTypeVariables Ghc-Options: -threaded