diff options
Diffstat (limited to '')
| -rw-r--r-- | src/Conftrack.hs | 35 |
1 files changed, 27 insertions, 8 deletions
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] |