haskell - 如何拥有可以被用户覆盖的 "dependent"默认值？

Question

我的odd-jobs 有以下功能作业队列库。有一堆配置参数，其中默认实现依赖于另一个配置参数。例如:

• cfgJobToHtml 依赖于 cfgJobType，默认为 defaultJobType。但是，在调用 defaultConfig 之后，用户可以选择覆盖 cfgJobType 而不更改 cfgJobToHtml 的值。预期的行为是 cfgJobToHtml 现在应该使用用户提供的值而不是 defaultJobType。
• 同样，cfgAllJobTypes 依赖于 cfgJobTypeSql，而 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