{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE StandaloneDeriving #-}
#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE TemplateHaskellQuotes #-}
#else
{-# LANGUAGE TemplateHaskell #-}
#endif
module Data.Aeson.Types.Internal
(
Value(..)
, Key
, Array
, emptyArray, isEmptyArray
, Pair
, Object
, emptyObject
, Parser
, Result(..)
, IResult(..)
, JSONPathElement(..)
, JSONPath
, iparse
, parse
, parseEither
, parseMaybe
, parseFail
, modifyFailure
, prependFailure
, parserThrowError
, parserCatchError
, formatError
, formatPath
, formatRelativePath
, (<?>)
, object
, Options(
fieldLabelModifier
, constructorTagModifier
, allNullaryToStringTag
, omitNothingFields
, sumEncoding
, unwrapUnaryRecords
, tagSingleConstructors
, rejectUnknownFields
)
, SumEncoding(..)
, JSONKeyOptions(keyModifier)
, defaultOptions
, defaultTaggedObject
, defaultJSONKeyOptions
, camelTo
, camelTo2
, DotNetTime(..)
) where
import Prelude.Compat
import Control.Applicative (Alternative(..))
import Control.DeepSeq (NFData(..))
import Control.Monad (MonadPlus(..), ap)
import Data.Char (isLower, isUpper, toLower, isAlpha, isAlphaNum)
import Data.Aeson.Key (Key)
import Data.Data (Data)
import Data.Foldable (foldl')
import Data.Hashable (Hashable(..))
import Data.List (intercalate)
import Data.Scientific (Scientific)
import Data.String (IsString(..))
import Data.Text (Text, pack, unpack)
import Data.Time (UTCTime)
import Data.Time.Format (FormatTime)
import Data.Typeable (Typeable)
import Data.Vector (Vector)
import GHC.Generics (Generic)
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
(JSONPathElement -> JSONPathElement -> Bool)
-> (JSONPathElement -> JSONPathElement -> Bool)
-> Eq JSONPathElement
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
(Int -> JSONPathElement -> ShowS)
-> (JSONPathElement -> String)
-> ([JSONPathElement] -> ShowS)
-> Show JSONPathElement
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
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
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
$cp1Ord :: Eq JSONPathElement
Ord)
type JSONPath = [JSONPathElement]
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
/= :: 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
[IResult a] -> ShowS
IResult a -> String
(Int -> IResult a -> ShowS)
-> (IResult a -> String)
-> ([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 -> 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
(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
/= :: 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
[Result a] -> ShowS
Result a -> String
(Int -> Result a -> ShowS)
-> (Result a -> String) -> ([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 -> 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 t :: Key
t) = Key -> ()
forall a. NFData a => a -> ()
rnf Key
t
rnf (Index i :: 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) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
rnf (IError path :: [JSONPathElement]
path err :: String
err) = [JSONPathElement] -> ()
forall a. NFData a => a -> ()
rnf [JSONPathElement]
path () -> () -> ()
forall a b. a -> b -> b
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
err
instance (NFData a) => NFData (Result a) where
rnf :: Result a -> ()
rnf (Success a :: a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
rnf (Error err :: String
err) = String -> ()
forall a. NFData a => a -> ()
rnf String
err
instance Functor IResult where
fmap :: (a -> b) -> IResult a -> IResult b
fmap f :: a -> b
f (ISuccess a :: a
a) = b -> IResult b
forall a. a -> IResult a
ISuccess (a -> b
f a
a)
fmap _ (IError path :: [JSONPathElement]
path err :: String
err) = [JSONPathElement] -> String -> IResult b
forall a. [JSONPathElement] -> String -> IResult a
IError [JSONPathElement]
path String
err
{-# INLINE fmap #-}
instance Functor Result where
fmap :: (a -> b) -> Result a -> Result b
fmap f :: a -> b
f (Success a :: a
a) = b -> Result b
forall a. a -> Result a
Success (a -> b
f a
a)
fmap _ (Error err :: String
err) = String -> Result b
forall a. String -> Result a
Error String
err
{-# INLINE fmap #-}
instance Monad.Monad IResult where
return :: a -> IResult a
return = a -> IResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE return #-}
ISuccess a :: a
a >>= :: IResult a -> (a -> IResult b) -> IResult b
>>= k :: a -> IResult b
k = a -> IResult b
k a
a
IError path :: [JSONPathElement]
path err :: String
err >>= _ = [JSONPathElement] -> String -> 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 :: String -> IResult a
fail err :: String
err = [JSONPathElement] -> String -> IResult a
forall a. [JSONPathElement] -> String -> IResult a
IError [] String
err
{-# INLINE fail #-}
instance Monad.Monad Result where
return :: a -> Result a
return = a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE return #-}
Success a :: a
a >>= :: Result a -> (a -> Result b) -> Result b
>>= k :: a -> Result b
k = a -> Result b
k a
a
Error err :: String
err >>= _ = String -> 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 :: String -> Result a
fail err :: String
err = String -> Result a
forall a. String -> Result a
Error String
err
{-# INLINE fail #-}
instance Applicative IResult where
pure :: a -> IResult a
pure = a -> IResult a
forall a. a -> IResult a
ISuccess
{-# INLINE pure #-}
<*> :: 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 :: a -> Result a
pure = a -> Result a
forall a. a -> Result a
Success
{-# INLINE pure #-}
<*> :: 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 :: IResult a
mzero = String -> IResult a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "mzero"
{-# INLINE mzero #-}
mplus :: IResult a -> IResult a -> IResult a
mplus a :: IResult a
a@(ISuccess _) _ = IResult a
a
mplus _ b :: IResult a
b = IResult a
b
{-# INLINE mplus #-}
instance MonadPlus Result where
mzero :: Result a
mzero = String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "mzero"
{-# INLINE mzero #-}
mplus :: Result a -> Result a -> Result a
mplus a :: Result a
a@(Success _) _ = Result a
a
mplus _ b :: Result a
b = Result a
b
{-# INLINE mplus #-}
instance Alternative IResult where
empty :: IResult a
empty = IResult a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
{-# INLINE empty #-}
<|> :: IResult a -> IResult a -> IResult 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 :: Result a
empty = Result a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
{-# INLINE empty #-}
<|> :: Result a -> Result a -> Result 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 (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
{-# INLINE (<>) #-}
instance Monoid (IResult a) where
mempty :: IResult a
mempty = String -> IResult a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "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 (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
{-# INLINE (<>) #-}
instance Monoid (Result a) where
mempty :: Result a
mempty = String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "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 :: (a -> m) -> IResult a -> m
foldMap _ (IError _ _) = m
forall a. Monoid a => a
mempty
foldMap f :: a -> m
f (ISuccess y :: a
y) = a -> m
f a
y
{-# INLINE foldMap #-}
foldr :: (a -> b -> b) -> b -> IResult a -> b
foldr _ z :: b
z (IError _ _) = b
z
foldr f :: a -> b -> b
f z :: b
z (ISuccess y :: a
y) = a -> b -> b
f a
y b
z
{-# INLINE foldr #-}
instance Foldable Result where
foldMap :: (a -> m) -> Result a -> m
foldMap _ (Error _) = m
forall a. Monoid a => a
mempty
foldMap f :: a -> m
f (Success y :: a
y) = a -> m
f a
y
{-# INLINE foldMap #-}
foldr :: (a -> b -> b) -> b -> Result a -> b
foldr _ z :: b
z (Error _) = b
z
foldr f :: a -> b -> b
f z :: b
z (Success y :: a
y) = a -> b -> b
f a
y b
z
{-# INLINE foldr #-}
instance Traversable IResult where
traverse :: (a -> f b) -> IResult a -> f (IResult b)
traverse _ (IError path :: [JSONPathElement]
path err :: String
err) = IResult b -> f (IResult b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([JSONPathElement] -> String -> IResult b
forall a. [JSONPathElement] -> String -> IResult a
IError [JSONPathElement]
path String
err)
traverse f :: a -> f b
f (ISuccess a :: 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 :: (a -> f b) -> Result a -> f (Result b)
traverse _ (Error err :: String
err) = Result b -> f (Result b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Result b
forall a. String -> Result a
Error String
err)
traverse f :: a -> f b
f (Success a :: 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 #-}
type Failure f r = JSONPath -> String -> f r
type Success a f r = a -> f r
newtype Parser a = Parser {
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
m :: Parser a
m >>= :: Parser a -> (a -> Parser b) -> Parser b
>>= g :: 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
$ \path :: [JSONPathElement]
path kf :: Failure f r
kf ks :: Success b f r
ks -> let ks' :: a -> f r
ks' a :: a
a = Parser b
-> [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 -> [JSONPathElement] -> Failure f r -> (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 :: a -> Parser a
return = 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
instance Fail.MonadFail Parser where
fail :: String -> Parser a
fail msg :: String
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
$ \path :: [JSONPathElement]
path kf :: Failure f r
kf _ks :: Success a f r
_ks -> Failure f r
kf ([JSONPathElement] -> [JSONPathElement]
forall a. [a] -> [a]
reverse [JSONPathElement]
path) String
msg
{-# INLINE fail #-}
instance Functor Parser where
fmap :: (a -> b) -> Parser a -> Parser b
fmap f :: a -> b
f m :: 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
$ \path :: [JSONPathElement]
path kf :: Failure f r
kf ks :: Success b f r
ks -> let ks' :: a -> f r
ks' a :: a
a = Success b f r
ks (a -> b
f a
a)
in Parser a -> [JSONPathElement] -> Failure f r -> (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 :: a -> Parser a
pure a :: 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
$ \_path :: [JSONPathElement]
_path _kf :: Failure f r
_kf ks :: Success a f r
ks -> Success a f r
ks a
a
{-# INLINE pure #-}
<*> :: 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 :: Parser a
empty = String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "empty"
{-# INLINE empty #-}
<|> :: Parser a -> Parser a -> Parser 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 :: Parser a
mzero = String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "mzero"
{-# INLINE mzero #-}
mplus :: Parser a -> Parser a -> Parser a
mplus a :: Parser a
a b :: 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
$ \path :: [JSONPathElement]
path kf :: Failure f r
kf ks :: Success a f r
ks -> let kf' :: p -> p -> f r
kf' _ _ = Parser a
-> [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
-> [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 (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
{-# INLINE (<>) #-}
instance Monoid (Parser a) where
mempty :: Parser a
mempty = String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "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 #-}
parseFail :: String -> Parser a
parseFail :: String -> Parser a
parseFail = String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
apP :: Parser (a -> b) -> Parser a -> Parser b
apP :: Parser (a -> b) -> Parser a -> Parser b
apP d :: Parser (a -> b)
d e :: Parser a
e = do
a -> b
b <- Parser (a -> b)
d
a -> b
b (a -> b) -> Parser a -> Parser 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
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
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]
(Int -> ReadS Value)
-> ReadS [Value]
-> ReadPrec Value
-> ReadPrec [Value]
-> Read 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
DataType
Constr
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 -> DataType
Value -> Constr
(forall b. Data b => b -> b) -> Value -> Value
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cNull :: Constr
$cBool :: Constr
$cNumber :: Constr
$cString :: Constr
$cArray :: Constr
$cObject :: Constr
$tValue :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Value -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Value -> u
gmapQ :: (forall d. Data d => d -> u) -> Value -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Value -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable 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
$cto :: forall x. Rep Value x -> Value
$cfrom :: forall x. Value -> Rep Value x
Generic)
instance Show Value where
showsPrec :: Int -> Value -> ShowS
showsPrec _ Null = String -> ShowS
showString "Null"
showsPrec d :: Int
d (Bool b :: Bool
b) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10)
(ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString "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 11 Bool
b
showsPrec d :: Int
d (Number s :: Scientific
s) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10)
(ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString "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 11 Scientific
s
showsPrec d :: Int
d (String s :: Text
s) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10)
(ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString "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 11 Text
s
showsPrec d :: Int
d (Array xs :: Array
xs) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10)
(ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString "Array " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Array -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 Array
xs
showsPrec d :: Int
d (Object xs :: Object
xs) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10)
(ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString "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 11 (Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toAscList Object
xs)
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar ')'
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 Null = []
go (Bool b :: 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 x :: Text
x) = Value
Null Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: (String -> Value) -> [String] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Value
String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (String -> [String]
forall a. Arbitrary a => a -> [a]
QC.shrink (Text -> String
T.unpack Text
x))
go (Number x :: 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 x :: Array
x) = Value
Null Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
x [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ ([Value] -> Value) -> [[Value]] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Array -> Value
Array (Array -> Value) -> ([Value] -> Array) -> [Value] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Array
forall a. [a] -> Vector a
V.fromList) ((Value -> [Value]) -> [Value] -> [[Value]]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
QC.liftShrink Value -> [Value]
go (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
x))
go (Object x :: Object
x) = Value
Null Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: Object -> [Value]
forall v. KeyMap v -> [v]
KM.elems Object
x [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ ([(Key, Value)] -> Value) -> [[(Key, Value)]] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Object -> Value
Object (Object -> Value)
-> ([(Key, Value)] -> Object) -> [(Key, Value)] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList) (((Key, Value) -> [(Key, Value)])
-> [(Key, Value)] -> [[(Key, Value)]]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
QC.liftShrink ((Value -> [Value]) -> (Key, Value) -> [(Key, Value)]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
QC.liftShrink Value -> [Value]
go) (Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
x))
instance QC.CoArbitrary Value where
coarbitrary :: Value -> Gen b -> Gen b
coarbitrary Null = Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (0 :: Int)
coarbitrary (Bool b :: Bool
b) = Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (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 a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary Bool
b
coarbitrary (String x :: Text
x) = Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (2 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Text -> String
T.unpack Text
x)
coarbitrary (Number x :: Scientific
x) = Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (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 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 a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Scientific -> Int
Sci.base10Exponent Scientific
x)
coarbitrary (Array x :: Array
x) = Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (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 a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
x)
coarbitrary (Object x :: Object
x) = Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (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 a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
x)
instance QC.Function Value where
function :: (Value -> b) -> Value :-> b
function = (Value -> RepValue)
-> (RepValue -> Value) -> (Value -> b) -> Value :-> b
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 Null = Maybe Bool -> RepValue
forall a b. a -> Either a b
Left Maybe Bool
forall a. Maybe a
Nothing
fwd (Bool b :: Bool
b) = Maybe Bool -> RepValue
forall a b. a -> Either a b
Left (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b)
fwd (String x :: Text
x) = Either
(Either String (Integer, Int)) (Either [Value] [(Key, Value)])
-> RepValue
forall a b. b -> Either a b
Right (Either String (Integer, Int)
-> Either
(Either String (Integer, Int)) (Either [Value] [(Key, Value)])
forall a b. a -> Either a b
Left (String -> Either String (Integer, Int)
forall a b. a -> Either a b
Left (Text -> String
T.unpack Text
x)))
fwd (Number x :: Scientific
x) = Either
(Either String (Integer, Int)) (Either [Value] [(Key, Value)])
-> RepValue
forall a b. b -> Either a b
Right (Either String (Integer, Int)
-> Either
(Either String (Integer, Int)) (Either [Value] [(Key, Value)])
forall a b. a -> Either a b
Left ((Integer, Int) -> Either String (Integer, Int)
forall a b. b -> Either a b
Right (Scientific -> Integer
Sci.coefficient Scientific
x, Scientific -> Int
Sci.base10Exponent Scientific
x)))
fwd (Array x :: Array
x) = Either
(Either String (Integer, Int)) (Either [Value] [(Key, Value)])
-> RepValue
forall a b. b -> Either a b
Right (Either [Value] [(Key, Value)]
-> Either
(Either String (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 (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
x)))
fwd (Object x :: Object
x) = Either
(Either String (Integer, Int)) (Either [Value] [(Key, Value)])
-> RepValue
forall a b. b -> Either a b
Right (Either [Value] [(Key, Value)]
-> Either
(Either String (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 (Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
x)))
bwd :: RepValue -> Value
bwd :: RepValue -> Value
bwd (Left Nothing) = Value
Null
bwd (Left (Just b :: Bool
b)) = Bool -> Value
Bool Bool
b
bwd (Right (Left (Left x :: String
x))) = Text -> Value
String (String -> Text
T.pack String
x)
bwd (Right (Left (Right (x :: Integer
x, y :: Int
y)))) = Scientific -> Value
Number (Integer -> Int -> Scientific
Sci.scientific Integer
x Int
y)
bwd (Right (Right (Left x :: [Value]
x))) = Array -> Value
Array ([Value] -> Array
forall a. [a] -> Vector a
V.fromList [Value]
x)
bwd (Right (Right (Right x :: [(Key, Value)]
x))) = Object -> Value
Object ([(Key, 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 n :: Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = [Gen Value] -> Gen Value
forall a. [Gen a] -> Gen a
QC.oneof
[ Value -> Gen Value
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
]
| Bool
otherwise = [Gen Value] -> Gen Value
forall a. [Gen a] -> Gen a
QC.oneof
[ Object -> Value
Object (Object -> Value) -> Gen Object -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Object
arbObject Int
n
, Array -> Value
Array (Array -> Value) -> Gen Array -> Gen Value
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 (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
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 (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 s :: 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 Object
arbObject n :: Int
n = do
[Int]
p <- Int -> Gen [Int]
arbPartition (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
[(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList ([(Key, Value)] -> Object) -> Gen [(Key, Value)] -> Gen Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Gen (Key, Value)) -> [Int] -> Gen [(Key, Value)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\m :: 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 (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 n :: Int
n = do
[Int]
p <- Int -> Gen [Int]
arbPartition (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
[Value] -> Array
forall a. [a] -> Vector a
V.fromList ([Value] -> Array) -> Gen [Value] -> Gen Array
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Gen Value) -> [Int] -> Gen [Value]
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 k :: Int
k = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
k 1 of
LT -> [Int] -> Gen [Int]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
EQ -> [Int] -> Gen [Int]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [1]
GT -> do
Int
first <- (Int, Int) -> Gen Int
QC.chooseInt (1, Int
k)
[Int]
rest <- Int -> Gen [Int]
arbPartition (Int -> Gen [Int]) -> Int -> Gen [Int]
forall a b. (a -> b) -> a -> b
$ Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
first
[Int] -> Gen [Int]
forall a. [a] -> Gen [a]
QC.shuffle (Int
first Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
rest)
deriving instance Ord Value
newtype DotNetTime = DotNetTime {
DotNetTime -> UTCTime
fromDotNetTime :: UTCTime
} deriving (DotNetTime -> DotNetTime -> Bool
(DotNetTime -> DotNetTime -> Bool)
-> (DotNetTime -> DotNetTime -> Bool) -> Eq DotNetTime
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
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
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
$cp1Ord :: Eq 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
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
(Int -> DotNetTime -> ShowS)
-> (DotNetTime -> String)
-> ([DotNetTime] -> ShowS)
-> Show DotNetTime
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)
(Bool -> Char -> Maybe (FormatOptions -> DotNetTime -> String))
-> FormatTime DotNetTime
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 o :: Object
o) = Object -> ()
forall a. NFData a => a -> ()
rnf Object
o
rnf (Array a :: Array
a) = (() -> Value -> ()) -> () -> Array -> ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\x :: ()
x y :: Value
y -> Value -> ()
forall a. NFData a => a -> ()
rnf Value
y () -> () -> ()
forall a b. a -> b -> b
`seq` ()
x) () Array
a
rnf (String s :: Text
s) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
s
rnf (Number n :: Scientific
n) = Scientific -> ()
forall a. NFData a => a -> ()
rnf Scientific
n
rnf (Bool b :: Bool
b) = Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
b
rnf Null = ()
instance IsString Value where
fromString :: String -> Value
fromString = Text -> Value
String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack
{-# INLINE fromString #-}
hashValue :: Int -> Value -> Int
hashValue :: Int -> Value -> Int
hashValue s :: Int
s (Object o :: Object
o) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (0::Int) Int -> Object -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Object
o
hashValue s :: Int
s (Array a :: Array
a) = (Int -> Value -> Int) -> Int -> Array -> Int
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` (1::Int)) Array
a
hashValue s :: Int
s (String str :: Text
str) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (2::Int) Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
str
hashValue s :: Int
s (Number n :: Scientific
n) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (3::Int) Int -> Scientific -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Scientific
n
hashValue s :: Int
s (Bool b :: Bool
b) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (4::Int) Int -> Bool -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Bool
b
hashValue s :: Int
s Null = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (5::Int)
instance Hashable Value where
hashWithSalt :: Int -> Value -> Int
hashWithSalt = Int -> Value -> Int
hashValue
instance TH.Lift Value where
lift :: Value -> Q Exp
lift Null = [| Null |]
lift (Bool b :: Bool
b) = [| Bool b |]
lift (Number n :: Scientific
n) = [| Number n |]
lift (String t :: Text
t) = [| String (pack s) |]
where s :: String
s = Text -> String
unpack Text
t
lift (Array a :: Array
a) = [| Array (V.fromList a') |]
where a' :: [Value]
a' = Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
a
lift (Object o :: Object
o) = [| Object o |]
#if MIN_VERSION_template_haskell(2,17,0)
liftTyped = TH.unsafeCodeCoerce . TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
liftTyped = TH.unsafeTExpCoerce . TH.lift
#endif
emptyArray :: Value
emptyArray :: Value
emptyArray = Array -> Value
Array Array
forall a. Vector a
V.empty
isEmptyArray :: Value -> Bool
isEmptyArray :: Value -> Bool
isEmptyArray (Array arr :: Array
arr) = Array -> Bool
forall a. Vector a -> Bool
V.null Array
arr
isEmptyArray _ = Bool
False
emptyObject :: Value
emptyObject :: Value
emptyObject = Object -> Value
Object Object
forall v. KeyMap v
KM.empty
parse :: (a -> Parser b) -> a -> Result b
parse :: (a -> Parser b) -> a -> Result b
parse m :: a -> Parser b
m v :: a
v = Parser b
-> [JSONPathElement]
-> Failure Result b
-> Success b Result b
-> Result b
forall a.
Parser a
-> forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser (a -> Parser b
m a
v) [] ((String -> Result b) -> Failure Result b
forall a b. a -> b -> a
const String -> Result b
forall a. String -> Result a
Error) Success b Result b
forall a. a -> Result a
Success
{-# INLINE parse #-}
iparse :: (a -> Parser b) -> a -> IResult b
iparse :: (a -> Parser b) -> a -> IResult b
iparse m :: a -> Parser b
m v :: a
v = Parser b
-> [JSONPathElement]
-> Failure IResult b
-> Success b IResult b
-> IResult b
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] -> String -> IResult a
IError Success b IResult b
forall a. a -> IResult a
ISuccess
{-# INLINE iparse #-}
parseMaybe :: (a -> Parser b) -> a -> Maybe b
parseMaybe :: (a -> Parser b) -> a -> Maybe b
parseMaybe m :: a -> Parser b
m v :: a
v = Parser b
-> [JSONPathElement]
-> Failure Maybe b
-> Success b Maybe b
-> Maybe b
forall a.
Parser a
-> forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser (a -> Parser b
m a
v) [] (\_ _ -> Maybe b
forall a. Maybe a
Nothing) Success b Maybe b
forall a. a -> Maybe a
Just
{-# INLINE parseMaybe #-}
parseEither :: (a -> Parser b) -> a -> Either String b
parseEither :: (a -> Parser b) -> a -> Either String b
parseEither m :: a -> Parser b
m v :: a
v = Parser b
-> [JSONPathElement]
-> Failure (Either String) b
-> Success b (Either String) b
-> Either String b
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 String) b
forall b. [JSONPathElement] -> String -> Either String b
onError Success b (Either String) b
forall a b. b -> Either a b
Right
where onError :: [JSONPathElement] -> String -> Either String b
onError path :: [JSONPathElement]
path msg :: String
msg = String -> Either String b
forall a b. a -> Either a b
Left ([JSONPathElement] -> ShowS
formatError [JSONPathElement]
path String
msg)
{-# INLINE parseEither #-}
formatError :: JSONPath -> String -> String
formatError :: [JSONPathElement] -> ShowS
formatError path :: [JSONPathElement]
path msg :: String
msg = "Error in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [JSONPathElement] -> String
formatPath [JSONPathElement]
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
formatPath :: JSONPath -> String
formatPath :: [JSONPathElement] -> String
formatPath path :: [JSONPathElement]
path = "$" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [JSONPathElement] -> String
formatRelativePath [JSONPathElement]
path
formatRelativePath :: JSONPath -> String
formatRelativePath :: [JSONPathElement] -> String
formatRelativePath path :: [JSONPathElement]
path = String -> [JSONPathElement] -> String
format "" [JSONPathElement]
path
where
format :: String -> JSONPath -> String
format :: String -> [JSONPathElement] -> String
format pfx :: String
pfx [] = String
pfx
format pfx :: String
pfx (Index idx :: Int
idx:parts :: [JSONPathElement]
parts) = String -> [JSONPathElement] -> String
format (String
pfx String -> ShowS
forall a. [a] -> [a] -> [a]
++ "[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
idx String -> ShowS
forall a. [a] -> [a] -> [a]
++ "]") [JSONPathElement]
parts
format pfx :: String
pfx (Key key :: Key
key:parts :: [JSONPathElement]
parts) = String -> [JSONPathElement] -> String
format (String
pfx String -> ShowS
forall a. [a] -> [a] -> [a]
++ Key -> String
formatKey Key
key) [JSONPathElement]
parts
formatKey :: Key -> String
formatKey :: Key -> String
formatKey key :: Key
key
| String -> Bool
isIdentifierKey String
strKey = "." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strKey
| Bool
otherwise = "['" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeKey String
strKey String -> ShowS
forall a. [a] -> [a] -> [a]
++ "']"
where strKey :: String
strKey = Key -> String
Key.toString Key
key
isIdentifierKey :: String -> Bool
isIdentifierKey :: String -> Bool
isIdentifierKey [] = Bool
False
isIdentifierKey (x :: Char
x:xs :: String
xs) = Char -> Bool
isAlpha Char
x Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAlphaNum String
xs
escapeKey :: String -> String
escapeKey :: ShowS
escapeKey = (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escapeChar
escapeChar :: Char -> String
escapeChar :: Char -> String
escapeChar '\'' = "\\'"
escapeChar '\\' = "\\\\"
escapeChar c :: Char
c = [Char
c]
type Pair = (Key, Value)
object :: [Pair] -> Value
object :: [(Key, Value)] -> Value
object = Object -> Value
Object (Object -> Value)
-> ([(Key, Value)] -> Object) -> [(Key, Value)] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList
{-# INLINE object #-}
(<?>) :: Parser a -> JSONPathElement -> Parser a
p :: Parser a
p <?> :: Parser a -> JSONPathElement -> Parser a
<?> pathElem :: 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
$ \path :: [JSONPathElement]
path kf :: Failure f r
kf ks :: Success a f r
ks -> Parser a
-> [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
modifyFailure :: (String -> String) -> Parser a -> Parser a
modifyFailure :: ShowS -> Parser a -> Parser a
modifyFailure f :: ShowS
f (Parser p :: 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
$ \path :: [JSONPathElement]
path kf :: Failure f r
kf ks :: 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 (\p' :: [JSONPathElement]
p' m :: String
m -> Failure f r
kf [JSONPathElement]
p' (ShowS
f String
m)) Success a f r
ks
prependFailure :: String -> Parser a -> Parser a
prependFailure :: String -> Parser a -> Parser a
prependFailure = ShowS -> Parser a -> Parser a
forall a. ShowS -> Parser a -> Parser a
modifyFailure (ShowS -> Parser a -> Parser a)
-> (String -> ShowS) -> String -> Parser a -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. [a] -> [a] -> [a]
(++)
parserThrowError :: JSONPath -> String -> Parser a
parserThrowError :: [JSONPathElement] -> String -> Parser a
parserThrowError path' :: [JSONPathElement]
path' msg :: String
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
$ \path :: [JSONPathElement]
path kf :: Failure f r
kf _ks :: 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') String
msg
parserCatchError :: Parser a -> (JSONPath -> String -> Parser a) -> Parser a
parserCatchError :: Parser a -> ([JSONPathElement] -> String -> Parser a) -> Parser a
parserCatchError (Parser p :: forall (f :: * -> *) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
p) handler :: [JSONPathElement] -> String -> 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
$ \path :: [JSONPathElement]
path kf :: Failure f r
kf ks :: 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 (\e :: [JSONPathElement]
e msg :: String
msg -> Parser a
-> [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] -> 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 -> SumEncoding
sumEncoding :: SumEncoding
, Options -> Bool
unwrapUnaryRecords :: Bool
, Options -> Bool
tagSingleConstructors :: Bool
, Options -> Bool
rejectUnknownFields :: Bool
}
instance Show Options where
show :: Options -> String
show (Options f :: ShowS
f c :: ShowS
c a :: Bool
a o :: Bool
o s :: SumEncoding
s u :: Bool
u t :: Bool
t r :: Bool
r) =
"Options {"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", "
[ "fieldLabelModifier =~ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (ShowS
f "exampleField")
, "constructorTagModifier =~ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (ShowS
c "ExampleConstructor")
, "allNullaryToStringTag = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
a
, "omitNothingFields = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
o
, "sumEncoding = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SumEncoding -> String
forall a. Show a => a -> String
show SumEncoding
s
, "unwrapUnaryRecords = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
u
, "tagSingleConstructors = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
t
, "rejectUnknownFields = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
r
]
String -> ShowS
forall a. [a] -> [a] -> [a]
++ "}"
data SumEncoding =
TaggedObject { SumEncoding -> String
tagFieldName :: String
, SumEncoding -> String
contentsFieldName :: String
}
| UntaggedValue
| ObjectWithSingleField
| TwoElemArray
deriving (SumEncoding -> SumEncoding -> Bool
(SumEncoding -> SumEncoding -> Bool)
-> (SumEncoding -> SumEncoding -> Bool) -> Eq SumEncoding
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
(Int -> SumEncoding -> ShowS)
-> (SumEncoding -> String)
-> ([SumEncoding] -> ShowS)
-> Show SumEncoding
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 :: ShowS
-> ShowS
-> Bool
-> Bool
-> SumEncoding
-> Bool
-> Bool
-> Bool
-> Options
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
, 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 :: String -> String -> SumEncoding
TaggedObject
{ tagFieldName :: String
tagFieldName = "tag"
, contentsFieldName :: String
contentsFieldName = "contents"
}
defaultJSONKeyOptions :: JSONKeyOptions
defaultJSONKeyOptions :: JSONKeyOptions
defaultJSONKeyOptions = ShowS -> JSONKeyOptions
JSONKeyOptions ShowS
forall a. a -> a
id
camelTo :: Char -> String -> String
{-# DEPRECATED camelTo "Use camelTo2 for better results" #-}
camelTo :: Char -> ShowS
camelTo c :: Char
c = Bool -> ShowS
lastWasCap Bool
True
where
lastWasCap :: Bool
-> String
-> String
lastWasCap :: Bool -> ShowS
lastWasCap _ [] = []
lastWasCap prev :: Bool
prev (x :: Char
x : xs :: String
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 String
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 String
xs
else Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: Bool -> ShowS
lastWasCap Bool
False String
xs
camelTo2 :: Char -> String -> String
camelTo2 :: Char -> ShowS
camelTo2 c :: 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 "" = ""
go1 (x :: Char
x:u :: Char
u:l :: Char
l:xs :: String
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 String
xs
go1 (x :: Char
x:xs :: String
xs) = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go1 String
xs
go2 :: ShowS
go2 "" = ""
go2 (l :: Char
l:u :: Char
u:xs :: String
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 String
xs
go2 (x :: Char
x:xs :: String
xs) = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go2 String
xs