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

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