{-# LANGUAGE GADTs #-}
module GHC.Utils.Json where

import GHC.Prelude

import GHC.Utils.Outputable
import Data.Char
import Numeric

-- | Simple data type to represent JSON documents.
data JsonDoc where
  JSNull :: JsonDoc
  JSBool :: Bool -> JsonDoc
  JSInt  :: Int  -> JsonDoc
  JSString :: String -> JsonDoc
  JSArray :: [JsonDoc] -> JsonDoc
  JSObject :: [(String, JsonDoc)] -> JsonDoc


-- This is simple and slow as it is only used for error reporting
renderJSON :: JsonDoc -> SDoc
renderJSON :: JsonDoc -> SDoc
renderJSON JsonDoc
d =
  case JsonDoc
d of
    JsonDoc
JSNull -> String -> SDoc
text String
"null"
    JSBool Bool
b -> String -> SDoc
text forall a b. (a -> b) -> a -> b
$ if Bool
b then String
"true" else String
"false"
    JSInt    Int
n -> forall a. Outputable a => a -> SDoc
ppr Int
n
    JSString String
s -> SDoc -> SDoc
doubleQuotes forall a b. (a -> b) -> a -> b
$ String -> SDoc
text forall a b. (a -> b) -> a -> b
$ String -> String
escapeJsonString String
s
    JSArray [JsonDoc]
as -> SDoc -> SDoc
brackets forall a b. (a -> b) -> a -> b
$ forall {a}. (a -> SDoc) -> [a] -> SDoc
pprList JsonDoc -> SDoc
renderJSON [JsonDoc]
as
    JSObject [(String, JsonDoc)]
fs -> SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$ forall {a}. (a -> SDoc) -> [a] -> SDoc
pprList (String, JsonDoc) -> SDoc
renderField [(String, JsonDoc)]
fs
  where
    renderField :: (String, JsonDoc) -> SDoc
    renderField :: (String, JsonDoc) -> SDoc
renderField (String
s, JsonDoc
j) = SDoc -> SDoc
doubleQuotes (String -> SDoc
text String
s) SDoc -> SDoc -> SDoc
<>  SDoc
colon SDoc -> SDoc -> SDoc
<+> JsonDoc -> SDoc
renderJSON JsonDoc
j

    pprList :: (a -> SDoc) -> [a] -> SDoc
pprList a -> SDoc
pp [a]
xs = [SDoc] -> SDoc
hcat (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma (forall a b. (a -> b) -> [a] -> [b]
map a -> SDoc
pp [a]
xs))

escapeJsonString :: String -> String
escapeJsonString :: String -> String
escapeJsonString = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escapeChar
  where
    escapeChar :: Char -> String
escapeChar Char
'\b' = String
"\\b"
    escapeChar Char
'\f' = String
"\\f"
    escapeChar Char
'\n' = String
"\\n"
    escapeChar Char
'\r' = String
"\\r"
    escapeChar Char
'\t' = String
"\\t"
    escapeChar Char
'"'  = String
"\\\""
    escapeChar Char
'\\'  = String
"\\\\"
    escapeChar Char
c | Char -> Bool
isControl Char
c Bool -> Bool -> Bool
|| forall a. Enum a => a -> Int
fromEnum Char
c forall a. Ord a => a -> a -> Bool
>= Int
0x7f  = forall {a}. Enum a => a -> String
uni_esc Char
c
    escapeChar Char
c = [Char
c]

    uni_esc :: a -> String
uni_esc a
c = String
"\\u" forall a. [a] -> [a] -> [a]
++ (Int -> String -> String
pad Int
4 (forall a. (Integral a, Show a) => a -> String -> String
showHex (forall a. Enum a => a -> Int
fromEnum a
c) String
""))

    pad :: Int -> String -> String
pad Int
n String
cs  | Int
len forall a. Ord a => a -> a -> Bool
< Int
n   = forall a. Int -> a -> [a]
replicate (Int
nforall a. Num a => a -> a -> a
-Int
len) Char
'0' forall a. [a] -> [a] -> [a]
++ String
cs
                          | Bool
otherwise = String
cs
                                   where len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cs

class ToJson a where
  json :: a -> JsonDoc