Stability | experimental |
---|---|
Safe Haskell | Safe-Inferred |
Language | GHC2021 |
A typeclass-based library for reading in configuration values from multiple sources, attempting to be simple, avoid unecessarily complex types, and be able to track where each value came from.
Synopsis
- class Config a where
- readConfig :: Fetch a
- readValue :: forall a. ConfigValue a => a -> Key -> Fetch a
- readOptionalValue :: forall a. ConfigValue a => Key -> Fetch (Maybe a)
- readRequiredValue :: ConfigValue a => Key -> Fetch a
- readNested :: forall a. Config a => Key -> Fetch a
- readNestedOptional :: forall a. (Show a, Config a) => Key -> Fetch (Maybe a)
- data SomeSource
- runFetchConfig :: forall a. Config a => NonEmpty SomeSource -> IO (Either [ConfigError] (a, Map Key [Origin], [Warning]))
- data Fetch a
- data Value
- class ConfigValue a where
- fromConfig :: Value -> Either ConfigError a
- prettyValue :: a -> Text
- newtype Key = Key (NonEmpty KeyPart)
- newtype Warning = Warning Text
- data ConfigError
- configKeysOf :: forall a. Config a => IO [Key]
- key :: QuasiQuoter
How to use this library
This library models configuration files as a list of configuration Key
s,
for which values can be retrieved from generic sources, such as environment
variables, a program's cli arguments, or a yaml (or json, etc.) file.
As a simple example, assume a program interacting with some API. We want it to read the API's base url (falling back to a default value if it is not given) and an API key (and error out if it is missing) from its config:
data ProgramConfig = { configBaseUrl :: URL , configApiKey :: Text }
Then we can write an appropriate instance of Config
for it:
instance Config ProgramConfig where readConfig = ProgramConfig <$> readValue "http://example.org" [key|baseUrl|] <*> readRequiredValue [key|apiKey|]
Config
is an instance of Applicative
. With the ApplicativeDo
language
extension enabled, the above can be equivalently written as:
instance Config ProgramConfig where readConfig = do configBaseUrl <- readValue "http://example.org" [key|baseUrl|] configApiKey <- readRequiredValue [key|apiKey|] pure (ProgramConfig {..})
Note that Config
is not a Monad
, so we cannot inspect the config values here,
or make the reading of further keys depend on the value of earlier ones. This is
to enable introspection-like uses as in configKeysOf
.
To read our config we must provide a non-empty list of sources. Functions to
construct these live in the Conftrack.Source.*
modules; here we use
mkYamlFileSource
and mkEnvSource
(from Conftrac.Source.Yaml and Conftrack.Source.Env respectively) to read
values from either a yaml file or environment variables:
main = do result <- runFetchConfig [ mkEnvSource "CONFTRACK" , mkYamlFileSource [path|./config.yaml|] ] case result of Left _ -> .. Right (config, origins, warnings) -> ..
Now we can read in a config file like
baseUrl: http://localhost/api/v1 apiKey: very-very-secret
or from environment variables
CONFTRACK_BASEURL=http://localhost/api/v1 CONFTRACK_APIKEY=very-very-secret
Of course, sources can be mixed: Perhaps we do not want to have our program's api
key inside the configuration file. Then we can simply omit it there and provide it
via the CONFTRACK_APIKEY
environment variable instead.
Multiple sources
The order of sources given to runFetchConfig
matters: values given in earlier
sources shadow values of the same key in all following sources.
Thus even if we have
apiKey: will-not-be-used
in our config.yaml
file, it will be ignored if the CONFTRACK_APIKEY
environment
variable also has a value.
Keeping track of things
Conftrack is written to always keep track of the configuration values it reads. In particular, it is intended to avoid frustrating questions of the kind "I have clearly set this config key in the file, why does my software not use it?".
This is reflected in runFetchConfig
's return type: if it does not produce an error,
it will not only return a set of config values, but also a map of Origin
s and a list
of Warning
s indicating likely misconfiguration:
main = do result <- runFetchConfig [ mkEnvSource "CONFTRACK" , mkYamlFileSource [path|./config.yaml|] ] case result of Left _ -> .. Right (config, origins, warnings) -> do printConfigOrigins origins ...
May print something like this:
Environment variable CONFTRACK_APIKEY apiKey = "very-very-secret" YAML file ./config.yaml baseUrl = "http://localhost/api/v1"
It is recommended that programs making use of conftrack include a --show-config
option (or a similar method of introspection) to help in debugging such cases.
Defining a configuration format
A class to model configurations. See Conftrack's documention for a usage example
readConfig :: Fetch a Source #
readValue :: forall a. ConfigValue a => a -> Key -> Fetch a Source #
read in a config value, or give the given default value if it is not present.
readOptionalValue :: forall a. ConfigValue a => Key -> Fetch (Maybe a) Source #
read an optional config value, resulting in a Just
if it is present
and a Nothing
if it is not.
This is distinct from using readValue
to produce a value of type Maybe a
:
the latter will require the key to be present, but allow it to be null
or similarly empty.
readRequiredValue :: ConfigValue a => Key -> Fetch a Source #
read in a config value, and produce an error if it is not present.
readNested :: forall a. Config a => Key -> Fetch a Source #
read a nested set of configuration values, prefixed by a given key. This corresponds to nested objects in json.
readNestedOptional :: forall a. (Show a, Config a) => Key -> Fetch (Maybe a) Source #
same as readNested
, but produce Nothing
if the nested keys are not present.
This can be used for optionally configurable sub-systems or similar constructs.
If only some but not all keys of the nested configuration are given, this will produce an error.
Defining sources
data SomeSource Source #
An opaque type for any kind of config sources. Values of this type can be
acquired from they Conftrack.Source.*
modules, or by implementing the
ConfigSource
type class.
Reading a config
runFetchConfig :: forall a. Config a => NonEmpty SomeSource -> IO (Either [ConfigError] (a, Map Key [Origin], [Warning])) Source #
A value of type Fetch a
can be used to read in a value a
, with configuration
sources handled implicitly.
Note that this is an instance of Applicative
but not Monad
. In practical terms
this means that values read from the configuration sources cannot be inspected while
reading the rest of the config, and in particular which keys are read cannot depend
on another key's value. This allows for introspection functions like configKeysOf
.
For configuration keys whose presence depends on each other, use
readNestedOptional
to model similar behaviour.
Parsing config values
A generic value read from a config source, to be parsed into a more useful type
(see the ConfigValue
class).
ConfigString ByteString | |
ConfigInteger Integer | |
ConfigMaybeInteger ByteString Integer | A value which may be an integer, but the source cannot say for sure, e.g. because
its values are entirely untyped. Use |
ConfigOther Text Text | |
ConfigBool Bool | |
ConfigNull |
class ConfigValue a where Source #
Values which can be read from a config source must implement this class
fromConfig :: Value -> Either ConfigError a Source #
prettyValue :: a -> Text Source #
optionally, a function to pretty-print values of this type, used by the
functions of Conftrack.Pretty. If not given, defaults to a
's Show
instance.
default prettyValue :: Show a => a -> Text Source #
Instances
Basic types
A configuration key is a non-empty list of parts. By convention, these parts are separated by dots when written, although dots withing parts are not disallowed.
For writing values easily, consider enabling the QuasiQuotes
language extension
to use key
:
>>>
[key|foo.bar|]
foo.bar
data ConfigError Source #
Instances
Show ConfigError Source # | |
Defined in Conftrack.Value showsPrec :: Int -> ConfigError -> ShowS # show :: ConfigError -> String # showList :: [ConfigError] -> ShowS # |
Utilities
configKeysOf :: forall a. Config a => IO [Key] Source #
a list of all keys which will be read when running runFetchConfig
to
produce a value of type a
.
This runs inside the IO
monad, but does not do any actual IO.
key :: QuasiQuoter Source #
to write values of Key
easily