-- | Utility json lib for Cabal
-- TODO: Remove it again.
module Distribution.Simple.Utils.Json
    ( Json(..)
    , renderJson
    ) where

data Json = JsonArray [Json]
          | JsonBool !Bool
          | JsonNull
          | JsonNumber !Int
          | JsonObject [(String, Json)]
          | JsonString !String

renderJson :: Json -> ShowS
renderJson :: Json -> ShowS
renderJson (JsonArray [Json]
objs)   =
  String -> String -> ShowS -> ShowS
surround String
"[" String
"]" (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> [ShowS] -> ShowS
intercalate String
"," ([ShowS] -> ShowS) -> [ShowS] -> ShowS
forall a b. (a -> b) -> a -> b
$ (Json -> ShowS) -> [Json] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map Json -> ShowS
renderJson [Json]
objs
renderJson (JsonBool Bool
True)    = String -> ShowS
showString String
"true"
renderJson (JsonBool Bool
False)   = String -> ShowS
showString String
"false"
renderJson  Json
JsonNull          = String -> ShowS
showString String
"null"
renderJson (JsonNumber Int
n)     = Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
n
renderJson (JsonObject [(String, Json)]
attrs) =
  String -> String -> ShowS -> ShowS
surround String
"{" String
"}" (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> [ShowS] -> ShowS
intercalate String
"," ([ShowS] -> ShowS) -> [ShowS] -> ShowS
forall a b. (a -> b) -> a -> b
$ ((String, Json) -> ShowS) -> [(String, Json)] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (String, Json) -> ShowS
render [(String, Json)]
attrs
  where
    render :: (String, Json) -> ShowS
render (String
k,Json
v) = (String -> String -> ShowS -> ShowS
surround String
"\"" String
"\"" (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString' String
k) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
":" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Json -> ShowS
renderJson Json
v
renderJson (JsonString String
s)     = String -> String -> ShowS -> ShowS
surround String
"\"" String
"\"" (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString' String
s

surround :: String -> String -> ShowS -> ShowS
surround :: String -> String -> ShowS -> ShowS
surround String
begin String
end ShowS
middle = String -> ShowS
showString String
begin ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
middle ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
end

showString' :: String -> ShowS
showString' :: String -> ShowS
showString' String
xs = String -> ShowS
showStringWorker String
xs
    where
        showStringWorker :: String -> ShowS
        showStringWorker :: String -> ShowS
showStringWorker (Char
'\"':String
as) = String -> ShowS
showString String
"\\\"" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showStringWorker String
as
        showStringWorker (Char
'\\':String
as) = String -> ShowS
showString String
"\\\\" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showStringWorker String
as
        showStringWorker (Char
'\'':String
as) = String -> ShowS
showString String
"\\\'" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showStringWorker String
as
        showStringWorker (Char
x:String
as) = String -> ShowS
showString [Char
x] ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showStringWorker String
as
        showStringWorker [] = String -> ShowS
showString String
""

intercalate :: String -> [ShowS] -> ShowS
intercalate :: String -> [ShowS] -> ShowS
intercalate String
sep = [ShowS] -> ShowS
go
  where
    go :: [ShowS] -> ShowS
go []     = ShowS
forall a. a -> a
id
    go [ShowS
x]    = ShowS
x
    go (ShowS
x:[ShowS]
xs) = ShowS
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString' String
sep ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ShowS] -> ShowS
go [ShowS]
xs