summaryrefslogtreecommitdiff
path: root/src/Conftrack.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Conftrack.hs')
-rw-r--r--src/Conftrack.hs29
1 files changed, 15 insertions, 14 deletions
diff --git a/src/Conftrack.hs b/src/Conftrack.hs
index fd718d4..b272e3f 100644
--- a/src/Conftrack.hs
+++ b/src/Conftrack.hs
@@ -7,6 +7,7 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Conftrack
( Config(..)
@@ -86,9 +87,9 @@ runFetchConfig sources = do
configKeysOf :: forall a. Config a => IO [Key]
configKeysOf = do
let (Fetch m) = readConfig @a
- (_, FetcherState _ _ origins warnings errors) <- m (FetcherState [] [] [] [] [])
+ (_, FetcherState _ _ _ _ errors) <- m (FetcherState [] [] [] [] [])
- let keys = mapMaybe (\case {(NotPresent key) -> Just key; _ -> Nothing }) errors
+ let keys = mapMaybe (\case {(NotPresent k) -> Just k; _ -> Nothing }) errors
pure keys
@@ -96,9 +97,9 @@ configKeysOf = do
readOptionalValue :: forall a. ConfigValue a => Key -> Fetch (Maybe a)
readOptionalValue bareKey = Fetch $ \s1@FetcherState{..} -> do
- let key = bareKey `prefixedWith` fetcherPrefix
+ let k = bareKey `prefixedWith` fetcherPrefix
- stuff <- firstMatchInSources key fetcherSources
+ stuff <- firstMatchInSources k fetcherSources
let (maybeValues, sources) = unzip stuff
@@ -111,33 +112,33 @@ readOptionalValue bareKey = Fetch $ \s1@FetcherState{..} -> do
(value, origin):_ -> pure (Just value, origin)
pure (fst val, s1 { fetcherSources = sources
- , fetcherOrigins = M.insertWith (<>) key (snd val) fetcherOrigins })
+ , fetcherOrigins = M.insertWith (<>) k (snd val) fetcherOrigins })
readRequiredValue :: ConfigValue a => Key -> Fetch a
-readRequiredValue key =
+readRequiredValue k =
let
- Fetch m = readOptionalValue key
+ Fetch m = readOptionalValue k
in
Fetch (m >=> (\(a, s) -> case a of
Nothing ->
let
dummy = error "A nonexisting config value was evaluated. This is a bug."
in
- pure (dummy, s { fetcherErrors = NotPresent (key `prefixedWith` fetcherPrefix s) : fetcherErrors s })
+ pure (dummy, s { fetcherErrors = NotPresent (k `prefixedWith` fetcherPrefix s) : fetcherErrors s })
Just v -> pure (v, s)))
readValue :: forall a. ConfigValue a => a -> Key -> Fetch a
-readValue defaultValue key =
+readValue defaultValue k =
let
- Fetch m = readOptionalValue @a key
+ Fetch m = readOptionalValue @a k
in
Fetch (m >=> (\(a, s) -> case a of
Just val -> pure (val, s)
Nothing ->
let
origins = M.insertWith (<>)
- (key `prefixedWith` fetcherPrefix s)
+ (k `prefixedWith` fetcherPrefix s)
[Origin defaultValue "default value"]
(fetcherOrigins s)
in
@@ -145,12 +146,12 @@ readValue defaultValue key =
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
+firstMatchInSources k (SomeSource (source, sourceState):sources) = do
+ (eitherValue, newState) <- runStateT (fetchValue k source) sourceState
case eitherValue of
Left _ -> do
- firstMatchInSources key sources
+ firstMatchInSources k sources
<&> (\a -> (eitherValue, SomeSource (source, newState)) : a)
Right _ ->
pure $ (eitherValue, SomeSource (source, newState)) : fmap (Left Shadowed ,) sources