-- | Display JSON values using pretty printing combinators.

module Text.JSON.Pretty
  ( module Text.JSON.Pretty
  , module Text.PrettyPrint.HughesPJ
  ) where

import Text.JSON.Types
import Text.PrettyPrint.HughesPJ
import qualified Text.PrettyPrint.HughesPJ as PP
import Data.Ratio
import Data.Char
import Numeric

pp_value         :: JSValue -> Doc
pp_value :: JSValue -> Doc
pp_value JSValue
v        = case JSValue
v of
    JSValue
JSNull       -> Doc
pp_null
    JSBool Bool
x     -> Bool -> Doc
pp_boolean Bool
x
    JSRational Bool
asf Rational
x -> Bool -> Rational -> Doc
pp_number Bool
asf Rational
x
    JSString JSString
x   -> JSString -> Doc
pp_js_string JSString
x
    JSArray [JSValue]
vs   -> [JSValue] -> Doc
pp_array [JSValue]
vs
    JSObject JSObject JSValue
xs  -> JSObject JSValue -> Doc
pp_js_object JSObject JSValue
xs

pp_null          :: Doc
pp_null :: Doc
pp_null           = String -> Doc
text String
"null"

pp_boolean       :: Bool -> Doc
pp_boolean :: Bool -> Doc
pp_boolean Bool
True   = String -> Doc
text String
"true"
pp_boolean Bool
False  = String -> Doc
text String
"false"

pp_number        :: Bool -> Rational -> Doc
pp_number :: Bool -> Rational -> Doc
pp_number Bool
_ Rational
x | forall a. Ratio a -> a
denominator Rational
x forall a. Eq a => a -> a -> Bool
== Integer
1 = Integer -> Doc
integer (forall a. Ratio a -> a
numerator Rational
x)
pp_number Bool
True Rational
x                   = Float -> Doc
float (forall a. Fractional a => Rational -> a
fromRational Rational
x)
pp_number Bool
_    Rational
x                   = Double -> Doc
double (forall a. Fractional a => Rational -> a
fromRational Rational
x)

pp_array         :: [JSValue] -> Doc
pp_array :: [JSValue] -> Doc
pp_array [JSValue]
xs       = Doc -> Doc
brackets forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map JSValue -> Doc
pp_value [JSValue]
xs

pp_string        :: String -> Doc
pp_string :: String -> Doc
pp_string String
x       = Doc -> Doc
doubleQuotes forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Char -> Doc
pp_char String
x
  where pp_char :: Char -> Doc
pp_char Char
'\\'            = String -> Doc
text String
"\\\\"
        pp_char Char
'"'             = String -> Doc
text String
"\\\""
        pp_char Char
c | Char -> Bool
isControl Char
c = forall {a}. Enum a => a -> Doc
uni_esc Char
c
        pp_char Char
c               = Char -> Doc
char Char
c

        uni_esc :: a -> Doc
uni_esc a
c = String -> Doc
text String
"\\u" Doc -> Doc -> Doc
PP.<> String -> Doc
text (Int -> String -> String
pad Int
4 (forall a. (Integral a, Show a) => a -> String -> String
showHex (forall a. Enum a => a -> Int
fromEnum a
c) String
""))

        pad :: Int -> String -> String
pad Int
n String
cs  | Int
len forall a. Ord a => a -> a -> Bool
< Int
n   = forall a. Int -> a -> [a]
replicate (Int
nforall a. Num a => a -> a -> a
-Int
len) Char
'0' forall a. [a] -> [a] -> [a]
++ String
cs
                  | Bool
otherwise = String
cs
          where len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cs

pp_object        :: [(String,JSValue)] -> Doc
pp_object :: [(String, JSValue)] -> Doc
pp_object [(String, JSValue)]
xs      = Doc -> Doc
braces forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String, JSValue) -> Doc
pp_field [(String, JSValue)]
xs
  where pp_field :: (String, JSValue) -> Doc
pp_field (String
k,JSValue
v) = String -> Doc
pp_string String
k Doc -> Doc -> Doc
PP.<> Doc
colon Doc -> Doc -> Doc
<+> JSValue -> Doc
pp_value JSValue
v

pp_js_string     :: JSString -> Doc
pp_js_string :: JSString -> Doc
pp_js_string JSString
x    = String -> Doc
pp_string (JSString -> String
fromJSString JSString
x)

pp_js_object     :: JSObject JSValue -> Doc
pp_js_object :: JSObject JSValue -> Doc
pp_js_object JSObject JSValue
x    = [(String, JSValue)] -> Doc
pp_object (forall e. JSObject e -> [(String, e)]
fromJSObject JSObject JSValue
x)