From d7a53eb0a8195e50f54f850fdd6421b4f149f0ed Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Wed, 10 Jul 2024 15:56:15 +0200
Subject: handle partially present optional nestings

these would previously silently fail and simply produce a Nothing if
only some (but not all) of the nested keys were present. This is not
reasonable behaviour that anyone would expect; whenever a nested key
is present, absence of another should be an error (the same goes for
any other errors in that key's definition).
---
 src/Conftrack.hs | 35 +++++++++++++++++++++++++++--------
 1 file changed, 27 insertions(+), 8 deletions(-)

(limited to 'src')

diff --git a/src/Conftrack.hs b/src/Conftrack.hs
index b272e3f..e1652b1 100644
--- a/src/Conftrack.hs
+++ b/src/Conftrack.hs
@@ -162,16 +162,35 @@ readNested (Key prefix') = Fetch $ \s1 -> do
   (config, s2) <- nested (s1 { fetcherPrefix = fetcherPrefix s1 <> NonEmpty.toList prefix' })
   pure (config, s2 { fetcherPrefix = fetcherPrefix s1 })
 
-readNestedOptional :: forall a. Config a => Key -> Fetch (Maybe a)
+readNestedOptional :: forall a. (Show a, Config a) => Key -> Fetch (Maybe a)
 readNestedOptional (Key prefix) = Fetch $ \s1 -> do
   let (Fetch nested) = readConfig @a
-  (config, s2) <- nested (s1 { fetcherPrefix = fetcherPrefix s1 <> NonEmpty.toList prefix })
-
-  if null (fetcherErrors s2)
-    then pure (Just config, s2 { fetcherPrefix = fetcherPrefix s1 })
-    -- TODO: resetting errors like this makes configKeysOf less useful. Perhaps move nested errors to warnings?
-    else pure (Nothing, s2 { fetcherPrefix = fetcherPrefix s1
-                           , fetcherErrors = fetcherErrors s1 })
+  let nestedState = s1
+       { fetcherPrefix = fetcherPrefix s1 <> NonEmpty.toList prefix
+       , fetcherOrigins = [] -- pass an empy list so we can check if at least one element was present
+       , fetcherErrors = []
+       }
+
+  (config, s2) <- nested nestedState
+
+  let origins = fetcherOrigins s1 <> fetcherOrigins s2
+
+  -- none of the keys present? then return Nothing & produce no errors
+  if length (fetcherOrigins s2) == length (filter (\case {NotPresent _ -> True; _ -> False}) (fetcherErrors s2))
+     && length (fetcherOrigins s2) == length (fetcherErrors s2) then
+    pure (Nothing, s2 { fetcherPrefix = fetcherPrefix s1, fetcherErrors = fetcherErrors s1, fetcherOrigins = fetcherOrigins s1 })
+  else
+    -- any other errors? if so, forward those
+    if not (null (fetcherErrors s2)) then
+      pure (Nothing, s2 { fetcherPrefix = fetcherPrefix s1
+                        , fetcherOrigins = origins
+                        , fetcherErrors = fetcherErrors s2 <> fetcherErrors s1
+                        })
+    else
+      -- success!
+      pure (Just config, s2 { fetcherPrefix = fetcherPrefix s1
+                            , fetcherOrigins = origins
+                            })
 
 
 collectUnused :: [SomeSource] -> IO [Warning]
-- 
cgit v1.2.3