haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Deprecate Yesod.Config; more configurable config in yesod-default

Browse Source
This commit is contained in:
Michael Snoyman 2011-12-14 08:26:44 +02:00
parent 7dfc1b44ec
commit 49f2da73ee
14 changed files with 199 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
yesod-core/Yesod/Config.hs
View File

@ -1,5 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
module Yesod.Config
{-# DEPRECATED "This code has been moved to yesod-default. This module will be removed in the next major version bump." #-}
( AppConfig(..)
, loadConfig
, withYamlEnvironment

2
yesod-core/yesod-core.cabal
View File

@ -1,5 +1,5 @@
name: yesod-core
version: 0.9.3.6
version: 0.9.4
license: BSD3
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>

186
yesod-default/Yesod/Default/Config.hs
View File

@ -1,19 +1,27 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
module Yesod.Default.Config
( DefaultEnv(..)
, ArgConfig(..)
, defaultArgConfig
( DefaultEnv (..)
, fromArgs
, fromArgsWith
, fromArgsExtra
, loadDevelopmentConfig
-- reexport
, module Yesod.Config
, AppConfig (..)
, ConfigSettings (..)
, configSettings
, loadConfig
, withYamlEnvironment
) where
import Yesod.Config
import Data.Char (toUpper, toLower)
import System.Console.CmdArgs hiding (args)
import Data.Text (Text)
import qualified Data.Text as T
import Control.Monad (join)
import Data.Object
import Data.Object.Yaml
import Data.Maybe (fromMaybe)
-- | A yesod-provided @'AppEnv'@, allows for Development, Testing, and
-- Production environments
@ -32,7 +40,8 @@ data ArgConfig = ArgConfig
defaultArgConfig :: ArgConfig
defaultArgConfig =
ArgConfig
{ environment = "development"
{ environment = def
&= argPos 0
&= help ("application environment, one of: " ++ environments)
&= typ "ENVIRONMENT"
, port = def
@ -48,11 +57,20 @@ defaultArgConfig =
-- | Load an @'AppConfig'@ using the @'DefaultEnv'@ environments from
-- commandline arguments.
fromArgs :: IO (AppConfig DefaultEnv)
fromArgs = fromArgsWith defaultArgConfig
fromArgs :: IO (AppConfig DefaultEnv ())
fromArgs = fromArgsExtra (const $ const $ return ())
fromArgsWith :: (Read e, Show e) => ArgConfig -> IO (AppConfig e)
fromArgsWith argConfig = do
-- | Same as 'fromArgs', but allows you to specify how to parse the 'appExtra'
-- record.
fromArgsExtra :: (DefaultEnv -> TextObject -> IO extra)
-> IO (AppConfig DefaultEnv extra)
fromArgsExtra = fromArgsWith defaultArgConfig
fromArgsWith :: (Read env, Show env)
=> ArgConfig
-> (env -> TextObject -> IO extra)
-> IO (AppConfig env extra)
fromArgsWith argConfig getExtra = do
args <- cmdArgs argConfig
env <-
@ -60,7 +78,10 @@ fromArgsWith argConfig = do
(e, _):_ -> return e
[] -> error $ "Invalid environment: " ++ environment args
config <- loadConfig env
let cs = (configSettings env)
{ csLoadExtra = getExtra
}
config <- loadConfig cs
return $ if port args /= 0
then config { appPort = port args }
@ -71,5 +92,142 @@ fromArgsWith argConfig = do
capitalize (x:xs) = toUpper x : map toLower xs
-- | Load your development config (when using @'DefaultEnv'@)
loadDevelopmentConfig :: IO (AppConfig DefaultEnv)
loadDevelopmentConfig = loadConfig Development
loadDevelopmentConfig :: IO (AppConfig DefaultEnv ())
loadDevelopmentConfig = loadConfig $ configSettings Development
-- | Dynamic per-environment configuration which can be loaded at
-- run-time negating the need to recompile between environments.
data AppConfig environment extra = AppConfig
{ appEnv :: environment
, appPort :: Int
, appRoot :: Text
, appExtra :: extra
} deriving (Show)
data ConfigSettings environment extra = ConfigSettings
{
-- | An arbitrary value, used below, to indicate the current running
-- environment. Usually, you will use 'DefaultEnv' for this type.
csEnv :: environment
-- | Load any extra data, to be used by the application.
, csLoadExtra :: environment -> TextObject -> IO extra
-- | Return the path to the YAML config file.
, csFile :: environment -> IO FilePath
-- | Get the sub-object (if relevant) from the given YAML source which
-- contains the specific settings for the current environment.
, csGetObject :: environment -> TextObject -> IO TextObject
}
-- | Default config settings.
configSettings :: Show env => env -> ConfigSettings env ()
configSettings env0 = ConfigSettings
{ csEnv = env0
, csLoadExtra = \_ _ -> return ()
, csFile = \_ -> return "config/settings.yml"
, csGetObject = \env obj -> do
envs <- fromMapping obj
let senv = show env
tenv = T.pack senv
maybe
(error $ "Could not find environment: " ++ senv)
return
(lookup tenv envs)
}
-- | Load an @'AppConfig'@.
--
-- Some examples:
--
-- > -- typical local development
-- > Development:
-- > host: localhost
-- > port: 3000
-- >
-- > -- ssl: will default false
-- > -- approot: will default to "http://localhost:3000"
--
-- > -- typical outward-facing production box
-- > Production:
-- > host: www.example.com
-- >
-- > -- ssl: will default false
-- > -- port: will default 80
-- > -- approot: will default "http://www.example.com"
--
-- > -- maybe you're reverse proxying connections to the running app
-- > -- on some other port
-- > Production:
-- > port: 8080
-- > approot: "http://example.com"
-- >
-- > -- approot is specified so that the non-80 port is not appended
-- > -- automatically.
--
loadConfig :: ConfigSettings environment extra
-> IO (AppConfig environment extra)
loadConfig (ConfigSettings env loadExtra getFile getObject) = do
fp <- getFile env
topObj <- join $ decodeFile fp
obj <- getObject env topObj
m <- maybe (fail "Expected map") return $ fromMapping obj
let mssl = lookupScalar "ssl" m
let mhost = lookupScalar "host" m
let mport = lookupScalar "port" m
let mapproot = lookupScalar "approot" m
extra <- loadExtra env obj
-- set some default arguments
let ssl = maybe False toBool mssl
port' <- safeRead "port" $ fromMaybe (if ssl then "443" else "80") mport
approot <- case (mhost, mapproot) of
(_ , Just ar) -> return ar
(Just host, _ ) -> return $ T.concat
[ if ssl then "https://" else "http://"
, host
, addPort ssl port'
]
_ -> fail "You must supply either a host or approot"
return $ AppConfig
{ appEnv = env
, appPort = port'
, appRoot = approot
, appExtra = extra
}
where
toBool :: Text -> Bool
toBool = (`elem` ["true", "TRUE", "yes", "YES", "Y", "1"])
addPort :: Bool -> Int -> Text
addPort True 443 = ""
addPort False 80 = ""
addPort _ p = T.pack $ ':' : show p
-- | Returns 'fail' if read fails
safeRead :: Monad m => String -> Text -> m Int
safeRead name' t = case reads s of
(i, _):_ -> return i
[] -> fail $ concat ["Invalid value for ", name', ": ", s]
where
s = T.unpack t
-- | Loads the configuration block in the passed file named by the
-- passed environment, yeilds to the passed function as a mapping.
--
-- Errors in the case of a bad load or if your function returns
-- @Nothing@.
withYamlEnvironment :: Show e
=> FilePath -- ^ the yaml file
-> e -- ^ the environment you want to load
-> (TextObject -> IO a) -- ^ what to do with the mapping
-> IO a
withYamlEnvironment fp env f = do
obj <- join $ decodeFile fp
envs <- fromMapping obj
conf <- maybe (fail $ "Could not find environment: " ++ show env) return
$ lookup (T.pack $ show env) envs
f conf

15
yesod-default/Yesod/Default/Main.hs
View File

@ -7,7 +7,7 @@ module Yesod.Default.Main
, defaultDevelAppWith
) where
import Yesod.Core
import Yesod.Core hiding (AppConfig (..))
import Yesod.Default.Config
import Yesod.Logger (Logger, makeLogger, logString, logLazyText, flushLogger)
import Network.Wai (Application)
@ -39,7 +39,10 @@ import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
-- > main :: IO ()
-- > main = defaultMain (fromArgsWith customArgConfig) withMySite
--
defaultMain :: (Show e, Read e) => IO (AppConfig e) -> (AppConfig e -> Logger -> (Application -> IO ()) -> IO ()) -> IO ()
defaultMain :: (Show env, Read env)
=> IO (AppConfig env extra)
-> (AppConfig env extra -> Logger -> (Application -> IO ()) -> IO ())
-> IO ()
defaultMain load withSite = do
config <- load
logger <- makeLogger
@ -85,7 +88,7 @@ defaultRunner f h = do
-- > withDevelAppPort :: Dynamic
-- > withDevelAppPort = toDyn $ defaultDevelApp withMySite
--
defaultDevelApp :: (AppConfig DefaultEnv -> Logger -> (Application -> IO ()) -> IO ())
defaultDevelApp :: (AppConfig DefaultEnv () -> Logger -> (Application -> IO ()) -> IO ())
-> ((Int, Application) -> IO ())
-> IO ()
defaultDevelApp = defaultDevelAppWith loadDevelopmentConfig
@ -96,9 +99,9 @@ defaultDevelApp = defaultDevelAppWith loadDevelopmentConfig
-- > withDevelAppPort :: Dynamic
-- > withDevelAppPort = toDyn $ (defaultDevelAppWith customLoadAppConfig) withMySite
--
defaultDevelAppWith :: (Show e, Read e)
=> IO (AppConfig e) -- ^ A means to load your development @'AppConfig'@
-> (AppConfig e -> Logger -> (Application -> IO ()) -> IO ()) -- ^ Your @withMySite@ function
defaultDevelAppWith :: (Show env, Read env)
=> IO (AppConfig env extra) -- ^ A means to load your development @'AppConfig'@
-> (AppConfig env extra -> Logger -> (Application -> IO ()) -> IO ()) -- ^ Your @withMySite@ function
-> ((Int, Application) -> IO ()) -> IO ()
defaultDevelAppWith load withSite f = do
conf <- load

6
yesod-default/yesod-default.cabal
View File

@ -1,5 +1,5 @@
name: yesod-default
version: 0.4.1
version: 0.5.0
license: BSD3
license-file: LICENSE
author: Patrick Brisbin
@ -18,7 +18,7 @@ library
cpp-options: -DWINDOWS
build-depends: base >= 4 && < 5
, yesod-core >= 0.9 && < 0.10
, yesod-core >= 0.9.4 && < 0.10
, cmdargs >= 0.8
, warp >= 0.4 && < 0.5
, wai >= 0.4 && < 0.5
@ -30,6 +30,8 @@ library
, shakespeare-css >= 0.10 && < 0.11
, shakespeare-js >= 0.10 && < 0.11
, template-haskell
, data-object >= 0.3 && < 0.4
, data-object-yaml >= 0.3 && < 0.4
if !os(windows)
build-depends: unix

2
yesod/scaffold/Application.hs.cg
View File

@ -27,7 +27,7 @@ mkYesodDispatch "~sitearg~" resources~sitearg~
-- performs initialization and creates a WAI application. This is also the
-- place to put your migrate statements to have automatic database
-- migrations handled by Yesod.
with~sitearg~ :: AppConfig DefaultEnv -> Logger -> (Application -> IO ()) -> IO ()
with~sitearg~ :: AppConfig DefaultEnv () -> Logger -> (Application -> IO ()) -> IO ()
with~sitearg~ conf logger f = do
#ifdef PRODUCTION
s <- static Settings.staticDir

4
yesod/scaffold/Foundation.hs.cg
View File

@ -16,7 +16,7 @@ module Foundation
) where
import Prelude
import Yesod hiding (Form)
import Yesod hiding (Form, AppConfig (..), withYamlEnvironment)
import Yesod.Static (Static, base64md5, StaticRoute(..))
import Settings.StaticFiles
import Yesod.Auth
@ -44,7 +44,7 @@ import qualified Data.Text.Lazy.Encoding
-- starts running, such as database connections. Every handler will have
-- access to the data present here.
data ~sitearg~ = ~sitearg~
{ settings :: AppConfig DefaultEnv
{ settings :: AppConfig DefaultEnv ()
, getLogger :: Logger
, getStatic :: Static -- ^ Settings for static file serving.
, connPool :: Database.Persist.Base.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool.

2
yesod/scaffold/Settings.hs.cg
View File

@ -41,7 +41,7 @@ staticDir = "static"
-- have to make a corresponding change here.
--
-- To see how this value is used, see urlRenderOverride in Foundation.hs
staticRoot :: AppConfig DefaultEnv -> Text
staticRoot :: AppConfig DefaultEnv x -> Text
staticRoot conf = [~qq~st|#{appRoot conf}/static|]

4
yesod/scaffold/project.cabal.cg
View File

@ -77,9 +77,9 @@ executable ~project~
, yesod-core >= 0.9.3 && < 0.10
, yesod-auth >= 0.7.3 && < 0.8
, yesod-static >= 0.3.1 && < 0.4
, yesod-default >= 0.4 && < 0.5
, yesod-default >= 0.5 && < 0.6
, yesod-form >= 0.3.4 && < 0.4
, mime-mail >= 0.3.0.3 && < 0.4
, mime-mail >= 0.3.0.3 && < 0.5
, clientsession >= 0.7.3 && < 0.8
, bytestring >= 0.9 && < 0.10
, text >= 0.11 && < 0.12

2
yesod/scaffold/tiny/Application.hs.cg
View File

@ -26,7 +26,7 @@ mkYesodDispatch "~sitearg~" resources~sitearg~
-- performs initialization and creates a WAI application. This is also the
-- place to put your migrate statements to have automatic database
-- migrations handled by Yesod.
with~sitearg~ :: AppConfig DefaultEnv -> Logger -> (Application -> IO ()) -> IO ()
with~sitearg~ :: AppConfig DefaultEnv () -> Logger -> (Application -> IO ()) -> IO ()
with~sitearg~ conf logger f = do
#ifdef PRODUCTION
s <- static Settings.staticDir

4
yesod/scaffold/tiny/Foundation.hs.cg
View File

@ -13,7 +13,7 @@ module Foundation
) where
import Prelude
import Yesod.Core
import Yesod.Core hiding (AppConfig (..))
import Yesod.Default.Config
import Yesod.Default.Util (addStaticContentExternal)
import Yesod.Static (Static, base64md5, StaticRoute(..))
@ -31,7 +31,7 @@ import Text.Hamlet (hamletFile)
-- starts running, such as database connections. Every handler will have
-- access to the data present here.
data ~sitearg~ = ~sitearg~
{ settings :: AppConfig DefaultEnv
{ settings :: AppConfig DefaultEnv ()
, getLogger :: Logger
, getStatic :: Static -- ^ Settings for static file serving.
}

2
yesod/scaffold/tiny/Settings.hs.cg
View File

@ -34,7 +34,7 @@ staticDir = "static"
-- have to make a corresponding change here.
--
-- To see how this value is used, see urlRenderOverride in ~project~.hs
staticRoot :: AppConfig DefaultEnv -> Text
staticRoot :: AppConfig DefaultEnv a -> Text
staticRoot conf = [~qq~st|#{appRoot conf}/static|]
widgetFile :: String -> Q Exp

2
yesod/scaffold/tiny/project.cabal.cg
View File

@ -67,7 +67,7 @@ executable ~project~
build-depends: base >= 4 && < 5
, yesod-core >= 0.9.3 && < 0.10
, yesod-static >= 0.3.1 && < 0.4
, yesod-default >= 0.4 && < 0.5
, yesod-default >= 0.5 && < 0.6
, clientsession >= 0.7.3 && < 0.8
, bytestring >= 0.9 && < 0.10
, text >= 0.11 && < 0.12

2
yesod/yesod.cabal
View File

@ -1,5 +1,5 @@
name: yesod
version: 0.9.3.4
version: 0.9.4
license: BSD3
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>