{-# LANGUAGE CPP #-}
--------------------------------------------------------------------
-- |
-- Module    : Text.JSON.Parsec
-- Copyright : (c) Galois, Inc. 2007-2009, Duncan Coutts 2015
--
--
-- Minimal implementation of Canonical JSON.
--
-- <http://wiki.laptop.org/go/Canonical_JSON>
--
-- A \"canonical JSON\" format is provided in order to provide meaningful and
-- repeatable hashes of JSON-encoded data. Canonical JSON is parsable with any
-- full JSON parser, but security-conscious applications will want to verify
-- that input is in canonical form before authenticating any hash or signature
-- on that input.
--
-- This implementation is derived from the json parser from the json package,
-- with simplifications to meet the Canonical JSON grammar.
--
-- TODO: Known bugs/limitations:
--
--  * Decoding/encoding Unicode code-points beyond @U+00ff@ is currently broken
--
module Text.JSON.Canonical
  ( JSValue(..)
  , Int54
  , parseCanonicalJSON
  , renderCanonicalJSON
  , prettyCanonicalJSON
  ) where

import MyPrelude
import Text.ParserCombinators.Parsec
         ( CharParser, (<|>), (<?>), many, between, sepBy
         , satisfy, char, string, digit, spaces
         , parse )
import Text.PrettyPrint hiding (char)
import qualified Text.PrettyPrint as Doc
#if !(MIN_VERSION_base(4,7,0))
import Control.Applicative ((<$>), (<$), pure, (<*>), (<*), (*>))
#endif
import Control.Arrow (first)
import Data.Bits (Bits)
#if MIN_VERSION_base(4,7,0)
import Data.Bits (FiniteBits)
#endif
import Data.Char (isDigit, digitToInt)
import Data.Data (Data)
import Data.Function (on)
import Data.Int (Int64)
import Data.Ix (Ix)
import Data.List (foldl', sortBy)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Text.Printf (PrintfArg)
import qualified Data.ByteString.Lazy.Char8 as BS

data JSValue
    = JSNull
    | JSBool     !Bool
    | JSNum      !Int54
    | JSString   String
    | JSArray    [JSValue]
    | JSObject   [(String, JSValue)]
    deriving (Int -> JSValue -> ShowS
[JSValue] -> ShowS
JSValue -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [JSValue] -> ShowS
$cshowList :: [JSValue] -> ShowS
show :: JSValue -> [Char]
$cshow :: JSValue -> [Char]
showsPrec :: Int -> JSValue -> ShowS
$cshowsPrec :: Int -> JSValue -> ShowS
Show, ReadPrec [JSValue]
ReadPrec JSValue
Int -> ReadS JSValue
ReadS [JSValue]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JSValue]
$creadListPrec :: ReadPrec [JSValue]
readPrec :: ReadPrec JSValue
$creadPrec :: ReadPrec JSValue
readList :: ReadS [JSValue]
$creadList :: ReadS [JSValue]
readsPrec :: Int -> ReadS JSValue
$creadsPrec :: Int -> ReadS JSValue
Read, JSValue -> JSValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSValue -> JSValue -> Bool
$c/= :: JSValue -> JSValue -> Bool
== :: JSValue -> JSValue -> Bool
$c== :: JSValue -> JSValue -> Bool
Eq, Eq JSValue
JSValue -> JSValue -> Bool
JSValue -> JSValue -> Ordering
JSValue -> JSValue -> JSValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: JSValue -> JSValue -> JSValue
$cmin :: JSValue -> JSValue -> JSValue
max :: JSValue -> JSValue -> JSValue
$cmax :: JSValue -> JSValue -> JSValue
>= :: JSValue -> JSValue -> Bool
$c>= :: JSValue -> JSValue -> Bool
> :: JSValue -> JSValue -> Bool
$c> :: JSValue -> JSValue -> Bool
<= :: JSValue -> JSValue -> Bool
$c<= :: JSValue -> JSValue -> Bool
< :: JSValue -> JSValue -> Bool
$c< :: JSValue -> JSValue -> Bool
compare :: JSValue -> JSValue -> Ordering
$ccompare :: JSValue -> JSValue -> Ordering
Ord)

-- | 54-bit integer values
--
-- JavaScript can only safely represent numbers between @-(2^53 - 1)@ and
-- @2^53 - 1@.
--
-- TODO: Although we introduce the type here, we don't actually do any bounds
-- checking and just inherit all type class instance from Int64. We should
-- probably define `fromInteger` to do bounds checking, give different instances
-- for type classes such as `Bounded` and `FiniteBits`, etc.
newtype Int54 = Int54 { Int54 -> Int64
int54ToInt64 :: Int64 }
  deriving ( Int -> Int54
Int54 -> Int
Int54 -> [Int54]
Int54 -> Int54
Int54 -> Int54 -> [Int54]
Int54 -> Int54 -> Int54 -> [Int54]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Int54 -> Int54 -> Int54 -> [Int54]
$cenumFromThenTo :: Int54 -> Int54 -> Int54 -> [Int54]
enumFromTo :: Int54 -> Int54 -> [Int54]
$cenumFromTo :: Int54 -> Int54 -> [Int54]
enumFromThen :: Int54 -> Int54 -> [Int54]
$cenumFromThen :: Int54 -> Int54 -> [Int54]
enumFrom :: Int54 -> [Int54]
$cenumFrom :: Int54 -> [Int54]
fromEnum :: Int54 -> Int
$cfromEnum :: Int54 -> Int
toEnum :: Int -> Int54
$ctoEnum :: Int -> Int54
pred :: Int54 -> Int54
$cpred :: Int54 -> Int54
succ :: Int54 -> Int54
$csucc :: Int54 -> Int54
Enum
           , Int54 -> Int54 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Int54 -> Int54 -> Bool
$c/= :: Int54 -> Int54 -> Bool
== :: Int54 -> Int54 -> Bool
$c== :: Int54 -> Int54 -> Bool
Eq
           , Enum Int54
Real Int54
Int54 -> Integer
Int54 -> Int54 -> (Int54, Int54)
Int54 -> Int54 -> Int54
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Int54 -> Integer
$ctoInteger :: Int54 -> Integer
divMod :: Int54 -> Int54 -> (Int54, Int54)
$cdivMod :: Int54 -> Int54 -> (Int54, Int54)
quotRem :: Int54 -> Int54 -> (Int54, Int54)
$cquotRem :: Int54 -> Int54 -> (Int54, Int54)
mod :: Int54 -> Int54 -> Int54
$cmod :: Int54 -> Int54 -> Int54
div :: Int54 -> Int54 -> Int54
$cdiv :: Int54 -> Int54 -> Int54
rem :: Int54 -> Int54 -> Int54
$crem :: Int54 -> Int54 -> Int54
quot :: Int54 -> Int54 -> Int54
$cquot :: Int54 -> Int54 -> Int54
Integral
           , Typeable Int54
Int54 -> DataType
Int54 -> Constr
(forall b. Data b => b -> b) -> Int54 -> Int54
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Int54 -> u
forall u. (forall d. Data d => d -> u) -> Int54 -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Int54 -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Int54 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Int54 -> m Int54
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Int54 -> m Int54
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int54
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Int54 -> c Int54
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Int54)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Int54)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Int54 -> m Int54
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Int54 -> m Int54
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Int54 -> m Int54
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Int54 -> m Int54
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Int54 -> m Int54
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Int54 -> m Int54
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Int54 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Int54 -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Int54 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Int54 -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Int54 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Int54 -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Int54 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Int54 -> r
gmapT :: (forall b. Data b => b -> b) -> Int54 -> Int54
$cgmapT :: (forall b. Data b => b -> b) -> Int54 -> Int54
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Int54)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Int54)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Int54)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Int54)
dataTypeOf :: Int54 -> DataType
$cdataTypeOf :: Int54 -> DataType
toConstr :: Int54 -> Constr
$ctoConstr :: Int54 -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int54
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int54
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Int54 -> c Int54
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Int54 -> c Int54
Data
           , Integer -> Int54
Int54 -> Int54
Int54 -> Int54 -> Int54
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Int54
$cfromInteger :: Integer -> Int54
signum :: Int54 -> Int54
$csignum :: Int54 -> Int54
abs :: Int54 -> Int54
$cabs :: Int54 -> Int54
negate :: Int54 -> Int54
$cnegate :: Int54 -> Int54
* :: Int54 -> Int54 -> Int54
$c* :: Int54 -> Int54 -> Int54
- :: Int54 -> Int54 -> Int54
$c- :: Int54 -> Int54 -> Int54
+ :: Int54 -> Int54 -> Int54
$c+ :: Int54 -> Int54 -> Int54
Num
           , Eq Int54
Int54 -> Int54 -> Bool
Int54 -> Int54 -> Ordering
Int54 -> Int54 -> Int54
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Int54 -> Int54 -> Int54
$cmin :: Int54 -> Int54 -> Int54
max :: Int54 -> Int54 -> Int54
$cmax :: Int54 -> Int54 -> Int54
>= :: Int54 -> Int54 -> Bool
$c>= :: Int54 -> Int54 -> Bool
> :: Int54 -> Int54 -> Bool
$c> :: Int54 -> Int54 -> Bool
<= :: Int54 -> Int54 -> Bool
$c<= :: Int54 -> Int54 -> Bool
< :: Int54 -> Int54 -> Bool
$c< :: Int54 -> Int54 -> Bool
compare :: Int54 -> Int54 -> Ordering
$ccompare :: Int54 -> Int54 -> Ordering
Ord
           , Num Int54
Ord Int54
Int54 -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Int54 -> Rational
$ctoRational :: Int54 -> Rational
Real
           , Ord Int54
(Int54, Int54) -> Int
(Int54, Int54) -> [Int54]
(Int54, Int54) -> Int54 -> Bool
(Int54, Int54) -> Int54 -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Int54, Int54) -> Int
$cunsafeRangeSize :: (Int54, Int54) -> Int
rangeSize :: (Int54, Int54) -> Int
$crangeSize :: (Int54, Int54) -> Int
inRange :: (Int54, Int54) -> Int54 -> Bool
$cinRange :: (Int54, Int54) -> Int54 -> Bool
unsafeIndex :: (Int54, Int54) -> Int54 -> Int
$cunsafeIndex :: (Int54, Int54) -> Int54 -> Int
index :: (Int54, Int54) -> Int54 -> Int
$cindex :: (Int54, Int54) -> Int54 -> Int
range :: (Int54, Int54) -> [Int54]
$crange :: (Int54, Int54) -> [Int54]
Ix
#if MIN_VERSION_base(4,7,0)
           , Bits Int54
Int54 -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: Int54 -> Int
$ccountTrailingZeros :: Int54 -> Int
countLeadingZeros :: Int54 -> Int
$ccountLeadingZeros :: Int54 -> Int
finiteBitSize :: Int54 -> Int
$cfiniteBitSize :: Int54 -> Int
FiniteBits
#endif
           , Eq Int54
Int54
Int -> Int54
Int54 -> Bool
Int54 -> Int
Int54 -> Maybe Int
Int54 -> Int54
Int54 -> Int -> Bool
Int54 -> Int -> Int54
Int54 -> Int54 -> Int54
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: Int54 -> Int
$cpopCount :: Int54 -> Int
rotateR :: Int54 -> Int -> Int54
$crotateR :: Int54 -> Int -> Int54
rotateL :: Int54 -> Int -> Int54
$crotateL :: Int54 -> Int -> Int54
unsafeShiftR :: Int54 -> Int -> Int54
$cunsafeShiftR :: Int54 -> Int -> Int54
shiftR :: Int54 -> Int -> Int54
$cshiftR :: Int54 -> Int -> Int54
unsafeShiftL :: Int54 -> Int -> Int54
$cunsafeShiftL :: Int54 -> Int -> Int54
shiftL :: Int54 -> Int -> Int54
$cshiftL :: Int54 -> Int -> Int54
isSigned :: Int54 -> Bool
$cisSigned :: Int54 -> Bool
bitSize :: Int54 -> Int
$cbitSize :: Int54 -> Int
bitSizeMaybe :: Int54 -> Maybe Int
$cbitSizeMaybe :: Int54 -> Maybe Int
testBit :: Int54 -> Int -> Bool
$ctestBit :: Int54 -> Int -> Bool
complementBit :: Int54 -> Int -> Int54
$ccomplementBit :: Int54 -> Int -> Int54
clearBit :: Int54 -> Int -> Int54
$cclearBit :: Int54 -> Int -> Int54
setBit :: Int54 -> Int -> Int54
$csetBit :: Int54 -> Int -> Int54
bit :: Int -> Int54
$cbit :: Int -> Int54
zeroBits :: Int54
$czeroBits :: Int54
rotate :: Int54 -> Int -> Int54
$crotate :: Int54 -> Int -> Int54
shift :: Int54 -> Int -> Int54
$cshift :: Int54 -> Int -> Int54
complement :: Int54 -> Int54
$ccomplement :: Int54 -> Int54
xor :: Int54 -> Int54 -> Int54
$cxor :: Int54 -> Int54 -> Int54
.|. :: Int54 -> Int54 -> Int54
$c.|. :: Int54 -> Int54 -> Int54
.&. :: Int54 -> Int54 -> Int54
$c.&. :: Int54 -> Int54 -> Int54
Bits
           , Ptr Int54 -> IO Int54
Ptr Int54 -> Int -> IO Int54
Ptr Int54 -> Int -> Int54 -> IO ()
Ptr Int54 -> Int54 -> IO ()
Int54 -> Int
forall b. Ptr b -> Int -> IO Int54
forall b. Ptr b -> Int -> Int54 -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Int54 -> Int54 -> IO ()
$cpoke :: Ptr Int54 -> Int54 -> IO ()
peek :: Ptr Int54 -> IO Int54
$cpeek :: Ptr Int54 -> IO Int54
pokeByteOff :: forall b. Ptr b -> Int -> Int54 -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Int54 -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO Int54
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Int54
pokeElemOff :: Ptr Int54 -> Int -> Int54 -> IO ()
$cpokeElemOff :: Ptr Int54 -> Int -> Int54 -> IO ()
peekElemOff :: Ptr Int54 -> Int -> IO Int54
$cpeekElemOff :: Ptr Int54 -> Int -> IO Int54
alignment :: Int54 -> Int
$calignment :: Int54 -> Int
sizeOf :: Int54 -> Int
$csizeOf :: Int54 -> Int
Storable
           , Int54 -> ModifierParser
Int54 -> FieldFormatter
forall a.
(a -> FieldFormatter) -> (a -> ModifierParser) -> PrintfArg a
parseFormat :: Int54 -> ModifierParser
$cparseFormat :: Int54 -> ModifierParser
formatArg :: Int54 -> FieldFormatter
$cformatArg :: Int54 -> FieldFormatter
PrintfArg
           , Typeable
           )

instance Bounded Int54 where
  maxBound :: Int54
maxBound = Int64 -> Int54
Int54 (  Int64
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
53 :: Int) forall a. Num a => a -> a -> a
- Int64
1)
  minBound :: Int54
minBound = Int64 -> Int54
Int54 (-(Int64
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
53 :: Int) forall a. Num a => a -> a -> a
- Int64
1))

instance Show Int54 where
  show :: Int54 -> [Char]
show = forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int54 -> Int64
int54ToInt64

instance Read Int54 where
  readsPrec :: Int -> ReadS Int54
readsPrec Int
p = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Int64 -> Int54
Int54) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => Int -> ReadS a
readsPrec Int
p

------------------------------------------------------------------------------
-- rendering flat
--

-- | Render a JSON value in canonical form. This rendered form is canonical
-- and so allows repeatable hashes.
--
-- For pretty printing, see prettyCanonicalJSON.
--
-- NB: Canonical JSON's string escaping rules deviate from RFC 7159
-- JSON which requires
--
--    "All Unicode characters may be placed within the quotation
--    marks, except for the characters that must be escaped: quotation
--    mark, reverse solidus, and the control characters (@U+0000@
--    through @U+001F@)."
--
-- Whereas the current specification of Canonical JSON explicitly
-- requires to violate this by only escaping the quotation mark and
-- the reverse solidus. This, however, contradicts Canonical JSON's
-- statement that "Canonical JSON is parsable with any full JSON
-- parser"
--
-- Consequently, Canonical JSON is not a proper subset of RFC 7159.
--
renderCanonicalJSON :: JSValue -> BS.ByteString
renderCanonicalJSON :: JSValue -> ByteString
renderCanonicalJSON JSValue
v = [Char] -> ByteString
BS.pack (JSValue -> ShowS
s_value JSValue
v [])

s_value :: JSValue -> ShowS
s_value :: JSValue -> ShowS
s_value JSValue
JSNull         = [Char] -> ShowS
showString [Char]
"null"
s_value (JSBool Bool
False) = [Char] -> ShowS
showString [Char]
"false"
s_value (JSBool Bool
True)  = [Char] -> ShowS
showString [Char]
"true"
s_value (JSNum Int54
n)      = forall a. Show a => a -> ShowS
shows Int54
n
s_value (JSString [Char]
s)   = [Char] -> ShowS
s_string [Char]
s
s_value (JSArray [JSValue]
vs)   = [JSValue] -> ShowS
s_array  [JSValue]
vs
s_value (JSObject [([Char], JSValue)]
fs)  = [([Char], JSValue)] -> ShowS
s_object (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) [([Char], JSValue)]
fs)

s_string :: String -> ShowS
s_string :: [Char] -> ShowS
s_string [Char]
s = Char -> ShowS
showChar Char
'"' forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showl [Char]
s
  where showl :: [Char] -> ShowS
showl []     = Char -> ShowS
showChar Char
'"'
        showl (Char
c:[Char]
cs) = Char -> ShowS
s_char Char
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showl [Char]
cs

        s_char :: Char -> ShowS
s_char Char
'"'   = Char -> ShowS
showChar Char
'\\' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'"'
        s_char Char
'\\'  = Char -> ShowS
showChar Char
'\\' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\\'
        s_char Char
c     = Char -> ShowS
showChar Char
c

s_array :: [JSValue] -> ShowS
s_array :: [JSValue] -> ShowS
s_array []           = [Char] -> ShowS
showString [Char]
"[]"
s_array (JSValue
v0:[JSValue]
vs0)     = Char -> ShowS
showChar Char
'[' forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> ShowS
s_value JSValue
v0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JSValue] -> ShowS
showl [JSValue]
vs0
  where showl :: [JSValue] -> ShowS
showl []     = Char -> ShowS
showChar Char
']'
        showl (JSValue
v:[JSValue]
vs) = Char -> ShowS
showChar Char
',' forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> ShowS
s_value JSValue
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JSValue] -> ShowS
showl [JSValue]
vs

s_object :: [(String, JSValue)] -> ShowS
s_object :: [([Char], JSValue)] -> ShowS
s_object []               = [Char] -> ShowS
showString [Char]
"{}"
s_object (([Char]
k0,JSValue
v0):[([Char], JSValue)]
kvs0)   = Char -> ShowS
showChar Char
'{' forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
s_string [Char]
k0
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
':' forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> ShowS
s_value JSValue
v0
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Char], JSValue)] -> ShowS
showl [([Char], JSValue)]
kvs0
  where showl :: [([Char], JSValue)] -> ShowS
showl []          = Char -> ShowS
showChar Char
'}'
        showl (([Char]
k,JSValue
v):[([Char], JSValue)]
kvs) = Char -> ShowS
showChar Char
',' forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
s_string [Char]
k
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
':' forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> ShowS
s_value JSValue
v
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Char], JSValue)] -> ShowS
showl [([Char], JSValue)]
kvs

------------------------------------------------------------------------------
-- parsing
--

-- | Parse a canonical JSON format string as a JSON value. The input string
-- does not have to be in canonical form, just in the \"canonical JSON\"
-- format.
--
-- Use 'renderCanonicalJSON' to convert into canonical form.
--
parseCanonicalJSON :: BS.ByteString -> Either String JSValue
parseCanonicalJSON :: ByteString -> Either [Char] JSValue
parseCanonicalJSON = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall a b. b -> Either a b
Right
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse CharParser () JSValue
p_value [Char]
""
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BS.unpack

p_value :: CharParser () JSValue
p_value :: CharParser () JSValue
p_value = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> CharParser () JSValue
p_jvalue

tok              :: CharParser () a -> CharParser () a
tok :: forall a. CharParser () a -> CharParser () a
tok CharParser () a
p             = CharParser () a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces

{-
value:
   string
   number
   object
   array
   true
   false
   null
-}
p_jvalue         :: CharParser () JSValue
p_jvalue :: CharParser () JSValue
p_jvalue          =  (JSValue
JSNull      forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  CharParser () ()
p_null)
                 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Bool -> JSValue
JSBool      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharParser () Bool
p_boolean)
                 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([JSValue] -> JSValue
JSArray     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharParser () [JSValue]
p_array)
                 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> JSValue
JSString    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharParser () [Char]
p_string)
                 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([([Char], JSValue)] -> JSValue
JSObject    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharParser () [([Char], JSValue)]
p_object)
                 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Int54 -> JSValue
JSNum       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharParser () Int54
p_number)
                 forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"JSON value"

p_null           :: CharParser () ()
p_null :: CharParser () ()
p_null            = forall a. CharParser () a -> CharParser () a
tok (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"null") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()

p_boolean        :: CharParser () Bool
p_boolean :: CharParser () Bool
p_boolean         = forall a. CharParser () a -> CharParser () a
tok
                      (  (Bool
True  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"true")
                     forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"false")
                      )
{-
array:
   []
   [ elements ]
elements:
   value
   value , elements
-}
p_array          :: CharParser () [JSValue]
p_array :: CharParser () [JSValue]
p_array           = forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (forall a. CharParser () a -> CharParser () a
tok (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[')) (forall a. CharParser () a -> CharParser () a
tok (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'))
                  forall a b. (a -> b) -> a -> b
$ CharParser () JSValue
p_jvalue forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` forall a. CharParser () a -> CharParser () a
tok (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')

{-
string:
   ""
   " chars "
chars:
   char
   char chars
char:
   any byte except hex 22 (") or hex 5C (\)
   \\
   \"
-}
p_string         :: CharParser () String
p_string :: CharParser () [Char]
p_string          = forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"') (forall a. CharParser () a -> CharParser () a
tok (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"')) (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall {s} {m :: * -> *} {u}. Stream s m Char => ParsecT s u m Char
p_char)
  where p_char :: ParsecT s u m Char
p_char    =  (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {s} {m :: * -> *} {u}. Stream s m Char => ParsecT s u m Char
p_esc)
                 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
x -> Char
x forall a. Eq a => a -> a -> Bool
/= Char
'"' Bool -> Bool -> Bool
&& Char
x forall a. Eq a => a -> a -> Bool
/= Char
'\\'))

        p_esc :: ParsecT s u m Char
p_esc     =  (Char
'"'   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"')
                 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char
'\\'  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\')
                 forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"escape character"
{-
object:
    {}
    { members }
members:
   pair
   pair , members
pair:
   string : value
-}
p_object         :: CharParser () [(String,JSValue)]
p_object :: CharParser () [([Char], JSValue)]
p_object          = forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (forall a. CharParser () a -> CharParser () a
tok (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{')) (forall a. CharParser () a -> CharParser () a
tok (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'))
                  forall a b. (a -> b) -> a -> b
$ ParsecT [Char] () Identity ([Char], JSValue)
p_field forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` forall a. CharParser () a -> CharParser () a
tok (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')
  where p_field :: ParsecT [Char] () Identity ([Char], JSValue)
p_field   = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CharParser () [Char]
p_string forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. CharParser () a -> CharParser () a
tok (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':')) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CharParser () JSValue
p_jvalue

{-
number:
   int
int:
   digit
   digit1-9 digits
   - digit1-9
   - digit1-9 digits
digits:
   digit
   digit digits
-}

-- | Parse an int
--
-- TODO: Currently this allows for a maximum of 15 digits (i.e. a maximum value
-- of @999,999,999,999,999@) as a crude approximation of the 'Int54' range.
p_number         :: CharParser () Int54
p_number :: CharParser () Int54
p_number          = forall a. CharParser () a -> CharParser () a
tok
                      (  (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall a. Num a => a -> a
negate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharParser () Int54
pnat))
                     forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser () Int54
pnat
                     forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {a} {s} {m :: * -> *} {u}.
(Num a, Stream s m Char) =>
ParsecT s u m a
zero
                      )
  where pnat :: CharParser () Int54
pnat      = (\Char
d [Char]
ds -> forall {t :: * -> *}. Foldable t => t Char -> Int54
strToInt (Char
dforall a. a -> [a] -> [a]
:[Char]
ds)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {s} {m :: * -> *} {u}. Stream s m Char => ParsecT s u m Char
digit19 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Int -> CharParser () a -> CharParser () [a]
manyN Int
14 forall {s} {m :: * -> *} {u}. Stream s m Char => ParsecT s u m Char
digit
        digit19 :: ParsecT s u m Char
digit19   = forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'0') forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"digit"
        strToInt :: t Char -> Int54
strToInt  = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int54
x Char
d -> Int54
10forall a. Num a => a -> a -> a
*Int54
x forall a. Num a => a -> a -> a
+ Char -> Int54
digitToInt54 Char
d) Int54
0
        zero :: ParsecT s u m a
zero      = a
0 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0'

digitToInt54 :: Char -> Int54
digitToInt54 :: Char -> Int54
digitToInt54 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt

manyN :: Int -> CharParser () a -> CharParser () [a]
manyN :: forall a. Int -> CharParser () a -> CharParser () [a]
manyN Int
0 CharParser () a
_ =  forall (f :: * -> *) a. Applicative f => a -> f a
pure []
manyN Int
n CharParser () a
p =  ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharParser () a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Int -> CharParser () a -> CharParser () [a]
manyN (Int
nforall a. Num a => a -> a -> a
-Int
1) CharParser () a
p)
         forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []

------------------------------------------------------------------------------
-- rendering nicely
--

-- | Render a JSON value in a reasonable human-readable form. This rendered
-- form is /not the canonical form/ used for repeatable hashes, use
-- 'renderCanonicalJSON' for that.

-- It is suitable however as an external form as any canonical JSON parser can
-- read it and convert it into the form used for repeatable hashes.
--
prettyCanonicalJSON :: JSValue -> String
prettyCanonicalJSON :: JSValue -> [Char]
prettyCanonicalJSON = Doc -> [Char]
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> Doc
jvalue

jvalue :: JSValue -> Doc
jvalue :: JSValue -> Doc
jvalue JSValue
JSNull         = [Char] -> Doc
text [Char]
"null"
jvalue (JSBool Bool
False) = [Char] -> Doc
text [Char]
"false"
jvalue (JSBool Bool
True)  = [Char] -> Doc
text [Char]
"true"
jvalue (JSNum Int54
n)      = Integer -> Doc
integer (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int54 -> Int64
int54ToInt64 Int54
n))
jvalue (JSString [Char]
s)   = [Char] -> Doc
jstring [Char]
s
jvalue (JSArray [JSValue]
vs)   = [JSValue] -> Doc
jarray  [JSValue]
vs
jvalue (JSObject [([Char], JSValue)]
fs)  = [([Char], JSValue)] -> Doc
jobject [([Char], JSValue)]
fs

jstring :: String -> Doc
jstring :: [Char] -> Doc
jstring = Doc -> Doc
doubleQuotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Doc
jchar

jchar :: Char -> Doc
jchar :: Char -> Doc
jchar Char
'"'   = Char -> Doc
Doc.char Char
'\\' Doc -> Doc -> Doc
Doc.<> Char -> Doc
Doc.char Char
'"'
jchar Char
'\\'  = Char -> Doc
Doc.char Char
'\\' Doc -> Doc -> Doc
Doc.<> Char -> Doc
Doc.char Char
'\\'
jchar Char
c     = Char -> Doc
Doc.char Char
c

jarray :: [JSValue] -> Doc
jarray :: [JSValue] -> Doc
jarray = [Doc] -> Doc
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc -> Doc -> [Doc] -> [Doc]
punctuate' Doc
lbrack Doc
comma Doc
rbrack
       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map JSValue -> Doc
jvalue

jobject :: [(String, JSValue)] -> Doc
jobject :: [([Char], JSValue)] -> Doc
jobject = [Doc] -> Doc
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc -> Doc -> [Doc] -> [Doc]
punctuate' Doc
lbrace Doc
comma Doc
rbrace
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\([Char]
k,JSValue
v) -> [Doc] -> Doc
sep [[Char] -> Doc
jstring [Char]
k Doc -> Doc -> Doc
Doc.<> Doc
colon, Int -> Doc -> Doc
nest Int
2 (JSValue -> Doc
jvalue JSValue
v)])


-- | Punctuate in this style:
--
-- > [ foo, bar ]
--
-- if it fits, or vertically otherwise:
--
-- > [ foo
-- > , bar
-- > ]
--
punctuate' :: Doc -> Doc -> Doc -> [Doc] -> [Doc]
punctuate' :: Doc -> Doc -> Doc -> [Doc] -> [Doc]
punctuate' Doc
l Doc
_ Doc
r []     = [Doc
l Doc -> Doc -> Doc
Doc.<> Doc
r]
punctuate' Doc
l Doc
_ Doc
r [Doc
x]    = [Doc
l Doc -> Doc -> Doc
<+> Doc
x Doc -> Doc -> Doc
<+> Doc
r]
punctuate' Doc
l Doc
p Doc
r (Doc
x:[Doc]
xs) = Doc
l Doc -> Doc -> Doc
<+> Doc
x forall a. a -> [a] -> [a]
: [Doc] -> [Doc]
go [Doc]
xs
  where
    go :: [Doc] -> [Doc]
go []     = []
    go [Doc
y]    = [Doc
p Doc -> Doc -> Doc
<+> Doc
y, Doc
r]
    go (Doc
y:[Doc]
ys) = (Doc
p Doc -> Doc -> Doc
<+> Doc
y) forall a. a -> [a] -> [a]
: [Doc] -> [Doc]
go [Doc]
ys