summaryrefslogtreecommitdiff
path: root/src/Conftrack/Source/Trivial.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Conftrack/Source/Trivial.hs')
-rw-r--r--src/Conftrack/Source/Trivial.hs41
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