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 +++++++++++++++--------------
 1 file changed, 15 insertions(+), 14 deletions(-)

(limited to 'src/Conftrack.hs')

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
-- 
cgit v1.2.3