add yaml source

3 files changed, 48 insertions, 2 deletions

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)