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