Add yesod-default
Still needs the cabal, Setup, etc etc but at least it compiles and is somewhat extensible.
This commit is contained in:
parent
4f52f22a2c
commit
b031702a9b
76
yesod-default/Yesod/Default/Config.hs
Normal file
76
yesod-default/Yesod/Default/Config.hs
Normal file
@ -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
|
||||||
65
yesod-default/Yesod/Default/Main.hs
Normal file
65
yesod-default/Yesod/Default/Main.hs
Normal file
@ -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
|
||||||
Loading…
Reference in New Issue
Block a user