{-# LANGUAGE CPP #-}
--------------------------------------------------------------------
-- |
-- Module    : Text.JSON.Canonical.Parse
-- Copyright : (c) Galois, Inc. 2007-2009, Duncan Coutts 2015, 2017
--
--
-- Minimal implementation of Canonical JSON parsing and printing.
--
-- <http://wiki.laptop.org/go/Canonical_JSON>
--
-- TODO: Known bugs/limitations:
--
--  * Decoding/encoding Unicode code-points beyond @U+00ff@ is currently broken
--
module Text.JSON.Canonical.Parse
  ( parseCanonicalJSON
  , renderCanonicalJSON
  , prettyCanonicalJSON
  ) where

import Text.JSON.Canonical.Types

import Text.Parsec
         ( (<|>), (<?>), many, between, sepBy
         , satisfy, char, string, digit, spaces
         , parse )
import Text.Parsec.ByteString.Lazy
         ( Parser )
import Text.PrettyPrint hiding (char)
import qualified Text.PrettyPrint as Doc
#if !(MIN_VERSION_base(4,8,0))
import Control.Applicative ((<$>), (<$), pure, (<*>), (<*), (*>))
#endif
#if MIN_VERSION_base(4,11,0)
import Prelude hiding ((<>))
#endif
import Data.Char (isDigit, digitToInt)
import Data.Function (on)
import Data.List (foldl', sortBy)
import qualified Data.ByteString.Lazy.Char8 as BS



------------------------------------------------------------------------------
-- 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 JSString
s)   = JSString -> ShowS
s_string JSString
s
s_value (JSArray [JSValue]
vs)   = [JSValue] -> ShowS
s_array  [JSValue]
vs
s_value (JSObject [(JSString, JSValue)]
fs)  = [(JSString, 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) [(JSString, JSValue)]
fs)

s_string :: JSString -> ShowS
s_string :: JSString -> ShowS
s_string JSString
s = Char -> ShowS
showChar Char
'"' forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showl (JSString -> [Char]
fromJSString JSString
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 :: [(JSString, JSValue)] -> ShowS
s_object :: [(JSString, JSValue)] -> ShowS
s_object []               = [Char] -> ShowS
showString [Char]
"{}"
s_object ((JSString
k0,JSValue
v0):[(JSString, JSValue)]
kvs0)   = Char -> ShowS
showChar Char
'{' forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSString -> ShowS
s_string JSString
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
. [(JSString, JSValue)] -> ShowS
showl [(JSString, JSValue)]
kvs0
  where showl :: [(JSString, JSValue)] -> ShowS
showl []          = Char -> ShowS
showChar Char
'}'
        showl ((JSString
k,JSValue
v):[(JSString, JSValue)]
kvs) = Char -> ShowS
showChar Char
',' forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSString -> ShowS
s_string JSString
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
. [(JSString, JSValue)] -> ShowS
showl [(JSString, 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 Parser JSValue
p_value [Char]
""

p_value :: Parser JSValue
p_value :: Parser 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
*> Parser JSValue
p_jvalue

tok              :: Parser a -> Parser a
tok :: forall a. Parser a -> Parser a
tok Parser a
p             = Parser 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         :: Parser JSValue
p_jvalue :: Parser JSValue
p_jvalue          =  (JSValue
JSNull      forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  Parser ()
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
<$> Parser 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
<$> Parser [JSValue]
p_array)
                 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (JSString -> JSValue
JSString    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser JSString
p_string)
                 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([(JSString, JSValue)] -> JSValue
JSObject    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [(JSString, 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
<$> Parser Int54
p_number)
                 forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"JSON value"

p_null           :: Parser ()
p_null :: Parser ()
p_null            = forall a. Parser a -> Parser 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        :: Parser Bool
p_boolean :: Parser Bool
p_boolean         = forall a. Parser a -> Parser 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          :: Parser [JSValue]
p_array :: Parser [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. Parser a -> Parser a
tok (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[')) (forall a. Parser a -> Parser 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
$ Parser 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. Parser a -> Parser 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         :: Parser JSString
p_string :: Parser JSString
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. Parser a -> Parser 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 {u}. ParsecT ByteString u Identity Char
p_char forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
str -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! [Char] -> JSString
toJSString [Char]
str)
  where p_char :: ParsecT ByteString u Identity 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 {u}. ParsecT ByteString u Identity 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 ByteString u Identity 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         :: Parser [(JSString, JSValue)]
p_object :: Parser [(JSString, 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. Parser a -> Parser a
tok (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{')) (forall a. Parser a -> Parser 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 ByteString () Identity (JSString, 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. Parser a -> Parser a
tok (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')
  where p_field :: ParsecT ByteString () Identity (JSString, JSValue)
p_field   = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser JSString
p_string forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parser a -> Parser 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
<*> Parser 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         :: Parser Int54
p_number :: Parser Int54
p_number          = forall a. Parser a -> Parser 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
<$> Parser Int54
pnat))
                     forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Int54
pnat
                     forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT ByteString u Identity Int54
zero
                      )
  where pnat :: Parser Int54
pnat      = (\Char
d [Char]
ds -> [Char] -> Int54
strToInt (Char
dforall a. a -> [a] -> [a]
:[Char]
ds)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {u}. ParsecT ByteString u Identity Char
digit19 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Int -> Parser a -> Parser [a]
manyN Int
14 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
        digit19 :: ParsecT ByteString u Identity 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 :: [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 ByteString u Identity Int54
zero      = Int54
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 -> Parser a -> Parser [a]
manyN :: forall a. Int -> Parser a -> Parser [a]
manyN Int
0 Parser a
_ =  forall (f :: * -> *) a. Applicative f => a -> f a
pure []
manyN Int
n Parser a
p =  ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Int -> Parser a -> Parser [a]
manyN (Int
n forall a. Num a => a -> a -> a
- Int
1) Parser 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 JSString
s)   = JSString -> Doc
jstring JSString
s
jvalue (JSArray [JSValue]
vs)   = [JSValue] -> Doc
jarray  [JSValue]
vs
jvalue (JSObject [(JSString, JSValue)]
fs)  = [(JSString, JSValue)] -> Doc
jobject [(JSString, JSValue)]
fs

jstring :: JSString -> Doc
jstring :: JSString -> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSString -> [Char]
fromJSString

jchar :: Char -> Doc
jchar :: Char -> Doc
jchar Char
'"'   = Char -> Doc
Doc.char Char
'\\' Doc -> Doc -> Doc
<> Char -> Doc
Doc.char Char
'"'
jchar Char
'\\'  = Char -> Doc
Doc.char Char
'\\' 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 :: [(JSString, JSValue)] -> Doc
jobject :: [(JSString, 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 (\(JSString
k,JSValue
v) -> [Doc] -> Doc
sep [JSString -> Doc
jstring JSString
k 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
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