1 files changed, 54 insertions, 0 deletions
diff --git a/compiler/utils/Json.hs b/compiler/utils/Json.hs
new file mode 100644
index 0000000000..1318ce2611
--- /dev/null
+++ b/compiler/utils/Json.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE GADTs #-}
+module Json where
+
+import Outputable
+import Data.Char
+import Numeric
+
+-- | Simple data type to represent JSON documents.
+data JsonDoc where
+  JSNull :: JsonDoc
+  JSBool :: Bool -> JsonDoc
+  JSInt  :: Int  -> JsonDoc
+  JSString :: String -> JsonDoc
+  JSArray :: [JsonDoc] -> JsonDoc
+  JSObject :: [(String, JsonDoc)] -> JsonDoc
+
+
+-- This is simple and slow as it is only used for error reporting
+renderJSON :: JsonDoc -> SDoc
+renderJSON d =
+  case d of
+    JSNull -> text "null"
+    JSBool b -> text $ if b then "true" else "false"
+    JSInt    n -> ppr n
+    JSString s -> doubleQuotes $ text $ escapeJsonString s
+    JSArray as -> brackets $ pprList renderJSON as
+    JSObject fs -> braces $ pprList renderField fs
+  where
+    renderField :: (String, JsonDoc) -> SDoc
+    renderField (s, j) = doubleQuotes (text s) <>  colon <+> renderJSON j
+
+    pprList pp xs = hcat (punctuate comma (map pp xs))
+
+escapeJsonString :: String -> String
+escapeJsonString = concatMap escapeChar
+  where
+    escapeChar '\b' = "\\b"
+    escapeChar '\f' = "\\f"
+    escapeChar '\n' = "\\n"
+    escapeChar '\r' = "\\r"
+    escapeChar '\t' = "\\t"
+    escapeChar '"'  = "\""
+    escapeChar '\\'  = "\\\\"
+    escapeChar c | isControl c || fromEnum c >= 0x7f  = uni_esc c
+    escapeChar c = [c]
+
+    uni_esc c = "\\u" ++ (pad 4 (showHex (fromEnum c) ""))
+
+    pad n cs  | len < n   = replicate (n-len) '0' ++ cs
+                          | otherwise = cs
+                                   where len = length cs
+
+class ToJson a where
+  json :: a -> JsonDoc