{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
module Distribution.Utils.Json
( Json(..)
, (.=)
, renderJson
) where
import Distribution.Compat.Prelude
import qualified Data.ByteString.Lazy as LBS
import Data.ByteString.Builder
( Builder, stringUtf8, intDec, toLazyByteString )
data Json = JsonArray [Json]
| JsonBool !Bool
| JsonNull
| JsonNumber !Int
| JsonObject [(String, Json)]
| JsonString !String
deriving Int -> Json -> ShowS
[Json] -> ShowS
Json -> String
(Int -> Json -> ShowS)
-> (Json -> String) -> ([Json] -> ShowS) -> Show Json
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Json -> ShowS
showsPrec :: Int -> Json -> ShowS
$cshow :: Json -> String
show :: Json -> String
$cshowList :: [Json] -> ShowS
showList :: [Json] -> ShowS
Show
renderJson :: Json -> LBS.ByteString
renderJson :: Json -> ByteString
renderJson Json
json = Builder -> ByteString
toLazyByteString (Json -> Builder
go Json
json)
where
go :: Json -> Builder
go (JsonArray [Json]
objs) =
Builder -> Builder -> Builder -> Builder
surround Builder
"[" Builder
"]" (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ [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 Builder
"," ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (Json -> Builder) -> [Json] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Json -> Builder
go [Json]
objs
go (JsonBool Bool
True) = String -> Builder
stringUtf8 String
"true"
go (JsonBool Bool
False) = String -> Builder
stringUtf8 String
"false"
go Json
JsonNull = String -> Builder
stringUtf8 String
"null"
go (JsonNumber Int
n) = Int -> Builder
intDec Int
n
go (JsonObject [(String, Json)]
attrs) =
Builder -> Builder -> Builder -> Builder
surround Builder
"{" Builder
"}" (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ [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 Builder
"," ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ ((String, Json) -> Builder) -> [(String, Json)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (String, Json) -> Builder
render [(String, Json)]
attrs
where
render :: (String, Json) -> Builder
render (String
k,Json
v) = (Builder -> Builder -> Builder -> Builder
surround Builder
"\"" Builder
"\"" (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ String -> Builder
stringUtf8 (ShowS
escape String
k)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Json -> Builder
go Json
v
go (JsonString String
s) = Builder -> Builder -> Builder -> Builder
surround Builder
"\"" Builder
"\"" (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ String -> Builder
stringUtf8 (ShowS
escape String
s)
surround :: Builder -> Builder -> Builder -> Builder
surround :: Builder -> Builder -> Builder -> Builder
surround Builder
begin Builder
end Builder
middle = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
begin , Builder
middle , Builder
end]
escape :: String -> String
escape :: ShowS
escape (Char
'\"':String
xs) = String
"\\\"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
escape String
xs
escape (Char
'\\':String
xs) = String
"\\\\" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
escape String
xs
escape (Char
'\b':String
xs) = String
"\\b" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
escape String
xs
escape (Char
'\f':String
xs) = String
"\\f" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
escape String
xs
escape (Char
'\n':String
xs) = String
"\\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
escape String
xs
escape (Char
'\r':String
xs) = String
"\\r" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
escape String
xs
escape (Char
'\t':String
xs) = String
"\\t" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
escape String
xs
escape (Char
x:String
xs) = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
escape String
xs
escape [] = String
forall a. Monoid a => a
mempty
(.=) :: String -> Json -> (String, Json)
String
k .= :: String -> Json -> (String, Json)
.= Json
v = (String
k, Json
v)