-- eidolon -- A simple gallery in Haskell and Yesod -- Copyright (C) 2015 Amedeo Molnár -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU Affero General Public License as published -- by the Free Software Foundation, either version 3 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU Affero General Public License for more details. -- -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . -- | 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 Control.Exception (throw) import Data.Aeson (Result (..), fromJSON, withObject, (.!=), (.:?)) import Data.FileEmbed (embedFile) import Data.Yaml (decodeEither') import Database.Persist.Sqlite (SqliteConf) import Language.Haskell.TH.Syntax (Exp, Name, Q) import Network.Wai.Handler.Warp (HostPreference) import Yesod.Default.Config2 (applyEnvValue, configSettingsYml) import Yesod.Default.Util (WidgetFileSettings, widgetFileNoReload, widgetFileReload) -- | 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 :: SqliteConf -- ^ Configuration settings for accessing the database. , appRoot :: Text -- ^ Base for all generated URLs. , 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 , appMutableStatic :: Bool -- ^ Assume that files in the static dir may change after compilation , appSkipCombining :: Bool -- ^ Perform no stylesheet/script combining -- Example app-specific configuration values. , appCopyright :: Text -- ^ Copyright text to appear in the footer of the page , appAnalytics :: Maybe Text -- ^ Google Analytics code , appSignupBlocked :: Bool -- ^ block signup site } instance FromJSON AppSettings where parseJSON = withObject "AppSettings" $ \o -> do let defaultDev = #if DEVELOPMENT True #else False #endif 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 appMutableStatic <- o .:? "mutable-static" .!= defaultDev appSkipCombining <- o .:? "skip-combining" .!= defaultDev appCopyright <- o .: "copyright" appAnalytics <- o .:? "analytics" appSignupBlocked <- o .: "signupBlocked" 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 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 -- The following two functions can be used to combine multiple CSS or JS files -- at compile time to decrease the number of http requests. -- Sample usage (inside a Widget): -- -- > $(combineStylesheets 'StaticR [style1_css, style2_css]) combineStylesheets :: Name -> [Route Static] -> Q Exp combineStylesheets = combineStylesheets' (appSkipCombining compileTimeAppSettings) combineSettings combineScripts :: Name -> [Route Static] -> Q Exp combineScripts = combineScripts' (appSkipCombining compileTimeAppSettings) combineSettings