Fix string escaping in JSON
[ghc.git] / compiler / utils / Json.hs
1 {-# LANGUAGE GADTs #-}
2 module Json where
3
4 import Outputable
5 import Data.Char
6 import Numeric
7
8 -- | Simple data type to represent JSON documents.
9 data JsonDoc where
10 JSNull :: JsonDoc
11 JSBool :: Bool -> JsonDoc
12 JSInt :: Int -> JsonDoc
13 JSString :: String -> JsonDoc
14 JSArray :: [JsonDoc] -> JsonDoc
15 JSObject :: [(String, JsonDoc)] -> JsonDoc
16
17
18 -- This is simple and slow as it is only used for error reporting
19 renderJSON :: JsonDoc -> SDoc
20 renderJSON d =
21 case d of
22 JSNull -> text "null"
23 JSBool b -> text $ if b then "true" else "false"
24 JSInt n -> ppr n
25 JSString s -> doubleQuotes $ text $ escapeJsonString s
26 JSArray as -> brackets $ pprList renderJSON as
27 JSObject fs -> braces $ pprList renderField fs
28 where
29 renderField :: (String, JsonDoc) -> SDoc
30 renderField (s, j) = doubleQuotes (text s) <> colon <+> renderJSON j
31
32 pprList pp xs = hcat (punctuate comma (map pp xs))
33
34 escapeJsonString :: String -> String
35 escapeJsonString = concatMap escapeChar
36 where
37 escapeChar '\b' = "\\b"
38 escapeChar '\f' = "\\f"
39 escapeChar '\n' = "\\n"
40 escapeChar '\r' = "\\r"
41 escapeChar '\t' = "\\t"
42 escapeChar '"' = "\\\""
43 escapeChar '\\' = "\\\\"
44 escapeChar c | isControl c || fromEnum c >= 0x7f = uni_esc c
45 escapeChar c = [c]
46
47 uni_esc c = "\\u" ++ (pad 4 (showHex (fromEnum c) ""))
48
49 pad n cs | len < n = replicate (n-len) '0' ++ cs
50 | otherwise = cs
51 where len = length cs
52
53 class ToJson a where
54 json :: a -> JsonDoc