module Text.JSON5.Pretty
( ppJSValue
, ppNull
, ppBoolean
, ppJSNumber
, ppRational
, ppInfNaN
, ppArray
, ppString
, ppObject
, ppJSString
, ppJSObject
) where
import Text.JSON5.Types
import Text.PrettyPrint.HughesPJ
import qualified Text.PrettyPrint.HughesPJ as PP
import Data.Ratio
import Data.Char
import Numeric
ppJSValue :: JSValue -> Doc
ppJSValue :: JSValue -> Doc
ppJSValue JSValue
v = case JSValue
v of
JSValue
JSNull -> Doc
ppNull
JSBool Bool
x -> Bool -> Doc
ppBoolean Bool
x
JSNumber JSNumber
jsn -> JSNumber -> Doc
ppJSNumber JSNumber
jsn
JSString JSString
x -> JSString -> Doc
ppJSString JSString
x
JSArray [JSValue]
vs -> [JSValue] -> Doc
ppArray [JSValue]
vs
JSObject JSObject JSValue
xs -> JSObject JSValue -> Doc
ppJSObject JSObject JSValue
xs
ppNull :: Doc
ppNull :: Doc
ppNull = String -> Doc
text String
"null"
ppBoolean :: Bool -> Doc
ppBoolean :: Bool -> Doc
ppBoolean Bool
True = String -> Doc
text String
"true"
ppBoolean Bool
False = String -> Doc
text String
"false"
ppJSNumber :: JSNumber -> Doc
ppJSNumber :: JSNumber -> Doc
ppJSNumber (JSRational Rational
r) = Rational -> Doc
ppRational Rational
r
ppJSNumber (JSInfNaN Float
n) = Float -> Doc
ppInfNaN Float
n
ppRational :: Rational -> Doc
ppRational :: Rational -> Doc
ppRational Rational
x
| Rational -> Integer
forall a. Ratio a -> a
denominator Rational
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = Integer -> Doc
integer (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
x)
| Bool
otherwise = Double -> Doc
double (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
x)
ppInfNaN :: Float -> Doc
ppInfNaN :: Float -> Doc
ppInfNaN Float
n
| Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
n = String -> Doc
text String
"NaN"
| Float
n Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 = String -> Doc
text String
"Infinity"
| Float
n Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 = String -> Doc
text String
"-Infinity"
ppArray :: [JSValue] -> Doc
ppArray :: [JSValue] -> Doc
ppArray [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
ppJSValue [JSValue]
xs
ppString :: String -> Doc
ppString :: String -> Doc
ppString 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 Char
'\\' = String -> Doc
text String
"\\\\"
pp_char Char
'"' = String -> Doc
text String
"\\\""
pp_char Char
c | Char -> Bool
isControl Char
c = Char -> Doc
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 (Int -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex (a -> Int
forall a. Enum a => a -> Int
fromEnum a
c) String
""))
pad :: Int -> String -> String
pad Int
n 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) Char
'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
ppObject :: [(String,JSValue)] -> Doc
ppObject :: [(String, JSValue)] -> Doc
ppObject [(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 (String
k,JSValue
v) = String -> Doc
ppString String
k Doc -> Doc -> Doc
PP.<> Doc
colon Doc -> Doc -> Doc
<+> JSValue -> Doc
ppJSValue JSValue
v
ppJSString :: JSString -> Doc
ppJSString :: JSString -> Doc
ppJSString = String -> Doc
ppString (String -> Doc) -> (JSString -> String) -> JSString -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSString -> String
fromJSString
ppJSObject :: JSObject JSValue -> Doc
ppJSObject :: JSObject JSValue -> Doc
ppJSObject = [(String, JSValue)] -> Doc
ppObject ([(String, JSValue)] -> Doc)
-> (JSObject JSValue -> [(String, JSValue)])
-> JSObject JSValue
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSObject JSValue -> [(String, JSValue)]
forall a. JSObject a -> [(String, a)]
fromJSObject