-- | 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 objs :: [Json]
objs)   =
  String -> String -> ShowS -> ShowS
surround "[" "]" (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> [ShowS] -> ShowS
intercalate "," ([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 True)    = String -> ShowS
showString "true"
renderJson (JsonBool False)   = String -> ShowS
showString "false"
renderJson  JsonNull          = String -> ShowS
showString "null"
renderJson (JsonNumber n :: Int
n)     = Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
n
renderJson (JsonObject attrs :: [(String, Json)]
attrs) =
  String -> String -> ShowS -> ShowS
surround "{" "}" (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> [ShowS] -> ShowS
intercalate "," ([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 (k :: String
k,v :: Json
v) = (String -> String -> ShowS -> ShowS
surround "\"" "\"" (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 ":" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Json -> ShowS
renderJson Json
v
renderJson (JsonString s :: String
s)     = String -> String -> ShowS -> ShowS
surround "\"" "\"" (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 begin :: String
begin end :: String
end middle :: 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' xs :: String
xs = String -> ShowS
showStringWorker String
xs
    where
        showStringWorker :: String -> ShowS
        showStringWorker :: String -> ShowS
showStringWorker ('\"':as :: String
as) = String -> ShowS
showString "\\\"" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showStringWorker String
as
        showStringWorker ('\\':as :: String
as) = String -> ShowS
showString "\\\\" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showStringWorker String
as
        showStringWorker ('\'':as :: String
as) = String -> ShowS
showString "\\\'" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showStringWorker String
as
        showStringWorker (x :: Char
x:as :: 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 ""

intercalate :: String -> [ShowS] -> ShowS
intercalate :: String -> [ShowS] -> ShowS
intercalate sep :: String
sep = [ShowS] -> ShowS
go
  where
    go :: [ShowS] -> ShowS
go []     = ShowS
forall a. a -> a
id
    go [x :: ShowS
x]    = ShowS
x
    go (x :: ShowS
x:xs :: [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