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