summaryrefslogtreecommitdiff
path: root/src/Conftrack/Source.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Conftrack/Source.hs')
-rw-r--r--src/Conftrack/Source.hs46
1 files changed, 46 insertions, 0 deletions
diff --git a/src/Conftrack/Source.hs b/src/Conftrack/Source.hs
new file mode 100644
index 0000000..df6f82c
--- /dev/null
+++ b/src/Conftrack/Source.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE ImpredicativeTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Conftrack.Source (ConfigSource(..), SomeSource(..), Trivial(..)) where
+
+import Conftrack.Value (Key, Value(..), ConfigError(..), Origin)
+
+import Control.Monad.State (get, modify, StateT (..), MonadState (..))
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+import Data.Function ((&))
+import Data.Text (Text)
+import qualified Data.Text as T
+
+
+class ConfigSource s where
+ type ConfigState s
+ fetchValue :: Key -> s -> StateT (ConfigState s) IO (Either ConfigError (Value, Text))
+ leftovers :: s -> StateT (ConfigState s) IO (Maybe [Key])
+
+data SomeSource = forall source. ConfigSource source
+ => SomeSource (source, ConfigState source)
+
+
+newtype Trivial = Trivial (Map Key Value)
+
+instance ConfigSource Trivial where
+ type ConfigState 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