From 234f3daa1439ace3db0cf2dbb92b83476afddd37 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 4 Jul 2024 18:09:13 +0200
Subject: fix a couple warnings

---
 src/Conftrack.hs                | 29 +++++++++++++++--------------
 src/Conftrack/Pretty.hs         |  4 +---
 src/Conftrack/Source/Trivial.hs |  4 ++--
 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
-- 
cgit v1.2.3