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 Show
renderJson :: Json -> LBS.ByteString
renderJson json = toLazyByteString (go json)
where
go (JsonArray objs) =
surround "[" "]" $ mconcat $ intersperse "," $ map go objs
go (JsonBool True) = stringUtf8 "true"
go (JsonBool False) = stringUtf8 "false"
go JsonNull = stringUtf8 "null"
go (JsonNumber n) = intDec n
go (JsonObject attrs) =
surround "{" "}" $ mconcat $ intersperse "," $ map render attrs
where
render (k,v) = (surround "\"" "\"" $ stringUtf8 (escape k)) <> ":" <> go v
go (JsonString s) = surround "\"" "\"" $ stringUtf8 (escape s)
surround :: Builder -> Builder -> Builder -> Builder
surround begin end middle = mconcat [ begin , middle , end]
escape :: String -> String
escape ('\"':xs) = "\\\"" <> escape xs
escape ('\\':xs) = "\\\\" <> escape xs
escape ('\b':xs) = "\\b" <> escape xs
escape ('\f':xs) = "\\f" <> escape xs
escape ('\n':xs) = "\\n" <> escape xs
escape ('\r':xs) = "\\r" <> escape xs
escape ('\t':xs) = "\\t" <> escape xs
escape (x:xs) = x : escape xs
escape [] = mempty
(.=) :: String -> Json -> (String, Json)
k .= v = (k, v)