Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to have "dependent" default values that can be overriden by the user?

Tags:

haskell

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.
  • Similarly, 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
like image 903
Saurabh Nanda Avatar asked Jan 01 '23 02:01

Saurabh Nanda


2 Answers

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
like image 115
Li-yao Xia Avatar answered Apr 13 '23 00:04

Li-yao Xia


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
like image 44
Yuras Avatar answered Apr 13 '23 00:04

Yuras