{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Extremely simple JSON helper. Don't do anything too fancy with this!

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 -- No support for Floats, Doubles just yet
          | JsonObject [(String, Json)]
          | JsonString !String
  deriving Int -> Json -> ShowS
[Json] -> ShowS
Json -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Json] -> ShowS
$cshowList :: [Json] -> ShowS
show :: Json -> String
$cshow :: Json -> String
showsPrec :: Int -> Json -> ShowS
$cshowsPrec :: Int -> Json -> ShowS
Show

-- | Convert a 'Json' into a 'ByteString'
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
"]" forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Builder
"," forall a b. (a -> b) -> a -> b
$ 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
"}" forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Builder
"," forall a b. (a -> b) -> a -> b
$ 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
"\"" forall a b. (a -> b) -> a -> b
$ String -> Builder
stringUtf8 (ShowS
escape String
k)) forall a. Semigroup a => a -> a -> a
<> Builder
":" forall a. Semigroup a => a -> a -> a
<> Json -> Builder
go Json
v
    go (JsonString String
s)     = Builder -> Builder -> Builder -> Builder
surround 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 = forall a. Monoid a => [a] -> a
mconcat [ Builder
begin , Builder
middle , Builder
end]

escape :: String -> String
escape :: ShowS
escape (Char
'\"':String
xs) = String
"\\\"" forall a. Semigroup a => a -> a -> a
<> ShowS
escape String
xs
escape (Char
'\\':String
xs) = String
"\\\\" forall a. Semigroup a => a -> a -> a
<> ShowS
escape String
xs
escape (Char
'\b':String
xs) = String
"\\b"  forall a. Semigroup a => a -> a -> a
<> ShowS
escape String
xs
escape (Char
'\f':String
xs) = String
"\\f"  forall a. Semigroup a => a -> a -> a
<> ShowS
escape String
xs
escape (Char
'\n':String
xs) = String
"\\n"  forall a. Semigroup a => a -> a -> a
<> ShowS
escape String
xs
escape (Char
'\r':String
xs) = String
"\\r"  forall a. Semigroup a => a -> a -> a
<> ShowS
escape String
xs
escape (Char
'\t':String
xs) = String
"\\t"  forall a. Semigroup a => a -> a -> a
<> ShowS
escape String
xs
escape (Char
x:String
xs)    = Char
x forall a. a -> [a] -> [a]
: ShowS
escape String
xs
escape []        = forall a. Monoid a => a
mempty

-- | A shorthand for building up 'JsonObject's
-- >>> JsonObject [ "a" .= JsonNumber 42, "b" .= JsonBool True ]
-- JsonObject [("a",JsonNumber 42),("b",JsonBool True)]
(.=) :: String -> Json -> (String, Json)
String
k .= :: String -> Json -> (String, Json)
.= Json
v = (String
k, Json
v)