{-# LANGUAGE CPP             #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Trustworthy     #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Copyright: © Herbert Valerio Riedel 2015-2018
-- SPDX-License-Identifier: GPL-2.0-or-later
--
-- The [YAML 1.2](https://yaml.org/spec/1.2/spec.html) format provides
-- a much richer data-model and feature-set
-- than the [JavaScript Object Notation (JSON)](https://tools.ietf.org/html/rfc7159) format.
-- However, sometimes it's desirable to ignore the extra capabilities
-- and treat YAML as if it was merely a more convenient markup format
-- for humans to write JSON data. To this end this module provides a
-- compatibility layer atop "Data.YAML" which allows decoding YAML
-- documents in the more limited JSON data-model while also providing
-- convenience by reusing @aeson@'s 'FromJSON' instances for decoding
-- the YAML data into native Haskell data types.
--
module Data.YAML.Aeson
    ( -- * Parsing YAML using JSON models
      -- ** High-level parsing/decoding via 'FromJSON' instances
      decode1
    , decode1'
    , decode1Strict
      -- ** Parsing into JSON AST ('J.Value')
    , decodeValue
    , decodeValue'
    , scalarToValue
      -- ** Encoding/Dumping
    , encode1
    , encode1Strict
    , encodeValue
    , encodeValue'
    ) where

import           Control.Applicative    as Ap
import           Control.Monad.Identity (runIdentity)
import           Data.Aeson             as J
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key                as AK
import qualified Data.Aeson.KeyMap             as AKM
#endif
import qualified Data.Aeson.Types       as J
import qualified Data.ByteString        as BS
import qualified Data.ByteString.Lazy   as BS.L
import qualified Data.HashMap.Strict    as HM
import qualified Data.Map               as Map
import           Data.Scientific
import           Data.Text              (Text)
import qualified Data.Vector            as V
import           Data.YAML              as Y hiding (decode1, decode1Strict, encode1, encode1Strict)
import           Data.YAML.Schema
import qualified Data.YAML.Token        as YT

-- | Parse a single YAML document using the 'coreSchemaResolver' and decode to Haskell types using 'FromJSON' instances.
--
-- This operation will fail if the YAML stream does not contain
-- exactly one YAML document. This operation is designed to be the
-- moral equivalent of @aeson@'s 'eitherDecode' function.
--
-- See 'decodeValue' for more information about this functions' YAML
-- decoder configuration.
--
-- __NOTE__: In contrast to 'FromYAML'-based decoding, error
-- source-locations are not available when errors occur in the
-- `FromJSON' decoding phase due to limitations of the 'FromJSON'
-- class; in such cases an improper 'Pos' value with a negative
-- 'posCharOffset' will be returned.
--
-- @since 0.2.0
decode1 :: FromJSON v => BS.L.ByteString -> Either (Pos,String) v
decode1 :: forall v. FromJSON v => ByteString -> Either (Pos, String) v
decode1 ByteString
bs = case ByteString -> Either (Pos, String) [Value]
decodeValue ByteString
bs of
    Left (Pos, String)
err -> (Pos, String) -> Either (Pos, String) v
forall a b. a -> Either a b
Left (Pos, String)
err
    Right [Value]
vs -> case [Value]
vs of
      [] -> (Pos, String) -> Either (Pos, String) v
forall a b. a -> Either a b
Left (Pos
zeroPos, String
"No documents found in YAML stream")
      (Value
_:Value
_:[Value]
_) -> (Pos, String) -> Either (Pos, String) v
forall a b. a -> Either a b
Left (Pos
dummyPos, String
"Multiple documents encountered in YAML stream")
      [Value
v1] -> do
        case Value -> Result v
forall a. FromJSON a => Value -> Result a
J.fromJSON Value
v1 of
          J.Success v
v2 -> v -> Either (Pos, String) v
forall a b. b -> Either a b
Right (v -> Either (Pos, String) v) -> v -> Either (Pos, String) v
forall a b. (a -> b) -> a -> b
$! v
v2
          J.Error String
err  -> (Pos, String) -> Either (Pos, String) v
forall a b. a -> Either a b
Left (Pos
dummyPos, String
"fromJSON: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
  where
    zeroPos :: Pos
zeroPos  = Pos { posByteOffset :: Int
posByteOffset = Int
0, posCharOffset :: Int
posCharOffset = Int
0, posLine :: Int
posLine = Int
1, posColumn :: Int
posColumn = Int
0 }
    dummyPos :: Pos
dummyPos = Pos { posByteOffset :: Int
posByteOffset = -Int
1, posCharOffset :: Int
posCharOffset = -Int
1, posLine :: Int
posLine = Int
1, posColumn :: Int
posColumn = Int
0 }

-- | Like 'decode1' but takes a strict 'BS.ByteString'
--
-- @since 0.2.0
decode1Strict :: FromJSON v => BS.ByteString -> Either (Pos,String) v
decode1Strict :: forall v. FromJSON v => ByteString -> Either (Pos, String) v
decode1Strict = ByteString -> Either (Pos, String) v
forall v. FromJSON v => ByteString -> Either (Pos, String) v
decode1 (ByteString -> Either (Pos, String) v)
-> (ByteString -> ByteString)
-> ByteString
-> Either (Pos, String) v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.L.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[])

-- | Variant of 'decode1' allowing for customization. See 'decodeValue'' for documentation of parameters.
--
-- @since 0.2.0
decode1' :: FromJSON v => SchemaResolver -> (J.Value -> Either String Text) -> BS.L.ByteString -> Either (Pos,String) v
decode1' :: forall v.
FromJSON v =>
SchemaResolver
-> (Value -> Either String Text)
-> ByteString
-> Either (Pos, String) v
decode1' SchemaResolver
schema Value -> Either String Text
keyconv ByteString
bs = case SchemaResolver
-> (Value -> Either String Text)
-> ByteString
-> Either (Pos, String) [Value]
decodeValue' SchemaResolver
schema Value -> Either String Text
keyconv ByteString
bs of
    Left (Pos, String)
err -> (Pos, String) -> Either (Pos, String) v
forall a b. a -> Either a b
Left (Pos, String)
err
    Right [Value]
vs -> case [Value]
vs of
      [] -> (Pos, String) -> Either (Pos, String) v
forall a b. a -> Either a b
Left (Pos
zeroPos, String
"No documents found in YAML stream")
      (Value
_:Value
_:[Value]
_) -> (Pos, String) -> Either (Pos, String) v
forall a b. a -> Either a b
Left (Pos
dummyPos, String
"Multiple documents encountered in YAML stream")
      [Value
v1] -> do
        case Value -> Result v
forall a. FromJSON a => Value -> Result a
J.fromJSON Value
v1 of
          J.Success v
v2 -> v -> Either (Pos, String) v
forall a b. b -> Either a b
Right (v -> Either (Pos, String) v) -> v -> Either (Pos, String) v
forall a b. (a -> b) -> a -> b
$! v
v2
          J.Error String
err  -> (Pos, String) -> Either (Pos, String) v
forall a b. a -> Either a b
Left (Pos
dummyPos, String
"fromJSON: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
  where
    zeroPos :: Pos
zeroPos  = Pos { posByteOffset :: Int
posByteOffset = Int
0, posCharOffset :: Int
posCharOffset = Int
0, posLine :: Int
posLine = Int
1, posColumn :: Int
posColumn = Int
0 }
    dummyPos :: Pos
dummyPos = Pos { posByteOffset :: Int
posByteOffset = -Int
1, posCharOffset :: Int
posCharOffset = -Int
1, posLine :: Int
posLine = Int
1, posColumn :: Int
posColumn = Int
0 }

-- | Parse YAML documents into JSON 'Value' ASTs
--
-- This is a wrapper function equivalent to
--
-- @'decodeValue'' 'coreSchemaResolver' identityKeyConv@
--
-- with @identityKeyConv@ being defined as
--
-- >> identityKeyConv :: Data.Aeson.Value -> Either String Text
-- >> identityKeyConv (Data.Aeson.String k) = Right k
-- >> identityKeyConv _ = Left "non-String key encountered in YAML mapping"
--
-- which performs no conversion and will fail when encountering YAML
-- Scalars that have not been resolved to a text Scalar (according to
-- the respective YAML schema resolver).
--
-- @since 0.2.0
decodeValue :: BS.L.ByteString -> Either (Pos, String) [J.Value]
decodeValue :: ByteString -> Either (Pos, String) [Value]
decodeValue = SchemaResolver
-> (Value -> Either String Text)
-> ByteString
-> Either (Pos, String) [Value]
decodeValue' SchemaResolver
coreSchemaResolver Value -> Either String Text
identityKeyConv
  where
    identityKeyConv :: J.Value -> Either String Text
    identityKeyConv :: Value -> Either String Text
identityKeyConv (J.String Text
k) = Text -> Either String Text
forall a b. b -> Either a b
Right Text
k
    identityKeyConv Value
_            = String -> Either String Text
forall a b. a -> Either a b
Left String
"non-String key encountered in mapping"

-- | Parse YAML documents into JSON 'Value' ASTs
--
-- YAML Anchors will be resolved and inlined accordingly. Resulting YAML cycles are not supported and will be treated as a decoding error.
--
-- __NOTE__: This decoder ignores YAML tags and relies on the YAML
-- 'SchemaResolver' provided to ensure that scalars have been resolved
-- to the proper known core YAML types.
--
-- @since 0.2.0
decodeValue' :: SchemaResolver  -- ^ YAML Schema resolver to use
             -> (J.Value -> Either String Text)
                -- ^ JSON object key conversion function. This operates on the YAML node as resolved by the 'SchemaResolver' and subsequently converted into a JSON Value according to the 'scalarToValue' conversion. See 'decodeValue' documentation for an example.

             -> BS.L.ByteString -- ^ YAML document to parse
             -> Either (Pos, String) [J.Value]
decodeValue' :: SchemaResolver
-> (Value -> Either String Text)
-> ByteString
-> Either (Pos, String) [Value]
decodeValue' SchemaResolver{Bool
Tag -> Either String Tag
Tag -> ScalarStyle -> Text -> Either String Scalar
schemaResolverSequence :: SchemaResolver -> Tag -> Either String Tag
schemaResolverScalar :: SchemaResolver
-> Tag -> ScalarStyle -> Text -> Either String Scalar
schemaResolverMappingDuplicates :: SchemaResolver -> Bool
schemaResolverMapping :: SchemaResolver -> Tag -> Either String Tag
schemaResolverMappingDuplicates :: Bool
schemaResolverMapping :: Tag -> Either String Tag
schemaResolverSequence :: Tag -> Either String Tag
schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either String Scalar
..} Value -> Either String Text
keyconv ByteString
bs0
    = Identity (Either (Pos, String) [Value])
-> Either (Pos, String) [Value]
forall a. Identity a -> a
runIdentity (Loader Identity Value
-> ByteString -> Identity (Either (Pos, String) [Value])
forall n (m :: * -> *).
MonadFix m =>
Loader m n -> ByteString -> m (Either (Pos, String) [n])
decodeLoader Loader Identity Value
failsafeLoader ByteString
bs0)
  where
    failsafeLoader :: Loader Identity Value
failsafeLoader = Loader { yScalar :: Tag -> ScalarStyle -> Text -> LoaderT Identity Value
yScalar   = \Tag
t ScalarStyle
s Text
v Pos
pos -> Either (Pos, String) Value -> Identity (Either (Pos, String) Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Pos, String) Value
 -> Identity (Either (Pos, String) Value))
-> Either (Pos, String) Value
-> Identity (Either (Pos, String) Value)
forall a b. (a -> b) -> a -> b
$! case Tag -> ScalarStyle -> Text -> Either String Scalar
schemaResolverScalar Tag
t ScalarStyle
s Text
v of
                                                                Left String
e   -> (Pos, String) -> Either (Pos, String) Value
forall a b. a -> Either a b
Left (Pos
pos, String
e)
                                                                Right Scalar
vs -> Scalar -> Pos -> Either (Pos, String) Value
mkScl Scalar
vs Pos
pos
                            , ySequence :: Tag -> [Value] -> LoaderT Identity Value
ySequence = \Tag
t [Value]
vs Pos
pos  -> Either (Pos, String) Value -> Identity (Either (Pos, String) Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Pos, String) Value
 -> Identity (Either (Pos, String) Value))
-> Either (Pos, String) Value
-> Identity (Either (Pos, String) Value)
forall a b. (a -> b) -> a -> b
$! case Tag -> Either String Tag
schemaResolverSequence Tag
t of
                                                                Left String
e  -> (Pos, String) -> Either (Pos, String) Value
forall a b. a -> Either a b
Left (Pos
pos, String
e)
                                                                Right Tag
_ -> [Value] -> Either (Pos, String) Value
mkArr [Value]
vs
                            , yMapping :: Tag -> [(Value, Value)] -> LoaderT Identity Value
yMapping  = \Tag
t [(Value, Value)]
kvs Pos
pos  -> Either (Pos, String) Value -> Identity (Either (Pos, String) Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Pos, String) Value
 -> Identity (Either (Pos, String) Value))
-> Either (Pos, String) Value
-> Identity (Either (Pos, String) Value)
forall a b. (a -> b) -> a -> b
$! case Tag -> Either String Tag
schemaResolverMapping Tag
t of
                                                                    Left String
e  -> (Pos, String) -> Either (Pos, String) Value
forall a b. a -> Either a b
Left (Pos
pos, String
e)
                                                                    Right Tag
_ -> Pos -> [(Value, Value)] -> Either (Pos, String) Value
mkObj Pos
pos [(Value, Value)]
kvs
                            , yAlias :: NodeId -> Bool -> Value -> LoaderT Identity Value
yAlias    = \NodeId
_ Bool
c Value
n Pos
pos -> Either (Pos, String) Value -> Identity (Either (Pos, String) Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Pos, String) Value
 -> Identity (Either (Pos, String) Value))
-> Either (Pos, String) Value
-> Identity (Either (Pos, String) Value)
forall a b. (a -> b) -> a -> b
$! if Bool
c then (Pos, String) -> Either (Pos, String) Value
forall a b. a -> Either a b
Left (Pos
pos, String
"cycle detected") else Value -> Either (Pos, String) Value
forall a b. b -> Either a b
Right Value
n
                            , yAnchor :: NodeId -> Value -> LoaderT Identity Value
yAnchor   = \NodeId
_ Value
n Pos
_   -> Either (Pos, String) Value -> Identity (Either (Pos, String) Value)
forall (f :: * -> *) a. Applicative f => a -> f a
Ap.pure (Either (Pos, String) Value
 -> Identity (Either (Pos, String) Value))
-> Either (Pos, String) Value
-> Identity (Either (Pos, String) Value)
forall a b. (a -> b) -> a -> b
$! Value -> Either (Pos, String) Value
forall a b. b -> Either a b
Right (Value -> Either (Pos, String) Value)
-> Value -> Either (Pos, String) Value
forall a b. (a -> b) -> a -> b
$! Value
n
                            }

    mkObj :: Pos -> [(J.Value, J.Value)] -> Either (Pos, String) J.Value
    mkObj :: Pos -> [(Value, Value)] -> Either (Pos, String) Value
mkObj Pos
pos [(Value, Value)]
xs = [Pair] -> Value
object ([Pair] -> Value)
-> Either (Pos, String) [Pair] -> Either (Pos, String) Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Value, Value) -> Either (Pos, String) Pair)
-> [(Value, Value)] -> Either (Pos, String) [Pair]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Pos -> (Value, Value) -> Either (Pos, String) Pair
mkPair Pos
pos) [(Value, Value)]
xs

    mkPair :: Pos -> (J.Value,J.Value) -> Either (Pos, String) J.Pair
    mkPair :: Pos -> (Value, Value) -> Either (Pos, String) Pair
mkPair Pos
pos (Value
k, Value
v) = case Value -> Either String Text
keyconv Value
k of
        Right Text
k' -> Pair -> Either (Pos, String) Pair
forall a b. b -> Either a b
Right (Text -> Key
fT Text
k', Value
v)
        Left String
s   -> (Pos, String) -> Either (Pos, String) Pair
forall a b. a -> Either a b
Left (Pos
pos, String
s)
#if MIN_VERSION_aeson(2,0,0)
    fT :: Text -> Key
fT = Text -> Key
AK.fromText
#else
    fT = id   
#endif

    mkArr :: [J.Value] -> Either (Pos, String) J.Value
    mkArr :: [Value] -> Either (Pos, String) Value
mkArr [Value]
xs = Value -> Either (Pos, String) Value
forall a b. b -> Either a b
Right (Value -> Either (Pos, String) Value)
-> Value -> Either (Pos, String) Value
forall a b. (a -> b) -> a -> b
$! Array -> Value
J.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$! [Value] -> Array
forall a. [a] -> Vector a
V.fromList [Value]
xs

    mkScl :: Y.Scalar -> Pos -> Either (Pos, String) J.Value
    mkScl :: Scalar -> Pos -> Either (Pos, String) Value
mkScl Scalar
s Pos
pos = case Scalar -> Maybe Value
scalarToValue Scalar
s of
                Maybe Value
Nothing -> (Pos, String) -> Either (Pos, String) Value
forall a b. a -> Either a b
Left (Pos
pos, String
"unresolved YAML scalar encountered")
                Just Value
v  -> Value -> Either (Pos, String) Value
forall a b. b -> Either a b
Right (Value -> Either (Pos, String) Value)
-> Value -> Either (Pos, String) Value
forall a b. (a -> b) -> a -> b
$! Value
v

-- | Convert a YAML t'Scalar' into a JSON 'J.Value'
--
-- This conversion will return 'Nothing' for 'SUnknown',
-- i.e. unresolved YAML nodes.
scalarToValue :: Scalar -> Maybe J.Value
scalarToValue :: Scalar -> Maybe Value
scalarToValue Scalar
Y.SNull        = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
J.Null
scalarToValue (Y.SBool Bool
b)    = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$! Bool -> Value
J.Bool Bool
b
scalarToValue (Y.SFloat Double
x)   = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$! Scientific -> Value
J.Number (Double -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x)
scalarToValue (Y.SInt Integer
i)     = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$! Scientific -> Value
J.Number (Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger Integer
i)
scalarToValue (SStr Text
t)       = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$! Text -> Value
J.String Text
t
scalarToValue (SUnknown Tag
_ Text
_) = Maybe Value
forall a. Maybe a
Nothing


-- | Equivalent to the fuction Data.ByteString.toStrict.
-- O(n) Convert a lazy ByteString into a strict ByteString.
{-# INLINE bsToStrict #-}
bsToStrict :: BS.L.ByteString -> BS.ByteString
#if MIN_VERSION_bytestring(0,10,0)
bsToStrict :: ByteString -> ByteString
bsToStrict = ByteString -> ByteString
BS.L.toStrict
#else
bsToStrict = BS.concat . BS.L.toChunks
#endif

-- | @since 0.2.0
instance ToYAML J.Value where
  toYAML :: Value -> Node ()
toYAML Value
J.Null = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar () Scalar
SNull
  toYAML (J.Bool Bool
b) = Bool -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML Bool
b
  toYAML (J.String Text
txt) = Text -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML Text
txt
  toYAML (J.Number Scientific
sc) = case Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
sc :: Either Double Integer of
    Right Integer
d  -> Integer -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML Integer
d
    Left Double
int -> Double -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML Double
int
  toYAML (J.Array Array
a) = [Value] -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
a)
  toYAML (J.Object Object
o) = Map Text Value -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML ([(Text, Value)] -> Map Text Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Object -> [(Text, Value)]
forall {b}. KeyMap b -> [(Text, b)]
fromObject Object
o))
   where
#if MIN_VERSION_aeson(2,0,0)
    fromObject :: KeyMap b -> [(Text, b)]
fromObject = ((Key, b) -> (Text, b)) -> [(Key, b)] -> [(Text, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Key
k, b
v) -> (Key -> Text
AK.toText Key
k, b
v)) ([(Key, b)] -> [(Text, b)])
-> (KeyMap b -> [(Key, b)]) -> KeyMap b -> [(Text, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap b -> [(Key, b)]
forall v. KeyMap v -> [(Key, v)]
AKM.toList
#else
    fromObject = HM.toList
#endif



-- | Serialize JSON Value using the YAML 1.2 Core schema to a lazy 'BS.L.ByteString'.
--
-- 'encode1' emits exactly one YAML document.
--
-- See 'encodeValue' for more information about this functions' YAML
-- encoder configuration.
--
-- @since 0.2.0
encode1 :: ToJSON v => v -> BS.L.ByteString
encode1 :: forall v. ToJSON v => v -> ByteString
encode1 v
a = [Value] -> ByteString
encodeValue [v -> Value
forall a. ToJSON a => a -> Value
J.toJSON v
a]

-- | Like 'encode1' but outputs 'BS.ByteString'
--
-- @since 0.2.0
encode1Strict :: ToJSON v => v -> BS.ByteString
encode1Strict :: forall v. ToJSON v => v -> ByteString
encode1Strict = ByteString -> ByteString
bsToStrict (ByteString -> ByteString) -> (v -> ByteString) -> v -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ByteString
forall v. ToJSON v => v -> ByteString
encode1

-- | Dump YAML Nodes as a lazy 'BS.L.ByteString'
--
-- Each YAML 'Node' is emitted as a individual YAML Document where each Document is terminated by a v'Data.YAML.Event.DocumentEnd' indicator.
--
-- This is a convenience wrapper over `encodeNode'`
--
-- @since 0.2.0
encodeValue :: [J.Value] -> BS.L.ByteString
encodeValue :: [Value] -> ByteString
encodeValue = SchemaEncoder -> Encoding -> [Value] -> ByteString
encodeValue' SchemaEncoder
coreSchemaEncoder Encoding
YT.UTF8

-- | Customizable variant of 'encodeNode'
--
-- @since 0.2.0
encodeValue' :: SchemaEncoder -> YT.Encoding -> [J.Value] -> BS.L.ByteString
encodeValue' :: SchemaEncoder -> Encoding -> [Value] -> ByteString
encodeValue' SchemaEncoder
schemaEncoder Encoding
encoding [Value]
values = SchemaEncoder -> Encoding -> [Doc (Node ())] -> ByteString
Y.encodeNode' SchemaEncoder
schemaEncoder Encoding
encoding ((Value -> Doc (Node ())) -> [Value] -> [Doc (Node ())]
forall a b. (a -> b) -> [a] -> [b]
map (Node () -> Doc (Node ())
forall n. n -> Doc n
Doc(Node () -> Doc (Node ()))
-> (Value -> Node ()) -> Value -> Doc (Node ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML) [Value]
values)