Permalink
Browse files

Move to using the `configurator` package from bos instead of our own,…

… we get imports etc for free.
  • Loading branch information...
1 parent c9f28ff commit c96b13785e2601ced7901a4cede1ca6376bbf07f Jamie Turner committed Oct 28, 2011
Showing with 61 additions and 101 deletions.
  1. +46 −17 Angel/Config.hs
  2. +0 −74 Angel/Parse.hs
  3. +6 −3 angel.cabal
  4. +9 −7 example.conf
View
@@ -1,37 +1,65 @@
module Angel.Config where
+import Control.Exception (try, SomeException)
import qualified Data.Map as M
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)
+
+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)
-
- 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
+ mconf <- try $ load [Required configPath] >>= getMap >>= buildConfigMap
+
+ 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 +79,7 @@ monitorConfig configPath sharedGroupConfig wakeSig = do
log $ " <<<< Config Error >>>>\n" ++ e
log " <<<< Config Error: Skipping reload >>>>"
Right spec -> do
+ print spec
atomically $ updateSpecConfig sharedGroupConfig spec
syncSupervisors sharedGroupConfig
waitForWake wakeSig
View
@@ -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
View
@@ -7,7 +7,7 @@ Name: angel
-- 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 @@ Executable angel
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 @@ Executable angel
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
View
@@ -1,8 +1,10 @@
-[watch-date]
-exec watch date
+watch-date {
+ exec = "watch date"
+}
-[ls]
-exec ls
-stdout /tmp/ls_log
-stderr /tmp/ls_log
-delay 7
+ls {
+ exec = "ls"
+ stdout = "/tmp/ls_log_$(USER)"
+ stderr = "/tmp/ls_log_$(USER)"
+ delay = 7
+}

0 comments on commit c96b137

Please sign in to comment.