nested values, tests, and aeson

1 files changed, 41 insertions, 0 deletions

diff --git a/src/Conftrack/Source/Trivial.hs b/src/Conftrack/Source/Trivial.hs
new file mode 100644
index 0000000..bb06e77
--- /dev/null
+++ b/src/Conftrack/Source/Trivial.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE ImpredicativeTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Conftrack.Source.Trivial where
+
+import Conftrack.Value (Key, Value(..), ConfigError(..), Origin)
+import Conftrack.Source (SomeSource(..), ConfigSource (..))
+
+import Control.Monad.State (get, modify, StateT (..), MonadState (..))
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+import Data.Function ((&))
+import qualified Data.Text as T
+
+
+newtype Trivial = Trivial (Map Key Value)
+
+mkTrivialSource :: [(Key, Value)] -> SomeSource
+mkTrivialSource pairs = SomeSource (source, [])
+  where source = Trivial (M.fromList pairs)
+
+instance ConfigSource Trivial where
+  type SourceState Trivial = [Key]
+  fetchValue key (Trivial tree) = do
+    case M.lookup key tree of
+      Nothing -> pure $ Left NotPresent
+      Just val -> do
+        modify (key :)
+        pure $ Right (val, "Trivial source with keys "<> T.pack (show (M.keys tree)))
+
+  leftovers (Trivial tree) = do
+    used <- get
+
+    M.keys tree
+     & filter (`notElem` used)
+     & Just
+     & pure