时间戳

首页 > 解决方案 > 如何拥有可以被用户覆盖的“依赖”默认值？

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

问题描述

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

下面的代码不像我期望的那样工作。如果您更改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

标签： haskell

解决方案

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

在您的示例中，您首先填写默认值，然后让用户根据需要覆盖某些字段。使用 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>

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

{-# 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

推荐阅读