diff --git a/yesod-core/Yesod/Main.hs b/yesod-core/Yesod/Main.hs new file mode 100644 index 00000000..fda8f99a --- /dev/null +++ b/yesod-core/Yesod/Main.hs @@ -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]) diff --git a/yesod-core/Yesod/Settings.hs b/yesod-core/Yesod/Settings.hs new file mode 100644 index 00000000..840264ca --- /dev/null +++ b/yesod-core/Yesod/Settings.hs @@ -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