    {-# 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 -> [Char]
    (Int -> Json -> ShowS)
    -> (Json -> [Char]) -> ([Json] -> ShowS) -> Show Json
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Json -> ShowS
    showsPrec :: Int -> Json -> ShowS
    $cshow :: Json -> [Char]
    show :: Json -> [Char]
    $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) = [Char] -> Builder
    stringUtf8 [Char]
    "true"
        go (JsonBool Bool
    False) = [Char] -> Builder
    stringUtf8 [Char]
    "false"
        go Json
    JsonNull = [Char] -> Builder
    stringUtf8 [Char]
    "null"
        go (JsonNumber Int
    n) = Int -> Builder
    intDec Int
    n
        go (JsonObject [([Char], 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
    $ (([Char], Json) -> Builder) -> [([Char], Json)] -> [Builder]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Char], Json) -> Builder
    render [([Char], Json)]
    attrs
          where
            render :: ([Char], Json) -> Builder
    render ([Char]
    k, Json
    v) = Builder -> Builder -> Builder -> Builder
    surround Builder
    "\"" Builder
    "\"" ([Char] -> Builder
    stringUtf8 (ShowS
    escape [Char]
    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 [Char]
    s) = Builder -> Builder -> Builder -> Builder
    surround Builder
    "\"" Builder
    "\"" (Builder -> Builder) -> Builder -> Builder
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Builder
    stringUtf8 (ShowS
    escape [Char]
    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
    '\"' : [Char]
    xs) = [Char]
    "\\\"" [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ShowS
    escape [Char]
    xs
    escape (Char
    '\\' : [Char]
    xs) = [Char]
    "\\\\" [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ShowS
    escape [Char]
    xs
    escape (Char
    '\b' : [Char]
    xs) = [Char]
    "\\b" [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ShowS
    escape [Char]
    xs
    escape (Char
    '\f' : [Char]
    xs) = [Char]
    "\\f" [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ShowS
    escape [Char]
    xs
    escape (Char
    '\n' : [Char]
    xs) = [Char]
    "\\n" [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ShowS
    escape [Char]
    xs
    escape (Char
    '\r' : [Char]
    xs) = [Char]
    "\\r" [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ShowS
    escape [Char]
    xs
    escape (Char
    '\t' : [Char]
    xs) = [Char]
    "\\t" [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ShowS
    escape [Char]
    xs
    escape (Char
    x : [Char]
    xs) = Char
    x Char -> ShowS
    forall a. a -> [a] -> [a]
    : ShowS
    escape [Char]
    xs
    escape [] = [Char]
    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)
    [Char]
    k .= :: [Char] -> Json -> ([Char], Json)
    .= Json
    v = ([Char]
    k, Json
    v)