diff options
Diffstat (limited to 'src/Conftrack')
-rw-r--r-- | src/Conftrack/Source.hs | 46 | ||||
-rw-r--r-- | src/Conftrack/Value.hs | 38 |
2 files changed, 84 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 diff --git a/src/Conftrack/Value.hs b/src/Conftrack/Value.hs new file mode 100644 index 0000000..c5768cc --- /dev/null +++ b/src/Conftrack/Value.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + +module Conftrack.Value (Value(..), ConfigError(..), Key(..), ConfigValue(..), Origin(..)) where + +import Data.Text(Text) +import Data.List.NonEmpty (NonEmpty) + +data Value = + ConfigText Text + | ConfigInteger Integer + | ConfigOther Text Text + deriving Show + +newtype Key = Key (NonEmpty Text) + deriving newtype (Eq, Ord, Show) + +data ConfigError = + ParseError + | NotPresent + deriving Show + +class ConfigValue a where + fromConfig :: Value -> Either ConfigError a + +data Origin = Origin Key Text + deriving Show + +instance ConfigValue Text where + fromConfig (ConfigText a) = Right a + fromConfig _ = Left ParseError + +instance ConfigValue Integer where + fromConfig (ConfigInteger a) = Right a + fromConfig _ = Left ParseError |