{-# 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]
(Int -> JSValue -> ShowS)
-> (JSValue -> [Char]) -> ([JSValue] -> ShowS) -> Show JSValue
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JSValue -> ShowS
showsPrec :: Int -> JSValue -> ShowS
$cshow :: JSValue -> [Char]
show :: JSValue -> [Char]
$cshowList :: [JSValue] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS JSValue
readsPrec :: Int -> ReadS JSValue
$creadList :: ReadS [JSValue]
readList :: ReadS [JSValue]
$creadPrec :: ReadPrec JSValue
readPrec :: ReadPrec JSValue
$creadListPrec :: ReadPrec [JSValue]
readListPrec :: ReadPrec [JSValue]
Read, JSValue -> JSValue -> Bool
(JSValue -> JSValue -> Bool)
-> (JSValue -> JSValue -> Bool) -> Eq JSValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JSValue -> JSValue -> Bool
== :: JSValue -> JSValue -> Bool
$c/= :: JSValue -> JSValue -> Bool
/= :: 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
$ccompare :: JSValue -> JSValue -> Ordering
compare :: JSValue -> JSValue -> Ordering
$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
>= :: JSValue -> JSValue -> Bool
$cmax :: JSValue -> JSValue -> JSValue
max :: JSValue -> JSValue -> JSValue
$cmin :: JSValue -> JSValue -> JSValue
min :: JSValue -> JSValue -> 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
$csucc :: Int54 -> Int54
succ :: Int54 -> Int54
$cpred :: Int54 -> Int54
pred :: Int54 -> Int54
$ctoEnum :: Int -> Int54
toEnum :: Int -> Int54
$cfromEnum :: Int54 -> Int
fromEnum :: Int54 -> Int
$cenumFrom :: Int54 -> [Int54]
enumFrom :: Int54 -> [Int54]
$cenumFromThen :: Int54 -> Int54 -> [Int54]
enumFromThen :: Int54 -> Int54 -> [Int54]
$cenumFromTo :: Int54 -> Int54 -> [Int54]
enumFromTo :: Int54 -> Int54 -> [Int54]
$cenumFromThenTo :: Int54 -> Int54 -> Int54 -> [Int54]
enumFromThenTo :: Int54 -> Int54 -> Int54 -> [Int54]
Enum
           , Int54 -> Int54 -> Bool
(Int54 -> Int54 -> Bool) -> (Int54 -> Int54 -> Bool) -> Eq Int54
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Int54 -> Int54 -> Bool
== :: Int54 -> Int54 -> Bool
$c/= :: Int54 -> Int54 -> Bool
/= :: 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
$cquot :: Int54 -> Int54 -> Int54
quot :: Int54 -> Int54 -> Int54
$crem :: Int54 -> Int54 -> Int54
rem :: Int54 -> Int54 -> Int54
$cdiv :: Int54 -> Int54 -> Int54
div :: Int54 -> Int54 -> Int54
$cmod :: Int54 -> Int54 -> Int54
mod :: Int54 -> Int54 -> Int54
$cquotRem :: Int54 -> Int54 -> (Int54, Int54)
quotRem :: Int54 -> Int54 -> (Int54, Int54)
$cdivMod :: Int54 -> Int54 -> (Int54, Int54)
divMod :: Int54 -> Int54 -> (Int54, Int54)
$ctoInteger :: Int54 -> Integer
toInteger :: Int54 -> Integer
Integral
           , Typeable Int54
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 -> Constr
Int54 -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Int54 -> c Int54
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Int54 -> c Int54
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int54
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int54
$ctoConstr :: Int54 -> Constr
toConstr :: Int54 -> Constr
$cdataTypeOf :: Int54 -> DataType
dataTypeOf :: Int54 -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Int54)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Int54)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Int54)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Int54)
$cgmapT :: (forall b. Data b => b -> b) -> Int54 -> Int54
gmapT :: (forall b. Data b => b -> b) -> Int54 -> Int54
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Int54 -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Int54 -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Int54 -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Int54 -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Int54 -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Int54 -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Int54 -> m Int54
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Int54 -> m 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
$c+ :: Int54 -> Int54 -> Int54
+ :: Int54 -> Int54 -> Int54
$c- :: Int54 -> Int54 -> Int54
- :: Int54 -> Int54 -> Int54
$c* :: Int54 -> Int54 -> Int54
* :: Int54 -> Int54 -> Int54
$cnegate :: Int54 -> Int54
negate :: Int54 -> Int54
$cabs :: Int54 -> Int54
abs :: Int54 -> Int54
$csignum :: Int54 -> Int54
signum :: Int54 -> Int54
$cfromInteger :: Integer -> Int54
fromInteger :: Integer -> 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
$ccompare :: Int54 -> Int54 -> Ordering
compare :: Int54 -> Int54 -> Ordering
$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
>= :: Int54 -> Int54 -> Bool
$cmax :: Int54 -> Int54 -> Int54
max :: Int54 -> Int54 -> Int54
$cmin :: Int54 -> Int54 -> Int54
min :: Int54 -> Int54 -> 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
$ctoRational :: Int54 -> Rational
toRational :: Int54 -> Rational
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
$crange :: (Int54, Int54) -> [Int54]
range :: (Int54, Int54) -> [Int54]
$cindex :: (Int54, Int54) -> Int54 -> Int
index :: (Int54, Int54) -> Int54 -> Int
$cunsafeIndex :: (Int54, Int54) -> Int54 -> Int
unsafeIndex :: (Int54, Int54) -> Int54 -> Int
$cinRange :: (Int54, Int54) -> Int54 -> Bool
inRange :: (Int54, Int54) -> Int54 -> Bool
$crangeSize :: (Int54, Int54) -> Int
rangeSize :: (Int54, Int54) -> Int
$cunsafeRangeSize :: (Int54, Int54) -> Int
unsafeRangeSize :: (Int54, Int54) -> Int
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
$cfiniteBitSize :: Int54 -> Int
finiteBitSize :: Int54 -> Int
$ccountLeadingZeros :: Int54 -> Int
countLeadingZeros :: Int54 -> Int
$ccountTrailingZeros :: Int54 -> Int
countTrailingZeros :: Int54 -> Int
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
$c.&. :: Int54 -> Int54 -> Int54
.&. :: Int54 -> Int54 -> Int54
$c.|. :: Int54 -> Int54 -> Int54
.|. :: Int54 -> Int54 -> Int54
$cxor :: Int54 -> Int54 -> Int54
xor :: Int54 -> Int54 -> Int54
$ccomplement :: Int54 -> Int54
complement :: Int54 -> Int54
$cshift :: Int54 -> Int -> Int54
shift :: Int54 -> Int -> Int54
$crotate :: Int54 -> Int -> Int54
rotate :: Int54 -> Int -> Int54
$czeroBits :: Int54
zeroBits :: Int54
$cbit :: Int -> Int54
bit :: Int -> Int54
$csetBit :: Int54 -> Int -> Int54
setBit :: Int54 -> Int -> Int54
$cclearBit :: Int54 -> Int -> Int54
clearBit :: Int54 -> Int -> Int54
$ccomplementBit :: Int54 -> Int -> Int54
complementBit :: Int54 -> Int -> Int54
$ctestBit :: Int54 -> Int -> Bool
testBit :: Int54 -> Int -> Bool
$cbitSizeMaybe :: Int54 -> Maybe Int
bitSizeMaybe :: Int54 -> Maybe Int
$cbitSize :: Int54 -> Int
bitSize :: Int54 -> Int
$cisSigned :: Int54 -> Bool
isSigned :: Int54 -> Bool
$cshiftL :: Int54 -> Int -> Int54
shiftL :: Int54 -> Int -> Int54
$cunsafeShiftL :: Int54 -> Int -> Int54
unsafeShiftL :: Int54 -> Int -> Int54
$cshiftR :: Int54 -> Int -> Int54
shiftR :: Int54 -> Int -> Int54
$cunsafeShiftR :: Int54 -> Int -> Int54
unsafeShiftR :: Int54 -> Int -> Int54
$crotateL :: Int54 -> Int -> Int54
rotateL :: Int54 -> Int -> Int54
$crotateR :: Int54 -> Int -> Int54
rotateR :: Int54 -> Int -> Int54
$cpopCount :: Int54 -> Int
popCount :: Int54 -> Int
Bits
           , 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
$csizeOf :: Int54 -> Int
sizeOf :: Int54 -> Int
$calignment :: Int54 -> Int
alignment :: Int54 -> Int
$cpeekElemOff :: Ptr Int54 -> Int -> IO Int54
peekElemOff :: Ptr Int54 -> Int -> IO Int54
$cpokeElemOff :: Ptr Int54 -> Int -> Int54 -> IO ()
pokeElemOff :: Ptr Int54 -> Int -> Int54 -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Int54
peekByteOff :: forall b. Ptr b -> Int -> IO Int54
$cpokeByteOff :: forall b. Ptr b -> Int -> Int54 -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Int54 -> IO ()
$cpeek :: Ptr Int54 -> IO Int54
peek :: Ptr Int54 -> IO Int54
$cpoke :: Ptr Int54 -> Int54 -> IO ()
poke :: Ptr Int54 -> Int54 -> IO ()
Storable
           , Int54 -> ModifierParser
Int54 -> FieldFormatter
(Int54 -> FieldFormatter)
-> (Int54 -> ModifierParser) -> PrintfArg Int54
forall a.
(a -> FieldFormatter) -> (a -> ModifierParser) -> PrintfArg a
$cformatArg :: Int54 -> FieldFormatter
formatArg :: Int54 -> FieldFormatter
$cparseFormat :: Int54 -> ModifierParser
parseFormat :: Int54 -> ModifierParser
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 -> [Char]
show = Int64 -> [Char]
forall a. Show a => a -> [Char]
show (Int64 -> [Char]) -> (Int54 -> Int64) -> Int54 -> [Char]
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, [Char]) -> (Int54, [Char]))
-> [(Int64, [Char])] -> [(Int54, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map ((Int64 -> Int54) -> (Int64, [Char]) -> (Int54, [Char])
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Int64 -> Int54
Int54) ([(Int64, [Char])] -> [(Int54, [Char])])
-> ([Char] -> [(Int64, [Char])]) -> ReadS Int54
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [(Int64, [Char])]
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)      = Int54 -> ShowS
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 ((([Char], JSValue) -> ([Char], JSValue) -> Ordering)
-> [([Char], JSValue)] -> [([Char], JSValue)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ([Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Char] -> [Char] -> Ordering)
-> (([Char], JSValue) -> [Char])
-> ([Char], JSValue)
-> ([Char], JSValue)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ([Char], JSValue) -> [Char]
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
'"' ShowS -> ShowS -> ShowS
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 ShowS -> ShowS -> ShowS
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
'\\' 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 []           = [Char] -> ShowS
showString [Char]
"[]"
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 :: [([Char], JSValue)] -> ShowS
s_object []               = [Char] -> ShowS
showString [Char]
"{}"
s_object (([Char]
k0,JSValue
v0):[([Char], JSValue)]
kvs0)   = Char -> ShowS
showChar Char
'{' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
s_string [Char]
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
. [([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
',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
s_string [Char]
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
. [([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 = (ParseError -> Either [Char] JSValue)
-> (JSValue -> Either [Char] JSValue)
-> Either ParseError JSValue
-> Either [Char] JSValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Either [Char] JSValue
forall a b. a -> Either a b
Left ([Char] -> Either [Char] JSValue)
-> (ParseError -> [Char]) -> ParseError -> Either [Char] JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Char]
forall a. Show a => a -> [Char]
show) JSValue -> Either [Char] JSValue
forall a b. b -> Either a b
Right
                   (Either ParseError JSValue -> Either [Char] JSValue)
-> (ByteString -> Either ParseError JSValue)
-> ByteString
-> Either [Char] JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec [Char] () JSValue
-> [Char] -> [Char] -> Either ParseError JSValue
forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse Parsec [Char] () JSValue
p_value [Char]
""
                   ([Char] -> Either ParseError JSValue)
-> (ByteString -> [Char])
-> ByteString
-> Either ParseError JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BS.unpack

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

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

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

p_boolean        :: CharParser () Bool
p_boolean :: ParsecT [Char] () Identity Bool
p_boolean         = ParsecT [Char] () Identity Bool -> ParsecT [Char] () Identity Bool
forall a. CharParser () a -> CharParser () a
tok
                      (  (Bool
True  Bool
-> ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity Bool
forall a b.
a -> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT [Char] () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"true")
                     ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
-> ParsecT [Char] () 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 [Char] () Identity [Char]
-> ParsecT [Char] () Identity Bool
forall a b.
a -> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT [Char] () Identity [Char]
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 :: ParsecT [Char] () Identity [JSValue]
p_array           = ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [JSValue]
-> ParsecT [Char] () 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 [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[')) (ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'))
                  (ParsecT [Char] () Identity [JSValue]
 -> ParsecT [Char] () Identity [JSValue])
-> ParsecT [Char] () Identity [JSValue]
-> ParsecT [Char] () Identity [JSValue]
forall a b. (a -> b) -> a -> b
$ Parsec [Char] () JSValue
p_jvalue Parsec [Char] () JSValue
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () 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 [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT [Char] () 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 [Char] () Identity [Char]
p_string          = ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity [Char]
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 [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"') (ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"')) (ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Char] () 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 a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
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 a b. a -> ParsecT s u m b -> 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
'"')
                 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 a b. a -> ParsecT s u m b -> 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
'\\')
                 ParsecT s u m Char -> [Char] -> ParsecT s u m 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 :: ParsecT [Char] () Identity [([Char], JSValue)]
p_object          = ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [([Char], JSValue)]
-> ParsecT [Char] () Identity [([Char], 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 [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{')) (ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'))
                  (ParsecT [Char] () Identity [([Char], JSValue)]
 -> ParsecT [Char] () Identity [([Char], JSValue)])
-> ParsecT [Char] () Identity [([Char], JSValue)]
-> ParsecT [Char] () Identity [([Char], JSValue)]
forall a b. (a -> b) -> a -> b
$ ParsecT [Char] () Identity ([Char], JSValue)
p_field ParsecT [Char] () Identity ([Char], JSValue)
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [([Char], 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 [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT [Char] () Identity Char
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   = (,) ([Char] -> JSValue -> ([Char], JSValue))
-> ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity (JSValue -> ([Char], JSValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT [Char] () Identity [Char]
p_string ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':')) ParsecT [Char] () Identity (JSValue -> ([Char], JSValue))
-> Parsec [Char] () JSValue
-> ParsecT [Char] () Identity ([Char], JSValue)
forall a b.
ParsecT [Char] () Identity (a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec [Char] () 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 [Char] () Identity Int54
p_number          = ParsecT [Char] () Identity Int54
-> ParsecT [Char] () Identity Int54
forall a. CharParser () a -> CharParser () a
tok
                      (  (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Int54
-> ParsecT [Char] () Identity Int54
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int54 -> Int54
forall a. Num a => a -> a
negate (Int54 -> Int54)
-> ParsecT [Char] () Identity Int54
-> ParsecT [Char] () Identity Int54
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity Int54
pnat))
                     ParsecT [Char] () Identity Int54
-> ParsecT [Char] () Identity Int54
-> ParsecT [Char] () Identity Int54
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity Int54
pnat
                     ParsecT [Char] () Identity Int54
-> ParsecT [Char] () Identity Int54
-> ParsecT [Char] () Identity Int54
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity Int54
forall {a} {s} {m :: * -> *} {u}.
(Num a, Stream s m Char) =>
ParsecT s u m a
zero
                      )
  where pnat :: ParsecT [Char] () Identity Int54
pnat      = (\Char
d [Char]
ds -> [Char] -> Int54
forall {t :: * -> *}. Foldable t => t Char -> Int54
strToInt (Char
dChar -> ShowS
forall a. a -> [a] -> [a]
:[Char]
ds)) (Char -> [Char] -> Int54)
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity ([Char] -> Int54)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity Char
forall {s} {m :: * -> *} {u}. Stream s m Char => ParsecT s u m Char
digit19 ParsecT [Char] () Identity ([Char] -> Int54)
-> ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity Int54
forall a b.
ParsecT [Char] () Identity (a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall a. Int -> CharParser () a -> CharParser () [a]
manyN Int
14 ParsecT [Char] () 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 -> [Char] -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"digit"
        strToInt :: t Char -> Int54
strToInt  = (Int54 -> Char -> Int54) -> Int54 -> t Char -> Int54
forall b a. (b -> a -> b) -> b -> t a -> b
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 a b. a -> ParsecT s u m b -> 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 :: forall a. Int -> CharParser () a -> CharParser () [a]
manyN Int
0 CharParser () a
_ =  [a] -> ParsecT [Char] () Identity [a]
forall a. a -> ParsecT [Char] () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
manyN Int
n CharParser () a
p =  ((:) (a -> [a] -> [a])
-> CharParser () a -> ParsecT [Char] () Identity ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharParser () a
p ParsecT [Char] () Identity ([a] -> [a])
-> ParsecT [Char] () Identity [a] -> ParsecT [Char] () Identity [a]
forall a b.
ParsecT [Char] () Identity (a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> CharParser () a -> ParsecT [Char] () Identity [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)
         ParsecT [Char] () Identity [a]
-> ParsecT [Char] () Identity [a] -> ParsecT [Char] () Identity [a]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [a] -> ParsecT [Char] () Identity [a]
forall a. a -> ParsecT [Char] () Identity 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 (Doc -> [Char]) -> (JSValue -> Doc) -> JSValue -> [Char]
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 (Int64 -> 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 (Doc -> Doc) -> ([Char] -> Doc) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hcat ([Doc] -> Doc) -> ([Char] -> [Doc]) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Doc) -> [Char] -> [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 :: [([Char], JSValue)] -> Doc
jobject = [Doc] -> Doc
sep ([Doc] -> Doc)
-> ([([Char], JSValue)] -> [Doc]) -> [([Char], 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])
-> ([([Char], JSValue)] -> [Doc]) -> [([Char], JSValue)] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], JSValue) -> Doc) -> [([Char], JSValue)] -> [Doc]
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 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