allow for non-required config options

2 files changed, 23 insertions, 7 deletions

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 []
diff --git a/test/Main.hs b/test/Main.hs
index 99b01d8..5c01f64 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -31,12 +31,12 @@ instance Arbitrary TestNested where
 
 instance Config TestFlat where
   readConfig = TestType
-    <$> readValue (Key ["foo"])
-    <*> readValue (Key ["bar"])
+    <$> readRequiredValue (Key ["foo"])
+    <*> readRequiredValue (Key ["bar"])
 
 instance Config TestNested where
   readConfig = TestNested
-    <$> readValue (Key ["foo"])
+    <$> readRequiredValue (Key ["foo"])
     <*> readNested (Key ["nested"])
 
 testTypeToTrivial :: TestFlat -> SomeSource