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:
patrick brisbin 2011-09-10 23:21:35 -04:00
parent c569ed5f2f
commit d3c7ccebe1
2 changed files with 93 additions and 0 deletions

51
yesod-core/Yesod/Main.hs Normal file
View 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])

View 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