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
|
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE LambdaCase #-}
module Conftrack where
import Conftrack.Value (ConfigError(..), ConfigValue(..), Key, Origin(..))
import Conftrack.Source (SomeSource (..), ConfigSource (..))
import Prelude hiding (unzip)
import Control.Monad.State (get, StateT (..), MonadState (..), gets)
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)
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, [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, origins, warnings)) -> do
unusedWarnings <- collectUnused sources
pure $ Right (result, origins, unusedWarnings <> warnings)
readValue :: ConfigValue a => Key -> FetchMonad a
readValue key = do
(sources, origins, warnings) <- get
-- TODO: this should short-curcuit here (so we have correct unused key sets)
stuff <- liftIO $ forM sources $ \(SomeSource (source, sourceState)) -> do
(eitherValue, newState) <- runStateT (fetchValue key source) sourceState
pure (eitherValue, SomeSource (source, newState))
let (maybeValues, states) = Data.List.NonEmpty.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
[] -> lift $ throwE [NotPresent]
val:_ -> pure val
put (states, snd val : origins, warnings)
pure (fst val)
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))
. NonEmpty.filter isJust
|
