{-# 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 = Builder
forall a. Monoid a => a
mempty
indent Int
n = ShortByteString -> Builder
bs ShortByteString
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Int -> Builder
indent (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$! Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
encode :: ToJSON a => a -> ByteString.Lazy.ByteString
encode :: forall a. ToJSON a => a -> ByteString
encode a
v =
Builder -> ByteString
ByteString.Builder.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
Bool -> Bool -> Int -> Value -> Builder
encodeBuilder Bool
False Bool
False Int
0 (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
v) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
bs ShortByteString
"\n"
encodeDocuments :: ToJSON a => [a] -> ByteString.Lazy.ByteString
encodeDocuments :: forall a. ToJSON a => [a] -> ByteString
encodeDocuments [a]
vs =
Builder -> ByteString
ByteString.Builder.toLazyByteString ((a -> Builder) -> [a] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Builder
forall {a}. ToJSON a => a -> Builder
encodeDocument [a]
vs)
where
encodeDocument :: a -> Builder
encodeDocument a
document =
Builder
"---\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Bool -> Int -> Value -> Builder
encodeBuilder Bool
False Bool
False Int
0 (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
document) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
encodeQuoted :: ToJSON a => a -> ByteString.Lazy.ByteString
encodeQuoted :: forall a. ToJSON a => a -> ByteString
encodeQuoted a
v =
Builder -> ByteString
ByteString.Builder.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
Bool -> Bool -> Int -> Value -> Builder
encodeBuilder Bool
True Bool
False Int
0 (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
v) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
bs ShortByteString
"\n"
encodeQuotedDocuments :: ToJSON a => [a] -> ByteString.Lazy.ByteString
encodeQuotedDocuments :: forall a. ToJSON a => [a] -> ByteString
encodeQuotedDocuments [a]
vs =
Builder -> ByteString
ByteString.Builder.toLazyByteString ((a -> Builder) -> [a] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Builder
forall {a}. ToJSON a => a -> Builder
encodeDocument [a]
vs)
where
encodeDocument :: a -> Builder
encodeDocument a
document =
Builder
"---\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Bool -> Int -> Value -> Builder
encodeBuilder Bool
True Bool
False Int
0 (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
document) Builder -> Builder -> Builder
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
| Object -> Bool
forall a. KeyMap a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Object
km -> ShortByteString -> Builder
bs ShortByteString
"{}"
| Bool
otherwise ->
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
(if Bool
newlineBeforeObject
then (Builder
prefix Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
:)
else [Builder] -> [Builder]
forall a. a -> a
id) ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$
Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
prefix ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$
((Text, Value) -> Builder) -> [(Text, Value)] -> [Builder]
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" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indent Int
level
Array Array
vec
| Array -> Bool
forall a. Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Array
vec -> ShortByteString -> Builder
bs ShortByteString
"[]"
| Bool
otherwise ->
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
(Builder
prefix Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
:) ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$
Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
prefix ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$
(Value -> Builder) -> [Value] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Bool -> Int -> Value -> Builder
encodeBuilder Bool
alwaysQuote Bool
False (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) (Array -> [Value]
forall a. Vector a -> [a]
Vector.toList Array
vec)
where prefix :: Builder
prefix = ShortByteString -> Builder
bs ShortByteString
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indent Int
level Builder -> Builder -> Builder
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 (Scientific -> ByteString
forall a. ToJSON a => a -> ByteString
Data.Aeson.encode Scientific
n)
Bool Bool
bool -> ByteString -> Builder
bl (Bool -> ByteString
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) =
[Builder] -> Builder
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 (Object -> Bool
forall a. KeyMap a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Object
hm) -> Builder
""
Array Array
vec
| Bool -> Bool
not (Array -> Bool
forall a. Vector a -> Bool
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' Int -> Int -> Int
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
| 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)
| (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
isNumberOrDateRelated Text
s Bool -> Bool -> Bool
|| Bool
isBoolString = Builder
singleQuote
| Bool
alwaysQuote Bool -> Bool -> Bool
&& Bool
unquotable = Builder
singleQuote
| Bool
alwaysQuote Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
unquotable = ByteString -> Builder
bl (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a. ToJSON a => a -> ByteString
Data.Aeson.encode Text
s
| 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
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
noQuote Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
bs ShortByteString
"'"
headS :: Char
headS = HasCallStack => Text -> Char
Text -> Char
Text.head Text
s
unquotable :: Bool
unquotable
=
Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" Bool -> Bool -> Bool
&&
(Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
isAllowed Text
s Bool -> Bool -> Bool
&&
(Char -> Bool
Data.Char.isAlpha Char
headS Bool -> Bool -> Bool
||
Char
headS Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/')
isBoolString :: Bool
isBoolString
| Text -> Int
Text.length Text
s Int -> Int -> Bool
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 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9') Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'='
isNumberOrDateRelated :: Char -> Bool
isNumberOrDateRelated Char
c = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'e' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
isAllowed :: Char -> Bool
isAllowed Char
c = Char -> Bool
isSafeAscii Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '
encodeLines :: Int -> [Text] -> Builder
encodeLines :: Int -> [Text] -> Builder
encodeLines Int
level [Text]
ls =
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
(Builder
prefix Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
:) ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$
Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (ShortByteString -> Builder
bs ShortByteString
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indent Int
level) ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (Text -> Builder) -> [Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Builder
b (ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.Encoding.encodeUtf8) [Text]
ls
where
prefix :: Builder
prefix =
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ ShortByteString -> Builder
bs ShortByteString
"|"
, if Bool
needsIndicator
then ShortByteString -> Builder
bs ShortByteString
"2"
else Builder
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 = ((Key, Value) -> (Text, Value))
-> [(Key, Value)] -> [(Text, Value)]
forall a b. (a -> b) -> [a] -> [b]
map ((Key -> Text) -> (Key, Value) -> (Text, Value)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key -> Text
Key.toText) ([(Key, Value)] -> [(Text, Value)])
-> (Object -> [(Key, Value)]) -> Object -> [(Text, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toAscList
#else
objectToAscList = sortOn fst . HashMap.toList
#endif