Rewrite AppConfig loader

* Remove AppEnv
* Add logic to set approort smartly in most cases
* Refactor YAML parser
* Update yesod-default to match

There's still much todo...

yesod-core/Yesod/Config.hs

@@ -1,8 +1,7 @@
 {-# OPTIONS -fno-warn-missing-signatures #-}
 {-# LANGUAGE QuasiQuotes                 #-}
 module Yesod.Config
-    ( AppEnv(..)
+    ( AppConfig(..)
-    , AppConfig(..)
     , loadConfig
     , loadPostgresqlConnStr
     , loadSqliteConnStr
@@ -10,88 +9,104 @@ module Yesod.Config
     ) where
 
 import Control.Monad (join)
+import Data.Maybe (fromMaybe)
 import Data.Object
+import Data.Object.Yaml
 import Data.Text (Text)
-import Text.Shakespeare.Text (st)
+--import Text.Shakespeare.Text (st)
 
-import qualified Data.Object.Yaml as YAML
 import qualified Data.Text        as T
 
-class AppEnv e where
-    displayPort :: e -> Bool
-
 -- | Dynamic per-environment configuration which can be loaded at
 --   run-time negating the need to recompile between environments.
 data AppConfig e = AppConfig
     { appEnv  :: e
     , appPort :: Int
-
-    -- TODO: put this in db configs
-    , connectionPoolSize :: Int
-
-    -- | The base URL for your application. This will usually be
-    --   different for development and production. Yesod automatically
-    --   constructs URLs for you, so this value must be accurate to
-    --   create valid links.
-    --
-    --   If your domain name was "yesod.com", you would probably want it
-    --   to be:
-    --
-    --   > "http://yesod.com"
-    --
     , appRoot :: Text
     } deriving (Show)
 
+-- | Dynamic per-environment database configuration which can be loaded
+--   at run-time
+data DbConfig = PostgresConf String String Int -- ^ Connection string, Database, Pool size
+              | SqliteConf String Int          -- ^ Database, Pool size
+              | MongoConf (String,String) Int  -- ^ (Database,Host), Pool size
 
 -- | Load an @'AppConfig'@ from a YAML-formatted file located at
---   @config\/settings.yml@.
+--   @config\/settings.yml@. @'show'@ will be called on the first
-loadConfig :: AppEnv e => e -> IO (AppConfig e)
+--   parameter to determine which environment block to load
-loadConfig env = do
+loadConfig :: Show e => e -> IO (AppConfig e)
-    allSettings <- (join $ YAML.decodeFile ("config/settings.yml" :: String)) >>= fromMapping
+loadConfig env = withYamlEnvironment "config/settings.yml" env $ \e -> do
-    settings    <- lookupMapping (show env) allSettings
+    let mssl     = lookupScalar "ssl"     e
-    hostS       <- lookupScalar "host" settings
+    let mhost    = lookupScalar "host"    e
-    port        <- fmap read $ lookupScalar "port" settings
+    let mport    = lookupScalar "port"    e
-    connectionPoolSizeS <- lookupScalar "connectionPoolSize" settings
+    let mapproot = lookupScalar "approot" e
+
+    -- set some default arguments
+    let ssl = toBool $ fromMaybe "false" mssl
+    port <- safeRead $ fromMaybe (if ssl then "443" else "80") mport
+
+    approot <- case (mhost, mapproot) of
+        (_        , Just ar) -> Just ar
+        (Just host, _      ) -> Just $ (if ssl then "http://" else "https://") ++ host ++ (addPort ssl port)
+        _                    -> Nothing
 
     return $ AppConfig
         { appEnv  = env
         , appPort = port
-        , appRoot = T.pack $ hostS ++ addPort port
+        , appRoot = T.pack approot
-        , connectionPoolSize = read connectionPoolSizeS
         }
 
     where
-        addPort :: Int -> String
+        toBool :: String -> Bool
-        addPort p = if displayPort env
+        toBool = (`elem` ["true", "TRUE", "yes", "YES", "Y", "1"])
-                        then ":" ++ show p else ""
 
--- | Load Postgresql settings from a YAML-formatted file located at
+        safeRead :: String -> Maybe Int
---   @config\/postgresql.yml@.
+        safeRead = undefined
-loadPostgresqlConnStr :: Show e => e -> IO Text
-loadPostgresqlConnStr env = do
-    allSettings <- (join $ YAML.decodeFile ("config/postgresql.yml" :: String)) >>= fromMapping
-    settings    <- lookupMapping (show env) allSettings
-    database    <- lookupScalar "database" settings :: IO Text
 
-    connPart <- fmap T.concat $ (flip mapM) ["user", "password", "host", "port"] $ \key -> do
+        addPort :: Bool -> Int -> String
-      value <- lookupScalar key settings
+        addPort True  443 = ""
-      return $ [st| #{key}=#{value} |]
+        addPort False 80  = ""
-    return $ [st|#{connPart} dbname=#{database}|]
+        addPort _     p   = ":" ++ show p
 
--- | Load Sqlite settings from a YAML-formatted file located at
+loadPostgresqlConnStr :: Show e => e -> IO DbConfig
---   @config\/sqlite.yml@.
+loadPostgresqlConnStr env = withYamlEnvironment "config/postgresql.yml" env $ \e -> do
-loadSqliteConnStr :: Show e => e -> IO Text
+    db   <- lookupScalar "database" e
-loadSqliteConnStr env = do
+    pool <- lookupScalar "poolsize" e
-    allSettings <- (join $ YAML.decodeFile ("config/sqlite.yml" :: String)) >>= fromMapping
-    settings    <- lookupMapping (show env) allSettings
-    lookupScalar "database" settings
 
--- note: no type signature to avoid an extra Persistent.MongoDB dep for
+    -- TODO: the rest of this
--- those that don't need it
+    return $ PostgresConf "todo" db (read pool)
---loadMongoConnParams :: AppEnvironment -> IO (Database, HostName)
+
-loadMongoConnParams env = do
+    {-connPart <- fmap T.concat $ (flip mapM) ["user", "password", "host", "port"] $ \key -> do-}
-    allSettings <- (join $ YAML.decodeFile ("config/mongoDB.yml" :: String)) >>= fromMapping
+      {-value <- lookupScalar key settings-}
-    settings    <- lookupMapping (show env) allSettings
+      {-return $ [st| #{key}=#{value} |]-}
-    database    <- lookupScalar "database" settings
+    {-return $ [st|#{connPart} dbname=#{database}|]-}
-    host        <- lookupScalar "host" settings
+
-    return (database, host)
+loadSqliteConnStr :: Show e => e -> IO DbConfig
+loadSqliteConnStr env = withYamlEnvironment "config/sqlite.yml" env $ \e -> do
+    db   <- lookupScalar "database" e
+    pool <- lookupScalar "poolsize" e
+
+    -- TODO: safer read
+    return $ SqliteConf db (read pool)
+
+loadMongoConnParams :: Show e => e -> IO DbConfig
+loadMongoConnParams env = withYamlEnvironment "config/mongoDB.yml" env $ \e -> do
+    db   <- lookupScalar "database" e
+    host <- lookupScalar "host"     e
+    pool <- lookupScalar "poolsize" e
+
+    -- TODO: safer read
+    return $ MongoConf (db, host) (read pool)
+
+-- TODO: type sig -- ghci and I disagree here...
+withYamlEnvironment fp env f = do
+    obj <- join $ decodeFile fp
+    case go obj env of
+        Just v  -> return v
+        Nothing -> error $ fp ++ ": invalid configuration file."
+
+    where
+        go o e = do
+            envs <- fromMapping o
+            conf <- lookupMapping (show e) envs
+            f conf

yesod-default/Yesod/Default/Config.hs

@@ -21,10 +21,6 @@ data DefaultEnv = Development
                 | Testing
                 | Production deriving (Read, Show, Enum, Bounded)
 
-instance AppEnv DefaultEnv where
-    displayPort Production = False
-    displayPort _          = True
-
 -- | Setup commandline arguments for environment and port
 data ArgConfig = ArgConfig
     { environment :: String
@@ -55,7 +51,7 @@ defaultArgConfig =
 fromArgs :: IO (AppConfig DefaultEnv)
 fromArgs = fromArgsWith defaultArgConfig
 
-fromArgsWith :: AppEnv e => ArgConfig -> IO (AppConfig e)
+fromArgsWith :: (Read e, Show e) => ArgConfig -> IO (AppConfig e)
 fromArgsWith argConfig = do
     args   <- cmdArgs argConfig
 

yesod-default/Yesod/Default/Main.hs

@@ -25,7 +25,7 @@ import Network.Wai.Middleware.Debug (debugHandle)
 --   > main :: IO ()
 --   > main = defaultMain (fromArgsWith customArgConfig) withMySite
 --
-defaultMain :: AppEnv e => IO (AppConfig e) -> (AppConfig e -> Logger -> (Application -> IO ()) -> IO ()) -> IO ()
+defaultMain :: (Show e, Read e) => IO (AppConfig e) -> (AppConfig e -> Logger -> (Application -> IO ()) -> IO ()) -> IO ()
 defaultMain load withSite = do
     config <- load
     logger <- makeLogger
@@ -47,7 +47,7 @@ defaultDevelApp = defaultDevelAppWith loadDevelopmentConfig
 --   > withDevelAppPort :: Dynamic
 --   > withDevelAppPort = toDyn $ (defaultDevelAppWith customLoadAppConfig) withMySite
 --
-defaultDevelAppWith :: AppEnv e
+defaultDevelAppWith :: (Show e, Read e)
                     => IO (AppConfig e) -- ^ A means to load your development @'AppConfig'@
                     -> (AppConfig e -> Logger -> (Application -> IO ()) -> IO ()) -- ^ Your @withMySite@ function
                     -> ((Int, Application) -> IO ()) -> IO ()