{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
module Data.Aeson.Types.Internal
(
Value(..)
, Key
, Array
, emptyArray, isEmptyArray
, Pair
, Object
, emptyObject
, Parser
, Result(..)
, IResult(..)
, JSONPathElement(..)
, JSONPath
, iparse
, iparseEither
, parse
, parseEither
, parseMaybe
, parseFail
, modifyFailure
, prependFailure
, parserThrowError
, parserCatchError
, formatError
, formatPath
, formatRelativePath
, (<?>)
, object
, Options(
fieldLabelModifier
, constructorTagModifier
, allNullaryToStringTag
, omitNothingFields
, allowOmittedFields
, sumEncoding
, unwrapUnaryRecords
, tagSingleConstructors
, rejectUnknownFields
)
, SumEncoding(..)
, JSONKeyOptions(keyModifier)
, defaultOptions
, defaultTaggedObject
, defaultJSONKeyOptions
, camelTo
, camelTo2
, AesonException (..)
, DotNetTime(..)
) where
import Data.Aeson.Internal.Prelude
import Control.DeepSeq (NFData(..))
import Control.Exception (Exception (..))
import Control.Monad (MonadPlus(..), ap)
import Data.Char (isLower, isUpper, toLower, isAlpha, isAlphaNum)
import Data.Aeson.Key (Key)
import Data.Hashable (Hashable(..))
import Data.List (intercalate)
import Data.Text (pack, unpack)
import Data.Time.Format (FormatTime)
import Data.Aeson.KeyMap (KeyMap)
import qualified Control.Monad as Monad
import qualified Control.Monad.Fail as Fail
import qualified Data.Vector as V
import qualified Language.Haskell.TH.Syntax as TH
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Scientific as Sci
import qualified Data.Text as T
import qualified Test.QuickCheck as QC
import Witherable (ordNub)
data JSONPathElement = Key Key
| Index {-# UNPACK #-} !Int
deriving (JSONPathElement -> JSONPathElement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSONPathElement -> JSONPathElement -> Bool
$c/= :: JSONPathElement -> JSONPathElement -> Bool
== :: JSONPathElement -> JSONPathElement -> Bool
$c== :: JSONPathElement -> JSONPathElement -> Bool
Eq, Int -> JSONPathElement -> ShowS
[JSONPathElement] -> ShowS
JSONPathElement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONPathElement] -> ShowS
$cshowList :: [JSONPathElement] -> ShowS
show :: JSONPathElement -> String
$cshow :: JSONPathElement -> String
showsPrec :: Int -> JSONPathElement -> ShowS
$cshowsPrec :: Int -> JSONPathElement -> ShowS
Show, Typeable, Eq JSONPathElement
JSONPathElement -> JSONPathElement -> Bool
JSONPathElement -> JSONPathElement -> Ordering
JSONPathElement -> JSONPathElement -> JSONPathElement
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 :: JSONPathElement -> JSONPathElement -> JSONPathElement
$cmin :: JSONPathElement -> JSONPathElement -> JSONPathElement
max :: JSONPathElement -> JSONPathElement -> JSONPathElement
$cmax :: JSONPathElement -> JSONPathElement -> JSONPathElement
>= :: JSONPathElement -> JSONPathElement -> Bool
$c>= :: JSONPathElement -> JSONPathElement -> Bool
> :: JSONPathElement -> JSONPathElement -> Bool
$c> :: JSONPathElement -> JSONPathElement -> Bool
<= :: JSONPathElement -> JSONPathElement -> Bool
$c<= :: JSONPathElement -> JSONPathElement -> Bool
< :: JSONPathElement -> JSONPathElement -> Bool
$c< :: JSONPathElement -> JSONPathElement -> Bool
compare :: JSONPathElement -> JSONPathElement -> Ordering
$ccompare :: JSONPathElement -> JSONPathElement -> Ordering
Ord)
type JSONPath = [JSONPathElement]
data IResult a = IError JSONPath String
| ISuccess a
deriving (IResult a -> IResult a -> Bool
forall a. Eq a => IResult a -> IResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IResult a -> IResult a -> Bool
$c/= :: forall a. Eq a => IResult a -> IResult a -> Bool
== :: IResult a -> IResult a -> Bool
$c== :: forall a. Eq a => IResult a -> IResult a -> Bool
Eq, Int -> IResult a -> ShowS
forall a. Show a => Int -> IResult a -> ShowS
forall a. Show a => [IResult a] -> ShowS
forall a. Show a => IResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IResult a] -> ShowS
$cshowList :: forall a. Show a => [IResult a] -> ShowS
show :: IResult a -> String
$cshow :: forall a. Show a => IResult a -> String
showsPrec :: Int -> IResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> IResult a -> ShowS
Show, Typeable)
data Result a = Error String
| Success a
deriving (Result a -> Result a -> Bool
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result a -> Result a -> Bool
$c/= :: forall a. Eq a => Result a -> Result a -> Bool
== :: Result a -> Result a -> Bool
$c== :: forall a. Eq a => Result a -> Result a -> Bool
Eq, Int -> Result a -> ShowS
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result a] -> ShowS
$cshowList :: forall a. Show a => [Result a] -> ShowS
show :: Result a -> String
$cshow :: forall a. Show a => Result a -> String
showsPrec :: Int -> Result a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
Show, Typeable)
instance NFData JSONPathElement where
rnf :: JSONPathElement -> ()
rnf (Key Key
t) = forall a. NFData a => a -> ()
rnf Key
t
rnf (Index Int
i) = forall a. NFData a => a -> ()
rnf Int
i
instance (NFData a) => NFData (IResult a) where
rnf :: IResult a -> ()
rnf (ISuccess a
a) = forall a. NFData a => a -> ()
rnf a
a
rnf (IError [JSONPathElement]
path String
err) = forall a. NFData a => a -> ()
rnf [JSONPathElement]
path seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf String
err
instance (NFData a) => NFData (Result a) where
rnf :: Result a -> ()
rnf (Success a
a) = forall a. NFData a => a -> ()
rnf a
a
rnf (Error String
err) = forall a. NFData a => a -> ()
rnf String
err
instance Functor IResult where
fmap :: forall a b. (a -> b) -> IResult a -> IResult b
fmap a -> b
f (ISuccess a
a) = forall a. a -> IResult a
ISuccess (a -> b
f a
a)
fmap a -> b
_ (IError [JSONPathElement]
path String
err) = forall a. [JSONPathElement] -> String -> IResult a
IError [JSONPathElement]
path String
err
{-# INLINE fmap #-}
instance Functor Result where
fmap :: forall a b. (a -> b) -> Result a -> Result b
fmap a -> b
f (Success a
a) = forall a. a -> Result a
Success (a -> b
f a
a)
fmap a -> b
_ (Error String
err) = forall a. String -> Result a
Error String
err
{-# INLINE fmap #-}
instance Monad.Monad IResult where
return :: forall a. a -> IResult a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE return #-}
ISuccess a
a >>= :: forall a b. IResult a -> (a -> IResult b) -> IResult b
>>= a -> IResult b
k = a -> IResult b
k a
a
IError [JSONPathElement]
path String
err >>= a -> IResult b
_ = forall a. [JSONPathElement] -> String -> IResult a
IError [JSONPathElement]
path String
err
{-# INLINE (>>=) #-}
#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
{-# INLINE fail #-}
#endif
instance Fail.MonadFail IResult where
fail :: forall a. String -> IResult a
fail String
err = forall a. [JSONPathElement] -> String -> IResult a
IError [] String
err
{-# INLINE fail #-}
instance Monad.Monad Result where
return :: forall a. a -> Result a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE return #-}
Success a
a >>= :: forall a b. Result a -> (a -> Result b) -> Result b
>>= a -> Result b
k = a -> Result b
k a
a
Error String
err >>= a -> Result b
_ = forall a. String -> Result a
Error String
err
{-# INLINE (>>=) #-}
#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
{-# INLINE fail #-}
#endif
instance Fail.MonadFail Result where
fail :: forall a. String -> Result a
fail String
err = forall a. String -> Result a
Error String
err
{-# INLINE fail #-}
instance Applicative IResult where
pure :: forall a. a -> IResult a
pure = forall a. a -> IResult a
ISuccess
{-# INLINE pure #-}
<*> :: forall a b. IResult (a -> b) -> IResult a -> IResult b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
{-# INLINE (<*>) #-}
instance Applicative Result where
pure :: forall a. a -> Result a
pure = forall a. a -> Result a
Success
{-# INLINE pure #-}
<*> :: forall a b. Result (a -> b) -> Result a -> Result b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
{-# INLINE (<*>) #-}
instance MonadPlus IResult where
mzero :: forall a. IResult a
mzero = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mzero"
{-# INLINE mzero #-}
mplus :: forall a. IResult a -> IResult a -> IResult a
mplus a :: IResult a
a@(ISuccess a
_) IResult a
_ = IResult a
a
mplus IResult a
_ IResult a
b = IResult a
b
{-# INLINE mplus #-}
instance MonadPlus Result where
mzero :: forall a. Result a
mzero = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mzero"
{-# INLINE mzero #-}
mplus :: forall a. Result a -> Result a -> Result a
mplus a :: Result a
a@(Success a
_) Result a
_ = Result a
a
mplus Result a
_ Result a
b = Result a
b
{-# INLINE mplus #-}
instance Alternative IResult where
empty :: forall a. IResult a
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
{-# INLINE empty #-}
<|> :: forall a. IResult a -> IResult a -> IResult a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
{-# INLINE (<|>) #-}
instance Alternative Result where
empty :: forall a. Result a
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
{-# INLINE empty #-}
<|> :: forall a. Result a -> Result a -> Result a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
{-# INLINE (<|>) #-}
instance Semigroup (IResult a) where
<> :: IResult a -> IResult a -> IResult a
(<>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
{-# INLINE (<>) #-}
instance Monoid (IResult a) where
mempty :: IResult a
mempty = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mempty"
{-# INLINE mempty #-}
mappend :: IResult a -> IResult a -> IResult a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE mappend #-}
instance Semigroup (Result a) where
<> :: Result a -> Result a -> Result a
(<>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
{-# INLINE (<>) #-}
instance Monoid (Result a) where
mempty :: Result a
mempty = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mempty"
{-# INLINE mempty #-}
mappend :: Result a -> Result a -> Result a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE mappend #-}
instance Foldable IResult where
foldMap :: forall m a. Monoid m => (a -> m) -> IResult a -> m
foldMap a -> m
_ (IError [JSONPathElement]
_ String
_) = forall a. Monoid a => a
mempty
foldMap a -> m
f (ISuccess a
y) = a -> m
f a
y
{-# INLINE foldMap #-}
foldr :: forall a b. (a -> b -> b) -> b -> IResult a -> b
foldr a -> b -> b
_ b
z (IError [JSONPathElement]
_ String
_) = b
z
foldr a -> b -> b
f b
z (ISuccess a
y) = a -> b -> b
f a
y b
z
{-# INLINE foldr #-}
instance Foldable Result where
foldMap :: forall m a. Monoid m => (a -> m) -> Result a -> m
foldMap a -> m
_ (Error String
_) = forall a. Monoid a => a
mempty
foldMap a -> m
f (Success a
y) = a -> m
f a
y
{-# INLINE foldMap #-}
foldr :: forall a b. (a -> b -> b) -> b -> Result a -> b
foldr a -> b -> b
_ b
z (Error String
_) = b
z
foldr a -> b -> b
f b
z (Success a
y) = a -> b -> b
f a
y b
z
{-# INLINE foldr #-}
instance Traversable IResult where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IResult a -> f (IResult b)
traverse a -> f b
_ (IError [JSONPathElement]
path String
err) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. [JSONPathElement] -> String -> IResult a
IError [JSONPathElement]
path String
err)
traverse a -> f b
f (ISuccess a
a) = forall a. a -> IResult a
ISuccess forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
{-# INLINE traverse #-}
instance Traversable Result where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Result a -> f (Result b)
traverse a -> f b
_ (Error String
err) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. String -> Result a
Error String
err)
traverse a -> f b
f (Success a
a) = forall a. a -> Result a
Success forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
{-# INLINE traverse #-}
type Failure f r = JSONPath -> String -> f r
type Success a f r = a -> f r
newtype Parser a = Parser {
forall a.
Parser a
-> forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser :: forall f r.
JSONPath
-> Failure f r
-> Success a f r
-> f r
}
instance Monad.Monad Parser where
Parser a
m >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
g = forall a.
(forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success b f r
ks -> let ks' :: a -> f r
ks' a
a = forall a.
Parser a
-> forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser (a -> Parser b
g a
a) [JSONPathElement]
path Failure f r
kf Success b f r
ks
in forall a.
Parser a
-> forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser Parser a
m [JSONPathElement]
path Failure f r
kf a -> f r
ks'
{-# INLINE (>>=) #-}
return :: forall a. a -> Parser a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE return #-}
#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
{-# INLINE fail #-}
#endif
instance MonadFix Parser where
mfix :: forall a. (a -> Parser a) -> Parser a
mfix a -> Parser a
f = forall a.
(forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success a f r
ks -> let x :: IResult a
x = forall a.
Parser a
-> forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser (a -> Parser a
f (forall a. IResult a -> a
fromISuccess IResult a
x)) [JSONPathElement]
path forall a. [JSONPathElement] -> String -> IResult a
IError forall a. a -> IResult a
ISuccess in
case IResult a
x of
IError [JSONPathElement]
p String
e -> Failure f r
kf [JSONPathElement]
p String
e
ISuccess a
y -> Success a f r
ks a
y
where
fromISuccess :: IResult a -> a
fromISuccess :: forall a. IResult a -> a
fromISuccess (ISuccess a
x) = a
x
fromISuccess (IError [JSONPathElement]
path String
msg) = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"mfix @Aeson.Parser: " forall a. [a] -> [a] -> [a]
++ [JSONPathElement] -> String
formatPath [JSONPathElement]
path forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
msg
instance Fail.MonadFail Parser where
fail :: forall a. String -> Parser a
fail String
msg = forall a.
(forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success a f r
_ks -> Failure f r
kf (forall a. [a] -> [a]
reverse [JSONPathElement]
path) String
msg
{-# INLINE fail #-}
instance Functor Parser where
fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
f Parser a
m = forall a.
(forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success b f r
ks -> let ks' :: a -> f r
ks' a
a = Success b f r
ks (a -> b
f a
a)
in forall a.
Parser a
-> forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser Parser a
m [JSONPathElement]
path Failure f r
kf a -> f r
ks'
{-# INLINE fmap #-}
instance Applicative Parser where
pure :: forall a. a -> Parser a
pure a
a = forall a.
(forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
_path Failure f r
_kf Success a f r
ks -> Success a f r
ks a
a
{-# INLINE pure #-}
<*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
(<*>) = forall a b. Parser (a -> b) -> Parser a -> Parser b
apP
{-# INLINE (<*>) #-}
instance Alternative Parser where
empty :: forall a. Parser a
empty = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty"
{-# INLINE empty #-}
<|> :: forall a. Parser a -> Parser a -> Parser a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
{-# INLINE (<|>) #-}
instance MonadPlus Parser where
mzero :: forall a. Parser a
mzero = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mzero"
{-# INLINE mzero #-}
mplus :: forall a. Parser a -> Parser a -> Parser a
mplus Parser a
a Parser a
b = forall a.
(forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success a f r
ks -> let kf' :: p -> p -> f r
kf' p
_ p
_ = forall a.
Parser a
-> forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser Parser a
b [JSONPathElement]
path Failure f r
kf Success a f r
ks
in forall a.
Parser a
-> forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser Parser a
a [JSONPathElement]
path forall {p} {p}. p -> p -> f r
kf' Success a f r
ks
{-# INLINE mplus #-}
instance Semigroup (Parser a) where
<> :: Parser a -> Parser a -> Parser a
(<>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
{-# INLINE (<>) #-}
instance Monoid (Parser a) where
mempty :: Parser a
mempty = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mempty"
{-# INLINE mempty #-}
mappend :: Parser a -> Parser a -> Parser a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE mappend #-}
parseFail :: String -> Parser a
parseFail :: forall a. String -> Parser a
parseFail = forall (m :: * -> *) a. MonadFail m => String -> m a
fail
apP :: Parser (a -> b) -> Parser a -> Parser b
apP :: forall a b. Parser (a -> b) -> Parser a -> Parser b
apP Parser (a -> b)
d Parser a
e = do
a -> b
b <- Parser (a -> b)
d
a -> b
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
e
{-# INLINE apP #-}
type Object = KeyMap Value
type Array = Vector Value
data Value = Object !Object
| Array !Array
| String !Text
| Number !Scientific
| Bool !Bool
| Null
deriving (Value -> Value -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, ReadPrec [Value]
ReadPrec Value
Int -> ReadS Value
ReadS [Value]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Value]
$creadListPrec :: ReadPrec [Value]
readPrec :: ReadPrec Value
$creadPrec :: ReadPrec Value
readList :: ReadS [Value]
$creadList :: ReadS [Value]
readsPrec :: Int -> ReadS Value
$creadsPrec :: Int -> ReadS Value
Read, Typeable, Typeable Value
Value -> DataType
Value -> Constr
(forall b. Data b => b -> b) -> Value -> Value
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) -> Value -> u
forall u. (forall d. Data d => d -> u) -> Value -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value -> m Value
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value -> m Value
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Value -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Value -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Value -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Value -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
gmapT :: (forall b. Data b => b -> b) -> Value -> Value
$cgmapT :: (forall b. Data b => b -> b) -> Value -> Value
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value)
dataTypeOf :: Value -> DataType
$cdataTypeOf :: Value -> DataType
toConstr :: Value -> Constr
$ctoConstr :: Value -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
Data, forall x. Rep Value x -> Value
forall x. Value -> Rep Value x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Value x -> Value
$cfrom :: forall x. Value -> Rep Value x
Generic)
instance Show Value where
showsPrec :: Int -> Value -> ShowS
showsPrec Int
_ Value
Null = String -> ShowS
showString String
"Null"
showsPrec Int
d (Bool Bool
b) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Bool " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Bool
b
showsPrec Int
d (Number Scientific
s) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Number " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Scientific
s
showsPrec Int
d (String Text
s) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"String " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
s
showsPrec Int
d (Array Array
xs) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Array " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Array
xs
showsPrec Int
d (Object Object
xs) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Object (fromList "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (forall v. KeyMap v -> [(Key, v)]
KM.toAscList Object
xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'
instance QC.Arbitrary Value where
arbitrary :: Gen Value
arbitrary = forall a. (Int -> Gen a) -> Gen a
QC.sized Int -> Gen Value
arbValue
shrink :: Value -> [Value]
shrink = forall (t :: * -> *) a. (Witherable t, Ord a) => t a -> t a
ordNub forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [Value]
go where
go :: Value -> [Value]
go Value
Null = []
go (Bool Bool
b) = Value
Null forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Bool -> Value
Bool (forall a. Arbitrary a => a -> [a]
QC.shrink Bool
b)
go (String Text
x) = Value
Null forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (forall a. Arbitrary a => a -> [a]
QC.shrink (Text -> String
T.unpack Text
x))
go (Number Scientific
x) = Value
Null forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Scientific -> Value
Number (Scientific -> [Scientific]
shrScientific Scientific
x)
go (Array Array
x) = Value
Null forall a. a -> [a] -> [a]
: forall a. Vector a -> [a]
V.toList Array
x forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Array -> Value
Array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList) (forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
QC.liftShrink Value -> [Value]
go (forall a. Vector a -> [a]
V.toList Array
x))
go (Object Object
x) = Value
Null forall a. a -> [a] -> [a]
: forall v. KeyMap v -> [v]
KM.elems Object
x forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Object -> Value
Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. [(Key, v)] -> KeyMap v
KM.fromList) (forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
QC.liftShrink (forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
QC.liftShrink Value -> [Value]
go) (forall v. KeyMap v -> [(Key, v)]
KM.toList Object
x))
instance QC.CoArbitrary Value where
coarbitrary :: forall b. Value -> Gen b -> Gen b
coarbitrary Value
Null = forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (Int
0 :: Int)
coarbitrary (Bool Bool
b) = forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (Int
1 :: Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary Bool
b
coarbitrary (String Text
x) = forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (Int
2 :: Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Text -> String
T.unpack Text
x)
coarbitrary (Number Scientific
x) = forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (Int
3 :: Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Scientific -> Integer
Sci.coefficient Scientific
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Scientific -> Int
Sci.base10Exponent Scientific
x)
coarbitrary (Array Array
x) = forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (Int
4 :: Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (forall a. Vector a -> [a]
V.toList Array
x)
coarbitrary (Object Object
x) = forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (Int
5 :: Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (forall v. KeyMap v -> [(Key, v)]
KM.toList Object
x)
instance QC.Function Value where
function :: forall b. (Value -> b) -> Value :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap Value -> RepValue
fwd RepValue -> Value
bwd where
fwd :: Value -> RepValue
fwd :: Value -> RepValue
fwd Value
Null = forall a b. a -> Either a b
Left forall a. Maybe a
Nothing
fwd (Bool Bool
b) = forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just Bool
b)
fwd (String Text
x) = forall a b. b -> Either a b
Right (forall a b. a -> Either a b
Left (forall a b. a -> Either a b
Left (Text -> String
T.unpack Text
x)))
fwd (Number Scientific
x) = forall a b. b -> Either a b
Right (forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right (Scientific -> Integer
Sci.coefficient Scientific
x, Scientific -> Int
Sci.base10Exponent Scientific
x)))
fwd (Array Array
x) = forall a b. b -> Either a b
Right (forall a b. b -> Either a b
Right (forall a b. a -> Either a b
Left (forall a. Vector a -> [a]
V.toList Array
x)))
fwd (Object Object
x) = forall a b. b -> Either a b
Right (forall a b. b -> Either a b
Right (forall a b. b -> Either a b
Right (forall v. KeyMap v -> [(Key, v)]
KM.toList Object
x)))
bwd :: RepValue -> Value
bwd :: RepValue -> Value
bwd (Left Maybe Bool
Nothing) = Value
Null
bwd (Left (Just Bool
b)) = Bool -> Value
Bool Bool
b
bwd (Right (Left (Left String
x))) = Text -> Value
String (String -> Text
T.pack String
x)
bwd (Right (Left (Right (Integer
x, Int
y)))) = Scientific -> Value
Number (Integer -> Int -> Scientific
Sci.scientific Integer
x Int
y)
bwd (Right (Right (Left [Value]
x))) = Array -> Value
Array (forall a. [a] -> Vector a
V.fromList [Value]
x)
bwd (Right (Right (Right [(Key, Value)]
x))) = Object -> Value
Object (forall v. [(Key, v)] -> KeyMap v
KM.fromList [(Key, Value)]
x)
type RepValue
= Either (Maybe Bool) (Either (Either String (Integer, Int)) (Either [Value] [(Key, Value)]))
arbValue :: Int -> QC.Gen Value
arbValue :: Int -> Gen Value
arbValue Int
n
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
1 = forall a. [Gen a] -> Gen a
QC.oneof
[ forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Null
, Bool -> Value
Bool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary
, Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
arbText
, Scientific -> Value
Number forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Scientific
arbScientific
, forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
emptyObject
, forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
emptyArray
]
| Bool
otherwise = forall a. [Gen a] -> Gen a
QC.oneof
[ Object -> Value
Object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Object
arbObject Int
n
, Array -> Value
Array forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Array
arbArray Int
n
]
arbText :: QC.Gen Text
arbText :: Gen Text
arbText = String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary
arbScientific :: QC.Gen Scientific
arbScientific :: Gen Scientific
arbScientific = Integer -> Int -> Scientific
Sci.scientific forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
QC.arbitrary
shrScientific :: Scientific -> [Scientific]
shrScientific :: Scientific -> [Scientific]
shrScientific Scientific
s = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Int -> Scientific
Sci.scientific) forall a b. (a -> b) -> a -> b
$
forall a. Arbitrary a => a -> [a]
QC.shrink (Scientific -> Integer
Sci.coefficient Scientific
s, Scientific -> Int
Sci.base10Exponent Scientific
s)
arbObject :: Int -> QC.Gen Object
arbObject :: Int -> Gen Object
arbObject Int
n = do
[Int]
p <- Int -> Gen [Int]
arbPartition (Int
n forall a. Num a => a -> a -> a
- Int
1)
forall v. [(Key, v)] -> KeyMap v
KM.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
m -> (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen Value
arbValue Int
m) [Int]
p
arbArray :: Int -> QC.Gen Array
arbArray :: Int -> Gen Array
arbArray Int
n = do
[Int]
p <- Int -> Gen [Int]
arbPartition (Int
n forall a. Num a => a -> a -> a
- Int
1)
forall a. [a] -> Vector a
V.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Int -> Gen Value
arbValue [Int]
p
arbPartition :: Int -> QC.Gen [Int]
arbPartition :: Int -> Gen [Int]
arbPartition Int
k = case forall a. Ord a => a -> a -> Ordering
compare Int
k Int
1 of
Ordering
LT -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Ordering
EQ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Int
1]
Ordering
GT -> do
Int
first <- (Int, Int) -> Gen Int
QC.chooseInt (Int
1, Int
k)
[Int]
rest <- Int -> Gen [Int]
arbPartition forall a b. (a -> b) -> a -> b
$ Int
k forall a. Num a => a -> a -> a
- Int
first
forall a. [a] -> Gen [a]
QC.shuffle (Int
first forall a. a -> [a] -> [a]
: [Int]
rest)
deriving instance Ord Value
newtype DotNetTime = DotNetTime {
DotNetTime -> UTCTime
fromDotNetTime :: UTCTime
} deriving (DotNetTime -> DotNetTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotNetTime -> DotNetTime -> Bool
$c/= :: DotNetTime -> DotNetTime -> Bool
== :: DotNetTime -> DotNetTime -> Bool
$c== :: DotNetTime -> DotNetTime -> Bool
Eq, Eq DotNetTime
DotNetTime -> DotNetTime -> Bool
DotNetTime -> DotNetTime -> Ordering
DotNetTime -> DotNetTime -> DotNetTime
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 :: DotNetTime -> DotNetTime -> DotNetTime
$cmin :: DotNetTime -> DotNetTime -> DotNetTime
max :: DotNetTime -> DotNetTime -> DotNetTime
$cmax :: DotNetTime -> DotNetTime -> DotNetTime
>= :: DotNetTime -> DotNetTime -> Bool
$c>= :: DotNetTime -> DotNetTime -> Bool
> :: DotNetTime -> DotNetTime -> Bool
$c> :: DotNetTime -> DotNetTime -> Bool
<= :: DotNetTime -> DotNetTime -> Bool
$c<= :: DotNetTime -> DotNetTime -> Bool
< :: DotNetTime -> DotNetTime -> Bool
$c< :: DotNetTime -> DotNetTime -> Bool
compare :: DotNetTime -> DotNetTime -> Ordering
$ccompare :: DotNetTime -> DotNetTime -> Ordering
Ord, ReadPrec [DotNetTime]
ReadPrec DotNetTime
Int -> ReadS DotNetTime
ReadS [DotNetTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DotNetTime]
$creadListPrec :: ReadPrec [DotNetTime]
readPrec :: ReadPrec DotNetTime
$creadPrec :: ReadPrec DotNetTime
readList :: ReadS [DotNetTime]
$creadList :: ReadS [DotNetTime]
readsPrec :: Int -> ReadS DotNetTime
$creadsPrec :: Int -> ReadS DotNetTime
Read, Int -> DotNetTime -> ShowS
[DotNetTime] -> ShowS
DotNetTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotNetTime] -> ShowS
$cshowList :: [DotNetTime] -> ShowS
show :: DotNetTime -> String
$cshow :: DotNetTime -> String
showsPrec :: Int -> DotNetTime -> ShowS
$cshowsPrec :: Int -> DotNetTime -> ShowS
Show, Typeable, Bool -> Char -> Maybe (FormatOptions -> DotNetTime -> String)
forall t.
(Bool -> Char -> Maybe (FormatOptions -> t -> String))
-> FormatTime t
formatCharacter :: Bool -> Char -> Maybe (FormatOptions -> DotNetTime -> String)
$cformatCharacter :: Bool -> Char -> Maybe (FormatOptions -> DotNetTime -> String)
FormatTime)
instance NFData Value where
rnf :: Value -> ()
rnf (Object Object
o) = forall a. NFData a => a -> ()
rnf Object
o
rnf (Array Array
a) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\()
x Value
y -> forall a. NFData a => a -> ()
rnf Value
y seq :: forall a b. a -> b -> b
`seq` ()
x) () Array
a
rnf (String Text
s) = forall a. NFData a => a -> ()
rnf Text
s
rnf (Number Scientific
n) = forall a. NFData a => a -> ()
rnf Scientific
n
rnf (Bool Bool
b) = forall a. NFData a => a -> ()
rnf Bool
b
rnf Value
Null = ()
instance IsString Value where
fromString :: String -> Value
fromString = Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack
{-# INLINE fromString #-}
hashValue :: Int -> Value -> Int
hashValue :: Int -> Value -> Int
hashValue Int
s (Object Object
o) = Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0::Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Object
o
hashValue Int
s (Array Array
a) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Hashable a => Int -> a -> Int
hashWithSalt
(Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1::Int)) Array
a
hashValue Int
s (String Text
str) = Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
2::Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
str
hashValue Int
s (Number Scientific
n) = Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
3::Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Scientific
n
hashValue Int
s (Bool Bool
b) = Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
4::Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Bool
b
hashValue Int
s Value
Null = Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
5::Int)
instance Hashable Value where
hashWithSalt :: Int -> Value -> Int
hashWithSalt = Int -> Value -> Int
hashValue
instance TH.Lift Value where
lift :: forall (m :: * -> *). Quote m => Value -> m Exp
lift Value
Null = [| Null |]
lift (Bool Bool
b) = [| Bool b |]
lift (Number Scientific
n) = [| Number n |]
lift (String Text
t) = [| String (pack s) |]
where s :: String
s = Text -> String
unpack Text
t
lift (Array Array
a) = [| Array (V.fromList a') |]
where a' :: [Value]
a' = forall a. Vector a -> [a]
V.toList Array
a
lift (Object Object
o) = [| Object o |]
#if MIN_VERSION_template_haskell(2,17,0)
liftTyped :: forall (m :: * -> *). Quote m => Value -> Code m Value
liftTyped = forall a (m :: * -> *). Quote m => m Exp -> Code m a
TH.unsafeCodeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
liftTyped = TH.unsafeTExpCoerce . TH.lift
#endif
emptyArray :: Value
emptyArray :: Value
emptyArray = Array -> Value
Array forall a. Vector a
V.empty
isEmptyArray :: Value -> Bool
isEmptyArray :: Value -> Bool
isEmptyArray (Array Array
arr) = forall a. Vector a -> Bool
V.null Array
arr
isEmptyArray Value
_ = Bool
False
emptyObject :: Value
emptyObject :: Value
emptyObject = Object -> Value
Object forall v. KeyMap v
KM.empty
parse :: (a -> Parser b) -> a -> Result b
parse :: forall a b. (a -> Parser b) -> a -> Result b
parse a -> Parser b
m a
v = forall a.
Parser a
-> forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser (a -> Parser b
m a
v) [] (forall a b. a -> b -> a
const forall a. String -> Result a
Error) forall a. a -> Result a
Success
{-# INLINE parse #-}
iparse :: (a -> Parser b) -> a -> IResult b
iparse :: forall a b. (a -> Parser b) -> a -> IResult b
iparse a -> Parser b
m a
v = forall a.
Parser a
-> forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser (a -> Parser b
m a
v) [] forall a. [JSONPathElement] -> String -> IResult a
IError forall a. a -> IResult a
ISuccess
{-# INLINE iparse #-}
parseMaybe :: (a -> Parser b) -> a -> Maybe b
parseMaybe :: forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe a -> Parser b
m a
v = forall a.
Parser a
-> forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser (a -> Parser b
m a
v) [] (\[JSONPathElement]
_ String
_ -> forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just
{-# INLINE parseMaybe #-}
parseEither :: (a -> Parser b) -> a -> Either String b
parseEither :: forall a b. (a -> Parser b) -> a -> Either String b
parseEither a -> Parser b
m a
v = forall a.
Parser a
-> forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser (a -> Parser b
m a
v) [] forall {b}. [JSONPathElement] -> String -> Either String b
onError forall a b. b -> Either a b
Right
where onError :: [JSONPathElement] -> String -> Either String b
onError [JSONPathElement]
path String
msg = forall a b. a -> Either a b
Left ([JSONPathElement] -> ShowS
formatError [JSONPathElement]
path String
msg)
{-# INLINE parseEither #-}
iparseEither :: (a -> Parser b) -> a -> Either (JSONPath, String) b
iparseEither :: forall a b.
(a -> Parser b) -> a -> Either ([JSONPathElement], String) b
iparseEither a -> Parser b
m a
v = forall a.
Parser a
-> forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser (a -> Parser b
m a
v) [] (\[JSONPathElement]
path String
msg -> forall a b. a -> Either a b
Left ([JSONPathElement]
path, String
msg)) forall a b. b -> Either a b
Right
{-# INLINE iparseEither #-}
formatError :: JSONPath -> String -> String
formatError :: [JSONPathElement] -> ShowS
formatError [JSONPathElement]
path String
msg = String
"Error in " forall a. [a] -> [a] -> [a]
++ [JSONPathElement] -> String
formatPath [JSONPathElement]
path forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
msg
formatPath :: JSONPath -> String
formatPath :: [JSONPathElement] -> String
formatPath [JSONPathElement]
path = String
"$" forall a. [a] -> [a] -> [a]
++ [JSONPathElement] -> String
formatRelativePath [JSONPathElement]
path
formatRelativePath :: JSONPath -> String
formatRelativePath :: [JSONPathElement] -> String
formatRelativePath [JSONPathElement]
path = String -> [JSONPathElement] -> String
format String
"" [JSONPathElement]
path
where
format :: String -> JSONPath -> String
format :: String -> [JSONPathElement] -> String
format String
pfx [] = String
pfx
format String
pfx (Index Int
idx:[JSONPathElement]
parts) = String -> [JSONPathElement] -> String
format (String
pfx forall a. [a] -> [a] -> [a]
++ String
"[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
idx forall a. [a] -> [a] -> [a]
++ String
"]") [JSONPathElement]
parts
format String
pfx (Key Key
key:[JSONPathElement]
parts) = String -> [JSONPathElement] -> String
format (String
pfx forall a. [a] -> [a] -> [a]
++ Key -> String
formatKey Key
key) [JSONPathElement]
parts
formatKey :: Key -> String
formatKey :: Key -> String
formatKey Key
key
| String -> Bool
isIdentifierKey String
strKey = String
"." forall a. [a] -> [a] -> [a]
++ String
strKey
| Bool
otherwise = String
"['" forall a. [a] -> [a] -> [a]
++ ShowS
escapeKey String
strKey forall a. [a] -> [a] -> [a]
++ String
"']"
where strKey :: String
strKey = Key -> String
Key.toString Key
key
isIdentifierKey :: String -> Bool
isIdentifierKey :: String -> Bool
isIdentifierKey [] = Bool
False
isIdentifierKey (Char
x:String
xs) = Char -> Bool
isAlpha Char
x Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAlphaNum String
xs
escapeKey :: String -> String
escapeKey :: ShowS
escapeKey = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escapeChar
escapeChar :: Char -> String
escapeChar :: Char -> String
escapeChar Char
'\'' = String
"\\'"
escapeChar Char
'\\' = String
"\\\\"
escapeChar Char
c = [Char
c]
type Pair = (Key, Value)
object :: [Pair] -> Value
object :: [(Key, Value)] -> Value
object = Object -> Value
Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. [(Key, v)] -> KeyMap v
KM.fromList
{-# INLINE object #-}
(<?>) :: Parser a -> JSONPathElement -> Parser a
Parser a
p <?> :: forall a. Parser a -> JSONPathElement -> Parser a
<?> JSONPathElement
pathElem = forall a.
(forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success a f r
ks -> forall a.
Parser a
-> forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser Parser a
p (JSONPathElement
pathElemforall a. a -> [a] -> [a]
:[JSONPathElement]
path) Failure f r
kf Success a f r
ks
modifyFailure :: (String -> String) -> Parser a -> Parser a
modifyFailure :: forall a. ShowS -> Parser a -> Parser a
modifyFailure ShowS
f (Parser forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
p) = forall a.
(forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success a f r
ks ->
forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
p [JSONPathElement]
path (\[JSONPathElement]
p' String
m -> Failure f r
kf [JSONPathElement]
p' (ShowS
f String
m)) Success a f r
ks
prependFailure :: String -> Parser a -> Parser a
prependFailure :: forall a. String -> Parser a -> Parser a
prependFailure = forall a. ShowS -> Parser a -> Parser a
modifyFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a] -> [a]
(++)
parserThrowError :: JSONPath -> String -> Parser a
parserThrowError :: forall a. [JSONPathElement] -> String -> Parser a
parserThrowError [JSONPathElement]
path' String
msg = forall a.
(forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success a f r
_ks ->
Failure f r
kf (forall a. [a] -> [a]
reverse [JSONPathElement]
path forall a. [a] -> [a] -> [a]
++ [JSONPathElement]
path') String
msg
parserCatchError :: Parser a -> (JSONPath -> String -> Parser a) -> Parser a
parserCatchError :: forall a.
Parser a -> ([JSONPathElement] -> String -> Parser a) -> Parser a
parserCatchError (Parser forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
p) [JSONPathElement] -> String -> Parser a
handler = forall a.
(forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success a f r
ks ->
forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
p [JSONPathElement]
path (\[JSONPathElement]
e String
msg -> forall a.
Parser a
-> forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser ([JSONPathElement] -> String -> Parser a
handler [JSONPathElement]
e String
msg) [JSONPathElement]
path Failure f r
kf Success a f r
ks) Success a f r
ks
data Options = Options
{ Options -> ShowS
fieldLabelModifier :: String -> String
, Options -> ShowS
constructorTagModifier :: String -> String
, Options -> Bool
allNullaryToStringTag :: Bool
, Options -> Bool
omitNothingFields :: Bool
, Options -> Bool
allowOmittedFields :: Bool
, Options -> SumEncoding
sumEncoding :: SumEncoding
, Options -> Bool
unwrapUnaryRecords :: Bool
, Options -> Bool
tagSingleConstructors :: Bool
, Options -> Bool
rejectUnknownFields :: Bool
}
instance Show Options where
show :: Options -> String
show (Options ShowS
f ShowS
c Bool
a Bool
o Bool
q SumEncoding
s Bool
u Bool
t Bool
r) =
String
"Options {"
forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", "
[ String
"fieldLabelModifier =~ " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ShowS
f String
"exampleField")
, String
"constructorTagModifier =~ " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ShowS
c String
"ExampleConstructor")
, String
"allNullaryToStringTag = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Bool
a
, String
"omitNothingFields = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Bool
o
, String
"allowOmittedFields = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Bool
q
, String
"sumEncoding = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SumEncoding
s
, String
"unwrapUnaryRecords = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Bool
u
, String
"tagSingleConstructors = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Bool
t
, String
"rejectUnknownFields = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Bool
r
]
forall a. [a] -> [a] -> [a]
++ String
"}"
data SumEncoding =
TaggedObject { SumEncoding -> String
tagFieldName :: String
, SumEncoding -> String
contentsFieldName :: String
}
| UntaggedValue
| ObjectWithSingleField
| TwoElemArray
deriving (SumEncoding -> SumEncoding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SumEncoding -> SumEncoding -> Bool
$c/= :: SumEncoding -> SumEncoding -> Bool
== :: SumEncoding -> SumEncoding -> Bool
$c== :: SumEncoding -> SumEncoding -> Bool
Eq, Int -> SumEncoding -> ShowS
[SumEncoding] -> ShowS
SumEncoding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SumEncoding] -> ShowS
$cshowList :: [SumEncoding] -> ShowS
show :: SumEncoding -> String
$cshow :: SumEncoding -> String
showsPrec :: Int -> SumEncoding -> ShowS
$cshowsPrec :: Int -> SumEncoding -> ShowS
Show)
data JSONKeyOptions = JSONKeyOptions
{ JSONKeyOptions -> ShowS
keyModifier :: String -> String
}
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options
{ fieldLabelModifier :: ShowS
fieldLabelModifier = forall a. a -> a
id
, constructorTagModifier :: ShowS
constructorTagModifier = forall a. a -> a
id
, allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
True
, omitNothingFields :: Bool
omitNothingFields = Bool
False
, allowOmittedFields :: Bool
allowOmittedFields = Bool
True
, sumEncoding :: SumEncoding
sumEncoding = SumEncoding
defaultTaggedObject
, unwrapUnaryRecords :: Bool
unwrapUnaryRecords = Bool
False
, tagSingleConstructors :: Bool
tagSingleConstructors = Bool
False
, rejectUnknownFields :: Bool
rejectUnknownFields = Bool
False
}
defaultTaggedObject :: SumEncoding
defaultTaggedObject :: SumEncoding
defaultTaggedObject = TaggedObject
{ tagFieldName :: String
tagFieldName = String
"tag"
, contentsFieldName :: String
contentsFieldName = String
"contents"
}
defaultJSONKeyOptions :: JSONKeyOptions
defaultJSONKeyOptions :: JSONKeyOptions
defaultJSONKeyOptions = ShowS -> JSONKeyOptions
JSONKeyOptions forall a. a -> a
id
camelTo :: Char -> String -> String
{-# DEPRECATED camelTo "Use camelTo2 for better results" #-}
camelTo :: Char -> ShowS
camelTo Char
c = Bool -> ShowS
lastWasCap Bool
True
where
lastWasCap :: Bool
-> String
-> String
lastWasCap :: Bool -> ShowS
lastWasCap Bool
_ [] = []
lastWasCap Bool
prev (Char
x : String
xs) = if Char -> Bool
isUpper Char
x
then if Bool
prev
then Char -> Char
toLower Char
x forall a. a -> [a] -> [a]
: Bool -> ShowS
lastWasCap Bool
True String
xs
else Char
c forall a. a -> [a] -> [a]
: Char -> Char
toLower Char
x forall a. a -> [a] -> [a]
: Bool -> ShowS
lastWasCap Bool
True String
xs
else Char
x forall a. a -> [a] -> [a]
: Bool -> ShowS
lastWasCap Bool
False String
xs
camelTo2 :: Char -> String -> String
camelTo2 :: Char -> ShowS
camelTo2 Char
c = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
go2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
go1
where go1 :: ShowS
go1 String
"" = String
""
go1 (Char
x:Char
u:Char
l:String
xs) | Char -> Bool
isUpper Char
u Bool -> Bool -> Bool
&& Char -> Bool
isLower Char
l = Char
x forall a. a -> [a] -> [a]
: Char
c forall a. a -> [a] -> [a]
: Char
u forall a. a -> [a] -> [a]
: Char
l forall a. a -> [a] -> [a]
: ShowS
go1 String
xs
go1 (Char
x:String
xs) = Char
x forall a. a -> [a] -> [a]
: ShowS
go1 String
xs
go2 :: ShowS
go2 String
"" = String
""
go2 (Char
l:Char
u:String
xs) | Char -> Bool
isLower Char
l Bool -> Bool -> Bool
&& Char -> Bool
isUpper Char
u = Char
l forall a. a -> [a] -> [a]
: Char
c forall a. a -> [a] -> [a]
: Char
u forall a. a -> [a] -> [a]
: ShowS
go2 String
xs
go2 (Char
x:String
xs) = Char
x forall a. a -> [a] -> [a]
: ShowS
go2 String
xs
newtype AesonException = AesonException String
deriving (Int -> AesonException -> ShowS
[AesonException] -> ShowS
AesonException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AesonException] -> ShowS
$cshowList :: [AesonException] -> ShowS
show :: AesonException -> String
$cshow :: AesonException -> String
showsPrec :: Int -> AesonException -> ShowS
$cshowsPrec :: Int -> AesonException -> ShowS
Show)
instance Exception AesonException where
displayException :: AesonException -> String
displayException (AesonException String
str) = String
"aeson: " forall a. [a] -> [a] -> [a]
++ String
str