summaryrefslogtreecommitdiff
path: root/src/Conftrack
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/Conftrack.hs2
-rw-r--r--src/Conftrack/Source/Trivial.hs2
-rw-r--r--src/Conftrack/Source/Yaml.hs42
-rw-r--r--src/Conftrack/Value.hs6
4 files changed, 49 insertions, 3 deletions
diff --git a/src/Conftrack.hs b/src/Conftrack.hs
index 0f40048..d6e68e2 100644
--- a/src/Conftrack.hs
+++ b/src/Conftrack.hs
@@ -69,7 +69,7 @@ readValue bareKey = do
Left e -> Left e
val <- case fmap (\(Right a) -> a) $ NonEmpty.filter isRight values of
- [] -> lift $ throwE [NotPresent]
+ [] -> lift $ throwE [NotPresent key]
val:_ -> pure val
put (states, prefix, snd val : origins, warnings)
diff --git a/src/Conftrack/Source/Trivial.hs b/src/Conftrack/Source/Trivial.hs
index bb06e77..ff22ee9 100644
--- a/src/Conftrack/Source/Trivial.hs
+++ b/src/Conftrack/Source/Trivial.hs
@@ -27,7 +27,7 @@ instance ConfigSource Trivial where
type SourceState Trivial = [Key]
fetchValue key (Trivial tree) = do
case M.lookup key tree of
- Nothing -> pure $ Left NotPresent
+ Nothing -> pure $ Left (NotPresent key)
Just val -> do
modify (key :)
pure $ Right (val, "Trivial source with keys "<> T.pack (show (M.keys tree)))
diff --git a/src/Conftrack/Source/Yaml.hs b/src/Conftrack/Source/Yaml.hs
new file mode 100644
index 0000000..6adc798
--- /dev/null
+++ b/src/Conftrack/Source/Yaml.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE ImpredicativeTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Conftrack.Source.Yaml (YamlSource(..), mkYamlSource, mkYamlSourceWith, mkYamlFileSource) where
+
+import Conftrack.Source (SomeSource(..), ConfigSource (..))
+import Conftrack.Source.Aeson
+
+import Prelude hiding (readFile)
+import qualified Data.Aeson as A
+import qualified Data.Yaml as Y
+import Data.Text (Text)
+import qualified Data.Aeson.Text as A
+import qualified Data.Text.Lazy as LT
+import Data.Functor ((<&>))
+import System.OsPath (OsPath)
+import qualified System.OsPath as OS
+import System.File.OsPath (readFile)
+import qualified Data.ByteString as BS
+
+newtype YamlSource = YamlSource JsonSource
+ deriving newtype (ConfigSource, Show)
+
+mkYamlSource :: A.Value -> SomeSource
+mkYamlSource value = mkYamlSourceWith ("Yaml string " <> LT.toStrict (A.encodeToLazyText value)) value
+
+mkYamlSourceWith :: Text -> A.Value -> SomeSource
+mkYamlSourceWith description value = SomeSource (source, [])
+ where source = YamlSource (JsonSource value description)
+
+mkYamlFileSource :: OsPath -> IO (Either Y.ParseException SomeSource)
+mkYamlFileSource path = do
+ bytes <- readFile path <&> BS.toStrict
+ pathAsText <- OS.decodeUtf path <&> LT.toStrict . LT.pack
+ pure $ Y.decodeEither' bytes
+ <&> mkYamlSourceWith ("YAML file " <> pathAsText)
+
diff --git a/src/Conftrack/Value.hs b/src/Conftrack/Value.hs
index f934d51..5c8d949 100644
--- a/src/Conftrack/Value.hs
+++ b/src/Conftrack/Value.hs
@@ -35,7 +35,7 @@ prefixedWith (Key key) prefix = Key (prependList prefix key)
data ConfigError =
ParseError Text
| TypeMismatch Text Value
- | NotPresent
+ | NotPresent Key
| Shadowed
deriving Show
@@ -53,6 +53,10 @@ instance ConfigValue Integer where
fromConfig (ConfigInteger a) = Right a
fromConfig val = Left (TypeMismatch "integer" val)
+instance ConfigValue Int where
+ fromConfig (ConfigInteger a) = Right (fromInteger a)
+ fromConfig val = Left (TypeMismatch "integer" val)
+
instance ConfigValue Bool where
fromConfig (ConfigBool b) = Right b
fromConfig val = Left (TypeMismatch "bool" val)