{-# 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 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 -> String
(Int -> JSValue -> ShowS)
-> (JSValue -> String) -> ([JSValue] -> ShowS) -> Show JSValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSValue] -> ShowS
$cshowList :: [JSValue] -> ShowS
show :: JSValue -> String
$cshow :: JSValue -> String
showsPrec :: Int -> JSValue -> ShowS
$cshowsPrec :: Int -> JSValue -> ShowS
Show, ReadPrec [JSValue]
ReadPrec JSValue
Int -> ReadS JSValue
ReadS [JSValue]
(Int -> ReadS JSValue)
-> ReadS [JSValue]
-> ReadPrec JSValue
-> ReadPrec [JSValue]
-> Read 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
(JSValue -> JSValue -> Bool)
-> (JSValue -> JSValue -> Bool) -> Eq JSValue
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
Eq JSValue
-> (JSValue -> JSValue -> Ordering)
-> (JSValue -> JSValue -> Bool)
-> (JSValue -> JSValue -> Bool)
-> (JSValue -> JSValue -> Bool)
-> (JSValue -> JSValue -> Bool)
-> (JSValue -> JSValue -> JSValue)
-> (JSValue -> JSValue -> JSValue)
-> Ord 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
$cp1Ord :: Eq JSValue
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]
(Int54 -> Int54)
-> (Int54 -> Int54)
-> (Int -> Int54)
-> (Int54 -> Int)
-> (Int54 -> [Int54])
-> (Int54 -> Int54 -> [Int54])
-> (Int54 -> Int54 -> [Int54])
-> (Int54 -> Int54 -> Int54 -> [Int54])
-> Enum 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
(Int54 -> Int54 -> Bool) -> (Int54 -> Int54 -> Bool) -> Eq Int54
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
Real Int54
-> Enum Int54
-> (Int54 -> Int54 -> Int54)
-> (Int54 -> Int54 -> Int54)
-> (Int54 -> Int54 -> Int54)
-> (Int54 -> Int54 -> Int54)
-> (Int54 -> Int54 -> (Int54, Int54))
-> (Int54 -> Int54 -> (Int54, Int54))
-> (Int54 -> Integer)
-> Integral 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
$cp2Integral :: Enum Int54
$cp1Integral :: Real Int54
Integral
           , Typeable Int54
DataType
Constr
Typeable Int54
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Int54 -> c Int54)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Int54)
-> (Int54 -> Constr)
-> (Int54 -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Int54 -> Int54)
-> (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 u. (forall d. Data d => d -> u) -> Int54 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Int54 -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Int54 -> m Int54)
-> Data Int54
Int54 -> DataType
Int54 -> Constr
(forall b. Data b => b -> b) -> Int54 -> Int54
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Int54 -> c Int54
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cInt54 :: Constr
$tInt54 :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Int54 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Int54 -> u
gmapQ :: (forall d. Data d => d -> u) -> Int54 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Int54 -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Int54
Data
           , Integer -> Int54
Int54 -> Int54
Int54 -> Int54 -> Int54
(Int54 -> Int54 -> Int54)
-> (Int54 -> Int54 -> Int54)
-> (Int54 -> Int54 -> Int54)
-> (Int54 -> Int54)
-> (Int54 -> Int54)
-> (Int54 -> Int54)
-> (Integer -> Int54)
-> Num 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
Eq Int54
-> (Int54 -> Int54 -> Ordering)
-> (Int54 -> Int54 -> Bool)
-> (Int54 -> Int54 -> Bool)
-> (Int54 -> Int54 -> Bool)
-> (Int54 -> Int54 -> Bool)
-> (Int54 -> Int54 -> Int54)
-> (Int54 -> Int54 -> Int54)
-> Ord 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
$cp1Ord :: Eq Int54
Ord
           , Num Int54
Ord Int54
Num Int54 -> Ord Int54 -> (Int54 -> Rational) -> Real Int54
Int54 -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Int54 -> Rational
$ctoRational :: Int54 -> Rational
$cp2Real :: Ord Int54
$cp1Real :: Num Int54
Real
           , Ord Int54
Ord Int54
-> ((Int54, Int54) -> [Int54])
-> ((Int54, Int54) -> Int54 -> Int)
-> ((Int54, Int54) -> Int54 -> Int)
-> ((Int54, Int54) -> Int54 -> Bool)
-> ((Int54, Int54) -> Int)
-> ((Int54, Int54) -> Int)
-> Ix 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]
$cp1Ix :: Ord Int54
Ix
#if MIN_VERSION_base(4,7,0)
           , Bits Int54
Bits Int54
-> (Int54 -> Int)
-> (Int54 -> Int)
-> (Int54 -> Int)
-> FiniteBits 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
$cp1FiniteBits :: Bits Int54
FiniteBits
#endif
           , Eq Int54
Int54
Eq Int54
-> (Int54 -> Int54 -> Int54)
-> (Int54 -> Int54 -> Int54)
-> (Int54 -> Int54 -> Int54)
-> (Int54 -> Int54)
-> (Int54 -> Int -> Int54)
-> (Int54 -> Int -> Int54)
-> Int54
-> (Int -> Int54)
-> (Int54 -> Int -> Int54)
-> (Int54 -> Int -> Int54)
-> (Int54 -> Int -> Int54)
-> (Int54 -> Int -> Bool)
-> (Int54 -> Maybe Int)
-> (Int54 -> Int)
-> (Int54 -> Bool)
-> (Int54 -> Int -> Int54)
-> (Int54 -> Int -> Int54)
-> (Int54 -> Int -> Int54)
-> (Int54 -> Int -> Int54)
-> (Int54 -> Int -> Int54)
-> (Int54 -> Int -> Int54)
-> (Int54 -> Int)
-> Bits 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
$cp1Bits :: Eq Int54
Bits
           , Ptr b -> Int -> IO Int54
Ptr b -> Int -> Int54 -> IO ()
Ptr Int54 -> IO Int54
Ptr Int54 -> Int -> IO Int54
Ptr Int54 -> Int -> Int54 -> IO ()
Ptr Int54 -> Int54 -> IO ()
Int54 -> Int
(Int54 -> Int)
-> (Int54 -> Int)
-> (Ptr Int54 -> Int -> IO Int54)
-> (Ptr Int54 -> Int -> Int54 -> IO ())
-> (forall b. Ptr b -> Int -> IO Int54)
-> (forall b. Ptr b -> Int -> Int54 -> IO ())
-> (Ptr Int54 -> IO Int54)
-> (Ptr Int54 -> Int54 -> IO ())
-> Storable Int54
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 :: Ptr b -> Int -> Int54 -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Int54 -> IO ()
peekByteOff :: 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
(Int54 -> FieldFormatter)
-> (Int54 -> ModifierParser) -> PrintfArg Int54
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
2Int64 -> Int -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
53 :: Int) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)
  minBound :: Int54
minBound = Int64 -> Int54
Int54 (-(Int64
2Int64 -> Int -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
53 :: Int) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1))

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

instance Read Int54 where
  readsPrec :: Int -> ReadS Int54
readsPrec Int
p = ((Int64, String) -> (Int54, String))
-> [(Int64, String)] -> [(Int54, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int64 -> Int54) -> (Int64, String) -> (Int54, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Int64 -> Int54
Int54) ([(Int64, String)] -> [(Int54, String)])
-> (String -> [(Int64, String)]) -> ReadS Int54
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Int64, String)]
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 = String -> ByteString
BS.pack (JSValue -> ShowS
s_value JSValue
v [])

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

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

        s_char :: Char -> ShowS
s_char Char
'"'   = Char -> ShowS
showChar Char
'\\' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'"'
        s_char Char
'\\'  = Char -> ShowS
showChar Char
'\\' ShowS -> ShowS -> ShowS
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 []           = String -> ShowS
showString String
"[]"
s_array (JSValue
v0:[JSValue]
vs0)     = Char -> ShowS
showChar Char
'[' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> ShowS
s_value JSValue
v0 ShowS -> ShowS -> ShowS
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
',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> ShowS
s_value JSValue
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JSValue] -> ShowS
showl [JSValue]
vs

s_object :: [(String, JSValue)] -> ShowS
s_object :: [(String, JSValue)] -> ShowS
s_object []               = String -> ShowS
showString String
"{}"
s_object ((String
k0,JSValue
v0):[(String, JSValue)]
kvs0)   = Char -> ShowS
showChar Char
'{' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
s_string String
k0
                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
':' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> ShowS
s_value JSValue
v0
                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, JSValue)] -> ShowS
showl [(String, JSValue)]
kvs0
  where showl :: [(String, JSValue)] -> ShowS
showl []          = Char -> ShowS
showChar Char
'}'
        showl ((String
k,JSValue
v):[(String, JSValue)]
kvs) = Char -> ShowS
showChar Char
',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
s_string String
k
                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
':' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> ShowS
s_value JSValue
v
                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, JSValue)] -> ShowS
showl [(String, 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 String JSValue
parseCanonicalJSON = (ParseError -> Either String JSValue)
-> (JSValue -> Either String JSValue)
-> Either ParseError JSValue
-> Either String JSValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String JSValue
forall a b. a -> Either a b
Left (String -> Either String JSValue)
-> (ParseError -> String) -> ParseError -> Either String JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) JSValue -> Either String JSValue
forall a b. b -> Either a b
Right
                   (Either ParseError JSValue -> Either String JSValue)
-> (ByteString -> Either ParseError JSValue)
-> ByteString
-> Either String JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec String () JSValue
-> String -> String -> Either ParseError JSValue
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () JSValue
p_value String
""
                   (String -> Either ParseError JSValue)
-> (ByteString -> String)
-> ByteString
-> Either ParseError JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BS.unpack

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

tok              :: CharParser () a -> CharParser () a
tok :: CharParser () a -> CharParser () a
tok CharParser () a
p             = CharParser () a
p CharParser () a -> ParsecT String () Identity () -> CharParser () a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
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 :: Parsec String () JSValue
p_jvalue          =  (JSValue
JSNull      JSValue
-> ParsecT String () Identity () -> Parsec String () JSValue
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  ParsecT String () Identity ()
p_null)
                 Parsec String () JSValue
-> Parsec String () JSValue -> Parsec String () JSValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Bool -> JSValue
JSBool      (Bool -> JSValue)
-> ParsecT String () Identity Bool -> Parsec String () JSValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Bool
p_boolean)
                 Parsec String () JSValue
-> Parsec String () JSValue -> Parsec String () JSValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([JSValue] -> JSValue
JSArray     ([JSValue] -> JSValue)
-> ParsecT String () Identity [JSValue] -> Parsec String () JSValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [JSValue]
p_array)
                 Parsec String () JSValue
-> Parsec String () JSValue -> Parsec String () JSValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> JSValue
JSString    (String -> JSValue)
-> ParsecT String () Identity String -> Parsec String () JSValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
p_string)
                 Parsec String () JSValue
-> Parsec String () JSValue -> Parsec String () JSValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([(String, JSValue)] -> JSValue
JSObject    ([(String, JSValue)] -> JSValue)
-> ParsecT String () Identity [(String, JSValue)]
-> Parsec String () JSValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [(String, JSValue)]
p_object)
                 Parsec String () JSValue
-> Parsec String () JSValue -> Parsec String () JSValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Int54 -> JSValue
JSNum       (Int54 -> JSValue)
-> ParsecT String () Identity Int54 -> Parsec String () JSValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Int54
p_number)
                 Parsec String () JSValue -> String -> Parsec String () JSValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"JSON value"

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

p_boolean        :: CharParser () Bool
p_boolean :: ParsecT String () Identity Bool
p_boolean         = ParsecT String () Identity Bool -> ParsecT String () Identity Bool
forall a. CharParser () a -> CharParser () a
tok
                      (  (Bool
True  Bool
-> ParsecT String () Identity String
-> ParsecT String () Identity Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"true")
                     ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Bool
False Bool
-> ParsecT String () Identity String
-> ParsecT String () Identity Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"false")
                      )
{-
array:
   []
   [ elements ]
elements:
   value
   value , elements
-}
p_array          :: CharParser () [JSValue]
p_array :: ParsecT String () Identity [JSValue]
p_array           = ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity [JSValue]
-> ParsecT String () Identity [JSValue]
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 (ParsecT String () Identity Char -> ParsecT String () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[')) (ParsecT String () Identity Char -> ParsecT String () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'))
                  (ParsecT String () Identity [JSValue]
 -> ParsecT String () Identity [JSValue])
-> ParsecT String () Identity [JSValue]
-> ParsecT String () Identity [JSValue]
forall a b. (a -> b) -> a -> b
$ Parsec String () JSValue
p_jvalue Parsec String () JSValue
-> ParsecT String () Identity Char
-> ParsecT String () Identity [JSValue]
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` ParsecT String () Identity Char -> ParsecT String () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT String () Identity Char
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 :: ParsecT String () Identity String
p_string          = ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity 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 (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"') (ParsecT String () Identity Char -> ParsecT String () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"')) (ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity Char
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    =  (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
p_esc)
                 ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\'))

        p_esc :: ParsecT s u m Char
p_esc     =  (Char
'"'   Char -> ParsecT s u m Char -> ParsecT s u m Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"')
                 ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char
'\\'  Char -> ParsecT s u m Char -> ParsecT s u m Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\')
                 ParsecT s u m Char -> String -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"escape character"
{-
object:
    {}
    { members }
members:
   pair
   pair , members
pair:
   string : value
-}
p_object         :: CharParser () [(String,JSValue)]
p_object :: ParsecT String () Identity [(String, JSValue)]
p_object          = ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity [(String, JSValue)]
-> ParsecT String () Identity [(String, JSValue)]
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 (ParsecT String () Identity Char -> ParsecT String () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{')) (ParsecT String () Identity Char -> ParsecT String () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'))
                  (ParsecT String () Identity [(String, JSValue)]
 -> ParsecT String () Identity [(String, JSValue)])
-> ParsecT String () Identity [(String, JSValue)]
-> ParsecT String () Identity [(String, JSValue)]
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity (String, JSValue)
p_field ParsecT String () Identity (String, JSValue)
-> ParsecT String () Identity Char
-> ParsecT String () Identity [(String, JSValue)]
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` ParsecT String () Identity Char -> ParsecT String () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')
  where p_field :: ParsecT String () Identity (String, JSValue)
p_field   = (,) (String -> JSValue -> (String, JSValue))
-> ParsecT String () Identity String
-> ParsecT String () Identity (JSValue -> (String, JSValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT String () Identity String
p_string ParsecT String () Identity String
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity Char -> ParsecT String () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':')) ParsecT String () Identity (JSValue -> (String, JSValue))
-> Parsec String () JSValue
-> ParsecT String () Identity (String, JSValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec String () 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 :: ParsecT String () Identity Int54
p_number          = ParsecT String () Identity Int54
-> ParsecT String () Identity Int54
forall a. CharParser () a -> CharParser () a
tok
                      (  (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT String () Identity Char
-> ParsecT String () Identity Int54
-> ParsecT String () Identity Int54
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int54 -> Int54
forall a. Num a => a -> a
negate (Int54 -> Int54)
-> ParsecT String () Identity Int54
-> ParsecT String () Identity Int54
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Int54
pnat))
                     ParsecT String () Identity Int54
-> ParsecT String () Identity Int54
-> ParsecT String () Identity Int54
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Int54
pnat
                     ParsecT String () Identity Int54
-> ParsecT String () Identity Int54
-> ParsecT String () Identity Int54
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Int54
forall a s (m :: * -> *) u.
(Num a, Stream s m Char) =>
ParsecT s u m a
zero
                      )
  where pnat :: ParsecT String () Identity Int54
pnat      = (\Char
d String
ds -> String -> Int54
forall (t :: * -> *). Foldable t => t Char -> Int54
strToInt (Char
dChar -> ShowS
forall a. a -> [a] -> [a]
:String
ds)) (Char -> String -> Int54)
-> ParsecT String () Identity Char
-> ParsecT String () Identity (String -> Int54)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit19 ParsecT String () Identity (String -> Int54)
-> ParsecT String () Identity String
-> ParsecT String () Identity Int54
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall a. Int -> CharParser () a -> CharParser () [a]
manyN Int
14 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
        digit19 :: ParsecT s u m Char
digit19   = (Char -> Bool) -> ParsecT s u m Char
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'0') ParsecT s u m Char -> String -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"digit"
        strToInt :: t Char -> Int54
strToInt  = (Int54 -> Char -> Int54) -> Int54 -> t Char -> Int54
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int54
x Char
d -> Int54
10Int54 -> Int54 -> Int54
forall a. Num a => a -> a -> a
*Int54
x Int54 -> Int54 -> Int54
forall a. Num a => a -> a -> a
+ Char -> Int54
digitToInt54 Char
d) Int54
0
        zero :: ParsecT s u m a
zero      = a
0 a -> ParsecT s u m Char -> ParsecT s u m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0'

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

manyN :: Int -> CharParser () a -> CharParser () [a]
manyN :: Int -> CharParser () a -> CharParser () [a]
manyN Int
0 CharParser () a
_ =  [a] -> CharParser () [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
manyN Int
n CharParser () a
p =  ((:) (a -> [a] -> [a])
-> CharParser () a -> ParsecT String () Identity ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharParser () a
p ParsecT String () Identity ([a] -> [a])
-> CharParser () [a] -> CharParser () [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> CharParser () a -> CharParser () [a]
forall a. Int -> CharParser () a -> CharParser () [a]
manyN (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) CharParser () a
p)
         CharParser () [a] -> CharParser () [a] -> CharParser () [a]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [a] -> CharParser () [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 -> String
prettyCanonicalJSON = Doc -> String
render (Doc -> String) -> (JSValue -> Doc) -> JSValue -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> Doc
jvalue

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

jstring :: String -> Doc
jstring :: String -> Doc
jstring = Doc -> Doc
doubleQuotes (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hcat ([Doc] -> Doc) -> (String -> [Doc]) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Doc) -> String -> [Doc]
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 ([Doc] -> Doc) -> ([JSValue] -> [Doc]) -> [JSValue] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc -> Doc -> [Doc] -> [Doc]
punctuate' Doc
lbrack Doc
comma Doc
rbrack
       ([Doc] -> [Doc]) -> ([JSValue] -> [Doc]) -> [JSValue] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JSValue -> Doc) -> [JSValue] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map JSValue -> Doc
jvalue

jobject :: [(String, JSValue)] -> Doc
jobject :: [(String, JSValue)] -> Doc
jobject = [Doc] -> Doc
sep ([Doc] -> Doc)
-> ([(String, JSValue)] -> [Doc]) -> [(String, JSValue)] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc -> Doc -> [Doc] -> [Doc]
punctuate' Doc
lbrace Doc
comma Doc
rbrace
        ([Doc] -> [Doc])
-> ([(String, JSValue)] -> [Doc]) -> [(String, JSValue)] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, JSValue) -> Doc) -> [(String, JSValue)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
k,JSValue
v) -> [Doc] -> Doc
sep [String -> Doc
jstring String
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 Doc -> [Doc] -> [Doc]
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) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc] -> [Doc]
go [Doc]
ys