    {-# 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 (String -> SDoc) -> String -> SDoc
    forall a b. (a -> b) -> a -> b
    $ if Bool
    b then String
    "true" else String
    "false"
        JSInt    Int
    n -> Int -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Int
    n
        JSString String
    s -> SDoc -> SDoc
    doubleQuotes (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text (String -> SDoc) -> String -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> String
    escapeJsonString String
    s
        JSArray [JsonDoc]
    as -> SDoc -> SDoc
    brackets (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (JsonDoc -> SDoc) -> [JsonDoc] -> SDoc
    forall {a}. (a -> SDoc) -> [a] -> SDoc
    pprList JsonDoc -> SDoc
    renderJSON [JsonDoc]
    as
        JSObject [(String, JsonDoc)]
    fs -> SDoc -> SDoc
    braces (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ ((String, JsonDoc) -> SDoc) -> [(String, JsonDoc)] -> SDoc
    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 ((a -> SDoc) -> [a] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> SDoc
    pp [a]
    xs))

    escapeJsonString :: String -> String
    escapeJsonString :: String -> String
    escapeJsonString = (Char -> String) -> String -> String
    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
    || Char -> Int
    forall a. Enum a => a -> Int
    fromEnum Char
    c Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0x7f  = Char -> String
    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" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Int -> String -> String
    pad Int
    4 (Int -> String -> String
    forall a. (Integral a, Show a) => a -> String -> String
    showHex (a -> Int
    forall a. Enum a => a -> Int
    fromEnum a
    c) String
    ""))

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

    class ToJson a where
      json :: a -> JsonDoc