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

Question

我的零工作业队列库中具有以下功能。有一堆配置参数，其中默认实现取决于另一个配置参数。例如：

• cfgJobToHtml取决于cfgJobType，默认为defaultJobType。但是，在调用 之后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

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

在您的示例中，您首先填写默认值，然后让用户根据需要覆盖某些字段。使用 builder 则相反：您让用户填充她想要覆盖的数据，然后填充其余部分。

具体来说，您创建一个中间数据类型来保存部分填充的配置，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>

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

*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>

这样施工就变得不那么嘈杂了：

*Config> buildConfig (return ())
Config {cfgJobType = "default job", cfgJobToHtml = "default job to html"}
*Config> buildConfig (setJobType "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