{-# 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 qualified Data.HashMap.Strict as HashMap
import Data.List (intersperse, sortOn)
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
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 0 = Builder
forall a. Monoid a => a
mempty
indent n :: Int
n = ShortByteString -> Builder
bs " " 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
- 1)
encode :: ToJSON a => a -> ByteString.Lazy.ByteString
encode :: a -> ByteString
encode v :: 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 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 "\n"
encodeDocuments :: ToJSON a => [a] -> ByteString.Lazy.ByteString
encodeDocuments :: [a] -> ByteString
encodeDocuments vs :: [a]
vs = Builder -> ByteString
ByteString.Builder.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder
output Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
bs "\n"
where
output :: Builder
output =
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (ShortByteString -> Builder
bs "\n---\n") ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Bool -> Int -> Value -> Builder
encodeBuilder Bool
False Bool
False 0 (Value -> Builder) -> (a -> Value) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON) [a]
vs
encodeQuoted :: ToJSON a => a -> ByteString.Lazy.ByteString
encodeQuoted :: a -> ByteString
encodeQuoted v :: 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 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 "\n"
encodeQuotedDocuments :: ToJSON a => [a] -> ByteString.Lazy.ByteString
encodeQuotedDocuments :: [a] -> ByteString
encodeQuotedDocuments vs :: [a]
vs =
Builder -> ByteString
ByteString.Builder.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder
output Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
bs "\n"
where
output :: Builder
output =
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (ShortByteString -> Builder
bs "\n---\n") ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Bool -> Int -> Value -> Builder
encodeBuilder Bool
True Bool
False 0 (Value -> Builder) -> (a -> Value) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON) [a]
vs
encodeBuilder :: Bool -> Bool -> Int -> Data.Aeson.Value -> Builder
encodeBuilder :: Bool -> Bool -> Int -> Value -> Builder
encodeBuilder alwaysQuote :: Bool
alwaysQuote newlineBeforeObject :: Bool
newlineBeforeObject level :: Int
level value :: Value
value =
case Value
value of
Object hm :: Object
hm
| Object -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Object
hm -> ShortByteString -> Builder
bs "{}"
| 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) (((Text, Value) -> Text) -> [(Text, Value)] -> [(Text, Value)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text, Value) -> Text
forall a b. (a, b) -> a
fst ([(Text, Value)] -> [(Text, Value)])
-> [(Text, Value)] -> [(Text, Value)]
forall a b. (a -> b) -> a -> b
$ Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList Object
hm)
where prefix :: Builder
prefix = ShortByteString -> Builder
bs "\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indent Int
level
Array vec :: Array
vec
| Array -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Array
vec -> ShortByteString -> Builder
bs "[]"
| 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
+ 1)) (Array -> [Value]
forall a. Vector a -> [a]
Vector.toList Array
vec)
where prefix :: Builder
prefix = ShortByteString -> Builder
bs "\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 "- "
String s :: Text
s -> Bool -> Bool -> Int -> Text -> Builder
encodeText Bool
True Bool
alwaysQuote Int
level Text
s
Number n :: Scientific
n -> ByteString -> Builder
bl (Scientific -> ByteString
forall a. ToJSON a => a -> ByteString
Data.Aeson.encode Scientific
n)
Bool bool :: Bool
bool -> ByteString -> Builder
bl (Bool -> ByteString
forall a. ToJSON a => a -> ByteString
Data.Aeson.encode Bool
bool)
Null -> ShortByteString -> Builder
bs "null"
where
keyValue :: Int -> (Text, Value) -> Builder
keyValue level' :: Int
level' (k :: Text
k, v :: 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
, ":"
, case Value
v of
Object hm :: Object
hm
| Bool -> Bool
not (Object -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Object
hm) -> ""
Array vec :: Array
vec
| Bool -> Bool
not (Array -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Array
vec) -> ""
_ -> " "
, Bool -> Bool -> Int -> Value -> Builder
encodeBuilder Bool
alwaysQuote Bool
True (Int
level' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Value
v
]
encodeText :: Bool -> Bool -> Int -> Text -> Builder
encodeText :: Bool -> Bool -> Int -> Text -> Builder
encodeText canMultiline :: Bool
canMultiline alwaysQuote :: Bool
alwaysQuote level :: Int
level s :: Text
s
| Bool
canMultiline Bool -> Bool -> Bool
&& "\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 "'" 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 "'"
headS :: Char
headS = Text -> Char
Text.head Text
s
unquotable :: Bool
unquotable
=
Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= "" 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
== '/')
isBoolString :: Bool
isBoolString
| Text -> Int
Text.length Text
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 5 = Bool
False
| Bool
otherwise =
case Text -> Text
Text.toLower Text
s of
"true" -> Bool
True
"false" -> Bool
True
_ -> Bool
False
isSafeAscii :: Char -> Bool
isSafeAscii c :: Char
c =
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= 'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= 'z') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= 'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= 'Z') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '9') Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '='
isNumberOrDateRelated :: Char -> Bool
isNumberOrDateRelated c :: Char
c = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'e' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-'
isAllowed :: Char -> Bool
isAllowed c :: Char
c = Char -> Bool
isSafeAscii Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ':' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' '
encodeLines :: Int -> [Text] -> Builder
encodeLines :: Int -> [Text] -> Builder
encodeLines level :: Int
level ls :: [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 "\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 "|"
, if Bool
needsIndicator
then ShortByteString -> Builder
bs "2"
else Builder
forall a. Monoid a => a
mempty
, "\n"
, Int -> Builder
indent Int
level
]
needsIndicator :: Bool
needsIndicator =
case [Text]
ls of
(line :: Text
line:_) -> " " Text -> Text -> Bool
`Text.isPrefixOf` Text
line
_ -> Bool
False