{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | 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 BtcLsp.Yesod.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 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
  { -- | Directory from which to serve static files.
    AppSettings -> String
appStaticDir :: String,
    -- | Base for all generated URLs. If @Nothing@, determined
    -- from the request headers.
    AppSettings -> Maybe Text
appRoot :: Maybe Text,
    -- | Host/interface the server should bind to.
    AppSettings -> HostPreference
appHost :: HostPreference,
    -- | Port to listen on
    AppSettings -> Int
appPort :: Int,
    -- | Get the IP address from the header when logging. Useful when sitting
    -- behind a reverse proxy.
    AppSettings -> Bool
appIpFromHeader :: Bool,
    -- | Use detailed request logging system
    AppSettings -> Bool
appDetailedRequestLogging :: Bool,
    -- | Should all log messages be displayed?
    AppSettings -> Bool
appShouldLogAll :: Bool,
    -- | Use the reload version of templates
    AppSettings -> Bool
appReloadTemplates :: Bool,
    -- | Assume that files in the static dir may change after compilation
    AppSettings -> Bool
appMutableStatic :: Bool,
    -- | Perform no stylesheet/script combining
    AppSettings -> Bool
appSkipCombining :: Bool,
    -- Example app-specific configuration values.

    -- | Copyright text to appear in the footer of the page
    AppSettings -> Text
appCopyright :: Text,
    -- | Google Analytics code
    AppSettings -> Maybe Text
appAnalytics :: Maybe Text,
    -- | Indicate if auth dummy login should be enabled.
    AppSettings -> Bool
appAuthDummyLogin :: Bool
  }

instance FromJSON AppSettings where
  parseJSON :: Value -> Parser AppSettings
parseJSON = String
-> (Object -> Parser AppSettings) -> Value -> Parser AppSettings
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AppSettings" ((Object -> Parser AppSettings) -> Value -> Parser AppSettings)
-> (Object -> Parser AppSettings) -> Value -> Parser AppSettings
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    let defaultDev :: Bool
defaultDev = Bool
False
    String
appStaticDir <- Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"static-dir"
    Maybe Text
appRoot <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"approot"
    HostPreference
appHost <- String -> HostPreference
forall a. IsString a => String -> a
fromString (String -> HostPreference)
-> Parser String -> Parser HostPreference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"host"
    Int
appPort <- Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"port"
    Bool
appIpFromHeader <- Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ip-from-header"

    Bool
dev <- Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"development" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
defaultDev

    Bool
appDetailedRequestLogging <- Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"detailed-logging" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
dev
    Bool
appShouldLogAll <- Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"should-log-all" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
dev
    Bool
appReloadTemplates <- Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"reload-templates" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
dev
    Bool
appMutableStatic <- Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"mutable-static" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
dev
    Bool
appSkipCombining <- Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"skip-combining" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
dev

    Text
appCopyright <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"copyright"
    Maybe Text
appAnalytics <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"analytics"

    Bool
appAuthDummyLogin <- Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"auth-dummy-login" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
dev

    AppSettings -> Parser AppSettings
forall (m :: * -> *) a. Monad m => a -> m a
return AppSettings :: String
-> Maybe Text
-> HostPreference
-> Int
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Text
-> Maybe Text
-> Bool
-> AppSettings
AppSettings {Bool
Int
String
Maybe Text
Text
HostPreference
appAuthDummyLogin :: Bool
appAnalytics :: Maybe Text
appCopyright :: Text
appSkipCombining :: Bool
appMutableStatic :: Bool
appReloadTemplates :: Bool
appShouldLogAll :: Bool
appDetailedRequestLogging :: Bool
appIpFromHeader :: Bool
appPort :: Int
appHost :: HostPreference
appRoot :: Maybe Text
appStaticDir :: String
appAuthDummyLogin :: Bool
appAnalytics :: Maybe Text
appCopyright :: Text
appSkipCombining :: Bool
appMutableStatic :: Bool
appReloadTemplates :: Bool
appShouldLogAll :: Bool
appDetailedRequestLogging :: Bool
appIpFromHeader :: Bool
appPort :: Int
appHost :: HostPreference
appRoot :: Maybe Text
appStaticDir :: String
..}

-- | 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 :: WidgetFileSettings
widgetFileSettings = WidgetFileSettings
forall a. Default a => a
def

-- | How static files should be combined.
combineSettings :: CombineSettings
combineSettings :: CombineSettings
combineSettings = CombineSettings
forall a. Default a => a
def

-- The rest of this file contains settings which rarely need changing by a
-- user.

widgetFile :: String -> Q Exp
widgetFile :: String -> Q Exp
widgetFile =
  ( if AppSettings -> Bool
appReloadTemplates AppSettings
compileTimeAppSettings
      then WidgetFileSettings -> String -> Q Exp
widgetFileReload
      else WidgetFileSettings -> String -> Q Exp
widgetFileNoReload
  )
    WidgetFileSettings
widgetFileSettings

-- | Raw bytes at compile time of @config/settings.yml@
configSettingsYmlBS :: ByteString
configSettingsYmlBS :: ByteString
configSettingsYmlBS = $(embedFile configSettingsYml)

-- | @config/settings.yml@, parsed to a @Value@.
configSettingsYmlValue :: Value
configSettingsYmlValue :: Value
configSettingsYmlValue =
  (ParseException -> Value)
-> (Value -> Value) -> Either ParseException Value -> Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseException -> Value
forall a e. Exception e => e -> a
Exception.throw Value -> Value
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (Either ParseException Value -> Value)
-> Either ParseException Value -> Value
forall a b. (a -> b) -> a -> b
$
    ByteString -> Either ParseException Value
forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' ByteString
configSettingsYmlBS

-- | A version of @AppSettings@ parsed at compile time from @config/settings.yml@.
compileTimeAppSettings :: AppSettings
compileTimeAppSettings :: AppSettings
compileTimeAppSettings =
  case Value -> Result AppSettings
forall a. FromJSON a => Value -> Result a
fromJSON (Value -> Result AppSettings) -> Value -> Result AppSettings
forall a b. (a -> b) -> a -> b
$ Bool -> KeyMap Text -> Value -> Value
applyEnvValue Bool
False KeyMap Text
forall a. Monoid a => a
mempty Value
configSettingsYmlValue of
    Error String
e -> String -> AppSettings
forall a. HasCallStack => String -> a
error String
e
    Success AppSettings
settings -> AppSettings
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 :: Name -> [Route Static] -> Q Exp
combineStylesheets =
  Bool -> CombineSettings -> Name -> [Route Static] -> Q Exp
combineStylesheets'
    (AppSettings -> Bool
appSkipCombining AppSettings
compileTimeAppSettings)
    CombineSettings
combineSettings

combineScripts :: Name -> [Route Static] -> Q Exp
combineScripts :: Name -> [Route Static] -> Q Exp
combineScripts =
  Bool -> CombineSettings -> Name -> [Route Static] -> Q Exp
combineScripts'
    (AppSettings -> Bool
appSkipCombining AppSettings
compileTimeAppSettings)
    CombineSettings
combineSettings