Provide sane defaults with less scaffolding
Yesod.Settings provides the typical definitions for AppConfig, AppEnvironment, and loadConfig (read from YAML). Yesod.Main provides a single defaultMain function which accepts your usual withSiteArg function and runs via Warp calling the now provided loadConfig to figure out what to do. Note: Yesod re-exports Y.Settings and Y.Main -- This is probably not the right thing to do since it would cause collisions with users not using the provided functionality (including all existing users).
This commit is contained in:
parent
c569ed5f2f
commit
d3c7ccebe1
51
yesod-core/Yesod/Main.hs
Normal file
51
yesod-core/Yesod/Main.hs
Normal file
@ -0,0 +1,51 @@
|
||||
{-# LANGUAGE CPP, DeriveDataTypeable #-}
|
||||
module Yesod.Main (defaultMain) where
|
||||
|
||||
import Yesod.Logger (Logger, makeLogger)
|
||||
import Yesod.Settings (AppEnvironment(..), AppConfig(..), loadConfig)
|
||||
import Network.Wai (Application)
|
||||
import Network.Wai.Handler.Warp (run)
|
||||
import System.Console.CmdArgs hiding (args)
|
||||
import Data.Char (toUpper, toLower)
|
||||
|
||||
defaultMain :: (AppConfig -> Logger -> (Application -> IO ()) -> IO ()) -> IO ()
|
||||
defaultMain withSite = do
|
||||
logger <- makeLogger
|
||||
args <- cmdArgs argConfig
|
||||
env <- getAppEnv args
|
||||
config <- loadConfig env
|
||||
|
||||
let c = if port args /= 0
|
||||
then config { appPort = port args }
|
||||
else config
|
||||
|
||||
withSite c logger $ run (appPort c)
|
||||
|
||||
data ArgConfig = ArgConfig
|
||||
{ environment :: String
|
||||
, port :: Int
|
||||
} deriving (Show, Data, Typeable)
|
||||
|
||||
argConfig :: ArgConfig
|
||||
argConfig = ArgConfig
|
||||
{ environment = def
|
||||
&= help ("application environment, one of: " ++ (foldl1 (\a b -> a ++ ", " ++ b) environments))
|
||||
&= typ "ENVIRONMENT"
|
||||
, port = def
|
||||
&= help "the port to listen on"
|
||||
&= typ "PORT"
|
||||
}
|
||||
|
||||
getAppEnv :: ArgConfig -> IO AppEnvironment
|
||||
getAppEnv cfg = do
|
||||
let e = if environment cfg /= ""
|
||||
then environment cfg
|
||||
else "development"
|
||||
return $ read $ capitalize e
|
||||
|
||||
where
|
||||
capitalize [] = []
|
||||
capitalize (x:xs) = toUpper x : map toLower xs
|
||||
|
||||
environments :: [String]
|
||||
environments = map ((map toLower) . show) ([minBound..maxBound] :: [AppEnvironment])
|
||||
42
yesod-core/Yesod/Settings.hs
Normal file
42
yesod-core/Yesod/Settings.hs
Normal file
@ -0,0 +1,42 @@
|
||||
module Yesod.Settings where
|
||||
|
||||
import Control.Monad (join)
|
||||
import Data.Object
|
||||
import Data.Text (Text)
|
||||
|
||||
import qualified Data.Object.Yaml as YAML
|
||||
import qualified Data.Text as T
|
||||
|
||||
data AppEnvironment = Development
|
||||
| Test
|
||||
| Staging
|
||||
| Production
|
||||
deriving (Eq, Show, Read, Enum, Bounded)
|
||||
|
||||
data AppConfig = AppConfig
|
||||
{ appEnv :: AppEnvironment
|
||||
, appPort :: Int
|
||||
, connectionPoolSize :: Int
|
||||
, appRoot :: Text
|
||||
} deriving (Show)
|
||||
|
||||
loadConfig :: AppEnvironment -> IO AppConfig
|
||||
loadConfig env = do
|
||||
allSettings <- (join $ YAML.decodeFile ("config/settings.yml" :: String)) >>= fromMapping
|
||||
settings <- lookupMapping (show env) allSettings
|
||||
hostS <- lookupScalar "host" settings
|
||||
port <- fmap read $ lookupScalar "port" settings
|
||||
connectionPoolSizeS <- lookupScalar "connectionPoolSize" settings
|
||||
|
||||
return $ AppConfig
|
||||
{ appEnv = env
|
||||
, appPort = port
|
||||
, appRoot = T.pack $ hostS ++ addPort port
|
||||
, connectionPoolSize = read connectionPoolSizeS
|
||||
}
|
||||
|
||||
where
|
||||
addPort :: Int -> String
|
||||
addPort p = case env of
|
||||
Production -> ""
|
||||
_ -> ":" ++ show p
|
||||
Loading…
Reference in New Issue
Block a user