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 | |
parent | 3e71d0ab05c7f5fd71a75b86eeac6f8a1edc3a44 (diff) |
fix a couple warnings
-rw-r--r-- | src/Conftrack.hs | 29 | ||||
-rw-r--r-- | src/Conftrack/Pretty.hs | 4 | ||||
-rw-r--r-- | src/Conftrack/Source/Trivial.hs | 4 | ||||
-rw-r--r-- | src/Conftrack/Value.hs | 2 |
4 files changed, 19 insertions, 20 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 diff --git a/src/Conftrack/Pretty.hs b/src/Conftrack/Pretty.hs index 8a11204..cf10b20 100644 --- a/src/Conftrack/Pretty.hs +++ b/src/Conftrack/Pretty.hs @@ -3,14 +3,12 @@ module Conftrack.Pretty where -import Conftrack.Value (Origin (..), ConfigError, ConfigValue (..)) +import Conftrack.Value (Origin(..), ConfigError, ConfigValue(..), Key) import Conftrack (Warning) import Data.Map (Map) -import Conftrack.Value (Key) import qualified Data.Map.Strict as M import qualified Data.Text.IO as T import qualified Data.Text as T -import Data.List (sortOn) import GHC.Exts (groupWith) diff --git a/src/Conftrack/Source/Trivial.hs b/src/Conftrack/Source/Trivial.hs index ff22ee9..d4151c2 100644 --- a/src/Conftrack/Source/Trivial.hs +++ b/src/Conftrack/Source/Trivial.hs @@ -7,10 +7,10 @@ module Conftrack.Source.Trivial where -import Conftrack.Value (Key, Value(..), ConfigError(..), Origin) +import Conftrack.Value (Key, Value(..), ConfigError(..)) import Conftrack.Source (SomeSource(..), ConfigSource (..)) -import Control.Monad.State (get, modify, StateT (..), MonadState (..)) +import Control.Monad.State (get, modify, MonadState (..)) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Function ((&)) diff --git a/src/Conftrack/Value.hs b/src/Conftrack/Value.hs index 50e4e30..3eda24a 100644 --- a/src/Conftrack/Value.hs +++ b/src/Conftrack/Value.hs @@ -48,7 +48,7 @@ key = QuasiQuoter prefixedWith :: Key -> [KeyPart] -> Key -prefixedWith (Key key) prefix = Key (prependList prefix key) +prefixedWith (Key k) prefix = Key (prependList prefix k) data ConfigError = ParseError Text |