never executed always true always false

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