summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorstuebinm2024-07-04 18:09:13 +0200
committerstuebinm2024-07-04 18:09:13 +0200
commit234f3daa1439ace3db0cf2dbb92b83476afddd37 (patch)
tree2d6d551a75f5098c1e1bbd593ff4c1c3645aeac7
parent3e71d0ab05c7f5fd71a75b86eeac6f8a1edc3a44 (diff)
fix a couple warnings
-rw-r--r--src/Conftrack.hs29
-rw-r--r--src/Conftrack/Pretty.hs4
-rw-r--r--src/Conftrack/Source/Trivial.hs4
-rw-r--r--src/Conftrack/Value.hs2
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