diff options
author | stuebinm | 2024-07-04 18:09:13 +0200 |
---|---|---|
committer | stuebinm | 2024-07-04 18:09:13 +0200 |
commit | 234f3daa1439ace3db0cf2dbb92b83476afddd37 (patch) | |
tree | 2d6d551a75f5098c1e1bbd593ff4c1c3645aeac7 /src/Conftrack.hs | |
parent | 3e71d0ab05c7f5fd71a75b86eeac6f8a1edc3a44 (diff) |
fix a couple warnings
Diffstat (limited to '')
-rw-r--r-- | src/Conftrack.hs | 29 |
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 |