content: {-# LANGUAGE GADTs #-}
  module Eta.Utils.Json where
  
  import Eta.Utils.Outputable
  import Data.Char
  import Data.Time
  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
  
  instance ToJson UTCTime where
    json = JSString . formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ"
  