More explicit config error messages; fix defaultArgConfig
This commit is contained in:
parent
a6e7924e7c
commit
1dbbfc8d06
@ -85,12 +85,12 @@ loadConfig env = withYamlEnvironment "config/settings.yml" env $ \e -> do
|
|||||||
|
|
||||||
-- set some default arguments
|
-- set some default arguments
|
||||||
let ssl = maybe False toBool mssl
|
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
|
approot <- case (mhost, mapproot) of
|
||||||
(_ , Just ar) -> Just ar
|
(_ , Just ar) -> return ar
|
||||||
(Just host, _ ) -> Just $ (if ssl then "https://" else "http://") ++ host ++ (addPort ssl port)
|
(Just host, _ ) -> return $ (if ssl then "https://" else "http://") ++ host ++ (addPort ssl port)
|
||||||
_ -> Nothing
|
_ -> fail "You must supply either a host or approot"
|
||||||
|
|
||||||
return $ AppConfig
|
return $ AppConfig
|
||||||
{ appEnv = env
|
{ appEnv = env
|
||||||
@ -120,7 +120,7 @@ loadConfig env = withYamlEnvironment "config/settings.yml" env $ \e -> do
|
|||||||
loadPostgresql :: Show e => e -> IO PostgresConf
|
loadPostgresql :: Show e => e -> IO PostgresConf
|
||||||
loadPostgresql env = withYamlEnvironment "config/postgresql.yml" env $ \e -> do
|
loadPostgresql env = withYamlEnvironment "config/postgresql.yml" env $ \e -> do
|
||||||
db <- lookupScalar "database" e
|
db <- lookupScalar "database" e
|
||||||
pool <- safeRead =<< lookupScalar "poolsize" e
|
pool <- safeRead "poolsize" =<< lookupScalar "poolsize" e
|
||||||
|
|
||||||
-- TODO: default host/port?
|
-- TODO: default host/port?
|
||||||
connparts <- forM ["user", "password", "host", "port"] $ \k -> do
|
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 :: Show e => e -> IO SqliteConf
|
||||||
loadSqlite env = withYamlEnvironment "config/sqlite.yml" env $ \e -> do
|
loadSqlite env = withYamlEnvironment "config/sqlite.yml" env $ \e -> do
|
||||||
db <- lookupScalar "database" e
|
db <- lookupScalar "database" e
|
||||||
pool <- safeRead =<< lookupScalar "poolsize" e
|
pool <- safeRead "poolsize" =<< lookupScalar "poolsize" e
|
||||||
|
|
||||||
return $ SqliteConf (T.pack db) pool
|
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
|
loadMongo env = withYamlEnvironment "config/mongoDB.yml" env $ \e -> do
|
||||||
db <- lookupScalar "database" e
|
db <- lookupScalar "database" e
|
||||||
host <- lookupScalar "host" e
|
host <- lookupScalar "host" e
|
||||||
pool <- safeRead =<< lookupScalar "poolsize" e
|
pool <- safeRead "poolsize" =<< lookupScalar "poolsize" e
|
||||||
|
|
||||||
return $ MongoConf db host pool
|
return $ MongoConf db host pool
|
||||||
|
|
||||||
@ -167,22 +167,16 @@ loadMongo env = withYamlEnvironment "config/mongoDB.yml" env $ \e -> do
|
|||||||
withYamlEnvironment :: (IsYamlScalar v, Show e)
|
withYamlEnvironment :: (IsYamlScalar v, Show e)
|
||||||
=> FilePath -- ^ the yaml file
|
=> FilePath -- ^ the yaml file
|
||||||
-> e -- ^ the environment you want to load
|
-> 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
|
-> IO a
|
||||||
withYamlEnvironment fp env f = do
|
withYamlEnvironment fp env f = do
|
||||||
obj <- join $ decodeFile fp
|
obj <- join $ decodeFile fp
|
||||||
case go obj env of
|
envs <- fromMapping obj
|
||||||
Just v -> return v
|
conf <- lookupMapping (show env) envs
|
||||||
Nothing -> error $ fp ++ ": invalid configuration file."
|
f conf
|
||||||
|
|
||||||
where
|
-- | Returns 'fail' if read fails
|
||||||
go o e = do
|
safeRead :: Monad m => String -> String -> m Int
|
||||||
envs <- fromMapping o
|
safeRead name s = case reads s of
|
||||||
conf <- lookupMapping (show e) envs
|
(i, _):_ -> return i
|
||||||
f conf
|
[] -> fail $ concat ["Invalid value for ", name, ": ", s]
|
||||||
|
|
||||||
-- | Returns Nothing if read fails
|
|
||||||
safeRead :: String -> Maybe Int
|
|
||||||
safeRead s = case reads s of
|
|
||||||
(i, _):_ -> Just i
|
|
||||||
[] -> Nothing
|
|
||||||
|
|||||||
@ -32,8 +32,7 @@ data ArgConfig = ArgConfig
|
|||||||
defaultArgConfig :: ArgConfig
|
defaultArgConfig :: ArgConfig
|
||||||
defaultArgConfig =
|
defaultArgConfig =
|
||||||
ArgConfig
|
ArgConfig
|
||||||
{ environment = def
|
{ environment = "development"
|
||||||
&= opt "development"
|
|
||||||
&= help ("application environment, one of: " ++ environments)
|
&= help ("application environment, one of: " ++ environments)
|
||||||
&= typ "ENVIRONMENT"
|
&= typ "ENVIRONMENT"
|
||||||
, port = def
|
, port = def
|
||||||
@ -56,7 +55,10 @@ fromArgsWith :: (Read e, Show e) => ArgConfig -> IO (AppConfig e)
|
|||||||
fromArgsWith argConfig = do
|
fromArgsWith argConfig = do
|
||||||
args <- cmdArgs argConfig
|
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
|
config <- loadConfig env
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user