From d84b462a711ce95593ff05a7581e722562c3835a Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 14 Mar 2017 01:06:28 +0100 Subject: Implement old bar.hs --- Settings.hs | 107 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 107 insertions(+) create mode 100644 Settings.hs (limited to 'Settings.hs') diff --git a/Settings.hs b/Settings.hs new file mode 100644 index 0000000..76aa2f3 --- /dev/null +++ b/Settings.hs @@ -0,0 +1,107 @@ +{-# Language CPP #-} +-- | Settings are centralized, as much as possible, into this file. This +-- includes database connection settings, static file locations, etc. +-- In addition, you can configure a number of different aspects of Yesod +-- by overriding methods in the Yesod typeclass. That instance is +-- declared in the Foundation.hs file. +module Settings where + +import ClassyPrelude.Yesod +import qualified Control.Exception as Exception +import Data.Aeson (Result (..), fromJSON, withObject, (.!=), + (.:?)) +import Data.FileEmbed (embedFile) +import Data.Yaml (decodeEither') +import Database.Persist.Postgresql (PostgresConf) +import Language.Haskell.TH.Syntax (Exp, Q) +import Network.Wai.Handler.Warp (HostPreference) +import Yesod.Default.Config2 (applyEnvValue, configSettingsYml) +import Yesod.Default.Util (WidgetFileSettings, widgetFileNoReload, + widgetFileReload) + +#ifdef DEVELOPMENT +#define DEV_BOOL True +#else +#define DEV_BOOL False +#endif + +-- | Runtime settings to configure this application. These settings can be +-- loaded from various sources: defaults, environment variables, config files, +-- theoretically even a database. +data AppSettings = AppSettings + { appStaticDir :: String + -- ^ Directory from which to serve static files. + , appDatabaseConf :: PostgresConf + -- ^ Configuration settings for accessing the database. + , appRoot :: Maybe Text + -- ^ Base for all generated URLs. If @Nothing@, determined + -- from the request headers. + , appHost :: HostPreference + -- ^ Host/interface the server should bind to. + , appPort :: Int + -- ^ Port to listen on + , appIpFromHeader :: Bool + -- ^ Get the IP address from the header when logging. Useful when sitting + -- behind a reverse proxy. + + , appDetailedRequestLogging :: Bool + -- ^ Use detailed request logging system + , appShouldLogAll :: Bool + -- ^ Should all log messages be displayed? + , appReloadTemplates :: Bool + -- ^ Use the reload version of templates + } + +instance FromJSON AppSettings where + parseJSON = withObject "AppSettings" $ \o -> do + let defaultDev = DEV_BOOL + appStaticDir <- o .: "static-dir" + appDatabaseConf <- o .: "database" + appRoot <- o .:? "approot" + appHost <- fromString <$> o .: "host" + appPort <- o .: "port" + appIpFromHeader <- o .: "ip-from-header" + + appDetailedRequestLogging <- o .:? "detailed-logging" .!= defaultDev + appShouldLogAll <- o .:? "should-log-all" .!= defaultDev + appReloadTemplates <- o .:? "reload-templates" .!= defaultDev + + return AppSettings {..} + +-- | Settings for 'widgetFile', such as which template languages to support and +-- default Hamlet settings. +-- +-- For more information on modifying behavior, see: +-- +-- https://github.com/yesodweb/yesod/wiki/Overriding-widgetFile +widgetFileSettings :: WidgetFileSettings +widgetFileSettings = def + +-- | How static files should be combined. +combineSettings :: CombineSettings +combineSettings = def + +-- The rest of this file contains settings which rarely need changing by a +-- user. + +widgetFile :: String -> Q Exp +widgetFile = (if appReloadTemplates compileTimeAppSettings + then widgetFileReload + else widgetFileNoReload) + widgetFileSettings + +-- | Raw bytes at compile time of @config/settings.yml@ +configSettingsYmlBS :: ByteString +configSettingsYmlBS = $(embedFile configSettingsYml) + +-- | @config/settings.yml@, parsed to a @Value@. +configSettingsYmlValue :: Value +configSettingsYmlValue = either Exception.throw id + $ decodeEither' configSettingsYmlBS + +-- | A version of @AppSettings@ parsed at compile time from @config/settings.yml@. +compileTimeAppSettings :: AppSettings +compileTimeAppSettings = + case fromJSON $ applyEnvValue False mempty configSettingsYmlValue of + Error e -> error e + Success settings -> settings -- cgit v1.2.3