I have the following function from my odd-jobs job-queue library. There are a bunch of configuration parameters where the default implementation depends on another config parameter. For example:
cfgJobToHtml
depends on cfgJobType
, which defaults to defaultJobType
. However, after calling defaultConfig
, the user may choose to override the value for cfgJobType
without changing cfgJobToHtml
. The expected behaviour is that cfgJobToHtml
should now use the user-provided value instead of defaultJobType
.cfgAllJobTypes
depends on cfgJobTypeSql
, which in-turn defauls to defaultJobTypeSql
. Again, after calling defaultConfig
, if the user overrides the value for cfgJobTypeSql
, then cfgAllJobTypes
should use the overridden value, not defaultJobTypeSql
.The code below does not work the way I'm expecting it to. If you change cfgJobType
the change is not picked up by cfgJobToHtml
. Similarly, for cfgJobTypeSql
.
What is the best way to have these "dependent" default values?
-- | 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
This can also be achieved with open recursion. The configuration is currently defined recursively (let cfg = mkConfig cfg in cfg
). The idea then is to only define this nonrecursive function mkConfig
and allow the user to apply their own logic before tying the knot.
So instead of
defaultConfig :: X -> Y -> Z -> Config
defaultConfig x y z =
let cfg = Config { ... }
in cfg
define
mkConfig :: X -> Y -> Z -> Config -> Config
mkConfig x y z cfg =
Config { ... }
so a user can set their own options as
userConfig = defaultConfig { ... } -- override defaultConfig
where defaultConfig = mkConfig x y z userConfig -- tie the knot
You can also hide the recursion from users by taking in the Config -> Config
function that they've implicitly defined above, getting back to a style more similar to your initial version:
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
People often implement it using builder pattern.
In your example, you first fill the defaults and then let user override some fields if she wants. With builder it's other way around: you let user fill the data she wants to override, then you fill the rest.
Specifically, you make an intermediate data type to hold a partially filled config, ConfigUnderConstruction
. All fields there are optional. User can specify all the fields she is interested in, then you assemble the config, filling all the defaults:
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"
Here is how you use it:
*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>
Sometimes people go further and add a bit of syntactic sugar:
{-# 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
That way construction becomes a bit less noisy:
*Config> buildConfig (return ())
Config {cfgJobType = "default job", cfgJobToHtml = "default job to html"}
*Config> buildConfig (setJobType "custom")
Config {cfgJobType = "custom", cfgJobToHtml = "custom to html"}
Added:
You can reduce the amount of boilerplate by defining the Config
in the following way:
data GConfig f = Config
{ cfgJobType :: f String
, cfgJobToHtml :: f String
} deriving (Show)
type Config = GConfig Identity
type ConfigUnderConstruction = GConfig Maybe
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With