From 17631c7294ee21a48f78ce4e51c827da93b501fa Mon Sep 17 00:00:00 2001 From: stuebinm Date: Fri, 7 Jun 2024 17:22:08 +0200 Subject: allow for non-required config options --- src/Conftrack.hs | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/Conftrack.hs b/src/Conftrack.hs index d6e68e2..0d3ffdd 100644 --- a/src/Conftrack.hs +++ b/src/Conftrack.hs @@ -12,6 +12,8 @@ module Conftrack , Warning(..) , runFetchConfig , readValue + , readOptionalValue + , readRequiredValue , readNested , SomeSource , ConfigError(..) @@ -54,8 +56,8 @@ runFetchConfig sources = do unusedWarnings <- collectUnused sources pure $ Right (result, origins, unusedWarnings <> warnings) -readValue :: ConfigValue a => Key -> FetchMonad a -readValue bareKey = do +readOptionalValue :: ConfigValue a => Key -> FetchMonad (Maybe a) +readOptionalValue bareKey = do (sources, prefix, origins, warnings) <- get let key = bareKey `prefixedWith` prefix @@ -69,12 +71,26 @@ readValue bareKey = do Left e -> Left e val <- case fmap (\(Right a) -> a) $ NonEmpty.filter isRight values of - [] -> lift $ throwE [NotPresent key] - val:_ -> pure val + [] -> pure (Nothing, Origin key "default value") + (value, origin):_ -> pure (Just value, origin) put (states, prefix, snd val : origins, warnings) pure (fst val) +readRequiredValue :: ConfigValue a => Key -> FetchMonad a +readRequiredValue key = + readOptionalValue key >>= \case + Nothing -> lift $ throwE [NotPresent key] + Just a -> pure a + +readValue :: ConfigValue a => a -> Key -> FetchMonad a +readValue defaultValue key = + readOptionalValue key >>= \case + Just a -> pure a + Nothing -> do + modify (\(states, prefix, origins, warnings) -> + (states, prefix, Origin key "default value" : origins, warnings)) + pure defaultValue firstMatchInSources :: Key -> [SomeSource] -> IO [(Either ConfigError (Value, Text), SomeSource)] firstMatchInSources _ [] = pure [] -- cgit v1.2.3