{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleInstances #-}
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
    -- ^ The 'String' is unescaped
  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 -> forall doc. IsLine doc => String -> doc
text String
"null"
    JSBool Bool
b -> if Bool
b then forall doc. IsLine doc => String -> doc
text String
"true" else forall doc. IsLine doc => String -> doc
text String
"false"
    JSInt    Int
n -> forall a. Outputable a => a -> SDoc
ppr Int
n
    JSString String
s -> forall doc. IsLine doc => doc -> doc
doubleQuotes forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text forall a b. (a -> b) -> a -> b
$ String -> String
escapeJsonString String
s
    JSArray [JsonDoc]
as -> forall doc. IsLine doc => doc -> doc
brackets forall a b. (a -> b) -> a -> b
$ forall {doc} {a}. IsLine doc => (a -> doc) -> [a] -> doc
pprList JsonDoc -> SDoc
renderJSON [JsonDoc]
as
    JSObject [(String, JsonDoc)]
fs -> forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$ forall {doc} {a}. IsLine doc => (a -> doc) -> [a] -> doc
pprList (String, JsonDoc) -> SDoc
renderField [(String, JsonDoc)]
fs
  where
    renderField :: (String, JsonDoc) -> SDoc
    renderField :: (String, JsonDoc) -> SDoc
renderField (String
s, JsonDoc
j) = forall doc. IsLine doc => doc -> doc
doubleQuotes (forall doc. IsLine doc => String -> doc
text String
s) forall doc. IsLine doc => doc -> doc -> doc
<>  forall doc. IsLine doc => doc
colon forall doc. IsLine doc => doc -> doc -> doc
<> JsonDoc -> SDoc
renderJSON JsonDoc
j

    pprList :: (a -> doc) -> [a] -> doc
pprList a -> doc
pp [a]
xs = forall doc. IsLine doc => [doc] -> doc
hcat (forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate forall doc. IsLine doc => doc
comma (forall a b. (a -> b) -> [a] -> [b]
map a -> doc
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

instance ToJson String where
  json :: String -> JsonDoc
json = String -> JsonDoc
JSString

instance ToJson Int where
  json :: Int -> JsonDoc
json = Int -> JsonDoc
JSInt