{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

{-|
Module: Conftrack
Stability: experimental

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.

-}
module Conftrack
  ( -- * How to use this library
    -- $use

    -- * Defining a configuration format
    Config(..)
  , readValue
  , readOptionalValue
  , readRequiredValue
  , readNested
  , readNestedOptional
    -- * Defining sources
  , SomeSource
    -- * Reading a config
  , runFetchConfig
  , Fetch
    -- * Parsing config values
  , Value(..)
  , ConfigValue(..)
    -- * Basic types
  , Key(..)
  , Warning(..)
  , ConfigError(..)
    -- * Utilities
  , configKeysOf
  , key
  ) where

import Conftrack.Value (ConfigError(..), ConfigValue(..), Key (..), Origin(..), Value(..), KeyPart, prefixedWith, key)
import Conftrack.Source (SomeSource (..), ConfigSource (..))

import Prelude hiding (unzip)
import Control.Monad.State (StateT (..))
import Data.Functor ((<&>))
import Data.List.NonEmpty (NonEmpty, unzip)
import qualified Data.List.NonEmpty as NonEmpty
import Control.Monad (forM, (>=>))
import Data.Either (isRight)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Maybe (isJust, mapMaybe)
import Data.Map (Map)
import qualified Data.Map.Strict as M


-- | A class to model configurations. See "Conftrack"'s documention for a usage example
class Config a where
  readConfig :: Fetch a

data FetcherState = FetcherState
  { FetcherState -> [SomeSource]
fetcherSources :: [SomeSource]
  , FetcherState -> [Text]
fetcherPrefix :: [KeyPart]
  , FetcherState -> Map Key [Origin]
fetcherOrigins :: Map Key [Origin]
  , FetcherState -> [Warning]
fetcherWarnings :: [Warning]
  , FetcherState -> [ConfigError]
fetcherErrors :: [ConfigError]
  }

-- | 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
-- 'Conftrack.readNestedOptional' to model similar behaviour.
newtype Fetch a = Fetch (FetcherState -> IO (a, FetcherState))
  deriving ((forall a b. (a -> b) -> Fetch a -> Fetch b)
-> (forall a b. a -> Fetch b -> Fetch a) -> Functor Fetch
forall a b. a -> Fetch b -> Fetch a
forall a b. (a -> b) -> Fetch a -> Fetch b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Fetch a -> Fetch b
fmap :: forall a b. (a -> b) -> Fetch a -> Fetch b
$c<$ :: forall a b. a -> Fetch b -> Fetch a
<$ :: forall a b. a -> Fetch b -> Fetch a
Functor)

newtype Warning = Warning Text
 deriving Int -> Warning -> ShowS
[Warning] -> ShowS
Warning -> String
(Int -> Warning -> ShowS)
-> (Warning -> String) -> ([Warning] -> ShowS) -> Show Warning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Warning -> ShowS
showsPrec :: Int -> Warning -> ShowS
$cshow :: Warning -> String
show :: Warning -> String
$cshowList :: [Warning] -> ShowS
showList :: [Warning] -> ShowS
Show

instance Applicative Fetch where
  pure :: forall a. a -> Fetch a
pure a
a = (FetcherState -> IO (a, FetcherState)) -> Fetch a
forall a. (FetcherState -> IO (a, FetcherState)) -> Fetch a
Fetch (\FetcherState
s -> (a, FetcherState) -> IO (a, FetcherState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, FetcherState
s))

  liftA2 :: forall a b c. (a -> b -> c) -> Fetch a -> Fetch b -> Fetch c
liftA2 a -> b -> c
f (Fetch FetcherState -> IO (a, FetcherState)
m) (Fetch FetcherState -> IO (b, FetcherState)
n) = (FetcherState -> IO (c, FetcherState)) -> Fetch c
forall a. (FetcherState -> IO (a, FetcherState)) -> Fetch a
Fetch ((FetcherState -> IO (c, FetcherState)) -> Fetch c)
-> (FetcherState -> IO (c, FetcherState)) -> Fetch c
forall a b. (a -> b) -> a -> b
$ \FetcherState
s -> do
    (a
a, FetcherState
s2) <- FetcherState -> IO (a, FetcherState)
m FetcherState
s
    (b
b, FetcherState
s3) <- FetcherState -> IO (b, FetcherState)
n FetcherState
s2
    (c, FetcherState) -> IO (c, FetcherState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> b -> c
f a
a b
b, FetcherState
s3)


runFetchConfig
  :: forall a. Config a
  => NonEmpty SomeSource
  -> IO (Either
         [ConfigError]
         (a, Map Key [Origin], [Warning]))
runFetchConfig :: forall a.
Config a =>
NonEmpty SomeSource
-> IO (Either [ConfigError] (a, Map Key [Origin], [Warning]))
runFetchConfig NonEmpty SomeSource
sources = do
  let (Fetch FetcherState -> IO (a, FetcherState)
m) = forall a. Config a => Fetch a
readConfig @a

  (a
result, FetcherState [SomeSource]
sources2 [Text]
_ Map Key [Origin]
origins [Warning]
warnings [ConfigError]
errors) <- FetcherState -> IO (a, FetcherState)
m ([SomeSource]
-> [Text]
-> Map Key [Origin]
-> [Warning]
-> [ConfigError]
-> FetcherState
FetcherState (NonEmpty SomeSource -> [SomeSource]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty SomeSource
sources) [] [] [] [])
  [Warning]
unusedWarnings <- [SomeSource] -> IO [Warning]
collectUnused [SomeSource]
sources2
  if [ConfigError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ConfigError]
errors
    then Either [ConfigError] (a, Map Key [Origin], [Warning])
-> IO (Either [ConfigError] (a, Map Key [Origin], [Warning]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [ConfigError] (a, Map Key [Origin], [Warning])
 -> IO (Either [ConfigError] (a, Map Key [Origin], [Warning])))
-> Either [ConfigError] (a, Map Key [Origin], [Warning])
-> IO (Either [ConfigError] (a, Map Key [Origin], [Warning]))
forall a b. (a -> b) -> a -> b
$ (a, Map Key [Origin], [Warning])
-> Either [ConfigError] (a, Map Key [Origin], [Warning])
forall a b. b -> Either a b
Right (a
result, Map Key [Origin]
origins, [Warning]
unusedWarnings [Warning] -> [Warning] -> [Warning]
forall a. Semigroup a => a -> a -> a
<> [Warning]
warnings)
    else Either [ConfigError] (a, Map Key [Origin], [Warning])
-> IO (Either [ConfigError] (a, Map Key [Origin], [Warning]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [ConfigError] (a, Map Key [Origin], [Warning])
 -> IO (Either [ConfigError] (a, Map Key [Origin], [Warning])))
-> Either [ConfigError] (a, Map Key [Origin], [Warning])
-> IO (Either [ConfigError] (a, Map Key [Origin], [Warning]))
forall a b. (a -> b) -> a -> b
$ [ConfigError]
-> Either [ConfigError] (a, Map Key [Origin], [Warning])
forall a b. a -> Either a b
Left [ConfigError]
errors

-- | 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.
configKeysOf :: forall a. Config a => IO [Key]
configKeysOf :: forall a. Config a => IO [Key]
configKeysOf = do
  let (Fetch FetcherState -> IO (a, FetcherState)
m) = forall a. Config a => Fetch a
readConfig @a
  (a
_, FetcherState [SomeSource]
_ [Text]
_ Map Key [Origin]
_ [Warning]
_ [ConfigError]
errors) <- FetcherState -> IO (a, FetcherState)
m ([SomeSource]
-> [Text]
-> Map Key [Origin]
-> [Warning]
-> [ConfigError]
-> FetcherState
FetcherState [] [] [] [] [])

  let keys :: [Key]
keys = (ConfigError -> Maybe Key) -> [ConfigError] -> [Key]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case {(NotPresent Key
k) -> Key -> Maybe Key
forall a. a -> Maybe a
Just Key
k; ConfigError
_ -> Maybe Key
forall a. Maybe a
Nothing }) [ConfigError]
errors
  [Key] -> IO [Key]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Key]
keys

-- | 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.
readOptionalValue :: forall a. ConfigValue a => Key -> Fetch (Maybe a)
readOptionalValue :: forall a. ConfigValue a => Key -> Fetch (Maybe a)
readOptionalValue Key
bareKey = (FetcherState -> IO (Maybe a, FetcherState)) -> Fetch (Maybe a)
forall a. (FetcherState -> IO (a, FetcherState)) -> Fetch a
Fetch ((FetcherState -> IO (Maybe a, FetcherState)) -> Fetch (Maybe a))
-> (FetcherState -> IO (Maybe a, FetcherState)) -> Fetch (Maybe a)
forall a b. (a -> b) -> a -> b
$ \s1 :: FetcherState
s1@FetcherState{[Text]
[ConfigError]
[SomeSource]
[Warning]
Map Key [Origin]
fetcherSources :: FetcherState -> [SomeSource]
fetcherPrefix :: FetcherState -> [Text]
fetcherOrigins :: FetcherState -> Map Key [Origin]
fetcherWarnings :: FetcherState -> [Warning]
fetcherErrors :: FetcherState -> [ConfigError]
fetcherSources :: [SomeSource]
fetcherPrefix :: [Text]
fetcherOrigins :: Map Key [Origin]
fetcherWarnings :: [Warning]
fetcherErrors :: [ConfigError]
..} -> do

  let k :: Key
k = Key
bareKey Key -> [Text] -> Key
`prefixedWith` [Text]
fetcherPrefix

  [(Either ConfigError (Value, Text), SomeSource)]
stuff <- Key
-> [SomeSource]
-> IO [(Either ConfigError (Value, Text), SomeSource)]
firstMatchInSources Key
k [SomeSource]
fetcherSources

  let ([Either ConfigError (Value, Text)]
maybeValues, [SomeSource]
sources) = [(Either ConfigError (Value, Text), SomeSource)]
-> ([Either ConfigError (Value, Text)], [SomeSource])
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzip [(Either ConfigError (Value, Text), SomeSource)]
stuff

  let values :: [Either ConfigError (a, [Origin])]
values = [Either ConfigError (Value, Text)]
maybeValues [Either ConfigError (Value, Text)]
-> (Either ConfigError (Value, Text)
    -> Either ConfigError (a, [Origin]))
-> [Either ConfigError (a, [Origin])]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Right (Value
val, Text
text) -> forall a. ConfigValue a => Value -> Either ConfigError a
fromConfig @a Value
val Either ConfigError a
-> (a -> (a, [Origin])) -> Either ConfigError (a, [Origin])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\a
a -> (a
a, [a -> Text -> Origin
forall a. ConfigValue a => a -> Text -> Origin
Origin a
a Text
text]))
        Left ConfigError
e -> ConfigError -> Either ConfigError (a, [Origin])
forall a b. a -> Either a b
Left ConfigError
e

  (Maybe a, [Origin])
val <- case (Either ConfigError (a, [Origin]) -> (a, [Origin]))
-> [Either ConfigError (a, [Origin])] -> [(a, [Origin])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Right (a, [Origin])
a) -> (a, [Origin])
a) ([Either ConfigError (a, [Origin])] -> [(a, [Origin])])
-> [Either ConfigError (a, [Origin])] -> [(a, [Origin])]
forall a b. (a -> b) -> a -> b
$ (Either ConfigError (a, [Origin]) -> Bool)
-> [Either ConfigError (a, [Origin])]
-> [Either ConfigError (a, [Origin])]
forall a. (a -> Bool) -> [a] -> [a]
filter Either ConfigError (a, [Origin]) -> Bool
forall a b. Either a b -> Bool
isRight [Either ConfigError (a, [Origin])]
values of
    [] -> (Maybe a, [Origin]) -> IO (Maybe a, [Origin])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a
forall a. Maybe a
Nothing, [])
    (a
value, [Origin]
origin):[(a, [Origin])]
_ -> (Maybe a, [Origin]) -> IO (Maybe a, [Origin])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
value, [Origin]
origin)

  (Maybe a, FetcherState) -> IO (Maybe a, FetcherState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe a, [Origin]) -> Maybe a
forall a b. (a, b) -> a
fst (Maybe a, [Origin])
val, FetcherState
s1 { fetcherSources = sources
                    , fetcherOrigins = M.insertWith (<>) k (snd val) fetcherOrigins })

-- | read in a config value, and produce an error if it is not present.
readRequiredValue :: ConfigValue a => Key -> Fetch a
readRequiredValue :: forall a. ConfigValue a => Key -> Fetch a
readRequiredValue Key
k =
  let
    Fetch FetcherState -> IO (Maybe a, FetcherState)
m = Key -> Fetch (Maybe a)
forall a. ConfigValue a => Key -> Fetch (Maybe a)
readOptionalValue Key
k
  in
    (FetcherState -> IO (a, FetcherState)) -> Fetch a
forall a. (FetcherState -> IO (a, FetcherState)) -> Fetch a
Fetch (FetcherState -> IO (Maybe a, FetcherState)
m (FetcherState -> IO (Maybe a, FetcherState))
-> ((Maybe a, FetcherState) -> IO (a, FetcherState))
-> FetcherState
-> IO (a, FetcherState)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\(Maybe a
a, FetcherState
s) -> case Maybe a
a of
      Maybe a
Nothing ->
        let
          dummy :: a
dummy = String -> a
forall a. HasCallStack => String -> a
error String
"A nonexisting config value was evaluated. This is a bug."
        in
          (a, FetcherState) -> IO (a, FetcherState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
forall {a}. a
dummy, FetcherState
s { fetcherErrors = NotPresent (k `prefixedWith` fetcherPrefix s) : fetcherErrors s })
      Just a
v -> (a, FetcherState) -> IO (a, FetcherState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
v, FetcherState
s)))

-- | read in a config value, or give the given default value if it is not present.
readValue :: forall a. ConfigValue a => a -> Key -> Fetch a
readValue :: forall a. ConfigValue a => a -> Key -> Fetch a
readValue a
defaultValue Key
k =
  let
    Fetch FetcherState -> IO (Maybe a, FetcherState)
m = forall a. ConfigValue a => Key -> Fetch (Maybe a)
readOptionalValue @a Key
k
  in
    (FetcherState -> IO (a, FetcherState)) -> Fetch a
forall a. (FetcherState -> IO (a, FetcherState)) -> Fetch a
Fetch (FetcherState -> IO (Maybe a, FetcherState)
m (FetcherState -> IO (Maybe a, FetcherState))
-> ((Maybe a, FetcherState) -> IO (a, FetcherState))
-> FetcherState
-> IO (a, FetcherState)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\(Maybe a
a, FetcherState
s) -> case Maybe a
a of
      Just a
val -> (a, FetcherState) -> IO (a, FetcherState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
val, FetcherState
s)
      Maybe a
Nothing ->
        let
          origins :: Map Key [Origin]
origins = ([Origin] -> [Origin] -> [Origin])
-> Key -> [Origin] -> Map Key [Origin] -> Map Key [Origin]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [Origin] -> [Origin] -> [Origin]
forall a. Semigroup a => a -> a -> a
(<>)
            (Key
k Key -> [Text] -> Key
`prefixedWith` FetcherState -> [Text]
fetcherPrefix FetcherState
s)
            [a -> Text -> Origin
forall a. ConfigValue a => a -> Text -> Origin
Origin a
defaultValue Text
"default value"]
            (FetcherState -> Map Key [Origin]
fetcherOrigins FetcherState
s)
        in
          (a, FetcherState) -> IO (a, FetcherState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
defaultValue, FetcherState
s { fetcherOrigins = origins })))

firstMatchInSources :: Key -> [SomeSource] -> IO [(Either ConfigError (Value, Text), SomeSource)]
firstMatchInSources :: Key
-> [SomeSource]
-> IO [(Either ConfigError (Value, Text), SomeSource)]
firstMatchInSources Key
_ [] = [(Either ConfigError (Value, Text), SomeSource)]
-> IO [(Either ConfigError (Value, Text), SomeSource)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
firstMatchInSources Key
k (SomeSource (source
source, SourceState source
sourceState):[SomeSource]
sources) = do
  (Either ConfigError (Value, Text)
eitherValue, SourceState source
newState) <- StateT (SourceState source) IO (Either ConfigError (Value, Text))
-> SourceState source
-> IO (Either ConfigError (Value, Text), SourceState source)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Key
-> source
-> StateT
     (SourceState source) IO (Either ConfigError (Value, Text))
forall s.
ConfigSource s =>
Key
-> s
-> StateT (SourceState s) IO (Either ConfigError (Value, Text))
fetchValue Key
k source
source) SourceState source
sourceState

  case Either ConfigError (Value, Text)
eitherValue of
    Left ConfigError
_ -> do
      Key
-> [SomeSource]
-> IO [(Either ConfigError (Value, Text), SomeSource)]
firstMatchInSources Key
k [SomeSource]
sources
        IO [(Either ConfigError (Value, Text), SomeSource)]
-> ([(Either ConfigError (Value, Text), SomeSource)]
    -> [(Either ConfigError (Value, Text), SomeSource)])
-> IO [(Either ConfigError (Value, Text), SomeSource)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\[(Either ConfigError (Value, Text), SomeSource)]
a -> (Either ConfigError (Value, Text)
eitherValue, (source, SourceState source) -> SomeSource
forall source.
ConfigSource source =>
(source, SourceState source) -> SomeSource
SomeSource (source
source, SourceState source
newState)) (Either ConfigError (Value, Text), SomeSource)
-> [(Either ConfigError (Value, Text), SomeSource)]
-> [(Either ConfigError (Value, Text), SomeSource)]
forall a. a -> [a] -> [a]
: [(Either ConfigError (Value, Text), SomeSource)]
a)
    Right (Value, Text)
_ ->
      [(Either ConfigError (Value, Text), SomeSource)]
-> IO [(Either ConfigError (Value, Text), SomeSource)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Either ConfigError (Value, Text), SomeSource)]
 -> IO [(Either ConfigError (Value, Text), SomeSource)])
-> [(Either ConfigError (Value, Text), SomeSource)]
-> IO [(Either ConfigError (Value, Text), SomeSource)]
forall a b. (a -> b) -> a -> b
$ (Either ConfigError (Value, Text)
eitherValue, (source, SourceState source) -> SomeSource
forall source.
ConfigSource source =>
(source, SourceState source) -> SomeSource
SomeSource (source
source, SourceState source
newState)) (Either ConfigError (Value, Text), SomeSource)
-> [(Either ConfigError (Value, Text), SomeSource)]
-> [(Either ConfigError (Value, Text), SomeSource)]
forall a. a -> [a] -> [a]
: (SomeSource -> (Either ConfigError (Value, Text), SomeSource))
-> [SomeSource] -> [(Either ConfigError (Value, Text), SomeSource)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ConfigError -> Either ConfigError (Value, Text)
forall a b. a -> Either a b
Left ConfigError
Shadowed ,) [SomeSource]
sources

-- | read a nested set of configuration values, prefixed by a given key. This
-- corresponds to nested objects in json.
readNested :: forall a. Config a => Key -> Fetch a
readNested :: forall a. Config a => Key -> Fetch a
readNested (Key NonEmpty Text
prefix') = (FetcherState -> IO (a, FetcherState)) -> Fetch a
forall a. (FetcherState -> IO (a, FetcherState)) -> Fetch a
Fetch ((FetcherState -> IO (a, FetcherState)) -> Fetch a)
-> (FetcherState -> IO (a, FetcherState)) -> Fetch a
forall a b. (a -> b) -> a -> b
$ \FetcherState
s1 -> do
  let (Fetch FetcherState -> IO (a, FetcherState)
nested) = forall a. Config a => Fetch a
readConfig @a
  (a
config, FetcherState
s2) <- FetcherState -> IO (a, FetcherState)
nested (FetcherState
s1 { fetcherPrefix = fetcherPrefix s1 <> NonEmpty.toList prefix' })
  (a, FetcherState) -> IO (a, FetcherState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
config, FetcherState
s2 { fetcherPrefix = fetcherPrefix s1 })

-- | 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.
readNestedOptional :: forall a. (Show a, Config a) => Key -> Fetch (Maybe a)
readNestedOptional :: forall a. (Show a, Config a) => Key -> Fetch (Maybe a)
readNestedOptional (Key NonEmpty Text
prefix) = (FetcherState -> IO (Maybe a, FetcherState)) -> Fetch (Maybe a)
forall a. (FetcherState -> IO (a, FetcherState)) -> Fetch a
Fetch ((FetcherState -> IO (Maybe a, FetcherState)) -> Fetch (Maybe a))
-> (FetcherState -> IO (Maybe a, FetcherState)) -> Fetch (Maybe a)
forall a b. (a -> b) -> a -> b
$ \FetcherState
s1 -> do
  let (Fetch FetcherState -> IO (a, FetcherState)
nested) = forall a. Config a => Fetch a
readConfig @a
  let nestedState :: FetcherState
nestedState = FetcherState
s1
       { fetcherPrefix = fetcherPrefix s1 <> NonEmpty.toList prefix
       , fetcherOrigins = [] -- pass an empy list so we can check if at least one element was present
       , fetcherErrors = []
       }

  (a
config, FetcherState
s2) <- FetcherState -> IO (a, FetcherState)
nested FetcherState
nestedState

  let origins :: Map Key [Origin]
origins = FetcherState -> Map Key [Origin]
fetcherOrigins FetcherState
s1 Map Key [Origin] -> Map Key [Origin] -> Map Key [Origin]
forall a. Semigroup a => a -> a -> a
<> FetcherState -> Map Key [Origin]
fetcherOrigins FetcherState
s2

  -- none of the keys present? then return Nothing & produce no errors
  if Map Key [Origin] -> Int
forall a. Map Key a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FetcherState -> Map Key [Origin]
fetcherOrigins FetcherState
s2) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [ConfigError] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((ConfigError -> Bool) -> [ConfigError] -> [ConfigError]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case {NotPresent Key
_ -> Bool
True; ConfigError
_ -> Bool
False}) (FetcherState -> [ConfigError]
fetcherErrors FetcherState
s2))
     Bool -> Bool -> Bool
&& Map Key [Origin] -> Int
forall a. Map Key a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FetcherState -> Map Key [Origin]
fetcherOrigins FetcherState
s2) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [ConfigError] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FetcherState -> [ConfigError]
fetcherErrors FetcherState
s2) then
    (Maybe a, FetcherState) -> IO (Maybe a, FetcherState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a
forall a. Maybe a
Nothing, FetcherState
s2 { fetcherPrefix = fetcherPrefix s1, fetcherErrors = fetcherErrors s1, fetcherOrigins = fetcherOrigins s1 })
  else
    -- any other errors? if so, forward those
    if Bool -> Bool
not ([ConfigError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FetcherState -> [ConfigError]
fetcherErrors FetcherState
s2)) then
      (Maybe a, FetcherState) -> IO (Maybe a, FetcherState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a
forall a. Maybe a
Nothing, FetcherState
s2 { fetcherPrefix = fetcherPrefix s1
                        , fetcherOrigins = origins
                        , fetcherErrors = fetcherErrors s2 <> fetcherErrors s1
                        })
    else
      -- success!
      (Maybe a, FetcherState) -> IO (Maybe a, FetcherState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
config, FetcherState
s2 { fetcherPrefix = fetcherPrefix s1
                            , fetcherOrigins = origins
                            })


collectUnused :: [SomeSource] -> IO [Warning]
collectUnused :: [SomeSource] -> IO [Warning]
collectUnused [SomeSource]
sources = do
  [SomeSource]
-> (SomeSource -> IO (Maybe [Key])) -> IO [Maybe [Key]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SomeSource]
sources (\(SomeSource (source
source, SourceState source
sourceState)) ->
    StateT (SourceState source) IO (Maybe [Key])
-> SourceState source -> IO (Maybe [Key], SourceState source)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (source -> StateT (SourceState source) IO (Maybe [Key])
forall s.
ConfigSource s =>
s -> StateT (SourceState s) IO (Maybe [Key])
leftovers source
source) SourceState source
sourceState IO (Maybe [Key], SourceState source)
-> ((Maybe [Key], SourceState source) -> Maybe [Key])
-> IO (Maybe [Key])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Maybe [Key], SourceState source) -> Maybe [Key]
forall a b. (a, b) -> a
fst)
    IO [Maybe [Key]] -> ([Maybe [Key]] -> [Warning]) -> IO [Warning]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Maybe [Key] -> Warning) -> [Maybe [Key]] -> [Warning]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Just [Key]
a) -> Text -> Warning
Warning (Text -> Warning) -> Text -> Warning
forall a b. (a -> b) -> a -> b
$ Text
"Unused Keys " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ([Key] -> String
forall a. Show a => a -> String
show [Key]
a))
        ([Maybe [Key]] -> [Warning])
-> ([Maybe [Key]] -> [Maybe [Key]]) -> [Maybe [Key]] -> [Warning]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [Key] -> Bool) -> [Maybe [Key]] -> [Maybe [Key]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Just [Key]
a) -> Bool -> Bool
not ([Key] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Key]
a))
        ([Maybe [Key]] -> [Maybe [Key]])
-> ([Maybe [Key]] -> [Maybe [Key]])
-> [Maybe [Key]]
-> [Maybe [Key]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [Key] -> Bool) -> [Maybe [Key]] -> [Maybe [Key]]
forall a. (a -> Bool) -> [a] -> [a]
filter Maybe [Key] -> Bool
forall a. Maybe a -> Bool
isJust


{- $use

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
'Conftrack.Source.Yaml.mkYamlFileSource' and 'Conftrack.Source.Env.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.
-}