{-|
This library exposes functions for encoding any Aeson value as YAML.
There is also support for encoding multiple values into YAML
"documents".

This library is pure Haskell, and does not depend on C FFI with
libyaml. It is also licensed under the BSD3 license.

This module is meant to be imported qualified.
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

module Data.Aeson.Yaml
  ( encode
  , encodeDocuments
  , encodeQuoted
  , encodeQuotedDocuments
  ) where

import Data.Aeson hiding (encode)
import qualified Data.Aeson
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as ByteString.Builder
import qualified Data.ByteString.Lazy as ByteString.Lazy
import qualified Data.ByteString.Short as ByteString.Short
import Data.Char (isAlpha, isDigit)
import Data.List (intersperse)
import Data.Monoid ((<>), mconcat, mempty)
import qualified Data.Text as Text
import Data.Text (Text)
import qualified Data.Text.Encoding as Text.Encoding
import qualified Data.Vector as Vector

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import Data.Bifunctor (first)
#else
import qualified Data.HashMap.Strict as HashMap
import Data.List (sortOn)
#endif

b :: ByteString -> Builder
b :: ByteString -> Builder
b = ByteString -> Builder
ByteString.Builder.byteString

bl :: ByteString.Lazy.ByteString -> Builder
bl :: ByteString -> Builder
bl = ByteString -> Builder
ByteString.Builder.lazyByteString

bs :: ByteString.Short.ShortByteString -> Builder
bs :: ShortByteString -> Builder
bs = ShortByteString -> Builder
ByteString.Builder.shortByteString

indent :: Int -> Builder
indent :: Int -> Builder
indent Int
0 = forall a. Monoid a => a
mempty
indent Int
n = ShortByteString -> Builder
bs ShortByteString
"  " forall a. Semigroup a => a -> a -> a
<> (Int -> Builder
indent forall a b. (a -> b) -> a -> b
$! Int
n forall a. Num a => a -> a -> a
- Int
1)

-- | Encode a value as YAML (lazy bytestring).
encode :: ToJSON a => a -> ByteString.Lazy.ByteString
encode :: forall a. ToJSON a => a -> ByteString
encode a
v =
  Builder -> ByteString
ByteString.Builder.toLazyByteString forall a b. (a -> b) -> a -> b
$
  Bool -> Bool -> Int -> Value -> Builder
encodeBuilder Bool
False Bool
False Int
0 (forall a. ToJSON a => a -> Value
toJSON a
v) forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
bs ShortByteString
"\n"

-- | Encode multiple values prefixed by @---\n@. To encode values of different
-- types, @import Data.Aeson(ToJSON(toJSON))@ and do
-- @encodeDocuments [toJSON x, toJSON y, toJSON z]@.
encodeDocuments :: ToJSON a => [a] -> ByteString.Lazy.ByteString
encodeDocuments :: forall a. ToJSON a => [a] -> ByteString
encodeDocuments [a]
vs =
    Builder -> ByteString
ByteString.Builder.toLazyByteString (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {a}. ToJSON a => a -> Builder
encodeDocument [a]
vs)
  where
    encodeDocument :: a -> Builder
encodeDocument a
document =
        Builder
"---\n" forall a. Semigroup a => a -> a -> a
<> Bool -> Bool -> Int -> Value -> Builder
encodeBuilder Bool
False Bool
False Int
0 (forall a. ToJSON a => a -> Value
toJSON a
document) forall a. Semigroup a => a -> a -> a
<> Builder
"\n"

-- | Encode a value as YAML (lazy bytestring). Keys and strings are always
-- quoted.
encodeQuoted :: ToJSON a => a -> ByteString.Lazy.ByteString
encodeQuoted :: forall a. ToJSON a => a -> ByteString
encodeQuoted a
v =
  Builder -> ByteString
ByteString.Builder.toLazyByteString forall a b. (a -> b) -> a -> b
$
  Bool -> Bool -> Int -> Value -> Builder
encodeBuilder Bool
True Bool
False Int
0 (forall a. ToJSON a => a -> Value
toJSON a
v) forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
bs ShortByteString
"\n"

-- | Encode multiple values separated by '\n---\n'. Keys and strings are always
-- quoted.
encodeQuotedDocuments :: ToJSON a => [a] -> ByteString.Lazy.ByteString
encodeQuotedDocuments :: forall a. ToJSON a => [a] -> ByteString
encodeQuotedDocuments [a]
vs =
    Builder -> ByteString
ByteString.Builder.toLazyByteString (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {a}. ToJSON a => a -> Builder
encodeDocument [a]
vs)
  where
    encodeDocument :: a -> Builder
encodeDocument a
document =
        Builder
"---\n" forall a. Semigroup a => a -> a -> a
<> Bool -> Bool -> Int -> Value -> Builder
encodeBuilder Bool
True Bool
False Int
0 (forall a. ToJSON a => a -> Value
toJSON a
document) forall a. Semigroup a => a -> a -> a
<> Builder
"\n"

encodeBuilder :: Bool -> Bool -> Int -> Data.Aeson.Value -> Builder
encodeBuilder :: Bool -> Bool -> Int -> Value -> Builder
encodeBuilder Bool
alwaysQuote Bool
newlineBeforeObject Int
level Value
value =
  case Value
value of
    Object Object
km
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Object
km -> ShortByteString -> Builder
bs ShortByteString
"{}"
      | Bool
otherwise ->
        forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
        (if Bool
newlineBeforeObject
           then (Builder
prefix forall a. a -> [a] -> [a]
:)
           else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
        forall a. a -> [a] -> [a]
intersperse Builder
prefix forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map (Int -> (Text, Value) -> Builder
keyValue Int
level) (Object -> [(Text, Value)]
objectToAscList Object
km)
      where prefix :: Builder
prefix = ShortByteString -> Builder
bs ShortByteString
"\n" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indent Int
level
    Array Array
vec
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Array
vec -> ShortByteString -> Builder
bs ShortByteString
"[]"
      | Bool
otherwise ->
        forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
        (Builder
prefix forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$
        forall a. a -> [a] -> [a]
intersperse Builder
prefix forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Bool -> Int -> Value -> Builder
encodeBuilder Bool
alwaysQuote Bool
False (Int
level forall a. Num a => a -> a -> a
+ Int
1)) (forall a. Vector a -> [a]
Vector.toList Array
vec)
      where prefix :: Builder
prefix = ShortByteString -> Builder
bs ShortByteString
"\n" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indent Int
level forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
bs ShortByteString
"- "
    String Text
s -> Bool -> Bool -> Int -> Text -> Builder
encodeText Bool
True Bool
alwaysQuote Int
level Text
s
    Number Scientific
n -> ByteString -> Builder
bl (forall a. ToJSON a => a -> ByteString
Data.Aeson.encode Scientific
n)
    Bool Bool
bool -> ByteString -> Builder
bl (forall a. ToJSON a => a -> ByteString
Data.Aeson.encode Bool
bool)
    Value
Null -> ShortByteString -> Builder
bs ShortByteString
"null"
  where
    keyValue :: Int -> (Text, Value) -> Builder
keyValue Int
level' (Text
k, Value
v) =
      forall a. Monoid a => [a] -> a
mconcat
        [ Bool -> Bool -> Int -> Text -> Builder
encodeText Bool
False Bool
alwaysQuote Int
level Text
k
        , Builder
":"
        , case Value
v of
            Object Object
hm
              | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Object
hm) -> Builder
""
            Array Array
vec
              | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Array
vec) -> Builder
""
            Value
_ -> Builder
" "
        , Bool -> Bool -> Int -> Value -> Builder
encodeBuilder Bool
alwaysQuote Bool
True (Int
level' forall a. Num a => a -> a -> a
+ Int
1) Value
v
        ]

encodeText :: Bool -> Bool -> Int -> Text -> Builder
encodeText :: Bool -> Bool -> Int -> Text -> Builder
encodeText Bool
canMultiline Bool
alwaysQuote Int
level Text
s
  -- s is a value, not a map key, and contains newlines; can be inserted
  -- literally with `|` syntax
  | Bool
canMultiline Bool -> Bool -> Bool
&& Text
"\n" Text -> Text -> Bool
`Text.isSuffixOf` Text
s = Int -> [Text] -> Builder
encodeLines Int
level (Text -> [Text]
Text.lines Text
s)
  -- s is a number, date, or boolString; single-quote
  | (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
isNumberOrDateRelated Text
s Bool -> Bool -> Bool
|| Bool
isBoolString = Builder
singleQuote
  -- s should be quoted, AND s is not unsafe; single-quote
  | Bool
alwaysQuote Bool -> Bool -> Bool
&& Bool
unquotable = Builder
singleQuote
  -- s should be quoted, OR s might be unsafe; double-quote
  | Bool
alwaysQuote Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
unquotable = ByteString -> Builder
bl forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
Data.Aeson.encode Text
s
  -- otherwise; no quotes
  | Bool
otherwise = Builder
noQuote
  where
    noQuote :: Builder
noQuote = ByteString -> Builder
b (Text -> ByteString
Text.Encoding.encodeUtf8 Text
s)
    singleQuote :: Builder
singleQuote = ShortByteString -> Builder
bs ShortByteString
"'" forall a. Semigroup a => a -> a -> a
<> Builder
noQuote forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
bs ShortByteString
"'"
    headS :: Char
headS = Text -> Char
Text.head Text
s
    unquotable :: Bool
unquotable -- s is unquotable if all are True
     =
      Text
s forall a. Eq a => a -> a -> Bool
/= Text
"" Bool -> Bool -> Bool
&& -- s is not empty
      (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
isAllowed Text
s Bool -> Bool -> Bool
&& -- s consists of acceptable chars
      (Char -> Bool
Data.Char.isAlpha Char
headS Bool -> Bool -> Bool
|| -- head of s is a char in A-Z or a-z or indicates a filepath
       Char
headS forall a. Eq a => a -> a -> Bool
== Char
'/')
    isBoolString :: Bool
isBoolString
      | Text -> Int
Text.length Text
s forall a. Ord a => a -> a -> Bool
> Int
5 = Bool
False
      | Bool
otherwise =
        case Text -> Text
Text.toLower Text
s of
          Text
"true" -> Bool
True
          Text
"false" -> Bool
True
          Text
_ -> Bool
False
    isSafeAscii :: Char -> Bool
isSafeAscii Char
c =
      (Char
c forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
||
      (Char
c forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'Z') Bool -> Bool -> Bool
||
      (Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9') Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'='
    isNumberOrDateRelated :: Char -> Bool
isNumberOrDateRelated Char
c = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'e' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-'
    isAllowed :: Char -> Bool
isAllowed Char
c = Char -> Bool
isSafeAscii Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
' '

encodeLines :: Int -> [Text] -> Builder
encodeLines :: Int -> [Text] -> Builder
encodeLines Int
level [Text]
ls =
  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
  (Builder
prefix forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$
  forall a. a -> [a] -> [a]
intersperse (ShortByteString -> Builder
bs ShortByteString
"\n" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indent Int
level) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Builder
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.Encoding.encodeUtf8) [Text]
ls
  where
    prefix :: Builder
prefix =
      forall a. Monoid a => [a] -> a
mconcat
        [ ShortByteString -> Builder
bs ShortByteString
"|"
        , if Bool
needsIndicator
            then ShortByteString -> Builder
bs ShortByteString
"2"
            else forall a. Monoid a => a
mempty
        , Builder
"\n"
        , Int -> Builder
indent Int
level
        ]
    needsIndicator :: Bool
needsIndicator =
      case [Text]
ls of
        (Text
line:[Text]
_) -> Text
" " Text -> Text -> Bool
`Text.isPrefixOf` Text
line
        [Text]
_ -> Bool
False

objectToAscList :: Object -> [(Text, Value)]
#if MIN_VERSION_aeson(2,0,0)
objectToAscList :: Object -> [(Text, Value)]
objectToAscList = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key -> Text
Key.toText) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KeyMap v -> [(Key, v)]
KeyMap.toAscList
#else
objectToAscList = sortOn fst . HashMap.toList
#endif