2017-10-02 03:07:09 -04:00
{- # LANGUAGE CPP # -}
{- # LANGUAGE NoImplicitPrelude # -}
{- # LANGUAGE OverloadedStrings # -}
{- # LANGUAGE RecordWildCards # -}
{- # LANGUAGE TemplateHaskell # -}
-- | 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.MySQL ( MySQLConf ( .. ) )
import Language.Haskell.TH.Syntax ( Exp , Name , Q )
import Network.Wai.Handler.Warp ( HostPreference )
2017-10-02 06:39:17 -04:00
import Text.Hamlet ( HamletSettings ( hamletNewlines ) , NewlineStyle ( AlwaysNewlines ) , defaultHamletSettings )
2017-10-02 03:07:09 -04:00
import Yesod.Default.Config2 ( applyEnvValue , configSettingsYml )
2017-10-02 06:39:17 -04:00
import Yesod.Default.Util ( WidgetFileSettings ( wfsHamletSettings ) , widgetFileNoReload ,
2017-10-02 03:07:09 -04:00
widgetFileReload )
import qualified Database.MySQL.Base as MySQL
-- | 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 :: MySQLConf
-- ^ 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.
2017-10-02 05:31:49 -04:00
, appStaticRoot :: Maybe Text
-- ^ Base for static generated URLs. Useful for serving static assets from
-- a separate domain. If @Nothing@, use @appRoot@ and @appStaticDir@ instead.
2017-10-02 03:07:09 -04:00
, 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.
, appAnalytics :: Maybe Text
-- ^ Google Analytics code
2017-10-14 02:22:07 -04:00
, appFacebookId :: Maybe Int
-- ^ Facebook app ID, also used for analytics.
2017-10-08 22:50:26 -04:00
, siteTitle :: Text
2017-10-02 07:04:20 -04:00
-- ^ Site-wide title.
2017-10-10 21:55:24 -04:00
, siteUsername :: Text
-- ^ Username of the site's main user, whose h-card will appear on the
-- homepage.
2017-10-02 03:07:09 -04:00
, appAuthDummyLogin :: Bool
-- ^ Indicate if auth dummy login should be enabled.
}
instance FromJSON AppSettings where
parseJSON = withObject " AppSettings " $ \ o -> do
let defaultDev =
# ifdef DEVELOPMENT
True
# else
False
# endif
appStaticDir <- o .: " static-dir "
fromYamlAppDatabaseConf <- o .: " database "
appRoot <- o .:? " approot "
appHost <- fromString <$> o .: " host "
appPort <- o .: " port "
appIpFromHeader <- o .: " ip-from-header "
2017-10-02 05:31:49 -04:00
appStaticRoot <- o .:? " static-root "
2017-10-02 03:07:09 -04:00
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
appAnalytics <- o .:? " analytics "
2017-10-14 02:22:07 -04:00
appFacebookId <- o .:? " fb-app-id "
2017-10-08 22:50:26 -04:00
siteTitle <- o .: " title "
2017-10-10 21:55:24 -04:00
siteUsername <- o .: " username "
2017-10-02 03:07:09 -04:00
-- This code enables MySQL's strict mode, without which MySQL will truncate data.
-- See https://github.com/yesodweb/persistent/wiki/Database-Configuration#strict-mode for details
-- If you choose to keep strict mode enabled, it's recommended that you enable it in your my.cnf file so that it's also enabled for your MySQL console sessions.
-- (If you enable it in your my.cnf file, you can delete this code).
let appDatabaseConf = fromYamlAppDatabaseConf { myConnInfo = ( myConnInfo fromYamlAppDatabaseConf ) {
MySQL . connectOptions =
( MySQL . connectOptions ( myConnInfo fromYamlAppDatabaseConf ) ) ++ [ MySQL . InitCommand " SET SESSION sql_mode = 'STRICT_ALL_TABLES'; \ 0 " ]
}
}
appAuthDummyLogin <- o .:? " auth-dummy-login " .!= 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
2017-10-02 06:39:17 -04:00
widgetFileSettings = def { wfsHamletSettings = defaultHamletSettings { hamletNewlines = AlwaysNewlines } }
2017-10-02 03:07:09 -04:00
-- | 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
-- 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