{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Functions for producing sources reading from yaml strings or files, using the aeson library.
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 (Key
-> YamlSource
-> StateT
     (SourceState YamlSource) IO (Either ConfigError (Value, Text))
YamlSource -> StateT (SourceState YamlSource) IO (Maybe [Key])
(Key
 -> YamlSource
 -> StateT
      (SourceState YamlSource) IO (Either ConfigError (Value, Text)))
-> (YamlSource -> StateT (SourceState YamlSource) IO (Maybe [Key]))
-> ConfigSource YamlSource
forall s.
(Key
 -> s
 -> StateT (SourceState s) IO (Either ConfigError (Value, Text)))
-> (s -> StateT (SourceState s) IO (Maybe [Key])) -> ConfigSource s
$cfetchValue :: Key
-> YamlSource
-> StateT
     (SourceState YamlSource) IO (Either ConfigError (Value, Text))
fetchValue :: Key
-> YamlSource
-> StateT
     (SourceState YamlSource) IO (Either ConfigError (Value, Text))
$cleftovers :: YamlSource -> StateT (SourceState YamlSource) IO (Maybe [Key])
leftovers :: YamlSource -> StateT (SourceState YamlSource) IO (Maybe [Key])
ConfigSource, Int -> YamlSource -> ShowS
[YamlSource] -> ShowS
YamlSource -> String
(Int -> YamlSource -> ShowS)
-> (YamlSource -> String)
-> ([YamlSource] -> ShowS)
-> Show YamlSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> YamlSource -> ShowS
showsPrec :: Int -> YamlSource -> ShowS
$cshow :: YamlSource -> String
show :: YamlSource -> String
$cshowList :: [YamlSource] -> ShowS
showList :: [YamlSource] -> ShowS
Show)

mkYamlSource :: A.Value -> SomeSource
mkYamlSource :: Value -> SomeSource
mkYamlSource Value
value = Text -> Value -> SomeSource
mkYamlSourceWith (Text
"Yaml string " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
LT.toStrict (Value -> Text
forall a. ToJSON a => a -> Text
A.encodeToLazyText Value
value)) Value
value

mkYamlSourceWith :: Text -> A.Value -> SomeSource
mkYamlSourceWith :: Text -> Value -> SomeSource
mkYamlSourceWith Text
description Value
value = (YamlSource, SourceState YamlSource) -> SomeSource
forall source.
ConfigSource source =>
(source, SourceState source) -> SomeSource
SomeSource (YamlSource
source, [])
  where source :: YamlSource
source = JsonSource -> YamlSource
YamlSource (Value -> Text -> JsonSource
JsonSource Value
value Text
description)

mkYamlFileSource :: OsPath -> IO (Either Y.ParseException SomeSource)
mkYamlFileSource :: OsPath -> IO (Either ParseException SomeSource)
mkYamlFileSource OsPath
path = do
  ByteString
bytes <- OsPath -> IO ByteString
readFile OsPath
path IO ByteString -> (ByteString -> ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ByteString -> ByteString
BS.toStrict
  Text
pathAsText <- OsPath -> IO String
forall (m :: * -> *). MonadThrow m => OsPath -> m String
OS.decodeUtf OsPath
path IO String -> (String -> Text) -> IO Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Text
LT.toStrict (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
LT.pack
  Either ParseException SomeSource
-> IO (Either ParseException SomeSource)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseException SomeSource
 -> IO (Either ParseException SomeSource))
-> Either ParseException SomeSource
-> IO (Either ParseException SomeSource)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ParseException Value
forall a. FromJSON a => ByteString -> Either ParseException a
Y.decodeEither' ByteString
bytes
    Either ParseException Value
-> (Value -> SomeSource) -> Either ParseException SomeSource
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Value -> SomeSource
mkYamlSourceWith (Text
"YAML file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pathAsText)