    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RankNTypes #-}

    -- | Extremely simple JSON helper. Don't do anything too fancy with this!
    module Distribution.Utils.Json
      ( Json (..)
      , (.=)
      , renderJson
      ) where

    import Data.ByteString.Builder
      ( Builder
      , intDec
      , stringUtf8
      , toLazyByteString
      )
    import qualified Data.ByteString.Lazy as LBS
    import Distribution.Compat.Prelude

    data Json
      = JsonArray [Json]
      | JsonBool !Bool
      | JsonNull
      | JsonNumber !Int -- No support for Floats, Doubles just yet
      | JsonObject [(String, Json)]
      | JsonString !String
      deriving (Int -> Json -> ShowS
    [Json] -> ShowS
    Json -> String
    (Int -> Json -> ShowS)
    -> (Json -> String) -> ([Json] -> ShowS) -> Show Json
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Json -> ShowS
    showsPrec :: Int -> Json -> ShowS
    $cshow :: Json -> String
    show :: Json -> String
    $cshowList :: [Json] -> ShowS
    showList :: [Json] -> ShowS
    Show)

    -- | Convert a 'Json' into a 'ByteString'
    renderJson :: Json -> LBS.ByteString
    renderJson :: Json -> ByteString
    renderJson Json
    json = Builder -> ByteString
    toLazyByteString (Json -> Builder
    go Json
    json)
      where
        go :: Json -> Builder
    go (JsonArray [Json]
    objs) =
          Builder -> Builder -> Builder -> Builder
    surround Builder
    "[" Builder
    "]" (Builder -> Builder) -> Builder -> Builder
    forall a b. (a -> b) -> a -> b
    $ [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat ([Builder] -> Builder) -> [Builder] -> Builder
    forall a b. (a -> b) -> a -> b
    $ Builder -> [Builder] -> [Builder]
    forall a. a -> [a] -> [a]
    intersperse Builder
    "," ([Builder] -> [Builder]) -> [Builder] -> [Builder]
    forall a b. (a -> b) -> a -> b
    $ (Json -> Builder) -> [Json] -> [Builder]
    forall a b. (a -> b) -> [a] -> [b]
    map Json -> Builder
    go [Json]
    objs
        go (JsonBool Bool
    True) = String -> Builder
    stringUtf8 String
    "true"
        go (JsonBool Bool
    False) = String -> Builder
    stringUtf8 String
    "false"
        go Json
    JsonNull = String -> Builder
    stringUtf8 String
    "null"
        go (JsonNumber Int
    n) = Int -> Builder
    intDec Int
    n
        go (JsonObject [(String, Json)]
    attrs) =
          Builder -> Builder -> Builder -> Builder
    surround Builder
    "{" Builder
    "}" (Builder -> Builder) -> Builder -> Builder
    forall a b. (a -> b) -> a -> b
    $ [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat ([Builder] -> Builder) -> [Builder] -> Builder
    forall a b. (a -> b) -> a -> b
    $ Builder -> [Builder] -> [Builder]
    forall a. a -> [a] -> [a]
    intersperse Builder
    "," ([Builder] -> [Builder]) -> [Builder] -> [Builder]
    forall a b. (a -> b) -> a -> b
    $ ((String, Json) -> Builder) -> [(String, Json)] -> [Builder]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, Json) -> Builder
    render [(String, Json)]
    attrs
          where
            render :: (String, Json) -> Builder
    render (String
    k, Json
    v) = Builder -> Builder -> Builder -> Builder
    surround Builder
    "\"" Builder
    "\"" (String -> Builder
    stringUtf8 (ShowS
    escape String
    k)) Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    ":" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Json -> Builder
    go Json
    v
        go (JsonString String
    s) = Builder -> Builder -> Builder -> Builder
    surround Builder
    "\"" Builder
    "\"" (Builder -> Builder) -> Builder -> Builder
    forall a b. (a -> b) -> a -> b
    $ String -> Builder
    stringUtf8 (ShowS
    escape String
    s)

    surround :: Builder -> Builder -> Builder -> Builder
    surround :: Builder -> Builder -> Builder -> Builder
    surround Builder
    begin Builder
    end Builder
    middle = [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat [Builder
    begin, Builder
    middle, Builder
    end]

    escape :: String -> String
    escape :: ShowS
    escape (Char
    '\"' : String
    xs) = String
    "\\\"" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ShowS
    escape String
    xs
    escape (Char
    '\\' : String
    xs) = String
    "\\\\" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ShowS
    escape String
    xs
    escape (Char
    '\b' : String
    xs) = String
    "\\b" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ShowS
    escape String
    xs
    escape (Char
    '\f' : String
    xs) = String
    "\\f" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ShowS
    escape String
    xs
    escape (Char
    '\n' : String
    xs) = String
    "\\n" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ShowS
    escape String
    xs
    escape (Char
    '\r' : String
    xs) = String
    "\\r" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ShowS
    escape String
    xs
    escape (Char
    '\t' : String
    xs) = String
    "\\t" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ShowS
    escape String
    xs
    escape (Char
    x : String
    xs) = Char
    x Char -> ShowS
    forall a. a -> [a] -> [a]
    : ShowS
    escape String
    xs
    escape [] = String
    forall a. Monoid a => a
    mempty

    -- | A shorthand for building up 'JsonObject's
    -- >>> JsonObject [ "a" .= JsonNumber 42, "b" .= JsonBool True ]
    -- JsonObject [("a",JsonNumber 42),("b",JsonBool True)]
    (.=) :: String -> Json -> (String, Json)
    String
    k .= :: String -> Json -> (String, Json)
    .= Json
    v = (String
    k, Json
    v)