1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE LambdaCase #-}
module Conftrack
( Config(..)
, Warning(..)
, runFetchConfig
, readValue
, readOptionalValue
, readRequiredValue
, readNested
, SomeSource
, ConfigError(..)
, Key(..)
, Value(..)
) where
import Conftrack.Value (ConfigError(..), ConfigValue(..), Key (..), Origin(..), Value(..), KeyPart, prefixedWith)
import Conftrack.Source (SomeSource (..), ConfigSource (..))
import Prelude hiding (unzip)
import Control.Monad.State (get, StateT (..), MonadState (..), modify)
import Data.Functor ((<&>))
import Control.Monad.Reader (MonadIO (liftIO))
import Data.List.NonEmpty (NonEmpty, unzip)
import qualified Data.List.NonEmpty as NonEmpty
import Control.Monad (forM, foldM)
import Data.Either (isRight)
import Control.Monad.Trans.Except (ExceptT(..), runExceptT, throwE)
import Control.Monad.Trans (lift)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Maybe (isJust)
class Config a where
readConfig :: FetchMonad a
type FetchMonad = StateT (NonEmpty SomeSource, [KeyPart], [Origin], [Warning]) (ExceptT [ConfigError] IO)
newtype Warning = Warning Text
deriving Show
runFetchConfig :: Config a => NonEmpty SomeSource -> IO (Either [ConfigError] (a, [Origin], [Warning]))
runFetchConfig sources = do
results <- runExceptT $ runStateT readConfig (sources, [], [], [])
case results of
Left a -> pure $ Left a
Right (result, (sources, _prefix, origins, warnings)) -> do
unusedWarnings <- collectUnused sources
pure $ Right (result, origins, unusedWarnings <> warnings)
readOptionalValue :: ConfigValue a => Key -> FetchMonad (Maybe a)
readOptionalValue bareKey = do
(sources, prefix, origins, warnings) <- get
let key = bareKey `prefixedWith` prefix
stuff <- liftIO $ firstMatchInSources key (NonEmpty.toList sources) <&> NonEmpty.fromList
let (maybeValues, states) = unzip stuff
let values = maybeValues <&> \case
Right (val, text) -> fromConfig val <&> (\val -> (val, Origin key text))
Left e -> Left e
val <- case fmap (\(Right a) -> a) $ NonEmpty.filter isRight values of
[] -> pure (Nothing, Origin key "default value")
(value, origin):_ -> pure (Just value, origin)
put (states, prefix, snd val : origins, warnings)
pure (fst val)
readRequiredValue :: ConfigValue a => Key -> FetchMonad a
readRequiredValue key =
readOptionalValue key >>= \case
Nothing -> lift $ throwE [NotPresent key]
Just a -> pure a
readValue :: ConfigValue a => a -> Key -> FetchMonad a
readValue defaultValue key =
readOptionalValue key >>= \case
Just a -> pure a
Nothing -> do
modify (\(states, prefix, origins, warnings) ->
(states, prefix, Origin key "default value" : origins, warnings))
pure defaultValue
firstMatchInSources :: Key -> [SomeSource] -> IO [(Either ConfigError (Value, Text), SomeSource)]
firstMatchInSources _ [] = pure []
firstMatchInSources key (SomeSource (source, sourceState):sources) = do
(eitherValue, newState) <- runStateT (fetchValue key source) sourceState
case eitherValue of
Left _ -> do
firstMatchInSources key sources
<&> (\a -> (eitherValue, SomeSource (source, newState)) : a)
Right _ ->
pure $ (eitherValue, SomeSource (source, newState)) : fmap (Left Shadowed ,) sources
readNested :: forall a. Config a => Key -> FetchMonad a
readNested (Key prefix') = do
prefix <- state (\(sources, prefix, origins, warnings) ->
(prefix, (sources, prefix <> NonEmpty.toList prefix', origins, warnings)))
config <- readConfig
modify (\(sources, _, origins, warnings) -> (sources, prefix, origins, warnings))
pure config
collectUnused :: NonEmpty SomeSource -> IO [Warning]
collectUnused sources = do
forM sources (\(SomeSource (source, sourceState)) ->
runStateT (leftovers source) sourceState <&> fst)
<&> fmap (\(Just a) -> Warning $ "Unused Keys " <> T.pack (show a))
. filter (\(Just a) -> not (null a))
. NonEmpty.filter isJust
|
