如何拥有“依赖”的默认值，可以被用户覆盖？

Question

我在我的零工作业队列库中有以下函数。在一些配置参数中，默认实现依赖于另一个配置参数。例如：

• cfgJobToHtml依赖于默认为defaultJobType的cfgJobType。但是，在调用defaultConfig之后，用户可以选择重写cfgJobType 的值，而不更改 cfgJobToHtml。预期的行为是cfgJobToHtml现在应该使用用户提供的值而不是defaultJobType。
• 类似地，cfgAllJobTypes依赖于cfgJobTypeSql，后者将默认为defaultJobTypeSql.同样，在调用defaultConfig之后，如果用户重写了cfgJobTypeSql的值，那么cfgAllJobTypes应该使用重写的值，而不是defaultJobTypeSql。

下面的代码不像我所期望的那样工作。如果您更改了cfgJobType，则更改将不会由cfgJobToHtml获取。同样，对于cfgJobTypeSql也是如此。

拥有这些“依赖”的默认值的最佳方法是什么？

-- | This function gives you a 'Config' with a bunch of sensible defaults
-- already applied. It requires the bare minimum arguments that this library
-- cannot assume on your behalf.
--
-- It makes a few __important assumptions__ about your 'jobPayload 'JSON, which
-- are documented in 'defaultJobType'.
defaultConfig :: (LogLevel -> LogEvent -> IO ())  -- ^ "Structured logging" function. Ref: 'cfgLogger'
              -> TableName                        -- ^ DB table which holds your jobs. Ref: 'cfgTableName'
              -> Pool Connection                  -- ^ DB connection-pool to be used by job-runner. Ref: 'cfgDbPool'
              -> ConcurrencyControl               -- ^ Concurrency configuration. Ref: 'cfgConcurrencyControl'
              -> (Job -> IO ())                   -- ^ The actual "job runner" which contains your application code. Ref: 'cfgJobRunner'
              -> Config
defaultConfig logger tname dbpool ccControl jrunner =
  let cfg = Config
            { cfgPollingInterval = defaultPollingInterval
            , cfgOnJobSuccess = (const $ pure ())
            , cfgOnJobFailed = []
            , cfgJobRunner = jrunner
            , cfgLogger = logger
            , cfgDbPool = dbpool
            , cfgOnJobStart = (const $ pure ())
            , cfgDefaultMaxAttempts = 10
            , cfgTableName = tname
            , cfgOnJobTimeout = (const $ pure ())
            , cfgConcurrencyControl = ccControl
            , cfgPidFile = Nothing
            , cfgJobType = defaultJobType
            , cfgDefaultJobTimeout = Seconds 600
            , cfgJobToHtml = defaultJobToHtml (cfgJobType cfg)
            , cfgAllJobTypes = defaultDynamicJobTypes (cfgTableName cfg) (cfgJobTypeSql cfg)
            , cfgJobTypeSql = defaultJobTypeSql
            }
  in cfg

Answer 1

这也可以通过开放递归来实现。配置当前是递归定义的(let cfg = mkConfig cfg in cfg)。因此，我们的想法是只定义这个非递归函数mkConfig，并允许用户在打结之前应用自己的逻辑。

所以而不是

defaultConfig :: X -> Y -> Z -> Config
defaultConfig x y z =
  let cfg = Config {  ...  }
  in cfg

定义

mkConfig :: X -> Y -> Z -> Config -> Config
mkConfig x y z cfg =
  Config {  ...  }

这样，用户就可以将自己的选项设置为

userConfig = defaultConfig {  ...  }          -- override defaultConfig
  where defaultConfig = mkConfig x y z userConfig   -- tie the knot

您还可以通过接受用户在上面隐式定义的Config -> Config函数来隐藏递归，从而恢复到与初始版本更相似的样式：

mkConfig :: X -> Y -> Z -> (Config -> Config) -> Config
mkConfig x y z mkCfg =
  let cfg = mkCfg $ Config {  ...  } in -- defaults here, using cfg recursively
  in cfg

userConfig :: Config
userConfig = mkConfig x y z \defaultConfig ->
  defaultConfig {  ...  }   -- override defaultConfig

Answer 2

人们通常使用构建器模式来实现它。

在您的示例中，您首先填充默认值，然后让用户覆盖某些字段(如果她愿意)。对于构建器，情况正好相反:让用户填充她想要覆盖的数据，然后填充其余的数据。

具体来说，您可以创建一个中间数据类型来保存部分填充的配置ConfigUnderConstruction。所有字段都是可选的。用户可以指定她感兴趣的所有字段，然后组装配置，填充所有默认值：

module Config
where

import Data.Maybe
import Control.Monad.Trans.State

data Config = Config
  { cfgJobType :: String
  , cfgJobToHtml :: String
  } deriving (Show)

data ConfigUnderConstruction = ConfigUnderConstruction
  { cucJobType :: Maybe String
  , cucJobToHtml :: Maybe String
  }

emptyConfig :: ConfigUnderConstruction
emptyConfig = ConfigUnderConstruction
  { cucJobType = Nothing
  , cucJobToHtml = Nothing
  }

assemble :: ConfigUnderConstruction -> Config
assemble partial = Config
  { cfgJobType = jobType
  , cfgJobToHtml = jobToHtml
  }
  where
  jobType = fromMaybe defaultJobType $ cucJobType partial
  jobToHtml = fromMaybe (defaultJobToHtml jobType) $ cucJobToHtml partial

defaultJobType :: String
defaultJobType = "default job"

defaultJobToHtml :: String -> String
defaultJobToHtml jobType = jobType ++ " to html"

下面是您如何使用它：

*Config> assemble emptyConfig 
Config {cfgJobType = "default job", cfgJobToHtml = "default job to html"}
*Config> assemble $ emptyConfig {cucJobType = Just "custom"}
Config {cfgJobType = "custom", cfgJobToHtml = "custom to html"}
*Config>

有时，人们会更进一步，添加一些语法糖：

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

newtype Builder a = Builder
  { fromBuilder :: State ConfigUnderConstruction a
  } deriving (Functor, Applicative, Monad)

setJobType :: String -> Builder ()
setJobType jobType = Builder $ modify' $ \s -> s
  { cucJobType = Just jobType
  }

setJobToHtml :: String -> Builder ()
setJobToHtml jobToHtml = Builder $ modify' $ \s -> s
  { cucJobToHtml = Just jobToHtml
  }

buildConfig :: Builder () -> Config
buildConfig builder =
  assemble $ execState (fromBuilder builder) emptyConfig

这样，建筑就变得不那么嘈杂了：

*Config> buildConfig (return ())
Config {cfgJobType = "default job", cfgJobToHtml = "default job to html"}
*Config> buildConfig (setJobType "custom")
Config {cfgJobType = "custom", cfgJobToHtml = "custom to html"}

添加:您可以通过以下列方式定义Config来减少样板的数量：

data GConfig f = Config
  { cfgJobType :: f String
  , cfgJobToHtml :: f String
  } deriving (Show)

type Config = GConfig Identity

type ConfigUnderConstruction = GConfig Maybe