From d3c7ccebe16434034bf8674cddc4724b57417534 Mon Sep 17 00:00:00 2001
From: patrick brisbin <pbrisbin@gmail.com>
Date: Sat, 10 Sep 2011 23:21:35 -0400
Subject: [PATCH] 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).
---
 yesod-core/Yesod/Main.hs     | 51 ++++++++++++++++++++++++++++++++++++
 yesod-core/Yesod/Settings.hs | 42 +++++++++++++++++++++++++++++
 2 files changed, 93 insertions(+)
 create mode 100644 yesod-core/Yesod/Main.hs
 create mode 100644 yesod-core/Yesod/Settings.hs

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