From b031702a9bec56c9a1bfba6275ce867a260f182b Mon Sep 17 00:00:00 2001
From: patrick brisbin <pbrisbin@gmail.com>
Date: Mon, 19 Sep 2011 15:15:04 -0400
Subject: [PATCH] Add yesod-default

Still needs the cabal, Setup, etc etc but at least it compiles and is
somewhat extensible.
---
 yesod-default/Yesod/Default/Config.hs | 76 +++++++++++++++++++++++++++
 yesod-default/Yesod/Default/Main.hs   | 65 +++++++++++++++++++++++
 2 files changed, 141 insertions(+)
 create mode 100644 yesod-default/Yesod/Default/Config.hs
 create mode 100644 yesod-default/Yesod/Default/Main.hs

diff --git a/yesod-default/Yesod/Default/Config.hs b/yesod-default/Yesod/Default/Config.hs
new file mode 100644
index 00000000..7f92b3b8
--- /dev/null
+++ b/yesod-default/Yesod/Default/Config.hs
@@ -0,0 +1,76 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+module Yesod.Default.Config
+    ( DefaultEnv(..)
+    , ArgConfig(..)
+    , defaultArgConfig
+    , fromArgs
+    , fromArgsWith
+    , loadDevelopmentConfig
+
+    -- reexport
+    , module Yesod.Config
+    ) where
+
+import Yesod.Config
+import Data.Char (toUpper, toLower)
+import System.Console.CmdArgs hiding (args)
+
+-- | A yesod-provided @'AppEnv'@, allows for Development, Testing, and
+--   Production environments
+data DefaultEnv = Development
+                | Testing
+                | Production deriving (Read, Show, Enum, Bounded)
+
+instance AppEnv DefaultEnv where
+    displayPort Production = False
+    displayPort _          = True
+
+-- | Setup commandline arguments for environment and port
+data ArgConfig = ArgConfig
+    { environment :: String
+    , port        :: Int
+    } deriving (Show, Data, Typeable)
+
+-- | A default @'ArgConfig'@ if using the provided @'DefaultEnv'@ type.
+defaultArgConfig :: ArgConfig
+defaultArgConfig =
+    ArgConfig
+        { environment = def 
+            &= opt "development"
+            &= help ("application environment, one of: " ++ environments)
+            &= typ   "ENVIRONMENT"
+        , port = def
+            &= help "the port to listen on"
+            &= typ  "PORT"
+        }
+
+    where
+        environments :: String
+        environments = foldl1 (\a b -> a ++ ", " ++ b)
+                     . map ((map toLower) . show)
+                     $ ([minBound..maxBound] :: [DefaultEnv])
+
+-- | Load an @'AppConfig'@ using the @'DefaultEnv'@ environments from
+--   commandline arguments.
+fromArgs :: IO (AppConfig DefaultEnv)
+fromArgs = fromArgsWith defaultArgConfig
+
+fromArgsWith :: AppEnv e => ArgConfig -> IO (AppConfig e)
+fromArgsWith argConfig = do
+    args   <- cmdArgs argConfig
+
+    let env = read $ capitalize $ environment args
+
+    config <- loadConfig env
+
+    return $ if port args /= 0
+                then config { appPort = port args }
+                else config
+
+    where
+        capitalize [] = []
+        capitalize (x:xs) = toUpper x : map toLower xs
+
+-- | Load your development config (when using @'DefaultEnv'@)
+loadDevelopmentConfig :: IO (AppConfig DefaultEnv)
+loadDevelopmentConfig = loadConfig Development
diff --git a/yesod-default/Yesod/Default/Main.hs b/yesod-default/Yesod/Default/Main.hs
new file mode 100644
index 00000000..9a1e2e45
--- /dev/null
+++ b/yesod-default/Yesod/Default/Main.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+module Yesod.Default.Main
+    ( defaultMain
+    , defaultDevelApp
+    , defaultDevelAppWith
+    ) where
+
+import Yesod.Default.Config
+import Yesod.Logger (Logger, makeLogger, logString, logLazyText, flushLogger)
+import Network.Wai (Application)
+import Network.Wai.Handler.Warp (run)
+import Network.Wai.Middleware.Debug (debugHandle)
+
+-- | Run your app, taking environment and port settings from the
+--   commandline.
+--
+--   Use @'fromArgs'@ when using the provided @'DefaultEnv'@ type, or
+--   @'fromArgsWith'@ when using a custom type
+--
+--   > main :: IO ()
+--   > main = defaultMain fromArgs withMySite
+--
+--   or
+--
+--   > main :: IO ()
+--   > main = defaultMain (fromArgsWith customArgConfig) withMySite
+--
+defaultMain :: AppEnv e => IO (AppConfig e) -> (AppConfig e -> Logger -> (Application -> IO ()) -> IO ()) -> IO ()
+defaultMain load withSite = do
+    config <- load
+    logger <- makeLogger
+    withSite config logger $ run (appPort config)
+
+-- | Run your development app using the provided @'DefaultEnv'@ type
+--
+--   > withDevelAppPort :: Dynamic
+--   > withDevelAppPort = toDyn $ defaultDevelApp withMySite
+--
+defaultDevelApp :: (AppConfig DefaultEnv -> Logger -> (Application -> IO ()) -> IO ())
+                -> ((Int, Application) -> IO ())
+                -> IO ()
+defaultDevelApp = defaultDevelAppWith loadDevelopmentConfig
+
+-- | Run your development app using a custom environment type and loader
+--   function
+--
+--   > withDevelAppPort :: Dynamic
+--   > withDevelAppPort = toDyn $ (defaultDevelAppWith customLoadAppConfig) withMySite
+--
+defaultDevelAppWith :: AppEnv e
+                    -- | A means to load your development @'AppConfig'@
+                    => IO (AppConfig e)
+                    -- | Your @withMySite@ function
+                    -> (AppConfig e -> Logger -> (Application -> IO ()) -> IO ())
+                    -> ((Int, Application) -> IO ()) -> IO ()
+defaultDevelAppWith load withSite f = do
+        conf   <- load
+        logger <- makeLogger
+        let p = appPort conf
+        logString logger $ "Devel application launched, listening on port " ++ show p
+        withSite conf logger $ \app -> f (p, debugHandle (logHandle logger) app)
+        flushLogger logger
+
+        where
+            logHandle logger msg = logLazyText logger msg >> flushLogger logger