More explicit config error messages; fix defaultArgConfig

This commit is contained in:
Michael Snoyman 2011-09-22 07:32:50 +03:00
parent a6e7924e7c
commit 1dbbfc8d06
2 changed files with 21 additions and 25 deletions

View File

@ -85,12 +85,12 @@ loadConfig env = withYamlEnvironment "config/settings.yml" env $ \e -> do
-- set some default arguments
let ssl = maybe False toBool mssl
port <- safeRead $ fromMaybe (if ssl then "443" else "80") mport
port <- safeRead "port" $ fromMaybe (if ssl then "443" else "80") mport
approot <- case (mhost, mapproot) of
(_ , Just ar) -> Just ar
(Just host, _ ) -> Just $ (if ssl then "https://" else "http://") ++ host ++ (addPort ssl port)
_ -> Nothing
(_ , Just ar) -> return ar
(Just host, _ ) -> return $ (if ssl then "https://" else "http://") ++ host ++ (addPort ssl port)
_ -> fail "You must supply either a host or approot"
return $ AppConfig
{ appEnv = env
@ -120,7 +120,7 @@ loadConfig env = withYamlEnvironment "config/settings.yml" env $ \e -> do
loadPostgresql :: Show e => e -> IO PostgresConf
loadPostgresql env = withYamlEnvironment "config/postgresql.yml" env $ \e -> do
db <- lookupScalar "database" e
pool <- safeRead =<< lookupScalar "poolsize" e
pool <- safeRead "poolsize" =<< lookupScalar "poolsize" e
-- TODO: default host/port?
connparts <- forM ["user", "password", "host", "port"] $ \k -> do
@ -140,7 +140,7 @@ loadPostgresql env = withYamlEnvironment "config/postgresql.yml" env $ \e -> do
loadSqlite :: Show e => e -> IO SqliteConf
loadSqlite env = withYamlEnvironment "config/sqlite.yml" env $ \e -> do
db <- lookupScalar "database" e
pool <- safeRead =<< lookupScalar "poolsize" e
pool <- safeRead "poolsize" =<< lookupScalar "poolsize" e
return $ SqliteConf (T.pack db) pool
@ -155,7 +155,7 @@ loadMongo :: Show e => e -> IO MongoConf
loadMongo env = withYamlEnvironment "config/mongoDB.yml" env $ \e -> do
db <- lookupScalar "database" e
host <- lookupScalar "host" e
pool <- safeRead =<< lookupScalar "poolsize" e
pool <- safeRead "poolsize" =<< lookupScalar "poolsize" e
return $ MongoConf db host pool
@ -167,22 +167,16 @@ loadMongo env = withYamlEnvironment "config/mongoDB.yml" env $ \e -> do
withYamlEnvironment :: (IsYamlScalar v, Show e)
=> FilePath -- ^ the yaml file
-> e -- ^ the environment you want to load
-> ([(String, Object String v)] -> Maybe a) -- ^ what to do with the mapping
-> ([(String, Object String v)] -> IO a) -- ^ what to do with the mapping
-> IO a
withYamlEnvironment fp env f = do
obj <- join $ decodeFile fp
case go obj env of
Just v -> return v
Nothing -> error $ fp ++ ": invalid configuration file."
envs <- fromMapping obj
conf <- lookupMapping (show env) envs
f conf
where
go o e = do
envs <- fromMapping o
conf <- lookupMapping (show e) envs
f conf
-- | Returns Nothing if read fails
safeRead :: String -> Maybe Int
safeRead s = case reads s of
(i, _):_ -> Just i
[] -> Nothing
-- | Returns 'fail' if read fails
safeRead :: Monad m => String -> String -> m Int
safeRead name s = case reads s of
(i, _):_ -> return i
[] -> fail $ concat ["Invalid value for ", name, ": ", s]

View File

@ -32,8 +32,7 @@ data ArgConfig = ArgConfig
defaultArgConfig :: ArgConfig
defaultArgConfig =
ArgConfig
{ environment = def
&= opt "development"
{ environment = "development"
&= help ("application environment, one of: " ++ environments)
&= typ "ENVIRONMENT"
, port = def
@ -56,7 +55,10 @@ fromArgsWith :: (Read e, Show e) => ArgConfig -> IO (AppConfig e)
fromArgsWith argConfig = do
args <- cmdArgs argConfig
let env = read $ capitalize $ environment args
env <-
case reads $ capitalize $ environment args of
(e, _):_ -> return e
[] -> error $ "Invalid environment: " ++ environment args
config <- loadConfig env