{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskellQuotes #-}

-- |
-- Module:      Data.Aeson.Types.Internal
-- Copyright:   (c) 2011-2016 Bryan O'Sullivan
--              (c) 2011 MailRank, Inc.
-- License:     BSD3
-- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
-- Stability:   experimental
-- Portability: portable
--
-- Types for working with JSON data.

module Data.Aeson.Types.Internal
    (
    -- * Core JSON types
      Value(..)
    , Key
    , Array
    , emptyArray, isEmptyArray
    , Pair
    , Object
    , emptyObject

    -- * Type conversion
    , Parser
    , Result(..)
    , IResult(..)
    , JSONPathElement(..)
    , JSONPath
    , iparse
    , iparseEither
    , parse
    , parseEither
    , parseMaybe
    , parseFail
    , modifyFailure
    , prependFailure
    , parserThrowError
    , parserCatchError
    , formatError
    , formatPath
    , formatRelativePath
    , (<?>)
    -- * Constructors and accessors
    , object

    -- * Generic and TH encoding configuration
    , Options(
          fieldLabelModifier
        , constructorTagModifier
        , allNullaryToStringTag
        , omitNothingFields
        , allowOmittedFields
        , sumEncoding
        , unwrapUnaryRecords
        , tagSingleConstructors
        , rejectUnknownFields
        )

    , SumEncoding(..)
    , JSONKeyOptions(keyModifier)
    , defaultOptions
    , defaultTaggedObject
    , defaultJSONKeyOptions

    -- * Used for changing CamelCase names into something else.
    , camelTo
    , camelTo2

    -- * Aeson Exception
    , AesonException (..)

    -- * Other types
    , 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)

-- | Elements of a JSON path used to describe the location of an
-- error.
data JSONPathElement = Key Key
                       -- ^ JSON path element of a key into an object,
                       -- \"object.key\".
                     | Index {-# UNPACK #-} !Int
                       -- ^ JSON path element of an index into an
                       -- array, \"array[index]\".
                       deriving (JSONPathElement -> JSONPathElement -> Bool
(JSONPathElement -> JSONPathElement -> Bool)
-> (JSONPathElement -> JSONPathElement -> Bool)
-> Eq JSONPathElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JSONPathElement -> JSONPathElement -> Bool
== :: JSONPathElement -> JSONPathElement -> Bool
$c/= :: JSONPathElement -> JSONPathElement -> Bool
/= :: JSONPathElement -> JSONPathElement -> Bool
Eq, Int -> JSONPathElement -> ShowS
[JSONPathElement] -> ShowS
JSONPathElement -> [Char]
(Int -> JSONPathElement -> ShowS)
-> (JSONPathElement -> [Char])
-> ([JSONPathElement] -> ShowS)
-> Show JSONPathElement
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JSONPathElement -> ShowS
showsPrec :: Int -> JSONPathElement -> ShowS
$cshow :: JSONPathElement -> [Char]
show :: JSONPathElement -> [Char]
$cshowList :: [JSONPathElement] -> ShowS
showList :: [JSONPathElement] -> ShowS
Show, Typeable, Eq JSONPathElement
Eq JSONPathElement =>
(JSONPathElement -> JSONPathElement -> Ordering)
-> (JSONPathElement -> JSONPathElement -> Bool)
-> (JSONPathElement -> JSONPathElement -> Bool)
-> (JSONPathElement -> JSONPathElement -> Bool)
-> (JSONPathElement -> JSONPathElement -> Bool)
-> (JSONPathElement -> JSONPathElement -> JSONPathElement)
-> (JSONPathElement -> JSONPathElement -> JSONPathElement)
-> Ord 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
$ccompare :: JSONPathElement -> JSONPathElement -> Ordering
compare :: JSONPathElement -> JSONPathElement -> Ordering
$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
>= :: JSONPathElement -> JSONPathElement -> Bool
$cmax :: JSONPathElement -> JSONPathElement -> JSONPathElement
max :: JSONPathElement -> JSONPathElement -> JSONPathElement
$cmin :: JSONPathElement -> JSONPathElement -> JSONPathElement
min :: JSONPathElement -> JSONPathElement -> JSONPathElement
Ord)
type JSONPath = [JSONPathElement]

-- | The internal result of running a 'Parser'.
data IResult a = IError JSONPath String
               | ISuccess a
               deriving (IResult a -> IResult a -> Bool
(IResult a -> IResult a -> Bool)
-> (IResult a -> IResult a -> Bool) -> Eq (IResult a)
forall a. Eq a => IResult a -> IResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: IResult a -> IResult a -> Bool
Eq, Int -> IResult a -> ShowS
[IResult a] -> ShowS
IResult a -> [Char]
(Int -> IResult a -> ShowS)
-> (IResult a -> [Char])
-> ([IResult a] -> ShowS)
-> Show (IResult a)
forall a. Show a => Int -> IResult a -> ShowS
forall a. Show a => [IResult a] -> ShowS
forall a. Show a => IResult a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> IResult a -> ShowS
showsPrec :: Int -> IResult a -> ShowS
$cshow :: forall a. Show a => IResult a -> [Char]
show :: IResult a -> [Char]
$cshowList :: forall a. Show a => [IResult a] -> ShowS
showList :: [IResult a] -> ShowS
Show, Typeable)

-- | The result of running a 'Parser'.
data Result a = Error String
              | Success a
                deriving (Result a -> Result a -> Bool
(Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool) -> Eq (Result a)
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: Result a -> Result a -> Bool
Eq, Int -> Result a -> ShowS
[Result a] -> ShowS
Result a -> [Char]
(Int -> Result a -> ShowS)
-> (Result a -> [Char]) -> ([Result a] -> ShowS) -> Show (Result a)
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
showsPrec :: Int -> Result a -> ShowS
$cshow :: forall a. Show a => Result a -> [Char]
show :: Result a -> [Char]
$cshowList :: forall a. Show a => [Result a] -> ShowS
showList :: [Result a] -> ShowS
Show, Typeable)

instance NFData JSONPathElement where
  rnf :: JSONPathElement -> ()
rnf (Key Key
t)   = Key -> ()
forall a. NFData a => a -> ()
rnf Key
t
  rnf (Index Int
i) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
i

instance (NFData a) => NFData (IResult a) where
    rnf :: IResult a -> ()
rnf (ISuccess a
a)      = a -> ()
forall a. NFData a => a -> ()
rnf a
a
    rnf (IError [JSONPathElement]
path [Char]
err) = [JSONPathElement] -> ()
forall a. NFData a => a -> ()
rnf [JSONPathElement]
path () -> () -> ()
forall a b. a -> b -> b
`seq` [Char] -> ()
forall a. NFData a => a -> ()
rnf [Char]
err

instance (NFData a) => NFData (Result a) where
    rnf :: Result a -> ()
rnf (Success a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
    rnf (Error [Char]
err) = [Char] -> ()
forall a. NFData a => a -> ()
rnf [Char]
err

instance Functor IResult where
    fmap :: forall a b. (a -> b) -> IResult a -> IResult b
fmap a -> b
f (ISuccess a
a)      = b -> IResult b
forall a. a -> IResult a
ISuccess (a -> b
f a
a)
    fmap a -> b
_ (IError [JSONPathElement]
path [Char]
err) = [JSONPathElement] -> [Char] -> IResult b
forall a. [JSONPathElement] -> [Char] -> IResult a
IError [JSONPathElement]
path [Char]
err
    {-# INLINE fmap #-}

instance Functor Result where
    fmap :: forall a b. (a -> b) -> Result a -> Result b
fmap a -> b
f (Success a
a) = b -> Result b
forall a. a -> Result a
Success (a -> b
f a
a)
    fmap a -> b
_ (Error [Char]
err) = [Char] -> Result b
forall a. [Char] -> Result a
Error [Char]
err
    {-# INLINE fmap #-}

instance Monad.Monad IResult where
    return :: forall a. a -> IResult a
return = a -> IResult a
forall a. a -> IResult a
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 [Char]
err >>= a -> IResult b
_ = [JSONPathElement] -> [Char] -> IResult b
forall a. [JSONPathElement] -> [Char] -> IResult a
IError [JSONPathElement]
path [Char]
err
    {-# INLINE (>>=) #-}

#if !(MIN_VERSION_base(4,13,0))
    fail = Fail.fail
    {-# INLINE fail #-}
#endif

instance Fail.MonadFail IResult where
    fail :: forall a. HasCallStack => [Char] -> IResult a
fail [Char]
err = [JSONPathElement] -> [Char] -> IResult a
forall a. [JSONPathElement] -> [Char] -> IResult a
IError [] [Char]
err
    {-# INLINE fail #-}

instance Monad.Monad Result where
    return :: forall a. a -> Result a
return = a -> Result a
forall a. a -> Result a
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 [Char]
err >>= a -> Result b
_ = [Char] -> Result b
forall a. [Char] -> Result a
Error [Char]
err
    {-# INLINE (>>=) #-}

#if !(MIN_VERSION_base(4,13,0))
    fail = Fail.fail
    {-# INLINE fail #-}
#endif

instance Fail.MonadFail Result where
    fail :: forall a. HasCallStack => [Char] -> Result a
fail [Char]
err = [Char] -> Result a
forall a. [Char] -> Result a
Error [Char]
err
    {-# INLINE fail #-}

instance Applicative IResult where
    pure :: forall a. a -> IResult a
pure  = a -> IResult a
forall a. a -> IResult a
ISuccess
    {-# INLINE pure #-}
    <*> :: forall a b. IResult (a -> b) -> IResult a -> IResult 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  = a -> Result a
forall a. a -> Result a
Success
    {-# INLINE pure #-}
    <*> :: forall a b. Result (a -> b) -> Result a -> Result 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 = [Char] -> IResult a
forall a. HasCallStack => [Char] -> IResult a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
[Char] -> m a
fail [Char]
"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 = [Char] -> Result a
forall a. HasCallStack => [Char] -> Result a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
[Char] -> m a
fail [Char]
"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 = IResult a
forall a. IResult a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    {-# INLINE empty #-}
    <|> :: forall a. IResult a -> IResult a -> IResult a
(<|>) = IResult a -> IResult a -> IResult a
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 = Result a
forall a. Result a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    {-# INLINE empty #-}
    <|> :: forall a. Result a -> Result a -> Result a
(<|>) = Result a -> Result a -> Result a
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
(<>) = IResult a -> IResult a -> IResult a
forall a. 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  = [Char] -> IResult a
forall a. HasCallStack => [Char] -> IResult a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
[Char] -> m a
fail [Char]
"mempty"
    {-# INLINE mempty #-}
    mappend :: IResult a -> IResult a -> IResult a
mappend = IResult a -> IResult a -> IResult a
forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE mappend #-}

instance Semigroup (Result a) where
    <> :: Result a -> Result a -> Result a
(<>) = Result a -> Result a -> Result a
forall a. 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  = [Char] -> Result a
forall a. HasCallStack => [Char] -> Result a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
[Char] -> m a
fail [Char]
"mempty"
    {-# INLINE mempty #-}
    mappend :: Result a -> Result a -> Result a
mappend = Result a -> Result a -> Result a
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]
_ [Char]
_) = m
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]
_ [Char]
_) = 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 [Char]
_)   = m
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 [Char]
_)   = 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 [Char]
err) = IResult b -> f (IResult b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([JSONPathElement] -> [Char] -> IResult b
forall a. [JSONPathElement] -> [Char] -> IResult a
IError [JSONPathElement]
path [Char]
err)
    traverse a -> f b
f (ISuccess a
a)      = b -> IResult b
forall a. a -> IResult a
ISuccess (b -> IResult b) -> f b -> f (IResult b)
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 [Char]
err) = Result b -> f (Result b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Result b
forall a. [Char] -> Result a
Error [Char]
err)
    traverse a -> f b
f (Success a
a) = b -> Result b
forall a. a -> Result a
Success (b -> Result b) -> f b -> f (Result b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
    {-# INLINE traverse #-}

-- | Failure continuation.
type Failure f r   = JSONPath -> String -> f r
-- | Success continuation.
type Success a f r = a -> f r

-- | A JSON parser.  N.B. This might not fit your usual understanding of
--  "parser".  Instead you might like to think of 'Parser' as a "parse result",
-- i.e. a parser to which the input has already been applied.
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 (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success b f r -> f r)
-> Parser b
forall a.
(forall (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser ((forall (f :: * -> *) r.
  [JSONPathElement] -> Failure f r -> Success b f r -> f r)
 -> Parser b)
-> (forall (f :: * -> *) r.
    [JSONPathElement] -> Failure f r -> Success b f r -> f r)
-> Parser b
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 = Parser b
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success b f r -> f r
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 Parser a
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
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 = a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE return #-}

#if !(MIN_VERSION_base(4,13,0))
    fail = Fail.fail
    {-# INLINE fail #-}
#endif

-- |
--
-- @since 2.1.0.0
instance MonadFix Parser where
    mfix :: forall a. (a -> Parser a) -> Parser a
mfix a -> Parser a
f = (forall (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a.
(forall (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser ((forall (f :: * -> *) r.
  [JSONPathElement] -> Failure f r -> Success a f r -> f r)
 -> Parser a)
-> (forall (f :: * -> *) r.
    [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success a f r
ks -> let x :: IResult a
x = Parser a
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
forall a.
Parser a
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser (a -> Parser a
f (IResult a -> a
forall a. IResult a -> a
fromISuccess IResult a
x)) [JSONPathElement]
path Failure IResult a
forall a. [JSONPathElement] -> [Char] -> IResult a
IError Success a IResult a
forall a. a -> IResult a
ISuccess in
        case IResult a
x of
            IError [JSONPathElement]
p [Char]
e -> Failure f r
kf [JSONPathElement]
p [Char]
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 [Char]
msg) = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"mfix @Aeson.Parser: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [JSONPathElement] -> [Char]
formatPath [JSONPathElement]
path [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
msg

instance Fail.MonadFail Parser where
    fail :: forall a. HasCallStack => [Char] -> Parser a
fail [Char]
msg = (forall (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a.
(forall (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser ((forall (f :: * -> *) r.
  [JSONPathElement] -> Failure f r -> Success a f r -> f r)
 -> Parser a)
-> (forall (f :: * -> *) r.
    [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success a f r
_ks -> Failure f r
kf ([JSONPathElement] -> [JSONPathElement]
forall a. [a] -> [a]
reverse [JSONPathElement]
path) [Char]
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 (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success b f r -> f r)
-> Parser b
forall a.
(forall (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser ((forall (f :: * -> *) r.
  [JSONPathElement] -> Failure f r -> Success b f r -> f r)
 -> Parser b)
-> (forall (f :: * -> *) r.
    [JSONPathElement] -> Failure f r -> Success b f r -> f r)
-> Parser b
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 Parser a
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
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 (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a.
(forall (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser ((forall (f :: * -> *) r.
  [JSONPathElement] -> Failure f r -> Success a f r -> f r)
 -> Parser a)
-> (forall (f :: * -> *) r.
    [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
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
(<*>) = 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 = [Char] -> Parser a
forall a. HasCallStack => [Char] -> Parser a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
[Char] -> m a
fail [Char]
"empty"
    {-# INLINE empty #-}
    <|> :: forall a. Parser a -> Parser a -> Parser a
(<|>) = Parser a -> Parser a -> Parser a
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 = [Char] -> Parser a
forall a. HasCallStack => [Char] -> Parser a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
[Char] -> m a
fail [Char]
"mzero"
    {-# INLINE mzero #-}
    mplus :: forall a. Parser a -> Parser a -> Parser a
mplus Parser a
a Parser a
b = (forall (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a.
(forall (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser ((forall (f :: * -> *) r.
  [JSONPathElement] -> Failure f r -> Success a f r -> f r)
 -> Parser a)
-> (forall (f :: * -> *) r.
    [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
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
_ = Parser a
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
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 Parser a
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
forall a.
Parser a
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser Parser a
a [JSONPathElement]
path Failure f r
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
(<>) = Parser a -> Parser a -> Parser a
forall a. 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  = [Char] -> Parser a
forall a. HasCallStack => [Char] -> Parser a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
[Char] -> m a
fail [Char]
"mempty"
    {-# INLINE mempty #-}
    mappend :: Parser a -> Parser a -> Parser a
mappend = Parser a -> Parser a -> Parser a
forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE mappend #-}

-- | Raise a parsing failure with some custom message.
parseFail :: String -> Parser a
parseFail :: forall a. [Char] -> Parser a
parseFail = [Char] -> Parser a
forall a. HasCallStack => [Char] -> Parser a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
[Char] -> 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
  b <- Parser (a -> b)
d
  b <$> e
{-# INLINE apP #-}

-- | A JSON \"object\" (key\/value map).
type Object = KeyMap Value

-- | A JSON \"array\" (sequence).
type Array = Vector Value

-- | A JSON value represented as a Haskell value.
data Value = Object !Object
           | Array !Array
           | String !Text
           | Number !Scientific
           | Bool !Bool
           | Null
             deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, ReadPrec [Value]
ReadPrec Value
Int -> ReadS Value
ReadS [Value]
(Int -> ReadS Value)
-> ReadS [Value]
-> ReadPrec Value
-> ReadPrec [Value]
-> Read Value
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Value
readsPrec :: Int -> ReadS Value
$creadList :: ReadS [Value]
readList :: ReadS [Value]
$creadPrec :: ReadPrec Value
readPrec :: ReadPrec Value
$creadListPrec :: ReadPrec [Value]
readListPrec :: ReadPrec [Value]
Read, Typeable, Typeable Value
Typeable Value =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Value -> c Value)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Value)
-> (Value -> Constr)
-> (Value -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Value -> Value)
-> (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 u. (forall d. Data d => d -> u) -> Value -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Value -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Value -> m Value)
-> Data Value
Value -> Constr
Value -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
$ctoConstr :: Value -> Constr
toConstr :: Value -> Constr
$cdataTypeOf :: Value -> DataType
dataTypeOf :: Value -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
$cgmapT :: (forall b. Data b => b -> b) -> Value -> Value
gmapT :: (forall b. Data b => b -> b) -> Value -> Value
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Value -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Value -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Value -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Value -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
Data, (forall x. Value -> Rep Value x)
-> (forall x. Rep Value x -> Value) -> Generic Value
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
$cfrom :: forall x. Value -> Rep Value x
from :: forall x. Value -> Rep Value x
$cto :: forall x. Rep Value x -> Value
to :: forall x. Rep Value x -> Value
Generic)

-- | Since version 1.5.6.0 version object values are printed in lexicographic key order
--
-- >>> toJSON $ H.fromList [("a", True), ("z", False)]
-- Object (fromList [("a",Bool True),("z",Bool False)])
--
-- >>> toJSON $ H.fromList [("z", False), ("a", True)]
-- Object (fromList [("a",Bool True),("z",Bool False)])
--
instance Show Value where
    showsPrec :: Int -> Value -> ShowS
showsPrec Int
_ Value
Null = [Char] -> ShowS
showString [Char]
"Null"
    showsPrec Int
d (Bool Bool
b) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS
showString [Char]
"Bool " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Bool
b
    showsPrec Int
d (Number Scientific
s) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS
showString [Char]
"Number " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Scientific -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Scientific
s
    showsPrec Int
d (String Text
s) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS
showString [Char]
"String " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
s
    showsPrec Int
d (Array Vector Value
xs) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS
showString [Char]
"Array " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Vector Value -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Vector Value
xs
    showsPrec Int
d (Object KeyMap Value
xs) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS
showString [Char]
"Object (fromList "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Key, Value)] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (KeyMap Value -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toAscList KeyMap Value
xs)
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'

-- | @since 2.0.3.0
instance QC.Arbitrary Value where
    arbitrary :: Gen Value
arbitrary = (Int -> Gen Value) -> Gen Value
forall a. (Int -> Gen a) -> Gen a
QC.sized Int -> Gen Value
arbValue

    shrink :: Value -> [Value]
shrink = [Value] -> [Value]
forall (t :: * -> *) a. (Witherable t, Ord a) => t a -> t a
ordNub ([Value] -> [Value]) -> (Value -> [Value]) -> Value -> [Value]
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 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: (Bool -> Value) -> [Bool] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Bool -> Value
Bool (Bool -> [Bool]
forall a. Arbitrary a => a -> [a]
QC.shrink Bool
b)
        go (String Text
x) = Value
Null Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: ([Char] -> Value) -> [[Char]] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Value
String (Text -> Value) -> ([Char] -> Text) -> [Char] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) ([Char] -> [[Char]]
forall a. Arbitrary a => a -> [a]
QC.shrink (Text -> [Char]
T.unpack Text
x))
        go (Number Scientific
x) = Value
Null Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: (Scientific -> Value) -> [Scientific] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Scientific -> Value
Number (Scientific -> [Scientific]
shrScientific Scientific
x)
        go (Array Vector Value
x)  = Value
Null Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList Vector Value
x [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ ([Value] -> Value) -> [[Value]] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Vector Value -> Value
Array (Vector Value -> Value)
-> ([Value] -> Vector Value) -> [Value] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Vector Value
forall a. [a] -> Vector a
V.fromList) ((Value -> [Value]) -> [Value] -> [[Value]]
forall a. (a -> [a]) -> [a] -> [[a]]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
QC.liftShrink Value -> [Value]
go (Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList Vector Value
x))
        go (Object KeyMap Value
x) = Value
Null Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: KeyMap Value -> [Value]
forall v. KeyMap v -> [v]
KM.elems KeyMap Value
x [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ ([(Key, Value)] -> Value) -> [[(Key, Value)]] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (KeyMap Value -> Value
Object (KeyMap Value -> Value)
-> ([(Key, Value)] -> KeyMap Value) -> [(Key, Value)] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> KeyMap Value
forall v. [(Key, v)] -> KeyMap v
KM.fromList) (((Key, Value) -> [(Key, Value)])
-> [(Key, Value)] -> [[(Key, Value)]]
forall a. (a -> [a]) -> [a] -> [[a]]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
QC.liftShrink ((Value -> [Value]) -> (Key, Value) -> [(Key, Value)]
forall a. (a -> [a]) -> (Key, a) -> [(Key, a)]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
QC.liftShrink Value -> [Value]
go) (KeyMap Value -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList KeyMap Value
x))

-- | @since 2.0.3.0
instance QC.CoArbitrary Value where
    coarbitrary :: forall b. Value -> Gen b -> Gen b
coarbitrary Value
Null       = Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (Int
0 :: Int)
    coarbitrary (Bool Bool
b)   = Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (Int
1 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Gen b -> Gen b
forall b. Bool -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary Bool
b
    coarbitrary (String Text
x) = Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (Int
2 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Gen b -> Gen b
forall b. [Char] -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Text -> [Char]
T.unpack Text
x)
    coarbitrary (Number Scientific
x) = Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (Int
3 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Gen b -> Gen b
forall b. Integer -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Scientific -> Integer
Sci.coefficient Scientific
x) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Gen b -> Gen b
forall b. Int -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Scientific -> Int
Sci.base10Exponent Scientific
x)
    coarbitrary (Array Vector Value
x)  = Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (Int
4 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Gen b -> Gen b
forall b. [Value] -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList Vector Value
x)
    coarbitrary (Object KeyMap Value
x) = Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (Int
5 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Gen b -> Gen b
forall b. [(Key, Value)] -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (KeyMap Value -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList KeyMap Value
x)

-- | @since 2.0.3.0
instance QC.Function Value where
    function :: forall b. (Value -> b) -> Value :-> b
function = (Value
 -> Either
      (Maybe Bool)
      (Either
         (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)])))
-> (Either
      (Maybe Bool)
      (Either
         (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)]))
    -> Value)
-> (Value -> b)
-> Value :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap Value
-> Either
     (Maybe Bool)
     (Either
        (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)]))
fwd Either
  (Maybe Bool)
  (Either
     (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)]))
-> Value
bwd where
        fwd :: Value -> RepValue
        fwd :: Value
-> Either
     (Maybe Bool)
     (Either
        (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)]))
fwd Value
Null       = Maybe Bool
-> Either
     (Maybe Bool)
     (Either
        (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)]))
forall a b. a -> Either a b
Left Maybe Bool
forall a. Maybe a
Nothing
        fwd (Bool Bool
b)   = Maybe Bool
-> Either
     (Maybe Bool)
     (Either
        (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)]))
forall a b. a -> Either a b
Left (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b)
        fwd (String Text
x) = Either
  (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)])
-> Either
     (Maybe Bool)
     (Either
        (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)]))
forall a b. b -> Either a b
Right (Either [Char] (Integer, Int)
-> Either
     (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)])
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (Integer, Int)
forall a b. a -> Either a b
Left (Text -> [Char]
T.unpack Text
x)))
        fwd (Number Scientific
x) = Either
  (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)])
-> Either
     (Maybe Bool)
     (Either
        (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)]))
forall a b. b -> Either a b
Right (Either [Char] (Integer, Int)
-> Either
     (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)])
forall a b. a -> Either a b
Left ((Integer, Int) -> Either [Char] (Integer, Int)
forall a b. b -> Either a b
Right (Scientific -> Integer
Sci.coefficient Scientific
x, Scientific -> Int
Sci.base10Exponent Scientific
x)))
        fwd (Array Vector Value
x)  = Either
  (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)])
-> Either
     (Maybe Bool)
     (Either
        (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)]))
forall a b. b -> Either a b
Right (Either [Value] [(Key, Value)]
-> Either
     (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)])
forall a b. b -> Either a b
Right ([Value] -> Either [Value] [(Key, Value)]
forall a b. a -> Either a b
Left (Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList Vector Value
x)))
        fwd (Object KeyMap Value
x) = Either
  (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)])
-> Either
     (Maybe Bool)
     (Either
        (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)]))
forall a b. b -> Either a b
Right (Either [Value] [(Key, Value)]
-> Either
     (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)])
forall a b. b -> Either a b
Right ([(Key, Value)] -> Either [Value] [(Key, Value)]
forall a b. b -> Either a b
Right (KeyMap Value -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList KeyMap Value
x)))

        bwd :: RepValue -> Value
        bwd :: Either
  (Maybe Bool)
  (Either
     (Either [Char] (Integer, Int)) (Either [Value] [(Key, Value)]))
-> Value
bwd (Left Maybe Bool
Nothing)                = Value
Null
        bwd (Left (Just Bool
b))               = Bool -> Value
Bool Bool
b
        bwd (Right (Left (Left [Char]
x)))       = Text -> Value
String ([Char] -> Text
T.pack [Char]
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)))      = Vector Value -> Value
Array ([Value] -> Vector Value
forall a. [a] -> Vector a
V.fromList [Value]
x)
        bwd (Right (Right (Right [(Key, Value)]
x)))     = KeyMap Value -> Value
Object ([(Key, Value)] -> KeyMap Value
forall v. [(Key, v)] -> KeyMap v
KM.fromList [(Key, Value)]
x)

-- Used to implement QC.Function Value instance
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = [Gen Value] -> Gen Value
forall a. HasCallStack => [Gen a] -> Gen a
QC.oneof
        [ Value -> Gen Value
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Null
        , Bool -> Value
Bool (Bool -> Value) -> Gen Bool -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
QC.arbitrary
        , Text -> Value
String (Text -> Value) -> Gen Text -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
arbText
        , Scientific -> Value
Number (Scientific -> Value) -> Gen Scientific -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Scientific
arbScientific
        , Value -> Gen Value
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
emptyObject
        , Value -> Gen Value
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
emptyArray
        ]

    | Bool
otherwise = [Gen Value] -> Gen Value
forall a. HasCallStack => [Gen a] -> Gen a
QC.oneof
        [ KeyMap Value -> Value
Object (KeyMap Value -> Value) -> Gen (KeyMap Value) -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen (KeyMap Value)
arbObject Int
n
        , Vector Value -> Value
Array (Vector Value -> Value) -> Gen (Vector Value) -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen (Vector Value)
arbArray  Int
n
        ]

arbText :: QC.Gen Text
arbText :: Gen Text
arbText = [Char] -> Text
T.pack ([Char] -> Text) -> Gen [Char] -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Char]
forall a. Arbitrary a => Gen a
QC.arbitrary

arbScientific :: QC.Gen Scientific
arbScientific :: Gen Scientific
arbScientific = Integer -> Int -> Scientific
Sci.scientific (Integer -> Int -> Scientific)
-> Gen Integer -> Gen (Int -> Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
QC.arbitrary Gen (Int -> Scientific) -> Gen Int -> Gen Scientific
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
QC.arbitrary

shrScientific :: Scientific -> [Scientific]
shrScientific :: Scientific -> [Scientific]
shrScientific Scientific
s = ((Integer, Int) -> Scientific) -> [(Integer, Int)] -> [Scientific]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> Int -> Scientific) -> (Integer, Int) -> Scientific
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Int -> Scientific
Sci.scientific) ([(Integer, Int)] -> [Scientific])
-> [(Integer, Int)] -> [Scientific]
forall a b. (a -> b) -> a -> b
$
    (Integer, Int) -> [(Integer, Int)]
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 (KeyMap Value)
arbObject Int
n = do
    p <- Int -> Gen [Int]
arbPartition (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    KM.fromList <$> traverse (\Int
m -> (,) (Key -> Value -> (Key, Value))
-> Gen Key -> Gen (Value -> (Key, Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Key
forall a. Arbitrary a => Gen a
QC.arbitrary Gen (Value -> (Key, Value)) -> Gen Value -> Gen (Key, Value)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen Value
arbValue Int
m) p

arbArray :: Int -> QC.Gen Array
arbArray :: Int -> Gen (Vector Value)
arbArray Int
n = do
    p <- Int -> Gen [Int]
arbPartition (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    V.fromList <$> traverse arbValue p

arbPartition :: Int -> QC.Gen [Int]
arbPartition :: Int -> Gen [Int]
arbPartition Int
k = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
k Int
1 of
    Ordering
LT -> [Int] -> Gen [Int]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Ordering
EQ -> [Int] -> Gen [Int]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Int
1]
    Ordering
GT -> do
        first <- (Int, Int) -> Gen Int
QC.chooseInt (Int
1, Int
k)
        rest <- arbPartition $ k - first
        QC.shuffle (first : rest)

-- |
--
-- The ordering is total, consistent with 'Eq' instance.
-- However, nothing else about the ordering is specified,
-- and it may change from environment to environment and version to version
-- of either this package or its dependencies ('hashable' and 'unordered-containers').
--
-- @since 1.5.2.0
deriving instance Ord Value
-- standalone deriving to attach since annotation.

-- | A newtype wrapper for 'UTCTime' that uses the same non-standard
-- serialization format as Microsoft .NET, whose
-- <https://msdn.microsoft.com/en-us/library/system.datetime(v=vs.110).aspx System.DateTime>
-- type is by default serialized to JSON as in the following example:
--
-- > /Date(1302547608878)/
--
-- The number represents milliseconds since the Unix epoch.
newtype DotNetTime = DotNetTime {
      DotNetTime -> UTCTime
fromDotNetTime :: UTCTime
      -- ^ Acquire the underlying value.
    } deriving (DotNetTime -> DotNetTime -> Bool
(DotNetTime -> DotNetTime -> Bool)
-> (DotNetTime -> DotNetTime -> Bool) -> Eq DotNetTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DotNetTime -> DotNetTime -> Bool
== :: DotNetTime -> DotNetTime -> Bool
$c/= :: DotNetTime -> DotNetTime -> Bool
/= :: DotNetTime -> DotNetTime -> Bool
Eq, Eq DotNetTime
Eq DotNetTime =>
(DotNetTime -> DotNetTime -> Ordering)
-> (DotNetTime -> DotNetTime -> Bool)
-> (DotNetTime -> DotNetTime -> Bool)
-> (DotNetTime -> DotNetTime -> Bool)
-> (DotNetTime -> DotNetTime -> Bool)
-> (DotNetTime -> DotNetTime -> DotNetTime)
-> (DotNetTime -> DotNetTime -> DotNetTime)
-> Ord 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
$ccompare :: DotNetTime -> DotNetTime -> Ordering
compare :: DotNetTime -> DotNetTime -> Ordering
$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
>= :: DotNetTime -> DotNetTime -> Bool
$cmax :: DotNetTime -> DotNetTime -> DotNetTime
max :: DotNetTime -> DotNetTime -> DotNetTime
$cmin :: DotNetTime -> DotNetTime -> DotNetTime
min :: DotNetTime -> DotNetTime -> DotNetTime
Ord, ReadPrec [DotNetTime]
ReadPrec DotNetTime
Int -> ReadS DotNetTime
ReadS [DotNetTime]
(Int -> ReadS DotNetTime)
-> ReadS [DotNetTime]
-> ReadPrec DotNetTime
-> ReadPrec [DotNetTime]
-> Read DotNetTime
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DotNetTime
readsPrec :: Int -> ReadS DotNetTime
$creadList :: ReadS [DotNetTime]
readList :: ReadS [DotNetTime]
$creadPrec :: ReadPrec DotNetTime
readPrec :: ReadPrec DotNetTime
$creadListPrec :: ReadPrec [DotNetTime]
readListPrec :: ReadPrec [DotNetTime]
Read, Int -> DotNetTime -> ShowS
[DotNetTime] -> ShowS
DotNetTime -> [Char]
(Int -> DotNetTime -> ShowS)
-> (DotNetTime -> [Char])
-> ([DotNetTime] -> ShowS)
-> Show DotNetTime
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DotNetTime -> ShowS
showsPrec :: Int -> DotNetTime -> ShowS
$cshow :: DotNetTime -> [Char]
show :: DotNetTime -> [Char]
$cshowList :: [DotNetTime] -> ShowS
showList :: [DotNetTime] -> ShowS
Show, Typeable, Bool -> Char -> Maybe (FormatOptions -> DotNetTime -> [Char])
(Bool -> Char -> Maybe (FormatOptions -> DotNetTime -> [Char]))
-> FormatTime DotNetTime
forall t.
(Bool -> Char -> Maybe (FormatOptions -> t -> [Char]))
-> FormatTime t
$cformatCharacter :: Bool -> Char -> Maybe (FormatOptions -> DotNetTime -> [Char])
formatCharacter :: Bool -> Char -> Maybe (FormatOptions -> DotNetTime -> [Char])
FormatTime)

instance NFData Value where
    rnf :: Value -> ()
rnf (Object KeyMap Value
o) = KeyMap Value -> ()
forall a. NFData a => a -> ()
rnf KeyMap Value
o
    rnf (Array Vector Value
a)  = (() -> Value -> ()) -> () -> Vector Value -> ()
forall b a. (b -> a -> b) -> b -> Vector a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\()
x Value
y -> Value -> ()
forall a. NFData a => a -> ()
rnf Value
y () -> () -> ()
forall a b. a -> b -> b
`seq` ()
x) () Vector Value
a
    rnf (String Text
s) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
s
    rnf (Number Scientific
n) = Scientific -> ()
forall a. NFData a => a -> ()
rnf Scientific
n
    rnf (Bool Bool
b)   = Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
b
    rnf Value
Null       = ()

instance IsString Value where
    fromString :: [Char] -> Value
fromString = Text -> Value
String (Text -> Value) -> ([Char] -> Text) -> [Char] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack
    {-# INLINE fromString #-}

hashValue :: Int -> Value -> Int
hashValue :: Int -> Value -> Int
hashValue Int
s (Object KeyMap Value
o)   = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0::Int) Int -> KeyMap Value -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` KeyMap Value
o
hashValue Int
s (Array Vector Value
a)    = (Int -> Value -> Int) -> Int -> Vector Value -> Int
forall b a. (b -> a -> b) -> b -> Vector a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Value -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt
                              (Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1::Int)) Vector Value
a
hashValue Int
s (String Text
str) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
2::Int) Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
str
hashValue Int
s (Number Scientific
n)   = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
3::Int) Int -> Scientific -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Scientific
n
hashValue Int
s (Bool Bool
b)     = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
4::Int) Int -> Bool -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Bool
b
hashValue Int
s Value
Null         = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
5::Int)

instance Hashable Value where
    hashWithSalt :: Int -> Value -> Int
hashWithSalt = Int -> Value -> Int
hashValue

-- | @since 0.11.0.0
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 :: [Char]
s = Text -> [Char]
unpack Text
t
    lift (Array Vector Value
a)  = [| Array (V.fromList a') |]
      where a' :: [Value]
a' = Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList Vector Value
a
    lift (Object KeyMap Value
o) = [| Object o |]

#if MIN_VERSION_template_haskell(2,17,0)
    liftTyped :: forall (m :: * -> *). Quote m => Value -> Code m Value
liftTyped = m Exp -> Code m Value
forall a (m :: * -> *). Quote m => m Exp -> Code m a
TH.unsafeCodeCoerce (m Exp -> Code m Value)
-> (Value -> m Exp) -> Value -> Code m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Value -> m Exp
TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
    liftTyped = TH.unsafeTExpCoerce . TH.lift
#endif

-- | The empty array.
emptyArray :: Value
emptyArray :: Value
emptyArray = Vector Value -> Value
Array Vector Value
forall a. Vector a
V.empty

-- | Determines if the 'Value' is an empty 'Array'.
-- Note that: @isEmptyArray 'emptyArray'@.
isEmptyArray :: Value -> Bool
isEmptyArray :: Value -> Bool
isEmptyArray (Array Vector Value
arr) = Vector Value -> Bool
forall a. Vector a -> Bool
V.null Vector Value
arr
isEmptyArray Value
_ = Bool
False

-- | The empty object.
emptyObject :: Value
emptyObject :: Value
emptyObject = KeyMap Value -> Value
Object KeyMap Value
forall v. KeyMap v
KM.empty

-- | Run a 'Parser'.
parse :: (a -> Parser b) -> a -> Result b
parse :: forall a b. (a -> Parser b) -> a -> Result b
parse a -> Parser b
m a
v = Parser b
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success b f r -> f r
forall a.
Parser a
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser (a -> Parser b
m a
v) [] (([Char] -> Result b) -> Failure Result b
forall a b. a -> b -> a
const [Char] -> Result b
forall a. [Char] -> Result a
Error) Success b Result b
forall a. a -> Result a
Success
{-# INLINE parse #-}

-- | Run a 'Parser'.
iparse :: (a -> Parser b) -> a -> IResult b
iparse :: forall a b. (a -> Parser b) -> a -> IResult b
iparse a -> Parser b
m a
v = Parser b
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success b f r -> f r
forall a.
Parser a
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser (a -> Parser b
m a
v) [] Failure IResult b
forall a. [JSONPathElement] -> [Char] -> IResult a
IError Success b IResult b
forall a. a -> IResult a
ISuccess
{-# INLINE iparse #-}

-- | Run a 'Parser' with a 'Maybe' result type.
parseMaybe :: (a -> Parser b) -> a -> Maybe b
parseMaybe :: forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe a -> Parser b
m a
v = Parser b
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success b f r -> f r
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]
_ [Char]
_ -> Maybe b
forall a. Maybe a
Nothing) Success b Maybe b
forall a. a -> Maybe a
Just
{-# INLINE parseMaybe #-}

-- | Run a 'Parser' with an 'Either' result type.  If the parse fails,
-- the 'Left' payload will contain an error message.
parseEither :: (a -> Parser b) -> a -> Either String b
parseEither :: forall a b. (a -> Parser b) -> a -> Either [Char] b
parseEither a -> Parser b
m a
v = Parser b
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success b f r -> f r
forall a.
Parser a
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser (a -> Parser b
m a
v) [] Failure (Either [Char]) b
forall {b}. [JSONPathElement] -> [Char] -> Either [Char] b
onError Success b (Either [Char]) b
forall a b. b -> Either a b
Right
  where onError :: [JSONPathElement] -> [Char] -> Either [Char] b
onError [JSONPathElement]
path [Char]
msg = [Char] -> Either [Char] b
forall a b. a -> Either a b
Left ([JSONPathElement] -> ShowS
formatError [JSONPathElement]
path [Char]
msg)
{-# INLINE parseEither #-}

-- | Run a 'Parser' with an 'Either' result type.
-- If the parse fails, the 'Left' payload will contain an error message and a json path to failed element.
--
-- @since 2.1.0.0
iparseEither :: (a -> Parser b) -> a -> Either (JSONPath, String) b
iparseEither :: forall a b.
(a -> Parser b) -> a -> Either ([JSONPathElement], [Char]) b
iparseEither a -> Parser b
m a
v = Parser b
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success b f r -> f r
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 [Char]
msg -> ([JSONPathElement], [Char]) -> Either ([JSONPathElement], [Char]) b
forall a b. a -> Either a b
Left ([JSONPathElement]
path, [Char]
msg)) Success b (Either ([JSONPathElement], [Char])) b
forall a b. b -> Either a b
Right
{-# INLINE iparseEither #-}

-- | Annotate an error message with a
-- <http://goessner.net/articles/JsonPath/ JSONPath> error location.
formatError :: JSONPath -> String -> String
formatError :: [JSONPathElement] -> ShowS
formatError [JSONPathElement]
path [Char]
msg = [Char]
"Error in " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [JSONPathElement] -> [Char]
formatPath [JSONPathElement]
path [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
msg

-- | Format a <http://goessner.net/articles/JsonPath/ JSONPath> as a 'String',
-- representing the root object as @$@.
formatPath :: JSONPath -> String
formatPath :: [JSONPathElement] -> [Char]
formatPath [JSONPathElement]
path = [Char]
"$" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [JSONPathElement] -> [Char]
formatRelativePath [JSONPathElement]
path

-- | Format a <http://goessner.net/articles/JsonPath/ JSONPath> as a 'String'
-- which represents the path relative to some root object.
formatRelativePath :: JSONPath -> String
formatRelativePath :: [JSONPathElement] -> [Char]
formatRelativePath [JSONPathElement]
path = [Char] -> [JSONPathElement] -> [Char]
format [Char]
"" [JSONPathElement]
path
  where
    format :: String -> JSONPath -> String
    format :: [Char] -> [JSONPathElement] -> [Char]
format [Char]
pfx []                = [Char]
pfx
    format [Char]
pfx (Index Int
idx:[JSONPathElement]
parts) = [Char] -> [JSONPathElement] -> [Char]
format ([Char]
pfx [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"[" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
idx [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"]") [JSONPathElement]
parts
    format [Char]
pfx (Key Key
key:[JSONPathElement]
parts)   = [Char] -> [JSONPathElement] -> [Char]
format ([Char]
pfx [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Key -> [Char]
formatKey Key
key) [JSONPathElement]
parts

    formatKey :: Key -> String
    formatKey :: Key -> [Char]
formatKey Key
key
       | [Char] -> Bool
isIdentifierKey [Char]
strKey = [Char]
"." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
strKey
       | Bool
otherwise              = [Char]
"['" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeKey [Char]
strKey [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"']"
      where strKey :: [Char]
strKey = Key -> [Char]
Key.toString Key
key

    isIdentifierKey :: String -> Bool
    isIdentifierKey :: [Char] -> Bool
isIdentifierKey []     = Bool
False
    isIdentifierKey (Char
x:[Char]
xs) = Char -> Bool
isAlpha Char
x Bool -> Bool -> Bool
&& (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAlphaNum [Char]
xs

    escapeKey :: String -> String
    escapeKey :: ShowS
escapeKey = (Char -> [Char]) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
escapeChar

    escapeChar :: Char -> String
    escapeChar :: Char -> [Char]
escapeChar Char
'\'' = [Char]
"\\'"
    escapeChar Char
'\\' = [Char]
"\\\\"
    escapeChar Char
c    = [Char
c]

-- | A key\/value pair for an 'Object'.
type Pair = (Key, Value)

-- | Create a 'Value' from a list of name\/value 'Pair's.  If duplicate
-- keys arise, later keys and their associated values win.
object :: [Pair] -> Value
object :: [(Key, Value)] -> Value
object = KeyMap Value -> Value
Object (KeyMap Value -> Value)
-> ([(Key, Value)] -> KeyMap Value) -> [(Key, Value)] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> KeyMap Value
forall v. [(Key, v)] -> KeyMap v
KM.fromList
{-# INLINE object #-}

-- | Add JSON Path context to a parser
--
-- When parsing a complex structure, it helps to annotate (sub)parsers
-- with context, so that if an error occurs, you can find its location.
--
-- > withObject "Person" $ \o ->
-- >   Person
-- >     <$> o .: "name" <?> Key "name"
-- >     <*> o .: "age"  <?> Key "age"
--
-- (Standard methods like '(.:)' already do this.)
--
-- With such annotations, if an error occurs, you will get a JSON Path
-- location of that error.
--
-- Since 0.10
(<?>) :: Parser a -> JSONPathElement -> Parser a
Parser a
p <?> :: forall a. Parser a -> JSONPathElement -> Parser a
<?> JSONPathElement
pathElem = (forall (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a.
(forall (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser ((forall (f :: * -> *) r.
  [JSONPathElement] -> Failure f r -> Success a f r -> f r)
 -> Parser a)
-> (forall (f :: * -> *) r.
    [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success a f r
ks -> Parser a
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
forall a.
Parser a
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser Parser a
p (JSONPathElement
pathElemJSONPathElement -> [JSONPathElement] -> [JSONPathElement]
forall a. a -> [a] -> [a]
:[JSONPathElement]
path) Failure f r
kf Success a f r
ks

-- | If the inner @Parser@ failed, modify the failure message using the
-- provided function. This allows you to create more descriptive error messages.
-- For example:
--
-- > parseJSON (Object o) = modifyFailure
-- >     ("Parsing of the Foo value failed: " ++)
-- >     (Foo <$> o .: "someField")
--
-- Since 0.6.2.0
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 (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a.
(forall (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser ((forall (f :: * -> *) r.
  [JSONPathElement] -> Failure f r -> Success a f r -> f r)
 -> Parser a)
-> (forall (f :: * -> *) r.
    [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success a f r
ks ->
    [JSONPathElement] -> Failure f r -> Success a f r -> f r
forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
p [JSONPathElement]
path (\[JSONPathElement]
p' [Char]
m -> Failure f r
kf [JSONPathElement]
p' (ShowS
f [Char]
m)) Success a f r
ks

-- | If the inner 'Parser' failed, prepend the given string to the failure
-- message.
--
-- @
-- 'prependFailure' s = 'modifyFailure' (s '++')
-- @
prependFailure :: String -> Parser a -> Parser a
prependFailure :: forall a. [Char] -> Parser a -> Parser a
prependFailure = ShowS -> Parser a -> Parser a
forall a. ShowS -> Parser a -> Parser a
modifyFailure (ShowS -> Parser a -> Parser a)
-> ([Char] -> ShowS) -> [Char] -> Parser a -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
forall a. [a] -> [a] -> [a]
(++)

-- | Throw a parser error with an additional path.
--
-- @since 1.2.1.0
parserThrowError :: JSONPath -> String -> Parser a
parserThrowError :: forall a. [JSONPathElement] -> [Char] -> Parser a
parserThrowError [JSONPathElement]
path' [Char]
msg = (forall (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a.
(forall (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser ((forall (f :: * -> *) r.
  [JSONPathElement] -> Failure f r -> Success a f r -> f r)
 -> Parser a)
-> (forall (f :: * -> *) r.
    [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success a f r
_ks ->
    Failure f r
kf ([JSONPathElement] -> [JSONPathElement]
forall a. [a] -> [a]
reverse [JSONPathElement]
path [JSONPathElement] -> [JSONPathElement] -> [JSONPathElement]
forall a. [a] -> [a] -> [a]
++ [JSONPathElement]
path') [Char]
msg

-- | A handler function to handle previous errors and return to normal execution.
--
-- @since 1.2.1.0
parserCatchError :: Parser a -> (JSONPath -> String -> Parser a) -> Parser a
parserCatchError :: forall a.
Parser a -> ([JSONPathElement] -> [Char] -> Parser a) -> Parser a
parserCatchError (Parser forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
p) [JSONPathElement] -> [Char] -> Parser a
handler = (forall (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a.
(forall (f :: * -> *) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser ((forall (f :: * -> *) r.
  [JSONPathElement] -> Failure f r -> Success a f r -> f r)
 -> Parser a)
-> (forall (f :: * -> *) r.
    [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success a f r
ks ->
    [JSONPathElement] -> Failure f r -> Success a f r -> f r
forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
p [JSONPathElement]
path (\[JSONPathElement]
e [Char]
msg -> Parser a
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
forall a.
Parser a
-> forall (f :: * -> *) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser ([JSONPathElement] -> [Char] -> Parser a
handler [JSONPathElement]
e [Char]
msg) [JSONPathElement]
path Failure f r
kf Success a f r
ks) Success a f r
ks

--------------------------------------------------------------------------------
-- Generic and TH encoding configuration
--------------------------------------------------------------------------------

-- | Options that specify how to encode\/decode your datatype to\/from JSON.
--
-- Options can be set using record syntax on 'defaultOptions' with the fields
-- below.
data Options = Options
    { Options -> ShowS
fieldLabelModifier :: String -> String
      -- ^ Function applied to field labels.
      -- Handy for removing common record prefixes for example.
    , Options -> ShowS
constructorTagModifier :: String -> String
      -- ^ Function applied to constructor tags which could be handy
      -- for lower-casing them for example.
    , Options -> Bool
allNullaryToStringTag :: Bool
      -- ^ If 'True' the constructors of a datatype, with /all/
      -- nullary constructors, will be encoded to just a string with
      -- the constructor tag. If 'False' the encoding will always
      -- follow the `sumEncoding`.
    , Options -> Bool
omitNothingFields :: Bool
      -- ^ If 'True', record fields with a 'Nothing' value will be
      -- omitted from the resulting object. If 'False', the resulting
      -- object will include those fields mapping to @null@.
      --
      -- In @aeson-2.2@ this flag is generalised to omit all values with @'Data.Aeson.Types.omitField' x = True@.
      -- If 'False', the resulting object will include those fields encoded as specified. 
      --
      -- Note that this /does not/ affect parsing: 'Maybe' fields are
      -- optional regardless of the value of 'omitNothingFields'.
      -- 'allowOmittedFieds' controls parsing behavior.
    , Options -> Bool
allowOmittedFields :: Bool
      -- ^ If 'True', missing fields of a record will be filled
      -- with 'omittedField' values (if they are 'Just').
      -- If 'False', all fields will required to present in the record object.
    , Options -> SumEncoding
sumEncoding :: SumEncoding
      -- ^ Specifies how to encode constructors of a sum datatype.
    , Options -> Bool
unwrapUnaryRecords :: Bool
      -- ^ Hide the field name when a record constructor has only one
      -- field, like a newtype.
    , Options -> Bool
tagSingleConstructors :: Bool
      -- ^ Encode types with a single constructor as sums,
      -- so that `allNullaryToStringTag` and `sumEncoding` apply.
    , Options -> Bool
rejectUnknownFields :: Bool
      -- ^ Applies only to 'Data.Aeson.FromJSON' instances. If a field appears in
      -- the parsed object map, but does not appear in the target object, parsing
      -- will fail, with an error message indicating which fields were unknown.
    }

instance Show Options where
  show :: Options -> [Char]
show (Options ShowS
f ShowS
c Bool
a Bool
o Bool
q SumEncoding
s Bool
u Bool
t Bool
r) =
       [Char]
"Options {"
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", "
      [ [Char]
"fieldLabelModifier =~ " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show (ShowS
f [Char]
"exampleField")
      , [Char]
"constructorTagModifier =~ " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show (ShowS
c [Char]
"ExampleConstructor")
      , [Char]
"allNullaryToStringTag = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
a
      , [Char]
"omitNothingFields = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
o
      , [Char]
"allowOmittedFields = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
q
      , [Char]
"sumEncoding = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SumEncoding -> [Char]
forall a. Show a => a -> [Char]
show SumEncoding
s
      , [Char]
"unwrapUnaryRecords = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
u
      , [Char]
"tagSingleConstructors = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
t
      , [Char]
"rejectUnknownFields = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
r
      ]
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"}"

-- | Specifies how to encode constructors of a sum datatype.
data SumEncoding =
    TaggedObject { SumEncoding -> [Char]
tagFieldName      :: String
                 , SumEncoding -> [Char]
contentsFieldName :: String
                 }
    -- ^ A constructor will be encoded to an object with a field
    -- 'tagFieldName' which specifies the constructor tag (modified by
    -- the 'constructorTagModifier'). If the constructor is a record
    -- the encoded record fields will be unpacked into this object. So
    -- make sure that your record doesn't have a field with the same
    -- label as the 'tagFieldName'. Otherwise the tag gets overwritten
    -- by the encoded value of that field! If the constructor is not a
    -- record the encoded constructor contents will be stored under
    -- the 'contentsFieldName' field.
  | UntaggedValue
    -- ^ Constructor names won't be encoded. Instead only the contents of the
    -- constructor will be encoded as if the type had a single constructor. JSON
    -- encodings have to be disjoint for decoding to work properly.
    --
    -- When decoding, constructors are tried in the order of definition. If some
    -- encodings overlap, the first one defined will succeed.
    --
    -- /Note:/ Nullary constructors are encoded as strings (using
    -- 'constructorTagModifier'). Having a nullary constructor alongside a
    -- single field constructor that encodes to a string leads to ambiguity.
    --
    -- /Note:/ Only the last error is kept when decoding, so in the case of
    -- malformed JSON, only an error for the last constructor will be reported.
  | ObjectWithSingleField
    -- ^ A constructor will be encoded to an object with a single
    -- field named after the constructor tag (modified by the
    -- 'constructorTagModifier') which maps to the encoded contents of
    -- the constructor.
  | TwoElemArray
    -- ^ A constructor will be encoded to a 2-element array where the
    -- first element is the tag of the constructor (modified by the
    -- 'constructorTagModifier') and the second element the encoded
    -- contents of the constructor.
    deriving (SumEncoding -> SumEncoding -> Bool
(SumEncoding -> SumEncoding -> Bool)
-> (SumEncoding -> SumEncoding -> Bool) -> Eq SumEncoding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SumEncoding -> SumEncoding -> Bool
== :: SumEncoding -> SumEncoding -> Bool
$c/= :: SumEncoding -> SumEncoding -> Bool
/= :: SumEncoding -> SumEncoding -> Bool
Eq, Int -> SumEncoding -> ShowS
[SumEncoding] -> ShowS
SumEncoding -> [Char]
(Int -> SumEncoding -> ShowS)
-> (SumEncoding -> [Char])
-> ([SumEncoding] -> ShowS)
-> Show SumEncoding
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SumEncoding -> ShowS
showsPrec :: Int -> SumEncoding -> ShowS
$cshow :: SumEncoding -> [Char]
show :: SumEncoding -> [Char]
$cshowList :: [SumEncoding] -> ShowS
showList :: [SumEncoding] -> ShowS
Show)

-- | Options for encoding keys with 'Data.Aeson.Types.genericFromJSONKey' and
-- 'Data.Aeson.Types.genericToJSONKey'.
data JSONKeyOptions = JSONKeyOptions
    { JSONKeyOptions -> ShowS
keyModifier :: String -> String
      -- ^ Function applied to keys. Its result is what goes into the encoded
      -- 'Value'.
      --
      -- === __Example__
      --
      -- The following instances encode the constructor @Bar@ to lower-case keys
      -- @\"bar\"@.
      --
      -- @
      -- data Foo = Bar
      --   deriving 'Generic'
      --
      -- opts :: 'JSONKeyOptions'
      -- opts = 'defaultJSONKeyOptions' { 'keyModifier' = 'toLower' }
      --
      -- instance 'ToJSONKey' Foo where
      --   'toJSONKey' = 'genericToJSONKey' opts
      --
      -- instance 'FromJSONKey' Foo where
      --   'fromJSONKey' = 'genericFromJSONKey' opts
      -- @
    }

-- | Default encoding 'Options':
--
-- @
-- 'Options'
-- { 'fieldLabelModifier'      = id
-- , 'constructorTagModifier'  = id
-- , 'allNullaryToStringTag'   = True
-- , 'omitNothingFields'       = False
-- , 'allowOmittedFields'      = True
-- , 'sumEncoding'             = 'defaultTaggedObject'
-- , 'unwrapUnaryRecords'      = False
-- , 'tagSingleConstructors'   = False
-- , 'rejectUnknownFields'     = False
-- }
-- @
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options
                 { fieldLabelModifier :: ShowS
fieldLabelModifier      = ShowS
forall a. a -> a
id
                 , constructorTagModifier :: ShowS
constructorTagModifier  = ShowS
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
                 }

-- | Default 'TaggedObject' 'SumEncoding' options:
--
-- @
-- defaultTaggedObject = 'TaggedObject'
--                       { 'tagFieldName'      = \"tag\"
--                       , 'contentsFieldName' = \"contents\"
--                       }
-- @
defaultTaggedObject :: SumEncoding
defaultTaggedObject :: SumEncoding
defaultTaggedObject = TaggedObject
                      { tagFieldName :: [Char]
tagFieldName      = [Char]
"tag"
                      , contentsFieldName :: [Char]
contentsFieldName = [Char]
"contents"
                      }

-- | Default 'JSONKeyOptions':
--
-- @
-- defaultJSONKeyOptions = 'JSONKeyOptions'
--                         { 'keyModifier' = 'id'
--                         }
-- @
defaultJSONKeyOptions :: JSONKeyOptions
defaultJSONKeyOptions :: JSONKeyOptions
defaultJSONKeyOptions = ShowS -> JSONKeyOptions
JSONKeyOptions ShowS
forall a. a -> a
id

-- | Converts from CamelCase to another lower case, interspersing
--   the character between all capital letters and their previous
--   entries, except those capital letters that appear together,
--   like 'API'.
--
--   For use by Aeson template haskell calls.
--
--   > camelTo '_' 'CamelCaseAPI' == "camel_case_api"
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    -- ^ Previous was a capital letter
              -> String  -- ^ The remaining string
              -> String
    lastWasCap :: Bool -> ShowS
lastWasCap Bool
_    []           = []
    lastWasCap Bool
prev (Char
x : [Char]
xs)     = if Char -> Bool
isUpper Char
x
                                      then if Bool
prev
                                             then Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: Bool -> ShowS
lastWasCap Bool
True [Char]
xs
                                             else Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: Bool -> ShowS
lastWasCap Bool
True [Char]
xs
                                      else Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: Bool -> ShowS
lastWasCap Bool
False [Char]
xs

-- | Better version of 'camelTo'. Example where it works better:
--
--   > camelTo '_' "CamelAPICase" == "camel_apicase"
--   > camelTo2 '_' "CamelAPICase" == "camel_api_case"
camelTo2 :: Char -> String -> String
camelTo2 :: Char -> ShowS
camelTo2 Char
c = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
go2 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
go1
    where go1 :: ShowS
go1 [Char]
"" = [Char]
""
          go1 (Char
x:Char
u:Char
l:[Char]
xs) | Char -> Bool
isUpper Char
u Bool -> Bool -> Bool
&& Char -> Bool
isLower Char
l = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Char
u Char -> ShowS
forall a. a -> [a] -> [a]
: Char
l Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go1 [Char]
xs
          go1 (Char
x:[Char]
xs) = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go1 [Char]
xs
          go2 :: ShowS
go2 [Char]
"" = [Char]
""
          go2 (Char
l:Char
u:[Char]
xs) | Char -> Bool
isLower Char
l Bool -> Bool -> Bool
&& Char -> Bool
isUpper Char
u = Char
l Char -> ShowS
forall a. a -> [a] -> [a]
: Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Char
u Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go2 [Char]
xs
          go2 (Char
x:[Char]
xs) = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go2 [Char]
xs

-------------------------------------------------------------------------------
-- AesonException
-------------------------------------------------------------------------------

-- | Exception thrown by 'throwDecode' and variants.
--
-- @since 2.1.2.0
newtype AesonException = AesonException String
  deriving (Int -> AesonException -> ShowS
[AesonException] -> ShowS
AesonException -> [Char]
(Int -> AesonException -> ShowS)
-> (AesonException -> [Char])
-> ([AesonException] -> ShowS)
-> Show AesonException
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AesonException -> ShowS
showsPrec :: Int -> AesonException -> ShowS
$cshow :: AesonException -> [Char]
show :: AesonException -> [Char]
$cshowList :: [AesonException] -> ShowS
showList :: [AesonException] -> ShowS
Show)

instance Exception AesonException where
    displayException :: AesonException -> [Char]
displayException (AesonException [Char]
str) = [Char]
"aeson: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
str