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 v :: JSValue
v = case JSValue
v of
JSNull -> Doc
pp_null
JSBool x :: Bool
x -> Bool -> Doc
pp_boolean Bool
x
JSRational asf :: Bool
asf x :: Rational
x -> Bool -> Rational -> Doc
pp_number Bool
asf Rational
x
JSString x :: JSString
x -> JSString -> Doc
pp_js_string JSString
x
JSArray vs :: [JSValue]
vs -> [JSValue] -> Doc
pp_array [JSValue]
vs
JSObject xs :: JSObject JSValue
xs -> JSObject JSValue -> Doc
pp_js_object JSObject JSValue
xs
pp_null :: Doc
pp_null :: Doc
pp_null = String -> Doc
text "null"
pp_boolean :: Bool -> Doc
pp_boolean :: Bool -> Doc
pp_boolean True = String -> Doc
text "true"
pp_boolean False = String -> Doc
text "false"
pp_number :: Bool -> Rational -> Doc
pp_number :: Bool -> Rational -> Doc
pp_number _ x :: Rational
x | Rational -> Integer
forall a. Ratio a -> a
denominator Rational
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = Integer -> Doc
integer (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
x)
pp_number True x :: Rational
x = Float -> Doc
float (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
x)
pp_number _ x :: Rational
x = Double -> Doc
double (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
x)
pp_array :: [JSValue] -> Doc
pp_array :: [JSValue] -> Doc
pp_array xs :: [JSValue]
xs = Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (JSValue -> Doc) -> [JSValue] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map JSValue -> Doc
pp_value [JSValue]
xs
pp_string :: String -> Doc
pp_string :: String -> Doc
pp_string x :: String
x = Doc -> Doc
doubleQuotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc) -> String -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Doc
pp_char String
x
where pp_char :: Char -> Doc
pp_char '\\' = String -> Doc
text "\\\\"
pp_char '"' = String -> Doc
text "\\\""
pp_char c :: Char
c | Char -> Bool
isControl Char
c = Char -> Doc
forall a. Enum a => a -> Doc
uni_esc Char
c
pp_char c :: Char
c = Char -> Doc
char Char
c
uni_esc :: a -> Doc
uni_esc c :: a
c = String -> Doc
text "\\u" Doc -> Doc -> Doc
PP.<> String -> Doc
text (Int -> String -> String
pad 4 (Int -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex (a -> Int
forall a. Enum a => a -> Int
fromEnum a
c) ""))
pad :: Int -> String -> String
pad n :: Int
n cs :: String
cs | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
len) '0' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs
| Bool
otherwise = String
cs
where len :: Int
len = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cs
pp_object :: [(String,JSValue)] -> Doc
pp_object :: [(String, JSValue)] -> Doc
pp_object xs :: [(String, JSValue)]
xs = Doc -> Doc
braces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ((String, JSValue) -> Doc) -> [(String, JSValue)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String, JSValue) -> Doc
pp_field [(String, JSValue)]
xs
where pp_field :: (String, JSValue) -> Doc
pp_field (k :: String
k,v :: 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 x :: 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 x :: JSObject JSValue
x = [(String, JSValue)] -> Doc
pp_object (JSObject JSValue -> [(String, JSValue)]
forall e. JSObject e -> [(String, e)]
fromJSObject JSObject JSValue
x)