nested values, tests, and aeson

1 files changed, 48 insertions, 18 deletions

diff --git a/src/Conftrack.hs b/src/Conftrack.hs
index 3003115..0f40048 100644
--- a/src/Conftrack.hs
+++ b/src/Conftrack.hs
@@ -7,18 +7,28 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE LambdaCase #-}
 
-module Conftrack  where
-
-import Conftrack.Value (ConfigError(..), ConfigValue(..), Key, Origin(..))
+module Conftrack
+  ( Config(..)
+  , Warning(..)
+  , runFetchConfig
+  , readValue
+  , readNested
+  , SomeSource
+  , ConfigError(..)
+  , Key(..)
+  , Value(..)
+  ) where
+
+import Conftrack.Value (ConfigError(..), ConfigValue(..), Key (..), Origin(..), Value(..), KeyPart, prefixedWith)
 import Conftrack.Source (SomeSource (..), ConfigSource (..))
 
 import Prelude hiding (unzip)
-import Control.Monad.State (get, StateT (..), MonadState (..), gets)
+import Control.Monad.State (get, StateT (..), MonadState (..), modify)
 import Data.Functor ((<&>))
 import Control.Monad.Reader (MonadIO (liftIO))
 import Data.List.NonEmpty (NonEmpty, unzip)
 import qualified Data.List.NonEmpty as NonEmpty
-import Control.Monad (forM)
+import Control.Monad (forM, foldM)
 import Data.Either (isRight)
 import Control.Monad.Trans.Except (ExceptT(..), runExceptT, throwE)
 import Control.Monad.Trans (lift)
@@ -30,31 +40,29 @@ import Data.Maybe (isJust)
 class Config a where
   readConfig :: FetchMonad a
 
-type FetchMonad = StateT (NonEmpty SomeSource, [Origin], [Warning]) (ExceptT [ConfigError] IO)
+type FetchMonad = StateT (NonEmpty SomeSource, [KeyPart], [Origin], [Warning]) (ExceptT [ConfigError] IO)
 
 newtype Warning = Warning Text
  deriving Show
 
 runFetchConfig :: Config a => NonEmpty SomeSource -> IO (Either [ConfigError] (a, [Origin], [Warning]))
 runFetchConfig sources = do
-  results <- runExceptT $ runStateT readConfig (sources, [], [])
-
+  results <- runExceptT $ runStateT readConfig (sources, [], [], [])
   case results of
     Left a -> pure $ Left a
-    Right (result, (sources, origins, warnings)) -> do
+    Right (result, (sources, _prefix, origins, warnings)) -> do
       unusedWarnings <- collectUnused sources
       pure $ Right (result, origins, unusedWarnings <> warnings)
 
 readValue :: ConfigValue a => Key -> FetchMonad a
-readValue key = do
-  (sources, origins, warnings) <- get
+readValue bareKey = do
+  (sources, prefix, origins, warnings) <- get
+
+  let key = bareKey `prefixedWith` prefix
 
-  -- TODO: this should short-curcuit here (so we have correct unused key sets)
-  stuff <- liftIO $ forM sources $ \(SomeSource (source, sourceState)) -> do
-    (eitherValue, newState) <- runStateT (fetchValue key source) sourceState
-    pure (eitherValue, SomeSource (source, newState))
+  stuff <- liftIO $ firstMatchInSources key (NonEmpty.toList sources) <&> NonEmpty.fromList
 
-  let (maybeValues, states) = Data.List.NonEmpty.unzip stuff
+  let (maybeValues, states) = unzip stuff
 
   let values = maybeValues <&> \case
         Right (val, text) -> fromConfig val <&> (\val -> (val, Origin key text))
@@ -64,13 +72,35 @@ readValue key = do
     [] -> lift $ throwE [NotPresent]
     val:_ -> pure val
 
-  put (states, snd val : origins, warnings)
-
+  put (states, prefix, snd val : origins, warnings)
   pure (fst val)
 
+
+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
+
+  case eitherValue of
+    Left _ -> do
+      firstMatchInSources key sources
+        <&> (\a -> (eitherValue, SomeSource (source, newState)) : a)
+    Right _ ->
+      pure $ (eitherValue, SomeSource (source, newState)) : fmap (Left Shadowed ,) sources
+
+
+readNested :: forall a. Config a => Key -> FetchMonad a
+readNested (Key prefix') = do
+  prefix <- state (\(sources, prefix, origins, warnings) ->
+                     (prefix, (sources, prefix <> NonEmpty.toList prefix', origins, warnings)))
+  config <- readConfig
+  modify (\(sources, _, origins, warnings) -> (sources, prefix, origins, warnings))
+  pure config
+
 collectUnused :: NonEmpty SomeSource -> IO [Warning]
 collectUnused sources = do
   forM sources (\(SomeSource (source, sourceState)) ->
     runStateT (leftovers source) sourceState <&> fst)
     <&> fmap (\(Just a) -> Warning $ "Unused Keys " <> T.pack (show a))
+        . filter (\(Just a) -> not (null a))
         . NonEmpty.filter isJust