{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Data.Aeson.Types.FromJSON
(
FromJSON(..)
, FromJSON1(..)
, parseJSON1
, omittedField1
, FromJSON2(..)
, parseJSON2
, omittedField2
, GFromJSON(..)
, FromArgs(..)
, genericParseJSON
, genericLiftParseJSON
, FromJSONKey(..)
, FromJSONKeyFunction(..)
, fromJSONKeyCoerce
, coerceFromJSONKeyFunction
, mapFromJSONKeyFunction
, GFromJSONKey()
, genericFromJSONKey
, listParser
, withObject
, withText
, withArray
, withScientific
, withBool
, withEmbeddedJSON
, fromJSON
, ifromJSON
, typeMismatch
, unexpected
, parseField
, parseFieldMaybe
, parseFieldMaybe'
, parseFieldOmit
, parseFieldOmit'
, explicitParseField
, explicitParseFieldMaybe
, explicitParseFieldMaybe'
, explicitParseFieldOmit
, explicitParseFieldOmit'
, parseIndexedJSON
, (.:)
, (.:?)
, (.:!)
, (.!=)
, (.:?=)
, (.:!=)
, parseOptionalFieldWith
) where
import Data.Aeson.Internal.Prelude
import Control.Monad (zipWithM, guard)
import Data.Aeson.Internal.Functions (mapKey, mapKeyO)
import Data.Aeson.Internal.Scientific
import Data.Aeson.Types.Generic
import Data.Aeson.Types.Internal
import Data.Aeson.Decoding.ByteString.Lazy
import Data.Aeson.Decoding.Conversion (unResult, toResultValue, lbsSpace)
import Data.Bits (unsafeShiftR)
import Data.Fixed (Fixed, HasResolution (resolution), Nano)
import Data.Functor.Compose (Compose(..))
import Data.Functor.Identity (Identity(..))
import Data.Functor.Product (Product(..))
import Data.Functor.Sum (Sum(..))
import Data.Functor.These (These1 (..))
import Data.Hashable (Hashable(..))
import Data.List.NonEmpty (NonEmpty(..))
import Data.Ord (Down (..))
import Data.Ratio ((%), Ratio)
import Data.Scientific (base10Exponent)
import Data.Tagged (Tagged(..))
import Data.Text (pack, unpack)
import Data.These (These (..))
import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, ZonedTime)
import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))
import Data.Time.Calendar.Month.Compat (Month)
import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..))
import Data.Time.LocalTime.Compat (CalendarDiffTime (..))
import Data.Time.Clock.System.Compat (SystemTime (..))
import Data.Time.Format.Compat (parseTimeM, defaultTimeLocale)
import Data.Traversable as Tr (sequence)
import Data.Tuple.Solo (Solo (..))
import Data.Type.Coercion (Coercion (..))
import Data.Version (Version, parseVersion)
import Foreign.Storable (Storable)
import Foreign.C.Types (CTime (..))
import GHC.Generics
import Text.ParserCombinators.ReadP (readP_to_S)
import Unsafe.Coerce (unsafeCoerce)
import qualified Data.Aeson.Parser.Time as Time
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString.Lazy as L
import qualified Data.DList as DList
import qualified Data.DList.DNonEmpty as DNE
import qualified Data.Fix as F
import qualified Data.HashMap.Strict as H
import qualified Data.HashSet as HashSet
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Map as M
import qualified Data.Monoid as Monoid
import qualified Data.Scientific as Scientific
import qualified Data.Semigroup as Semigroup
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import qualified Data.Strict as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Short as ST
import qualified Data.Tree as Tree
import qualified Data.UUID.Types as UUID
import qualified Data.Vector as V
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Unboxed as VU
import qualified Network.URI as URI
import qualified GHC.Exts as Exts
import qualified Data.Primitive.Array as PM
import qualified Data.Primitive.SmallArray as PM
import qualified Data.Primitive.Types as PM
import qualified Data.Primitive.PrimArray as PM
#if __GLASGOW_HASKELL__ < 804
import qualified Data.Type.Coercion
#endif
parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a
parseIndexedJSON :: forall a. (Value -> Parser a) -> Int -> Value -> Parser a
parseIndexedJSON Value -> Parser a
p Int
idx Value
value = Value -> Parser a
p Value
value Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Int -> JSONPathElement
Index Int
idx
parseIndexedJSONPair :: (Value -> Parser a) -> (Value -> Parser b) -> Int -> Value -> Parser (a, b)
parseIndexedJSONPair :: forall a b.
(Value -> Parser a)
-> (Value -> Parser b) -> Int -> Value -> Parser (a, b)
parseIndexedJSONPair Value -> Parser a
keyParser Value -> Parser b
valParser Int
idx Value
value = Value -> Parser (a, b)
p Value
value Parser (a, b) -> JSONPathElement -> Parser (a, b)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Int -> JSONPathElement
Index Int
idx
where
p :: Value -> Parser (a, b)
p = String -> (Array -> Parser (a, b)) -> Value -> Parser (a, b)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"(k, v)" ((Array -> Parser (a, b)) -> Value -> Parser (a, b))
-> (Array -> Parser (a, b)) -> Value -> Parser (a, b)
forall a b. (a -> b) -> a -> b
$ \Array
ab ->
let n :: Int
n = Array -> Int
forall a. Vector a -> Int
V.length Array
ab
in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
then (,) (a -> b -> (a, b)) -> Parser a -> Parser (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser a) -> Int -> Array -> Parser a
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser a
keyParser Int
0 Array
ab
Parser (b -> (a, b)) -> Parser b -> Parser (a, b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser b) -> Int -> Array -> Parser b
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser b
valParser Int
1 Array
ab
else String -> Parser (a, b)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a, b)) -> String -> Parser (a, b)
forall a b. (a -> b) -> a -> b
$ String
"cannot unpack array of length " String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" into a pair"
parseJSONElemAtIndex :: (Value -> Parser a) -> Int -> V.Vector Value -> Parser a
parseJSONElemAtIndex :: forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser a
p Int
idx Array
ary = Value -> Parser a
p (Array -> Int -> Value
forall a. Vector a -> Int -> a
V.unsafeIndex Array
ary Int
idx) Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Int -> JSONPathElement
Index Int
idx
parseRealFloat :: RealFloat a => String -> Value -> Parser a
parseRealFloat :: forall a. RealFloat a => String -> Value -> Parser a
parseRealFloat String
_ (Number Scientific
s) = a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Parser a) -> a -> Parser a
forall a b. (a -> b) -> a -> b
$ Scientific -> a
forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat Scientific
s
parseRealFloat String
_ Value
Null = a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
0a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0)
parseRealFloat String
_ (String Text
"-inf") = a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> a
forall a. Num a => a -> a
negate a
1a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0)
parseRealFloat String
_ (String Text
"+inf") = a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
1a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0)
parseRealFloat String
name Value
v = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependContext String
name (Value -> Parser a
forall a. Value -> Parser a
unexpected Value
v)
parseIntegralFromScientific :: forall a. Integral a => Scientific -> Parser a
parseIntegralFromScientific :: forall a. Integral a => Scientific -> Parser a
parseIntegralFromScientific Scientific
s =
case Scientific -> Either Double a
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Scientific.floatingOrInteger Scientific
s :: Either Double a of
Right a
x -> a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
Left Double
_ -> String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"unexpected floating number " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show Scientific
s
parseIntegral :: Integral a => String -> Value -> Parser a
parseIntegral :: forall a. Integral a => String -> Value -> Parser a
parseIntegral String
name =
String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependContext String
name (Parser a -> Parser a) -> (Value -> Parser a) -> Value -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scientific -> Parser a) -> Value -> Parser a
forall a. (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific' Scientific -> Parser a
forall a. Integral a => Scientific -> Parser a
parseIntegralFromScientific
parseBoundedIntegralFromScientific :: (Bounded a, Integral a) => Scientific -> Parser a
parseBoundedIntegralFromScientific :: forall a. (Bounded a, Integral a) => Scientific -> Parser a
parseBoundedIntegralFromScientific Scientific
s = Parser a -> (a -> Parser a) -> Maybe a -> Parser a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"value is either floating or will cause over or underflow " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show Scientific
s)
a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Scientific -> Maybe a
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Scientific.toBoundedInteger Scientific
s)
parseBoundedIntegral :: (Bounded a, Integral a) => String -> Value -> Parser a
parseBoundedIntegral :: forall a. (Bounded a, Integral a) => String -> Value -> Parser a
parseBoundedIntegral String
name =
String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependContext String
name (Parser a -> Parser a) -> (Value -> Parser a) -> Value -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scientific -> Parser a) -> Value -> Parser a
forall a. (Scientific -> Parser a) -> Value -> Parser a
withScientific' Scientific -> Parser a
forall a. (Bounded a, Integral a) => Scientific -> Parser a
parseBoundedIntegralFromScientific
parseScientificText :: Text -> Parser Scientific
parseScientificText :: Text -> Parser Scientific
parseScientificText = (Scientific -> Text -> Parser Scientific)
-> (String -> Parser Scientific) -> Text -> Parser Scientific
forall r. (Scientific -> Text -> r) -> (String -> r) -> Text -> r
scanScientific
(\Scientific
sci Text
rest -> if Text -> Bool
T.null Text
rest then Scientific -> Parser Scientific
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Scientific
sci else String -> Parser Scientific
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Scientific) -> String -> Parser Scientific
forall a b. (a -> b) -> a -> b
$ String
"Expecting end-of-input, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show (Int -> Text -> Text
T.take Int
10 Text
rest))
String -> Parser Scientific
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
parseIntegralText :: Integral a => String -> Text -> Parser a
parseIntegralText :: forall a. Integral a => String -> Text -> Parser a
parseIntegralText String
name Text
t =
String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependContext String
name (Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$
Text -> Parser Scientific
parseScientificText Text
t
Parser Scientific
-> (Scientific -> Parser Scientific) -> Parser Scientific
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Scientific -> Parser Scientific
rejectLargeExponent
Parser Scientific -> (Scientific -> Parser a) -> Parser a
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Scientific -> Parser a
forall a. Integral a => Scientific -> Parser a
parseIntegralFromScientific
where
rejectLargeExponent :: Scientific -> Parser Scientific
rejectLargeExponent :: Scientific -> Parser Scientific
rejectLargeExponent Scientific
s = (Scientific -> Parser Scientific) -> Value -> Parser Scientific
forall a. (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific' Scientific -> Parser Scientific
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> Value
Number Scientific
s)
parseBoundedIntegralText :: (Bounded a, Integral a) => String -> Text -> Parser a
parseBoundedIntegralText :: forall a. (Bounded a, Integral a) => String -> Text -> Parser a
parseBoundedIntegralText String
name Text
t =
String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependContext String
name (Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$
Text -> Parser Scientific
parseScientificText Text
t Parser Scientific -> (Scientific -> Parser a) -> Parser a
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Scientific -> Parser a
forall a. (Bounded a, Integral a) => Scientific -> Parser a
parseBoundedIntegralFromScientific
parseOptionalFieldWith :: (Value -> Parser (Maybe a))
-> Object -> Key -> Parser (Maybe a)
parseOptionalFieldWith :: forall a.
(Value -> Parser (Maybe a)) -> Object -> Key -> Parser (Maybe a)
parseOptionalFieldWith Value -> Parser (Maybe a)
pj Object
obj Key
key =
case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
key Object
obj of
Maybe Value
Nothing -> Maybe a -> Parser (Maybe a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
Just Value
v -> Value -> Parser (Maybe a)
pj Value
v Parser (Maybe a) -> JSONPathElement -> Parser (Maybe a)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
key
class GFromJSON arity f where
gParseJSON :: Options -> FromArgs arity a -> Value -> Parser (f a)
data FromArgs arity a where
NoFromArgs :: FromArgs Zero a
From1Args :: Maybe a -> (Value -> Parser a) -> (Value -> Parser [a]) -> FromArgs One a
genericParseJSON :: (Generic a, GFromJSON Zero (Rep a))
=> Options -> Value -> Parser a
genericParseJSON :: forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
opts = (Rep a Any -> a) -> Parser (Rep a Any) -> Parser a
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Parser (Rep a Any) -> Parser a)
-> (Value -> Parser (Rep a Any)) -> Value -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> FromArgs Zero Any -> Value -> Parser (Rep a Any)
forall a. Options -> FromArgs Zero a -> Value -> Parser (Rep a a)
forall arity (f :: * -> *) a.
GFromJSON arity f =>
Options -> FromArgs arity a -> Value -> Parser (f a)
gParseJSON Options
opts FromArgs Zero Any
forall a. FromArgs Zero a
NoFromArgs
genericLiftParseJSON :: (Generic1 f, GFromJSON One (Rep1 f))
=> Options -> Maybe a -> (Value -> Parser a) -> (Value -> Parser [a])
-> Value -> Parser (f a)
genericLiftParseJSON :: forall (f :: * -> *) a.
(Generic1 f, GFromJSON One (Rep1 f)) =>
Options
-> Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
genericLiftParseJSON Options
opts Maybe a
o Value -> Parser a
pj Value -> Parser [a]
pjl = (Rep1 f a -> f a) -> Parser (Rep1 f a) -> Parser (f a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep1 f a -> f a
forall a. Rep1 f a -> f a
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 (Parser (Rep1 f a) -> Parser (f a))
-> (Value -> Parser (Rep1 f a)) -> Value -> Parser (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> FromArgs One a -> Value -> Parser (Rep1 f a)
forall a. Options -> FromArgs One a -> Value -> Parser (Rep1 f a)
forall arity (f :: * -> *) a.
GFromJSON arity f =>
Options -> FromArgs arity a -> Value -> Parser (f a)
gParseJSON Options
opts (Maybe a
-> (Value -> Parser a) -> (Value -> Parser [a]) -> FromArgs One a
forall a.
Maybe a
-> (Value -> Parser a) -> (Value -> Parser [a]) -> FromArgs One a
From1Args Maybe a
o Value -> Parser a
pj Value -> Parser [a]
pjl)
class FromJSON a where
parseJSON :: Value -> Parser a
default parseJSON :: (Generic a, GFromJSON Zero (Rep a)) => Value -> Parser a
parseJSON = Options -> Value -> Parser a
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions
parseJSONList :: Value -> Parser [a]
parseJSONList = String -> (Array -> Parser [a]) -> Value -> Parser [a]
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"[]" ((Array -> Parser [a]) -> Value -> Parser [a])
-> (Array -> Parser [a]) -> Value -> Parser [a]
forall a b. (a -> b) -> a -> b
$ \Array
a ->
(Int -> Value -> Parser a) -> [Int] -> [Value] -> Parser [a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM ((Value -> Parser a) -> Int -> Value -> Parser a
forall a. (Value -> Parser a) -> Int -> Value -> Parser a
parseIndexedJSON Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON) [Int
0..]
([Value] -> Parser [a])
-> (Array -> [Value]) -> Array -> Parser [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall a. Vector a -> [a]
V.toList
(Array -> Parser [a]) -> Array -> Parser [a]
forall a b. (a -> b) -> a -> b
$ Array
a
omittedField :: Maybe a
omittedField = Maybe a
forall a. Maybe a
Nothing
instance (Generic a, GFromJSON Zero (Rep a)) => FromJSON (Generically a) where
parseJSON :: Value -> Parser (Generically a)
parseJSON = (Value -> Parser a) -> Value -> Parser (Generically a)
forall a b. Coercible a b => a -> b
coerce (Options -> Value -> Parser a
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions :: Value -> Parser a)
class FromJSONKey a where
fromJSONKey :: FromJSONKeyFunction a
default fromJSONKey :: FromJSON a => FromJSONKeyFunction a
fromJSONKey = (Value -> Parser a) -> FromJSONKeyFunction a
forall a. (Value -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyValue Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON
fromJSONKeyList :: FromJSONKeyFunction [a]
default fromJSONKeyList :: FromJSON a => FromJSONKeyFunction [a]
fromJSONKeyList = (Value -> Parser [a]) -> FromJSONKeyFunction [a]
forall a. (Value -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyValue Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
parseJSON
data FromJSONKeyFunction a where
FromJSONKeyCoerce :: Coercible Text a => FromJSONKeyFunction a
FromJSONKeyText :: !(Text -> a) -> FromJSONKeyFunction a
FromJSONKeyTextParser :: !(Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyValue :: !(Value -> Parser a) -> FromJSONKeyFunction a
instance Functor FromJSONKeyFunction where
fmap :: forall a b.
(a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
fmap a -> b
h FromJSONKeyFunction a
FromJSONKeyCoerce = (Text -> b) -> FromJSONKeyFunction b
forall a. (Text -> a) -> FromJSONKeyFunction a
FromJSONKeyText (a -> b
h (a -> b) -> (Text -> a) -> Text -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> a
forall a b. Coercible a b => a -> b
coerce)
fmap a -> b
h (FromJSONKeyText Text -> a
f) = (Text -> b) -> FromJSONKeyFunction b
forall a. (Text -> a) -> FromJSONKeyFunction a
FromJSONKeyText (a -> b
h (a -> b) -> (Text -> a) -> Text -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> a
f)
fmap a -> b
h (FromJSONKeyTextParser Text -> Parser a
f) = (Text -> Parser b) -> FromJSONKeyFunction b
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((a -> b) -> Parser a -> Parser b
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
h (Parser a -> Parser b) -> (Text -> Parser a) -> Text -> Parser b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Parser a
f)
fmap a -> b
h (FromJSONKeyValue Value -> Parser a
f) = (Value -> Parser b) -> FromJSONKeyFunction b
forall a. (Value -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyValue ((a -> b) -> Parser a -> Parser b
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
h (Parser a -> Parser b) -> (Value -> Parser a) -> Value -> Parser b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
f)
fromJSONKeyCoerce ::
Coercible Text a =>
FromJSONKeyFunction a
fromJSONKeyCoerce :: forall a. Coercible Text a => FromJSONKeyFunction a
fromJSONKeyCoerce = FromJSONKeyFunction a
forall a. Coercible Text a => FromJSONKeyFunction a
FromJSONKeyCoerce
coerceFromJSONKeyFunction ::
Coercible a b =>
FromJSONKeyFunction a -> FromJSONKeyFunction b
coerceFromJSONKeyFunction :: forall a b.
Coercible a b =>
FromJSONKeyFunction a -> FromJSONKeyFunction b
coerceFromJSONKeyFunction = FromJSONKeyFunction a -> FromJSONKeyFunction b
forall a b. Coercible a b => a -> b
coerce
{-# RULES
"FromJSONKeyCoerce: fmap coerce" forall x .
fmap coerce x = coerceFromJSONKeyFunction x
#-}
mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
mapFromJSONKeyFunction :: forall a b.
(a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
mapFromJSONKeyFunction = (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
forall a b.
(a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
genericFromJSONKey :: forall a. (Generic a, GFromJSONKey (Rep a))
=> JSONKeyOptions
-> FromJSONKeyFunction a
genericFromJSONKey :: forall a.
(Generic a, GFromJSONKey (Rep a)) =>
JSONKeyOptions -> FromJSONKeyFunction a
genericFromJSONKey JSONKeyOptions
opts = (Text -> Parser a) -> FromJSONKeyFunction a
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser a) -> FromJSONKeyFunction a)
-> (Text -> Parser a) -> FromJSONKeyFunction a
forall a b. (a -> b) -> a -> b
$ \Text
t ->
case (String -> String) -> Text -> Maybe (Rep a Any)
forall a. (String -> String) -> Text -> Maybe (Rep a a)
forall {k} (f :: k -> *) (a :: k).
SumFromString f =>
(String -> String) -> Text -> Maybe (f a)
parseSumFromString (JSONKeyOptions -> String -> String
keyModifier JSONKeyOptions
opts) Text
t of
Maybe (Rep a Any)
Nothing -> String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$
String
"invalid key " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", expected one of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
cnames
Just Rep a Any
k -> a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to Rep a Any
k)
where
cnames :: [String]
cnames = Tagged2 (Rep a) [String] -> [String]
forall (s :: * -> *) b. Tagged2 s b -> b
unTagged2 ((String -> String) -> Tagged2 (Rep a) [String]
forall (a :: * -> *) t.
ConstructorNames a =>
(String -> t) -> Tagged2 a [t]
constructorTags (JSONKeyOptions -> String -> String
keyModifier JSONKeyOptions
opts) :: Tagged2 (Rep a) [String])
class (ConstructorNames f, SumFromString f) => GFromJSONKey f where
instance (ConstructorNames f, SumFromString f) => GFromJSONKey f where
typeMismatch :: String
-> Value
-> Parser a
typeMismatch :: forall a. String -> Value -> Parser a
typeMismatch String
expected Value
actual =
String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expected String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but encountered " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
typeOf Value
actual
unexpected :: Value -> Parser a
unexpected :: forall a. Value -> Parser a
unexpected Value
actual = String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
typeOf Value
actual
typeOf :: Value -> String
typeOf :: Value -> String
typeOf Value
v = case Value
v of
Object Object
_ -> String
"Object"
Array Array
_ -> String
"Array"
String Text
_ -> String
"String"
Number Scientific
_ -> String
"Number"
Bool Bool
_ -> String
"Boolean"
Value
Null -> String
"Null"
class FromJSON1 f where
liftParseJSON :: Maybe a -> (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (f a)
default liftParseJSON :: (Generic1 f, GFromJSON One (Rep1 f))
=> Maybe a -> (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON = Options
-> Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
forall (f :: * -> *) a.
(Generic1 f, GFromJSON One (Rep1 f)) =>
Options
-> Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
genericLiftParseJSON Options
defaultOptions
liftParseJSONList :: Maybe a -> (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser [f a]
liftParseJSONList Maybe a
o Value -> Parser a
f Value -> Parser [a]
g Value
v = (Value -> Parser (f a)) -> Value -> Parser [f a]
forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser (Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
forall a.
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
forall (f :: * -> *) a.
FromJSON1 f =>
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
liftParseJSON Maybe a
o Value -> Parser a
f Value -> Parser [a]
g) Value
v
liftOmittedField :: Maybe a -> Maybe (f a)
liftOmittedField Maybe a
_ = Maybe (f a)
forall a. Maybe a
Nothing
instance (Generic1 f, GFromJSON One (Rep1 f)) => FromJSON1 (Generically1 f) where
liftParseJSON :: forall a. Maybe a -> (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (Generically1 f a)
liftParseJSON :: forall a.
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (Generically1 f a)
liftParseJSON = (Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a))
-> Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (Generically1 f a)
forall a b. Coercible a b => a -> b
coerce (Options
-> Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
forall (f :: * -> *) a.
(Generic1 f, GFromJSON One (Rep1 f)) =>
Options
-> Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
genericLiftParseJSON Options
defaultOptions :: Maybe a -> (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (f a))
parseJSON1 :: (FromJSON1 f, FromJSON a) => Value -> Parser (f a)
parseJSON1 :: forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1 = Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
forall a.
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
forall (f :: * -> *) a.
FromJSON1 f =>
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
liftParseJSON Maybe a
forall a. FromJSON a => Maybe a
omittedField Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [a]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
{-# INLINE parseJSON1 #-}
omittedField1 :: (FromJSON1 f, FromJSON a) => Maybe (f a)
omittedField1 :: forall (f :: * -> *) a. (FromJSON1 f, FromJSON a) => Maybe (f a)
omittedField1 = Maybe a -> Maybe (f a)
forall a. Maybe a -> Maybe (f a)
forall (f :: * -> *) a. FromJSON1 f => Maybe a -> Maybe (f a)
liftOmittedField Maybe a
forall a. FromJSON a => Maybe a
omittedField
class FromJSON2 f where
liftParseJSON2
:: Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Maybe b
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value -> Parser (f a b)
liftParseJSONList2
:: Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Maybe b
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value -> Parser [f a b]
liftParseJSONList2 Maybe a
oa Value -> Parser a
fa Value -> Parser [a]
ga Maybe b
ob Value -> Parser b
fb Value -> Parser [b]
gb = String -> (Array -> Parser [f a b]) -> Value -> Parser [f a b]
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"[]" ((Array -> Parser [f a b]) -> Value -> Parser [f a b])
-> (Array -> Parser [f a b]) -> Value -> Parser [f a b]
forall a b. (a -> b) -> a -> b
$ \Array
vals ->
(Vector (f a b) -> [f a b])
-> Parser (Vector (f a b)) -> Parser [f a b]
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector (f a b) -> [f a b]
forall a. Vector a -> [a]
V.toList ((Value -> Parser (f a b)) -> Array -> Parser (Vector (f a b))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM (Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Maybe b
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
forall a b.
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Maybe b
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Maybe b
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Maybe a
oa Value -> Parser a
fa Value -> Parser [a]
ga Maybe b
ob Value -> Parser b
fb Value -> Parser [b]
gb) Array
vals)
liftOmittedField2 :: Maybe a -> Maybe b -> Maybe (f a b)
liftOmittedField2 Maybe a
_ Maybe b
_ = Maybe (f a b)
forall a. Maybe a
Nothing
parseJSON2 :: (FromJSON2 f, FromJSON a, FromJSON b) => Value -> Parser (f a b)
parseJSON2 :: forall (f :: * -> * -> *) a b.
(FromJSON2 f, FromJSON a, FromJSON b) =>
Value -> Parser (f a b)
parseJSON2 = Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Maybe b
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
forall a b.
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Maybe b
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Maybe b
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Maybe a
forall a. FromJSON a => Maybe a
omittedField Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [a]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList Maybe b
forall a. FromJSON a => Maybe a
omittedField Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [b]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
{-# INLINE parseJSON2 #-}
omittedField2 :: (FromJSON2 f, FromJSON a, FromJSON b) => Maybe (f a b)
omittedField2 :: forall (f :: * -> * -> *) a b.
(FromJSON2 f, FromJSON a, FromJSON b) =>
Maybe (f a b)
omittedField2 = Maybe a -> Maybe b -> Maybe (f a b)
forall a b. Maybe a -> Maybe b -> Maybe (f a b)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
Maybe a -> Maybe b -> Maybe (f a b)
liftOmittedField2 Maybe a
forall a. FromJSON a => Maybe a
omittedField Maybe b
forall a. FromJSON a => Maybe a
omittedField
listParser :: (Value -> Parser a) -> Value -> Parser [a]
listParser :: forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser Value -> Parser a
f (Array Array
xs) = (Vector a -> [a]) -> Parser (Vector a) -> Parser [a]
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> [a]
forall a. Vector a -> [a]
V.toList ((Value -> Parser a) -> Array -> Parser (Vector a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM Value -> Parser a
f Array
xs)
listParser Value -> Parser a
_ Value
v = String -> Value -> Parser [a]
forall a. String -> Value -> Parser a
typeMismatch String
"Array" Value
v
{-# INLINE listParser #-}
instance FromJSON1 [] where
liftParseJSON :: forall a.
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser [a]
liftParseJSON Maybe a
_ Value -> Parser a
_ Value -> Parser [a]
p' = Value -> Parser [a]
p'
instance (FromJSON a) => FromJSON [a] where
parseJSON :: Value -> Parser [a]
parseJSON = Value -> Parser [a]
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
prependContext :: String -> Parser a -> Parser a
prependContext :: forall a. String -> Parser a -> Parser a
prependContext String
name = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependFailure (String
"parsing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" failed, ")
withObject :: String -> (Object -> Parser a) -> Value -> Parser a
withObject :: forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
_ Object -> Parser a
f (Object Object
obj) = Object -> Parser a
f Object
obj
withObject String
name Object -> Parser a
_ Value
v = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependContext String
name (String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
"Object" Value
v)
withText :: String -> (Text -> Parser a) -> Value -> Parser a
withText :: forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
_ Text -> Parser a
f (String Text
txt) = Text -> Parser a
f Text
txt
withText String
name Text -> Parser a
_ Value
v = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependContext String
name (String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
"String" Value
v)
withArray :: String -> (Array -> Parser a) -> Value -> Parser a
withArray :: forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
_ Array -> Parser a
f (Array Array
arr) = Array -> Parser a
f Array
arr
withArray String
name Array -> Parser a
_ Value
v = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependContext String
name (String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
"Array" Value
v)
withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific :: forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
_ Scientific -> Parser a
f (Number Scientific
scientific) = Scientific -> Parser a
f Scientific
scientific
withScientific String
name Scientific -> Parser a
_ Value
v = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependContext String
name (String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
"Number" Value
v)
withScientific' :: (Scientific -> Parser a) -> Value -> Parser a
withScientific' :: forall a. (Scientific -> Parser a) -> Value -> Parser a
withScientific' Scientific -> Parser a
f Value
v = case Value
v of
Number Scientific
n -> Scientific -> Parser a
f Scientific
n
Value
_ -> String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
"Number" Value
v
withBoundedScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific :: forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific String
name Scientific -> Parser a
f Value
v = (Parser a -> Parser a)
-> (Scientific -> Parser a) -> Value -> Parser a
forall a.
(Parser a -> Parser a)
-> (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific_ (String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependContext String
name) Scientific -> Parser a
f Value
v
withBoundedScientific' :: (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific' :: forall a. (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific' Scientific -> Parser a
f Value
v = (Parser a -> Parser a)
-> (Scientific -> Parser a) -> Value -> Parser a
forall a.
(Parser a -> Parser a)
-> (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific_ Parser a -> Parser a
forall a. a -> a
id Scientific -> Parser a
f Value
v
withBoundedScientific_ :: (Parser a -> Parser a) -> (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific_ :: forall a.
(Parser a -> Parser a)
-> (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific_ Parser a -> Parser a
whenFail Scientific -> Parser a
f (Number Scientific
scientific) =
if Int
exp10 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1024
then Parser a -> Parser a
whenFail (String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg)
else Scientific -> Parser a
f Scientific
scientific
where
exp10 :: Int
exp10 = Scientific -> Int
base10Exponent Scientific
scientific
msg :: String
msg = String
"found a number with exponent " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
exp10 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but it must not be greater than 1024"
withBoundedScientific_ Parser a -> Parser a
whenFail Scientific -> Parser a
_ Value
v =
Parser a -> Parser a
whenFail (String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
"Number" Value
v)
withBool :: String -> (Bool -> Parser a) -> Value -> Parser a
withBool :: forall a. String -> (Bool -> Parser a) -> Value -> Parser a
withBool String
_ Bool -> Parser a
f (Bool Bool
arr) = Bool -> Parser a
f Bool
arr
withBool String
name Bool -> Parser a
_ Value
v = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependContext String
name (String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
"Boolean" Value
v)
withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a
withEmbeddedJSON :: forall a. String -> (Value -> Parser a) -> Value -> Parser a
withEmbeddedJSON String
_ Value -> Parser a
innerParser (String Text
txt) =
(String -> Parser a)
-> (Value -> Parser a) -> Either String Value -> Parser a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Value -> Parser a
innerParser (Either String Value -> Parser a)
-> Either String Value -> Parser a
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> ByteString
L.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
txt)
where
eitherDecode :: (FromJSON a) => L.ByteString -> Either String a
eitherDecode :: forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs = Result String ByteString Value
-> forall r. (String -> r) -> (Value -> ByteString -> r) -> r
forall e k a.
Result e k a -> forall r. (e -> r) -> (a -> k -> r) -> r
unResult (Tokens ByteString String -> Result String ByteString Value
forall k e. Tokens k e -> Result e k Value
toResultValue (ByteString -> Tokens ByteString String
lbsToTokens ByteString
bs)) String -> Either String a
forall a b. a -> Either a b
Left ((Value -> ByteString -> Either String a) -> Either String a)
-> (Value -> ByteString -> Either String a) -> Either String a
forall a b. (a -> b) -> a -> b
$ \Value
v ByteString
bs' -> case Value -> IResult a
forall a. FromJSON a => Value -> IResult a
ifromJSON Value
v of
ISuccess a
x
| ByteString -> Bool
lbsSpace ByteString
bs' -> a -> Either String a
forall a b. b -> Either a b
Right a
x
| Bool
otherwise -> String -> Either String a
forall a b. a -> Either a b
Left String
"Trailing garbage"
IError JSONPath
path String
msg -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ JSONPath -> String -> String
formatError JSONPath
path String
msg
withEmbeddedJSON String
name Value -> Parser a
_ Value
v = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependContext String
name (String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
"String" Value
v)
fromJSON :: (FromJSON a) => Value -> Result a
fromJSON :: forall a. FromJSON a => Value -> Result a
fromJSON = (Value -> Parser a) -> Value -> Result a
forall a b. (a -> Parser b) -> a -> Result b
parse Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON
ifromJSON :: (FromJSON a) => Value -> IResult a
ifromJSON :: forall a. FromJSON a => Value -> IResult a
ifromJSON = (Value -> Parser a) -> Value -> IResult a
forall a b. (a -> Parser b) -> a -> IResult b
iparse Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON
(.:) :: (FromJSON a) => Object -> Key -> Parser a
.: :: forall a. FromJSON a => Object -> Key -> Parser a
(.:) = (Value -> Parser a) -> Object -> Key -> Parser a
forall a. (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON
(.:?) :: (FromJSON a) => Object -> Key -> Parser (Maybe a)
.:? :: forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
(.:?) = (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
forall a. (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
explicitParseFieldMaybe Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON
(.:!) :: (FromJSON a) => Object -> Key -> Parser (Maybe a)
.:! :: forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
(.:!) = (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
forall a. (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
explicitParseFieldMaybe' Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON
(.:?=) :: (FromJSON a) => Object -> Key -> Parser a
.:?= :: forall a. FromJSON a => Object -> Key -> Parser a
(.:?=) = Maybe a -> (Value -> Parser a) -> Object -> Key -> Parser a
forall a.
Maybe a -> (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseFieldOmit Maybe a
forall a. FromJSON a => Maybe a
omittedField Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON
(.:!=) :: (FromJSON a) => Object -> Key -> Parser a
.:!= :: forall a. FromJSON a => Object -> Key -> Parser a
(.:!=) = Maybe a -> (Value -> Parser a) -> Object -> Key -> Parser a
forall a.
Maybe a -> (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseFieldOmit' Maybe a
forall a. FromJSON a => Maybe a
omittedField Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON
parseField :: (FromJSON a) => Object -> Key -> Parser a
parseField :: forall a. FromJSON a => Object -> Key -> Parser a
parseField = Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
(.:)
parseFieldMaybe :: (FromJSON a) => Object -> Key -> Parser (Maybe a)
parseFieldMaybe :: forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
parseFieldMaybe = Object -> Key -> Parser (Maybe a)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
(.:?)
parseFieldMaybe' :: (FromJSON a) => Object -> Key -> Parser (Maybe a)
parseFieldMaybe' :: forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
parseFieldMaybe' = Object -> Key -> Parser (Maybe a)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
(.:!)
parseFieldOmit :: (FromJSON a) => Object -> Key -> Parser a
parseFieldOmit :: forall a. FromJSON a => Object -> Key -> Parser a
parseFieldOmit = Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
(.:?=)
parseFieldOmit' :: (FromJSON a) => Object -> Key -> Parser a
parseFieldOmit' :: forall a. FromJSON a => Object -> Key -> Parser a
parseFieldOmit' = Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
(.:!=)
explicitParseField :: (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField :: forall a. (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField Value -> Parser a
p Object
obj Key
key = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
key Object
obj of
Maybe Value
Nothing -> String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"key " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Key -> String
forall a. Show a => a -> String
show Key
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not found"
Just Value
v -> Value -> Parser a
p Value
v Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
key
explicitParseFieldMaybe :: (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
explicitParseFieldMaybe :: forall a. (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
explicitParseFieldMaybe Value -> Parser a
p Object
obj Key
key = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
key Object
obj of
Maybe Value
Nothing -> Maybe a -> Parser (Maybe a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
Just Value
v -> Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (Maybe a)
forall a.
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (Maybe a)
forall (f :: * -> *) a.
FromJSON1 f =>
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
liftParseJSON Maybe a
forall a. Maybe a
Nothing Value -> Parser a
p ((Value -> Parser a) -> Value -> Parser [a]
forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser Value -> Parser a
p) Value
v Parser (Maybe a) -> JSONPathElement -> Parser (Maybe a)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
key
explicitParseFieldMaybe' :: (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
explicitParseFieldMaybe' :: forall a. (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
explicitParseFieldMaybe' Value -> Parser a
p Object
obj Key
key = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
key Object
obj of
Maybe Value
Nothing -> Maybe a -> Parser (Maybe a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
Just Value
v -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
p Value
v Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
key
explicitParseFieldOmit :: Maybe a -> (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseFieldOmit :: forall a.
Maybe a -> (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseFieldOmit Maybe a
Nothing Value -> Parser a
p Object
obj Key
key = (Value -> Parser a) -> Object -> Key -> Parser a
forall a. (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField Value -> Parser a
p Object
obj Key
key
explicitParseFieldOmit (Just a
def) Value -> Parser a
p Object
obj Key
key = (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
forall a. (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
explicitParseFieldMaybe Value -> Parser a
p Object
obj Key
key Parser (Maybe a) -> a -> Parser a
forall a. Parser (Maybe a) -> a -> Parser a
.!= a
def
explicitParseFieldOmit' :: Maybe a -> (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseFieldOmit' :: forall a.
Maybe a -> (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseFieldOmit' Maybe a
Nothing Value -> Parser a
p Object
obj Key
key = (Value -> Parser a) -> Object -> Key -> Parser a
forall a. (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField Value -> Parser a
p Object
obj Key
key
explicitParseFieldOmit' (Just a
def) Value -> Parser a
p Object
obj Key
key = (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
forall a. (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
explicitParseFieldMaybe' Value -> Parser a
p Object
obj Key
key Parser (Maybe a) -> a -> Parser a
forall a. Parser (Maybe a) -> a -> Parser a
.!= a
def
(.!=) :: Parser (Maybe a) -> a -> Parser a
Parser (Maybe a)
pmval .!= :: forall a. Parser (Maybe a) -> a -> Parser a
.!= a
val = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
val (Maybe a -> a) -> Parser (Maybe a) -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe a)
pmval
instance GFromJSON arity V1 where
gParseJSON :: forall a. Options -> FromArgs arity a -> Value -> Parser (V1 a)
gParseJSON Options
_ FromArgs arity a
_ Value
_ = String -> Parser (V1 a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Attempted to parse empty type"
{-# INLINE gParseJSON #-}
instance {-# OVERLAPPABLE #-} (GFromJSON arity a) => GFromJSON arity (M1 i c a) where
gParseJSON :: forall a.
Options -> FromArgs arity a -> Value -> Parser (M1 i c a a)
gParseJSON Options
opts FromArgs arity a
fargs = (a a -> M1 i c a a) -> Parser (a a) -> Parser (M1 i c a a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Parser (a a) -> Parser (M1 i c a a))
-> (Value -> Parser (a a)) -> Value -> Parser (M1 i c a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> FromArgs arity a -> Value -> Parser (a a)
forall a. Options -> FromArgs arity a -> Value -> Parser (a a)
forall arity (f :: * -> *) a.
GFromJSON arity f =>
Options -> FromArgs arity a -> Value -> Parser (f a)
gParseJSON Options
opts FromArgs arity a
fargs
{-# INLINE gParseJSON #-}
type TypeName = String
type ConName = String
contextType :: TypeName -> Parser a -> Parser a
contextType :: forall a. String -> Parser a -> Parser a
contextType = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependContext
contextTag :: Key -> [String] -> Parser a -> Parser a
contextTag :: forall a. Key -> [String] -> Parser a -> Parser a
contextTag Key
tagKey [String]
cnames = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependFailure
(String
"expected Object with key \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Key -> String
Key.toString Key
tagKey String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" containing one of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
cnames String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", ")
contextCons :: ConName -> TypeName -> Parser a -> Parser a
contextCons :: forall a. String -> String -> Parser a -> Parser a
contextCons String
cname String
tname = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependContext (String -> String -> String
showCons String
cname String
tname)
showCons :: ConName -> TypeName -> String
showCons :: String -> String -> String
showCons String
cname String
tname = String
tname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
instance (FromJSON a) => GFromJSON arity (K1 i a) where
gParseJSON :: forall a. Options -> FromArgs arity a -> Value -> Parser (K1 i a a)
gParseJSON Options
_opts FromArgs arity a
_ = (a -> K1 i a a) -> Parser a -> Parser (K1 i a a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (Parser a -> Parser (K1 i a a))
-> (Value -> Parser a) -> Value -> Parser (K1 i a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON
{-# INLINE gParseJSON #-}
instance GFromJSON One Par1 where
gParseJSON :: forall a. Options -> FromArgs One a -> Value -> Parser (Par1 a)
gParseJSON Options
_opts (From1Args Maybe a
_ Value -> Parser a
pj Value -> Parser [a]
_) = (a -> Par1 a) -> Parser a -> Parser (Par1 a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Par1 a
forall p. p -> Par1 p
Par1 (Parser a -> Parser (Par1 a))
-> (Value -> Parser a) -> Value -> Parser (Par1 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
pj
{-# INLINE gParseJSON #-}
instance (FromJSON1 f) => GFromJSON One (Rec1 f) where
gParseJSON :: forall a. Options -> FromArgs One a -> Value -> Parser (Rec1 f a)
gParseJSON Options
_opts (From1Args Maybe a
o Value -> Parser a
pj Value -> Parser [a]
pjl) = (f a -> Rec1 f a) -> Parser (f a) -> Parser (Rec1 f a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> Rec1 f a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 (Parser (f a) -> Parser (Rec1 f a))
-> (Value -> Parser (f a)) -> Value -> Parser (Rec1 f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
forall a.
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
forall (f :: * -> *) a.
FromJSON1 f =>
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
liftParseJSON Maybe a
o Value -> Parser a
pj Value -> Parser [a]
pjl
{-# INLINE gParseJSON #-}
instance (FromJSON1 f, GFromJSON One g) => GFromJSON One (f :.: g) where
gParseJSON :: forall a.
Options -> FromArgs One a -> Value -> Parser ((:.:) f g a)
gParseJSON Options
opts FromArgs One a
fargs =
let gpj :: Value -> Parser (g a)
gpj = Options -> FromArgs One a -> Value -> Parser (g a)
forall a. Options -> FromArgs One a -> Value -> Parser (g a)
forall arity (f :: * -> *) a.
GFromJSON arity f =>
Options -> FromArgs arity a -> Value -> Parser (f a)
gParseJSON Options
opts FromArgs One a
fargs
in (f (g a) -> (:.:) f g a)
-> Parser (f (g a)) -> Parser ((:.:) f g a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (g a) -> (:.:) f g a
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (Parser (f (g a)) -> Parser ((:.:) f g a))
-> (Value -> Parser (f (g a))) -> Value -> Parser ((:.:) f g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (g a)
-> (Value -> Parser (g a))
-> (Value -> Parser [g a])
-> Value
-> Parser (f (g a))
forall a.
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
forall (f :: * -> *) a.
FromJSON1 f =>
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
liftParseJSON Maybe (g a)
forall a. Maybe a
Nothing Value -> Parser (g a)
gpj ((Value -> Parser (g a)) -> Value -> Parser [g a]
forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser Value -> Parser (g a)
gpj)
{-# INLINE gParseJSON #-}
instance (GFromJSON' arity a, Datatype d) => GFromJSON arity (D1 d a) where
gParseJSON :: forall a. Options -> FromArgs arity a -> Value -> Parser (D1 d a a)
gParseJSON Options
opts FromArgs arity a
fargs = (a a -> D1 d a a) -> Parser (a a) -> Parser (D1 d a a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a a -> D1 d a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Parser (a a) -> Parser (D1 d a a))
-> (Value -> Parser (a a)) -> Value -> Parser (D1 d a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String :* (Options :* FromArgs arity a)) -> Value -> Parser (a a)
forall a.
(String :* (Options :* FromArgs arity a)) -> Value -> Parser (a a)
forall arity (f :: * -> *) a.
GFromJSON' arity f =>
(String :* (Options :* FromArgs arity a)) -> Value -> Parser (f a)
gParseJSON' (String
tname String
-> (Options :* FromArgs arity a)
-> String :* (Options :* FromArgs arity a)
forall a b. a -> b -> a :* b
:* Options
opts Options -> FromArgs arity a -> Options :* FromArgs arity a
forall a b. a -> b -> a :* b
:* FromArgs arity a
fargs)
where
tname :: String
tname = M1 Any d Any Any -> String
forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t d f a -> String
moduleName M1 Any d Any Any
proxy String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ M1 Any d Any Any -> String
forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t d f a -> String
datatypeName M1 Any d Any Any
proxy
proxy :: M1 Any d Any Any
proxy = M1 _i d _f _p
forall {k} {_i} {_f :: k -> *} {_p :: k}. M1 _i d _f _p
forall a. HasCallStack => a
undefined :: M1 _i d _f _p
{-# INLINE gParseJSON #-}
class GFromJSON' arity f where
gParseJSON' :: TypeName :* Options :* FromArgs arity a
-> Value
-> Parser (f a)
instance GFromJSON' arity V1 where
gParseJSON' :: forall a.
(String :* (Options :* FromArgs arity a)) -> Value -> Parser (V1 a)
gParseJSON' String :* (Options :* FromArgs arity a)
_ Value
_ = String -> Parser (V1 a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Attempted to parse empty type"
{-# INLINE gParseJSON' #-}
instance ( ConsFromJSON arity a
, AllNullary (C1 c a) allNullary
, ParseSum arity (C1 c a) allNullary
, Constructor c
) => GFromJSON' arity (C1 c a) where
gParseJSON' :: forall a.
(String :* (Options :* FromArgs arity a))
-> Value -> Parser (C1 c a a)
gParseJSON' p :: String :* (Options :* FromArgs arity a)
p@(String
_ :* Options
opts :* FromArgs arity a
_)
| Options -> Bool
tagSingleConstructors Options
opts
= (Tagged allNullary (Parser (C1 c a p)) -> Parser (C1 c a p)
forall {p}.
Tagged allNullary (Parser (C1 c a p)) -> Parser (C1 c a p)
forall {k} (s :: k) b. Tagged s b -> b
unTagged :: Tagged allNullary (Parser (C1 c a p)) -> Parser (C1 c a p))
(Tagged allNullary (Parser (C1 c a a)) -> Parser (C1 c a a))
-> (Value -> Tagged allNullary (Parser (C1 c a a)))
-> Value
-> Parser (C1 c a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String :* (Options :* FromArgs arity a))
-> Value -> Tagged allNullary (Parser (C1 c a a))
forall a.
(String :* (Options :* FromArgs arity a))
-> Value -> Tagged allNullary (Parser (M1 C c a a))
forall {k} arity (f :: * -> *) (allNullary :: k) a.
ParseSum arity f allNullary =>
(String :* (Options :* FromArgs arity a))
-> Value -> Tagged allNullary (Parser (f a))
parseSum String :* (Options :* FromArgs arity a)
p
| Bool
otherwise = (a a -> C1 c a a) -> Parser (a a) -> Parser (C1 c a a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a a -> C1 c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Parser (a a) -> Parser (C1 c a a))
-> (Value -> Parser (a a)) -> Value -> Parser (C1 c a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (a a)
forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (a a)
forall arity (f :: * -> *) a.
ConsFromJSON arity f =>
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (f a)
consParseJSON (String
cname String
-> (String :* (Options :* FromArgs arity a))
-> String :* (String :* (Options :* FromArgs arity a))
forall a b. a -> b -> a :* b
:* String :* (Options :* FromArgs arity a)
p)
where
cname :: String
cname = M1 Any c Any Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t c f a -> String
conName (M1 _i c _f _p
forall {k} {_i} {_f :: k -> *} {_p :: k}. M1 _i c _f _p
forall a. HasCallStack => a
undefined :: M1 _i c _f _p)
{-# INLINE gParseJSON' #-}
instance ( AllNullary (a :+: b) allNullary
, ParseSum arity (a :+: b) allNullary
) => GFromJSON' arity (a :+: b) where
gParseJSON' :: forall a.
(String :* (Options :* FromArgs arity a))
-> Value -> Parser ((:+:) a b a)
gParseJSON' String :* (Options :* FromArgs arity a)
p =
(Tagged allNullary (Parser ((:+:) a b _d)) -> Parser ((:+:) a b _d)
forall {_d}.
Tagged allNullary (Parser ((:+:) a b _d)) -> Parser ((:+:) a b _d)
forall {k} (s :: k) b. Tagged s b -> b
unTagged :: Tagged allNullary (Parser ((a :+: b) _d)) ->
Parser ((a :+: b) _d))
(Tagged allNullary (Parser ((:+:) a b a)) -> Parser ((:+:) a b a))
-> (Value -> Tagged allNullary (Parser ((:+:) a b a)))
-> Value
-> Parser ((:+:) a b a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String :* (Options :* FromArgs arity a))
-> Value -> Tagged allNullary (Parser ((:+:) a b a))
forall a.
(String :* (Options :* FromArgs arity a))
-> Value -> Tagged allNullary (Parser ((:+:) a b a))
forall {k} arity (f :: * -> *) (allNullary :: k) a.
ParseSum arity f allNullary =>
(String :* (Options :* FromArgs arity a))
-> Value -> Tagged allNullary (Parser (f a))
parseSum String :* (Options :* FromArgs arity a)
p
{-# INLINE gParseJSON' #-}
class ParseSum arity f allNullary where
parseSum :: TypeName :* Options :* FromArgs arity a
-> Value
-> Tagged allNullary (Parser (f a))
instance ( ConstructorNames f
, SumFromString f
, FromPair arity f
, FromTaggedObject arity f
, FromUntaggedValue arity f
) => ParseSum arity f True where
parseSum :: forall a.
(String :* (Options :* FromArgs arity a))
-> Value -> Tagged True (Parser (f a))
parseSum p :: String :* (Options :* FromArgs arity a)
p@(String
tname :* Options
opts :* FromArgs arity a
_)
| Options -> Bool
allNullaryToStringTag Options
opts = Parser (f a) -> Tagged True (Parser (f a))
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Parser (f a) -> Tagged True (Parser (f a)))
-> (Value -> Parser (f a)) -> Value -> Tagged True (Parser (f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Options -> Value -> Parser (f a)
forall (f :: * -> *) a.
(SumFromString f, ConstructorNames f) =>
String -> Options -> Value -> Parser (f a)
parseAllNullarySum String
tname Options
opts
| Bool
otherwise = Parser (f a) -> Tagged True (Parser (f a))
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Parser (f a) -> Tagged True (Parser (f a)))
-> (Value -> Parser (f a)) -> Value -> Tagged True (Parser (f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String :* (Options :* FromArgs arity a)) -> Value -> Parser (f a)
forall (f :: * -> *) c arity.
(FromPair arity f, FromTaggedObject arity f,
FromUntaggedValue arity f, ConstructorNames f) =>
(String :* (Options :* FromArgs arity c)) -> Value -> Parser (f c)
parseNonAllNullarySum String :* (Options :* FromArgs arity a)
p
{-# INLINE parseSum #-}
instance ( ConstructorNames f
, FromPair arity f
, FromTaggedObject arity f
, FromUntaggedValue arity f
) => ParseSum arity f False where
parseSum :: forall a.
(String :* (Options :* FromArgs arity a))
-> Value -> Tagged False (Parser (f a))
parseSum String :* (Options :* FromArgs arity a)
p = Parser (f a) -> Tagged False (Parser (f a))
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Parser (f a) -> Tagged False (Parser (f a)))
-> (Value -> Parser (f a)) -> Value -> Tagged False (Parser (f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String :* (Options :* FromArgs arity a)) -> Value -> Parser (f a)
forall (f :: * -> *) c arity.
(FromPair arity f, FromTaggedObject arity f,
FromUntaggedValue arity f, ConstructorNames f) =>
(String :* (Options :* FromArgs arity c)) -> Value -> Parser (f c)
parseNonAllNullarySum String :* (Options :* FromArgs arity a)
p
{-# INLINE parseSum #-}
parseAllNullarySum :: (SumFromString f, ConstructorNames f)
=> TypeName -> Options -> Value -> Parser (f a)
parseAllNullarySum :: forall (f :: * -> *) a.
(SumFromString f, ConstructorNames f) =>
String -> Options -> Value -> Parser (f a)
parseAllNullarySum String
tname Options
opts =
String -> (Text -> Parser (f a)) -> Value -> Parser (f a)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
tname ((Text -> Parser (f a)) -> Value -> Parser (f a))
-> (Text -> Parser (f a)) -> Value -> Parser (f a)
forall a b. (a -> b) -> a -> b
$ \Text
tag ->
Parser (f a)
-> (f a -> Parser (f a)) -> Maybe (f a) -> Parser (f a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Parser (f a)
badTag Text
tag) f a -> Parser (f a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (f a) -> Parser (f a)) -> Maybe (f a) -> Parser (f a)
forall a b. (a -> b) -> a -> b
$
(String -> String) -> Text -> Maybe (f a)
forall a. (String -> String) -> Text -> Maybe (f a)
forall {k} (f :: k -> *) (a :: k).
SumFromString f =>
(String -> String) -> Text -> Maybe (f a)
parseSumFromString String -> String
modifier Text
tag
where
badTag :: Text -> Parser (f a)
badTag Text
tag = String
-> (String -> String) -> ([String] -> String) -> Parser (f a)
forall (f :: * -> *) a t.
ConstructorNames f =>
String -> (String -> t) -> ([t] -> String) -> Parser (f a)
failWithCTags String
tname String -> String
modifier (([String] -> String) -> Parser (f a))
-> ([String] -> String) -> Parser (f a)
forall a b. (a -> b) -> a -> b
$ \[String]
cnames ->
String
"expected one of the tags " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
cnames String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
", but found tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
tag
modifier :: String -> String
modifier = Options -> String -> String
constructorTagModifier Options
opts
failWithCTags
:: forall f a t. ConstructorNames f
=> TypeName -> (String -> t) -> ([t] -> String) -> Parser (f a)
failWithCTags :: forall (f :: * -> *) a t.
ConstructorNames f =>
String -> (String -> t) -> ([t] -> String) -> Parser (f a)
failWithCTags String
tname String -> t
modifier [t] -> String
f =
String -> Parser (f a) -> Parser (f a)
forall a. String -> Parser a -> Parser a
contextType String
tname (Parser (f a) -> Parser (f a))
-> (String -> Parser (f a)) -> String -> Parser (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser (f a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (f a)) -> String -> Parser (f a)
forall a b. (a -> b) -> a -> b
$ [t] -> String
f [t]
cnames
where
cnames :: [t]
cnames = Tagged2 f [t] -> [t]
forall (s :: * -> *) b. Tagged2 s b -> b
unTagged2 ((String -> t) -> Tagged2 f [t]
forall (a :: * -> *) t.
ConstructorNames a =>
(String -> t) -> Tagged2 a [t]
constructorTags String -> t
modifier :: Tagged2 f [t])
class SumFromString f where
parseSumFromString :: (String -> String) -> Text -> Maybe (f a)
instance (SumFromString a, SumFromString b) => SumFromString (a :+: b) where
parseSumFromString :: forall (a :: k). (String -> String) -> Text -> Maybe ((:+:) a b a)
parseSumFromString String -> String
opts Text
key = (a a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (a a -> (:+:) a b a) -> Maybe (a a) -> Maybe ((:+:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> Text -> Maybe (a a)
forall (a :: k). (String -> String) -> Text -> Maybe (a a)
forall {k} (f :: k -> *) (a :: k).
SumFromString f =>
(String -> String) -> Text -> Maybe (f a)
parseSumFromString String -> String
opts Text
key) Maybe ((:+:) a b a) -> Maybe ((:+:) a b a) -> Maybe ((:+:) a b a)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(b a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (b a -> (:+:) a b a) -> Maybe (b a) -> Maybe ((:+:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> Text -> Maybe (b a)
forall (a :: k). (String -> String) -> Text -> Maybe (b a)
forall {k} (f :: k -> *) (a :: k).
SumFromString f =>
(String -> String) -> Text -> Maybe (f a)
parseSumFromString String -> String
opts Text
key)
{-# INLINE parseSumFromString #-}
instance (Constructor c) => SumFromString (C1 c U1) where
parseSumFromString :: forall (a :: k). (String -> String) -> Text -> Maybe (C1 c U1 a)
parseSumFromString String -> String
modifier Text
key
| Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name = C1 c U1 a -> Maybe (C1 c U1 a)
forall a. a -> Maybe a
Just (C1 c U1 a -> Maybe (C1 c U1 a)) -> C1 c U1 a -> Maybe (C1 c U1 a)
forall a b. (a -> b) -> a -> b
$ U1 a -> C1 c U1 a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 U1 a
forall k (p :: k). U1 p
U1
| Bool
otherwise = Maybe (C1 c U1 a)
forall a. Maybe a
Nothing
where
name :: Text
name = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
modifier (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ M1 Any c Any Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t c f a -> String
conName (M1 _i c _f _p
forall {k} {_i} {_f :: k -> *} {_p :: k}. M1 _i c _f _p
forall a. HasCallStack => a
undefined :: M1 _i c _f _p)
{-# INLINE parseSumFromString #-}
instance SumFromString a => SumFromString (D1 d a) where
parseSumFromString :: forall (a :: k). (String -> String) -> Text -> Maybe (D1 d a a)
parseSumFromString String -> String
modifier Text
key = a a -> M1 D d a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> M1 D d a a) -> Maybe (a a) -> Maybe (M1 D d a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> Text -> Maybe (a a)
forall (a :: k). (String -> String) -> Text -> Maybe (a a)
forall {k} (f :: k -> *) (a :: k).
SumFromString f =>
(String -> String) -> Text -> Maybe (f a)
parseSumFromString String -> String
modifier Text
key
{-# INLINE parseSumFromString #-}
constructorTags :: ConstructorNames a => (String -> t) -> Tagged2 a [t]
constructorTags :: forall (a :: * -> *) t.
ConstructorNames a =>
(String -> t) -> Tagged2 a [t]
constructorTags String -> t
modifier =
(DList t -> [t]) -> Tagged2 a (DList t) -> Tagged2 a [t]
forall a b. (a -> b) -> Tagged2 a a -> Tagged2 a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DList t -> [t]
forall a. DList a -> [a]
DList.toList ((String -> t) -> Tagged2 a (DList t)
forall t. (String -> t) -> Tagged2 a (DList t)
forall (a :: * -> *) t.
ConstructorNames a =>
(String -> t) -> Tagged2 a (DList t)
constructorNames' String -> t
modifier)
class ConstructorNames a where
constructorNames' :: (String -> t) -> Tagged2 a (DList.DList t)
instance (ConstructorNames a, ConstructorNames b) => ConstructorNames (a :+: b) where
constructorNames' :: forall t. (String -> t) -> Tagged2 (a :+: b) (DList t)
constructorNames' = (Tagged2 a (DList t)
-> Tagged2 b (DList t) -> Tagged2 (a :+: b) (DList t))
-> ((String -> t) -> Tagged2 a (DList t))
-> ((String -> t) -> Tagged2 b (DList t))
-> (String -> t)
-> Tagged2 (a :+: b) (DList t)
forall a b c.
(a -> b -> c)
-> ((String -> t) -> a)
-> ((String -> t) -> b)
-> (String -> t)
-> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Tagged2 a (DList t)
-> Tagged2 b (DList t) -> Tagged2 (a :+: b) (DList t)
forall t.
Tagged2 a (DList t)
-> Tagged2 b (DList t) -> Tagged2 (a :+: b) (DList t)
append (String -> t) -> Tagged2 a (DList t)
forall t. (String -> t) -> Tagged2 a (DList t)
forall (a :: * -> *) t.
ConstructorNames a =>
(String -> t) -> Tagged2 a (DList t)
constructorNames' (String -> t) -> Tagged2 b (DList t)
forall t. (String -> t) -> Tagged2 b (DList t)
forall (a :: * -> *) t.
ConstructorNames a =>
(String -> t) -> Tagged2 a (DList t)
constructorNames'
where
append
:: Tagged2 a (DList.DList t)
-> Tagged2 b (DList.DList t)
-> Tagged2 (a :+: b) (DList.DList t)
append :: forall t.
Tagged2 a (DList t)
-> Tagged2 b (DList t) -> Tagged2 (a :+: b) (DList t)
append (Tagged2 DList t
xs) (Tagged2 DList t
ys) = DList t -> Tagged2 (a :+: b) (DList t)
forall (s :: * -> *) b. b -> Tagged2 s b
Tagged2 (DList t -> DList t -> DList t
forall a. DList a -> DList a -> DList a
DList.append DList t
xs DList t
ys)
{-# INLINE constructorNames' #-}
instance Constructor c => ConstructorNames (C1 c a) where
constructorNames' :: forall t. (String -> t) -> Tagged2 (C1 c a) (DList t)
constructorNames' String -> t
f = DList t -> Tagged2 (C1 c a) (DList t)
forall (s :: * -> *) b. b -> Tagged2 s b
Tagged2 (t -> DList t
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> t
f String
cname))
where
cname :: String
cname = M1 Any c Any Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t c f a -> String
conName (M1 _i c _f _p
forall {k} {_i} {_f :: k -> *} {_p :: k}. M1 _i c _f _p
forall a. HasCallStack => a
undefined :: M1 _i c _f _p)
{-# INLINE constructorNames' #-}
instance ConstructorNames a => ConstructorNames (D1 d a) where
constructorNames' :: forall t. (String -> t) -> Tagged2 (D1 d a) (DList t)
constructorNames' = Tagged2 a (DList t) -> Tagged2 (D1 d a) (DList t)
forall u. Tagged2 a u -> Tagged2 (D1 d a) u
retag (Tagged2 a (DList t) -> Tagged2 (D1 d a) (DList t))
-> ((String -> t) -> Tagged2 a (DList t))
-> (String -> t)
-> Tagged2 (D1 d a) (DList t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> t) -> Tagged2 a (DList t)
forall t. (String -> t) -> Tagged2 a (DList t)
forall (a :: * -> *) t.
ConstructorNames a =>
(String -> t) -> Tagged2 a (DList t)
constructorNames'
where
retag :: Tagged2 a u -> Tagged2 (D1 d a) u
retag :: forall u. Tagged2 a u -> Tagged2 (D1 d a) u
retag (Tagged2 u
x) = u -> Tagged2 (D1 d a) u
forall (s :: * -> *) b. b -> Tagged2 s b
Tagged2 u
x
{-# INLINE constructorNames' #-}
parseNonAllNullarySum :: forall f c arity.
( FromPair arity f
, FromTaggedObject arity f
, FromUntaggedValue arity f
, ConstructorNames f
) => TypeName :* Options :* FromArgs arity c
-> Value -> Parser (f c)
parseNonAllNullarySum :: forall (f :: * -> *) c arity.
(FromPair arity f, FromTaggedObject arity f,
FromUntaggedValue arity f, ConstructorNames f) =>
(String :* (Options :* FromArgs arity c)) -> Value -> Parser (f c)
parseNonAllNullarySum p :: String :* (Options :* FromArgs arity c)
p@(String
tname :* Options
opts :* FromArgs arity c
_) =
case Options -> SumEncoding
sumEncoding Options
opts of
TaggedObject{String
tagFieldName :: String
contentsFieldName :: String
tagFieldName :: SumEncoding -> String
contentsFieldName :: SumEncoding -> String
..} ->
String -> (Object -> Parser (f c)) -> Value -> Parser (f c)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
tname ((Object -> Parser (f c)) -> Value -> Parser (f c))
-> (Object -> Parser (f c)) -> Value -> Parser (f c)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
Text
tag <- String -> Parser Text -> Parser Text
forall a. String -> Parser a -> Parser a
contextType String
tname (Parser Text -> Parser Text)
-> (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> [String] -> Parser Text -> Parser Text
forall a. Key -> [String] -> Parser a -> Parser a
contextTag Key
tagKey [String]
cnames_ (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
tagKey
Parser (f c) -> Maybe (Parser (f c)) -> Parser (f c)
forall a. a -> Maybe a -> a
fromMaybe (Text -> Parser (f c)
badTag Text
tag Parser (f c) -> JSONPathElement -> Parser (f c)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
tagKey) (Maybe (Parser (f c)) -> Parser (f c))
-> Maybe (Parser (f c)) -> Parser (f c)
forall a b. (a -> b) -> a -> b
$
(Text :* (String :* (String :* (Options :* FromArgs arity c))))
-> Object -> Maybe (Parser (f c))
forall a.
(Text :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Maybe (Parser (f a))
forall arity (f :: * -> *) a.
FromTaggedObject arity f =>
(Text :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Maybe (Parser (f a))
parseFromTaggedObject (Text
tag Text
-> (String :* (String :* (Options :* FromArgs arity c)))
-> Text :* (String :* (String :* (Options :* FromArgs arity c)))
forall a b. a -> b -> a :* b
:* String
contentsFieldName String
-> (String :* (Options :* FromArgs arity c))
-> String :* (String :* (Options :* FromArgs arity c))
forall a b. a -> b -> a :* b
:* String :* (Options :* FromArgs arity c)
p) Object
obj
where
tagKey :: Key
tagKey = String -> Key
Key.fromString String
tagFieldName
badTag :: Text -> Parser (f c)
badTag Text
tag = ([String] -> String) -> Parser (f c)
failWith_ (([String] -> String) -> Parser (f c))
-> ([String] -> String) -> Parser (f c)
forall a b. (a -> b) -> a -> b
$ \[String]
cnames ->
String
"expected tag field to be one of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
cnames String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
", but found tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
tag
cnames_ :: [String]
cnames_ = Tagged2 f [String] -> [String]
forall (s :: * -> *) b. Tagged2 s b -> b
unTagged2 ((String -> String) -> Tagged2 f [String]
forall (a :: * -> *) t.
ConstructorNames a =>
(String -> t) -> Tagged2 a [t]
constructorTags (Options -> String -> String
constructorTagModifier Options
opts) :: Tagged2 f [String])
SumEncoding
ObjectWithSingleField ->
String -> (Object -> Parser (f c)) -> Value -> Parser (f c)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
tname ((Object -> Parser (f c)) -> Value -> Parser (f c))
-> (Object -> Parser (f c)) -> Value -> Parser (f c)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> case Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
obj of
[(Key
tag, Value
v)] -> Parser (f c)
-> (Parser (f c) -> Parser (f c))
-> Maybe (Parser (f c))
-> Parser (f c)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Key -> Parser (f c)
badTag Key
tag) (Parser (f c) -> JSONPathElement -> Parser (f c)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
tag) (Maybe (Parser (f c)) -> Parser (f c))
-> Maybe (Parser (f c)) -> Parser (f c)
forall a b. (a -> b) -> a -> b
$
(Key :* (String :* (Options :* FromArgs arity c)))
-> Value -> Maybe (Parser (f c))
forall a.
(Key :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (f a))
forall arity (f :: * -> *) a.
FromPair arity f =>
(Key :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (f a))
parsePair (Key
tag Key
-> (String :* (Options :* FromArgs arity c))
-> Key :* (String :* (Options :* FromArgs arity c))
forall a b. a -> b -> a :* b
:* String :* (Options :* FromArgs arity c)
p) Value
v
[(Key, Value)]
_ -> String -> Parser (f c) -> Parser (f c)
forall a. String -> Parser a -> Parser a
contextType String
tname (Parser (f c) -> Parser (f c))
-> (String -> Parser (f c)) -> String -> Parser (f c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser (f c)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (f c)) -> String -> Parser (f c)
forall a b. (a -> b) -> a -> b
$
String
"expected an Object with a single pair, but found " String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
forall a. Show a => a -> String
show (Object -> Int
forall v. KeyMap v -> Int
KM.size Object
obj) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" pairs"
where
badTag :: Key -> Parser (f c)
badTag Key
tag = ([String] -> String) -> Parser (f c)
failWith_ (([String] -> String) -> Parser (f c))
-> ([String] -> String) -> Parser (f c)
forall a b. (a -> b) -> a -> b
$ \[String]
cnames ->
String
"expected an Object with a single pair where the tag is one of " String -> String -> String
forall a. [a] -> [a] -> [a]
++
[String] -> String
forall a. Show a => a -> String
show [String]
cnames String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but found tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Key -> String
forall a. Show a => a -> String
show Key
tag
SumEncoding
TwoElemArray ->
String -> (Array -> Parser (f c)) -> Value -> Parser (f c)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
tname ((Array -> Parser (f c)) -> Value -> Parser (f c))
-> (Array -> Parser (f c)) -> Value -> Parser (f c)
forall a b. (a -> b) -> a -> b
$ \Array
arr -> case Array -> Int
forall a. Vector a -> Int
V.length Array
arr of
Int
2 | String Text
tag <- Array -> Int -> Value
forall a. Vector a -> Int -> a
V.unsafeIndex Array
arr Int
0 ->
Parser (f c)
-> (Parser (f c) -> Parser (f c))
-> Maybe (Parser (f c))
-> Parser (f c)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Parser (f c)
badTag Text
tag Parser (f c) -> JSONPathElement -> Parser (f c)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Int -> JSONPathElement
Index Int
0) (Parser (f c) -> JSONPathElement -> Parser (f c)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Int -> JSONPathElement
Index Int
1) (Maybe (Parser (f c)) -> Parser (f c))
-> Maybe (Parser (f c)) -> Parser (f c)
forall a b. (a -> b) -> a -> b
$
(Key :* (String :* (Options :* FromArgs arity c)))
-> Value -> Maybe (Parser (f c))
forall a.
(Key :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (f a))
forall arity (f :: * -> *) a.
FromPair arity f =>
(Key :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (f a))
parsePair (Text -> Key
Key.fromText Text
tag Key
-> (String :* (Options :* FromArgs arity c))
-> Key :* (String :* (Options :* FromArgs arity c))
forall a b. a -> b -> a :* b
:* String :* (Options :* FromArgs arity c)
p) (Array -> Int -> Value
forall a. Vector a -> Int -> a
V.unsafeIndex Array
arr Int
1)
| Bool
otherwise ->
String -> Parser (f c) -> Parser (f c)
forall a. String -> Parser a -> Parser a
contextType String
tname (Parser (f c) -> Parser (f c)) -> Parser (f c) -> Parser (f c)
forall a b. (a -> b) -> a -> b
$
String -> Parser (f c)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"tag element is not a String" Parser (f c) -> JSONPathElement -> Parser (f c)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Int -> JSONPathElement
Index Int
0
Int
len -> String -> Parser (f c) -> Parser (f c)
forall a. String -> Parser a -> Parser a
contextType String
tname (Parser (f c) -> Parser (f c))
-> (String -> Parser (f c)) -> String -> Parser (f c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser (f c)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (f c)) -> String -> Parser (f c)
forall a b. (a -> b) -> a -> b
$
String
"expected a 2-element Array, but encountered an Array of length " String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
forall a. Show a => a -> String
show Int
len
where
badTag :: Text -> Parser (f c)
badTag Text
tag = ([String] -> String) -> Parser (f c)
failWith_ (([String] -> String) -> Parser (f c))
-> ([String] -> String) -> Parser (f c)
forall a b. (a -> b) -> a -> b
$ \[String]
cnames ->
String
"expected tag of the 2-element Array to be one of " String -> String -> String
forall a. [a] -> [a] -> [a]
++
[String] -> String
forall a. Show a => a -> String
show [String]
cnames String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but found tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
tag
SumEncoding
UntaggedValue -> (String :* (Options :* FromArgs arity c)) -> Value -> Parser (f c)
forall a.
(String :* (Options :* FromArgs arity a)) -> Value -> Parser (f a)
forall arity (f :: * -> *) a.
FromUntaggedValue arity f =>
(String :* (Options :* FromArgs arity a)) -> Value -> Parser (f a)
parseUntaggedValue String :* (Options :* FromArgs arity c)
p
where
failWith_ :: ([String] -> String) -> Parser (f c)
failWith_ = String
-> (String -> String) -> ([String] -> String) -> Parser (f c)
forall (f :: * -> *) a t.
ConstructorNames f =>
String -> (String -> t) -> ([t] -> String) -> Parser (f a)
failWithCTags String
tname (Options -> String -> String
constructorTagModifier Options
opts)
class FromTaggedObject arity f where
parseFromTaggedObject
:: Text :* String :* TypeName :* Options :* FromArgs arity a
-> Object
-> Maybe (Parser (f a))
instance ( FromTaggedObject arity a, FromTaggedObject arity b) =>
FromTaggedObject arity (a :+: b) where
parseFromTaggedObject :: forall a.
(Text :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Maybe (Parser ((:+:) a b a))
parseFromTaggedObject Text :* (String :* (String :* (Options :* FromArgs arity a)))
p Object
obj =
((a a -> (:+:) a b a) -> Parser (a a) -> Parser ((:+:) a b a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (Parser (a a) -> Parser ((:+:) a b a))
-> Maybe (Parser (a a)) -> Maybe (Parser ((:+:) a b a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Maybe (Parser (a a))
forall a.
(Text :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Maybe (Parser (a a))
forall arity (f :: * -> *) a.
FromTaggedObject arity f =>
(Text :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Maybe (Parser (f a))
parseFromTaggedObject Text :* (String :* (String :* (Options :* FromArgs arity a)))
p Object
obj) Maybe (Parser ((:+:) a b a))
-> Maybe (Parser ((:+:) a b a)) -> Maybe (Parser ((:+:) a b a))
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((b a -> (:+:) a b a) -> Parser (b a) -> Parser ((:+:) a b a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (Parser (b a) -> Parser ((:+:) a b a))
-> Maybe (Parser (b a)) -> Maybe (Parser ((:+:) a b a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Maybe (Parser (b a))
forall a.
(Text :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Maybe (Parser (b a))
forall arity (f :: * -> *) a.
FromTaggedObject arity f =>
(Text :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Maybe (Parser (f a))
parseFromTaggedObject Text :* (String :* (String :* (Options :* FromArgs arity a)))
p Object
obj)
{-# INLINE parseFromTaggedObject #-}
instance ( IsRecord f isRecord
, FromTaggedObject' arity f isRecord
, Constructor c
) => FromTaggedObject arity (C1 c f) where
parseFromTaggedObject :: forall a.
(Text :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Maybe (Parser (C1 c f a))
parseFromTaggedObject (Text
tag :* String
contentsFieldName :* p :: String :* (Options :* FromArgs arity a)
p@(String
_ :* Options
opts :* FromArgs arity a
_))
| Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tag'
= Parser (C1 c f a) -> Maybe (Parser (C1 c f a))
forall a. a -> Maybe a
Just (Parser (C1 c f a) -> Maybe (Parser (C1 c f a)))
-> (Object -> Parser (C1 c f a))
-> Object
-> Maybe (Parser (C1 c f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a -> C1 c f a) -> Parser (f a) -> Parser (C1 c f a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> C1 c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Parser (f a) -> Parser (C1 c f a))
-> (Object -> Parser (f a)) -> Object -> Parser (C1 c f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Tagged isRecord (Parser (f a)) -> Parser (f a)
forall {a}. Tagged isRecord (Parser (f a)) -> Parser (f a)
forall {k} (s :: k) b. Tagged s b -> b
unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a)) (Tagged isRecord (Parser (f a)) -> Parser (f a))
-> (Object -> Tagged isRecord (Parser (f a)))
-> Object
-> Parser (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(String :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Tagged isRecord (Parser (f a))
forall a.
(String :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Tagged isRecord (Parser (f a))
forall {k} arity (f :: * -> *) (isRecord :: k) a.
FromTaggedObject' arity f isRecord =>
(String :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Tagged isRecord (Parser (f a))
parseFromTaggedObject' (String
contentsFieldName String
-> (String :* (String :* (Options :* FromArgs arity a)))
-> String :* (String :* (String :* (Options :* FromArgs arity a)))
forall a b. a -> b -> a :* b
:* String
cname String
-> (String :* (Options :* FromArgs arity a))
-> String :* (String :* (Options :* FromArgs arity a))
forall a b. a -> b -> a :* b
:* String :* (Options :* FromArgs arity a)
p)
| Bool
otherwise = Maybe (Parser (C1 c f a)) -> Object -> Maybe (Parser (C1 c f a))
forall a b. a -> b -> a
const Maybe (Parser (C1 c f a))
forall a. Maybe a
Nothing
where
tag' :: Text
tag' = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Options -> String -> String
constructorTagModifier Options
opts String
cname
cname :: String
cname = M1 Any c Any Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t c f a -> String
conName (M1 _i c _f _p
forall {k} {_i} {_f :: k -> *} {_p :: k}. M1 _i c _f _p
forall a. HasCallStack => a
undefined :: M1 _i c _f _p)
{-# INLINE parseFromTaggedObject #-}
class FromTaggedObject' arity f isRecord where
parseFromTaggedObject'
:: String :* ConName :* TypeName :* Options :* FromArgs arity a
-> Object -> Tagged isRecord (Parser (f a))
instance (RecordFromJSON arity f, FieldNames f) => FromTaggedObject' arity f True where
parseFromTaggedObject' :: forall a.
(String :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Tagged True (Parser (f a))
parseFromTaggedObject' (String
_ :* String :* (String :* (Options :* FromArgs arity a))
p) = Parser (f a) -> Tagged True (Parser (f a))
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Parser (f a) -> Tagged True (Parser (f a)))
-> (Object -> Parser (f a)) -> Object -> Tagged True (Parser (f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Parser (f a)
forall a.
(Bool :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Parser (f a)
forall arity (f :: * -> *) a.
RecordFromJSON arity f =>
(Bool :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Parser (f a)
recordParseJSON (Bool
True Bool
-> (String :* (String :* (Options :* FromArgs arity a)))
-> Bool :* (String :* (String :* (Options :* FromArgs arity a)))
forall a b. a -> b -> a :* b
:* String :* (String :* (Options :* FromArgs arity a))
p)
{-# INLINE parseFromTaggedObject' #-}
instance (ConsFromJSON arity f) => FromTaggedObject' arity f False where
parseFromTaggedObject' :: forall a.
(String :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Tagged False (Parser (f a))
parseFromTaggedObject' String :* (String :* (String :* (Options :* FromArgs arity a)))
p Object
obj = Parser (f a) -> Tagged False (Parser (f a))
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Parser (f a) -> Tagged False (Parser (f a)))
-> Parser (f a) -> Tagged False (Parser (f a))
forall a b. (a -> b) -> a -> b
$ do
Value
contents <- String -> String -> Parser Value -> Parser Value
forall a. String -> String -> Parser a -> Parser a
contextCons String
cname String
tname (Object
obj Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
key)
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (f a)
forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (f a)
forall arity (f :: * -> *) a.
ConsFromJSON arity f =>
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (f a)
consParseJSON String :* (String :* (Options :* FromArgs arity a))
p' Value
contents Parser (f a) -> JSONPathElement -> Parser (f a)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
key
where
key :: Key
key = String -> Key
Key.fromString String
contentsFieldName
String
contentsFieldName :* p' :: String :* (String :* (Options :* FromArgs arity a))
p'@(String
cname :* String
tname :* Options :* FromArgs arity a
_) = String :* (String :* (String :* (Options :* FromArgs arity a)))
p
{-# INLINE parseFromTaggedObject' #-}
instance {-# OVERLAPPING #-} FromTaggedObject' arity U1 False where
parseFromTaggedObject' :: forall a.
(String :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Tagged False (Parser (U1 a))
parseFromTaggedObject' String :* (String :* (String :* (Options :* FromArgs arity a)))
_ Object
_ = Parser (U1 a) -> Tagged False (Parser (U1 a))
forall {k} (s :: k) b. b -> Tagged s b
Tagged (U1 a -> Parser (U1 a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a
forall k (p :: k). U1 p
U1)
{-# INLINE parseFromTaggedObject' #-}
class ConsFromJSON arity f where
consParseJSON
:: ConName :* TypeName :* Options :* FromArgs arity a
-> Value -> Parser (f a)
class ConsFromJSON' arity f isRecord where
consParseJSON'
:: ConName :* TypeName :* Options :* FromArgs arity a
-> Value -> Tagged isRecord (Parser (f a))
instance ( IsRecord f isRecord
, ConsFromJSON' arity f isRecord
) => ConsFromJSON arity f where
consParseJSON :: forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (f a)
consParseJSON String :* (String :* (Options :* FromArgs arity a))
p =
(Tagged isRecord (Parser (f a)) -> Parser (f a)
forall {a}. Tagged isRecord (Parser (f a)) -> Parser (f a)
forall {k} (s :: k) b. Tagged s b -> b
unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a))
(Tagged isRecord (Parser (f a)) -> Parser (f a))
-> (Value -> Tagged isRecord (Parser (f a)))
-> Value
-> Parser (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Tagged isRecord (Parser (f a))
forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Tagged isRecord (Parser (f a))
forall {k} arity (f :: * -> *) (isRecord :: k) a.
ConsFromJSON' arity f isRecord =>
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Tagged isRecord (Parser (f a))
consParseJSON' String :* (String :* (Options :* FromArgs arity a))
p
{-# INLINE consParseJSON #-}
instance {-# OVERLAPPING #-}
( GFromJSON arity a, RecordFromJSON arity (S1 s a)
) => ConsFromJSON' arity (S1 s a) True where
consParseJSON' :: forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Tagged True (Parser (S1 s a a))
consParseJSON' p :: String :* (String :* (Options :* FromArgs arity a))
p@(String
cname :* String
tname :* Options
opts :* FromArgs arity a
fargs)
| Options -> Bool
unwrapUnaryRecords Options
opts = Parser (S1 s a a) -> Tagged True (Parser (S1 s a a))
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Parser (S1 s a a) -> Tagged True (Parser (S1 s a a)))
-> (Value -> Parser (S1 s a a))
-> Value
-> Tagged True (Parser (S1 s a a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a a -> S1 s a a) -> Parser (a a) -> Parser (S1 s a a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a a -> S1 s a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Parser (a a) -> Parser (S1 s a a))
-> (Value -> Parser (a a)) -> Value -> Parser (S1 s a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> FromArgs arity a -> Value -> Parser (a a)
forall a. Options -> FromArgs arity a -> Value -> Parser (a a)
forall arity (f :: * -> *) a.
GFromJSON arity f =>
Options -> FromArgs arity a -> Value -> Parser (f a)
gParseJSON Options
opts FromArgs arity a
fargs
| Bool
otherwise = Parser (S1 s a a) -> Tagged True (Parser (S1 s a a))
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Parser (S1 s a a) -> Tagged True (Parser (S1 s a a)))
-> (Value -> Parser (S1 s a a))
-> Value
-> Tagged True (Parser (S1 s a a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> (Object -> Parser (S1 s a a)) -> Value -> Parser (S1 s a a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject (String -> String -> String
showCons String
cname String
tname) ((Bool :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Parser (S1 s a a)
forall a.
(Bool :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Parser (M1 S s a a)
forall arity (f :: * -> *) a.
RecordFromJSON arity f =>
(Bool :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Parser (f a)
recordParseJSON (Bool
False Bool
-> (String :* (String :* (Options :* FromArgs arity a)))
-> Bool :* (String :* (String :* (Options :* FromArgs arity a)))
forall a b. a -> b -> a :* b
:* String :* (String :* (Options :* FromArgs arity a))
p))
{-# INLINE consParseJSON' #-}
instance RecordFromJSON arity f => ConsFromJSON' arity f True where
consParseJSON' :: forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Tagged True (Parser (f a))
consParseJSON' p :: String :* (String :* (Options :* FromArgs arity a))
p@(String
cname :* String
tname :* Options :* FromArgs arity a
_) =
Parser (f a) -> Tagged True (Parser (f a))
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Parser (f a) -> Tagged True (Parser (f a)))
-> (Value -> Parser (f a)) -> Value -> Tagged True (Parser (f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Object -> Parser (f a)) -> Value -> Parser (f a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject (String -> String -> String
showCons String
cname String
tname) ((Bool :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Parser (f a)
forall a.
(Bool :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Parser (f a)
forall arity (f :: * -> *) a.
RecordFromJSON arity f =>
(Bool :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Parser (f a)
recordParseJSON (Bool
False Bool
-> (String :* (String :* (Options :* FromArgs arity a)))
-> Bool :* (String :* (String :* (Options :* FromArgs arity a)))
forall a b. a -> b -> a :* b
:* String :* (String :* (Options :* FromArgs arity a))
p))
{-# INLINE consParseJSON' #-}
instance {-# OVERLAPPING #-}
ConsFromJSON' arity U1 False where
consParseJSON' :: forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Tagged False (Parser (U1 a))
consParseJSON' (String
cname :* String
tname :* Options :* FromArgs arity a
_) Value
v =
Parser (U1 a) -> Tagged False (Parser (U1 a))
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Parser (U1 a) -> Tagged False (Parser (U1 a)))
-> (Parser (U1 a) -> Parser (U1 a))
-> Parser (U1 a)
-> Tagged False (Parser (U1 a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Parser (U1 a) -> Parser (U1 a)
forall a. String -> String -> Parser a -> Parser a
contextCons String
cname String
tname (Parser (U1 a) -> Tagged False (Parser (U1 a)))
-> Parser (U1 a) -> Tagged False (Parser (U1 a))
forall a b. (a -> b) -> a -> b
$ case Value
v of
Array Array
a | Array -> Bool
forall a. Vector a -> Bool
V.null Array
a -> U1 a -> Parser (U1 a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a
forall k (p :: k). U1 p
U1
| Bool
otherwise -> Array -> Parser (U1 a)
forall {m :: * -> *} {a} {a}. MonadFail m => Vector a -> m a
fail_ Array
a
Value
_ -> String -> Value -> Parser (U1 a)
forall a. String -> Value -> Parser a
typeMismatch String
"Array" Value
v
where
fail_ :: Vector a -> m a
fail_ Vector a
a = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$
String
"expected an empty Array, but encountered an Array of length " String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
forall a. Show a => a -> String
show (Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
a)
{-# INLINE consParseJSON' #-}
instance {-# OVERLAPPING #-}
GFromJSON arity f => ConsFromJSON' arity (S1 s f) False where
consParseJSON' :: forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Tagged False (Parser (S1 s f a))
consParseJSON' (String
_ :* String
_ :* Options
opts :* FromArgs arity a
fargs) =
Parser (S1 s f a) -> Tagged False (Parser (S1 s f a))
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Parser (S1 s f a) -> Tagged False (Parser (S1 s f a)))
-> (Value -> Parser (S1 s f a))
-> Value
-> Tagged False (Parser (S1 s f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a -> S1 s f a) -> Parser (f a) -> Parser (S1 s f a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> S1 s f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Parser (f a) -> Parser (S1 s f a))
-> (Value -> Parser (f a)) -> Value -> Parser (S1 s f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> FromArgs arity a -> Value -> Parser (f a)
forall a. Options -> FromArgs arity a -> Value -> Parser (f a)
forall arity (f :: * -> *) a.
GFromJSON arity f =>
Options -> FromArgs arity a -> Value -> Parser (f a)
gParseJSON Options
opts FromArgs arity a
fargs
{-# INLINE consParseJSON' #-}
instance (ProductFromJSON arity f, ProductSize f
) => ConsFromJSON' arity f False where
consParseJSON' :: forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Tagged False (Parser (f a))
consParseJSON' String :* (String :* (Options :* FromArgs arity a))
p = Parser (f a) -> Tagged False (Parser (f a))
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Parser (f a) -> Tagged False (Parser (f a)))
-> (Value -> Parser (f a)) -> Value -> Tagged False (Parser (f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (f a)
forall (f :: * -> *) arity a.
(ProductFromJSON arity f, ProductSize f) =>
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (f a)
productParseJSON0 String :* (String :* (Options :* FromArgs arity a))
p
{-# INLINE consParseJSON' #-}
class FieldNames f where
fieldNames :: f a -> [String] -> [String]
instance (FieldNames a, FieldNames b) => FieldNames (a :*: b) where
fieldNames :: forall (a :: k). (:*:) a b a -> [String] -> [String]
fieldNames (:*:) a b a
_ =
a Any -> [String] -> [String]
forall (a :: k). a a -> [String] -> [String]
forall {k} (f :: k -> *) (a :: k).
FieldNames f =>
f a -> [String] -> [String]
fieldNames (a x
forall {x :: k}. a x
forall a. HasCallStack => a
undefined :: a x) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
b Any -> [String] -> [String]
forall (a :: k). b a -> [String] -> [String]
forall {k} (f :: k -> *) (a :: k).
FieldNames f =>
f a -> [String] -> [String]
fieldNames (b y
forall {y :: k}. b y
forall a. HasCallStack => a
undefined :: b y)
{-# INLINE fieldNames #-}
instance (Selector s) => FieldNames (S1 s f) where
fieldNames :: forall (a :: k). S1 s f a -> [String] -> [String]
fieldNames S1 s f a
_ = (M1 Any s Any Any -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t s f a -> String
selName (M1 _i s _f _p
forall {k} {_i} {_f :: k -> *} {_p :: k}. M1 _i s _f _p
forall a. HasCallStack => a
undefined :: M1 _i s _f _p) String -> [String] -> [String]
forall a. a -> [a] -> [a]
:)
{-# INLINE fieldNames #-}
class RecordFromJSON arity f where
recordParseJSON
:: Bool :* ConName :* TypeName :* Options :* FromArgs arity a
-> Object -> Parser (f a)
instance ( FieldNames f
, RecordFromJSON' arity f
) => RecordFromJSON arity f where
recordParseJSON :: forall a.
(Bool :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Parser (f a)
recordParseJSON (Bool
fromTaggedSum :* p :: String :* (String :* (Options :* FromArgs arity a))
p@(String
cname :* String
tname :* Options
opts :* FromArgs arity a
_)) =
\Object
obj -> Object -> Parser ()
checkUnknown Object
obj Parser () -> Parser (f a) -> Parser (f a)
forall a b. Parser a -> Parser b -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (f a)
forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (f a)
forall arity (f :: * -> *) a.
RecordFromJSON' arity f =>
(String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (f a)
recordParseJSON' String :* (String :* (Options :* FromArgs arity a))
p Object
obj
where
knownFields :: KM.KeyMap ()
knownFields :: KeyMap ()
knownFields = [(Key, ())] -> KeyMap ()
forall v. [(Key, v)] -> KeyMap v
KM.fromList ([(Key, ())] -> KeyMap ()) -> [(Key, ())] -> KeyMap ()
forall a b. (a -> b) -> a -> b
$ (String -> (Key, ())) -> [String] -> [(Key, ())]
forall a b. (a -> b) -> [a] -> [b]
map ((,()) (Key -> (Key, ())) -> (String -> Key) -> String -> (Key, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Key
Key.fromString) ([String] -> [(Key, ())]) -> [String] -> [(Key, ())]
forall a b. (a -> b) -> a -> b
$
[SumEncoding -> String
tagFieldName (Options -> SumEncoding
sumEncoding Options
opts) | Bool
fromTaggedSum] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<>
(Options -> String -> String
fieldLabelModifier Options
opts (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Any -> [String] -> [String]
forall a. f a -> [String] -> [String]
forall {k} (f :: k -> *) (a :: k).
FieldNames f =>
f a -> [String] -> [String]
fieldNames (f a
forall {a}. f a
forall a. HasCallStack => a
undefined :: f a) [])
checkUnknown :: Object -> Parser ()
checkUnknown =
if Bool -> Bool
not (Options -> Bool
rejectUnknownFields Options
opts)
then \Object
_ -> () -> Parser ()
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else \Object
obj -> case Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys (Object -> KeyMap () -> Object
forall v v'. KeyMap v -> KeyMap v' -> KeyMap v
KM.difference Object
obj KeyMap ()
knownFields) of
[] -> () -> Parser ()
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[Key]
unknownFields -> String -> String -> Parser () -> Parser ()
forall a. String -> String -> Parser a -> Parser a
contextCons String
cname String
tname (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
String -> Parser ()
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unknown fields: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Key] -> String
forall a. Show a => a -> String
show [Key]
unknownFields)
{-# INLINE recordParseJSON #-}
class RecordFromJSON' arity f where
recordParseJSON'
:: ConName :* TypeName :* Options :* FromArgs arity a
-> Object -> Parser (f a)
instance ( RecordFromJSON' arity a
, RecordFromJSON' arity b
) => RecordFromJSON' arity (a :*: b) where
recordParseJSON' :: forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser ((:*:) a b a)
recordParseJSON' String :* (String :* (Options :* FromArgs arity a))
p Object
obj =
a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (a a -> b a -> (:*:) a b a)
-> Parser (a a) -> Parser (b a -> (:*:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (a a)
forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (a a)
forall arity (f :: * -> *) a.
RecordFromJSON' arity f =>
(String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (f a)
recordParseJSON' String :* (String :* (Options :* FromArgs arity a))
p Object
obj
Parser (b a -> (:*:) a b a) -> Parser (b a) -> Parser ((:*:) a b a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (b a)
forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (b a)
forall arity (f :: * -> *) a.
RecordFromJSON' arity f =>
(String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (f a)
recordParseJSON' String :* (String :* (Options :* FromArgs arity a))
p Object
obj
{-# INLINE recordParseJSON' #-}
instance {-# OVERLAPPABLE #-}
RecordFromJSON' arity f => RecordFromJSON' arity (M1 i s f) where
recordParseJSON' :: forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (M1 i s f a)
recordParseJSON' String :* (String :* (Options :* FromArgs arity a))
args Object
obj = f a -> M1 i s f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 i s f a) -> Parser (f a) -> Parser (M1 i s f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (f a)
forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (f a)
forall arity (f :: * -> *) a.
RecordFromJSON' arity f =>
(String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (f a)
recordParseJSON' String :* (String :* (Options :* FromArgs arity a))
args Object
obj
{-# INLINE recordParseJSON' #-}
instance (Selector s, FromJSON a, Generic a, K1 i a ~ Rep a) =>
RecordFromJSON' arity (S1 s (K1 i a)) where
recordParseJSON' :: forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (S1 s (K1 i a) a)
recordParseJSON' args :: String :* (String :* (Options :* FromArgs arity a))
args@(String
_ :* String
_ :* Options
opts :* FromArgs arity a
_) Object
obj =
Maybe (K1 i a a)
-> (Options -> FromArgs arity a -> Value -> Parser (K1 i a a))
-> (String :* (String :* (Options :* FromArgs arity a)))
-> Object
-> Parser (M1 S s (K1 i a) a)
forall (s :: Meta) arity a (f :: * -> *) i.
Selector s =>
Maybe (f a)
-> (Options -> FromArgs arity a -> Value -> Parser (f a))
-> (String :* (String :* (Options :* FromArgs arity a)))
-> Object
-> Parser (M1 i s f a)
recordParseJSONImpl (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Options -> Bool
allowOmittedFields Options
opts) Maybe () -> Maybe (K1 i a a) -> Maybe (K1 i a a)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> K1 i a a) -> Maybe a -> Maybe (K1 i a a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 Maybe a
forall a. FromJSON a => Maybe a
omittedField) Options -> FromArgs arity a -> Value -> Parser (K1 i a a)
forall a. Options -> FromArgs arity a -> Value -> Parser (K1 i a a)
forall arity (f :: * -> *) a.
GFromJSON arity f =>
Options -> FromArgs arity a -> Value -> Parser (f a)
gParseJSON String :* (String :* (Options :* FromArgs arity a))
args Object
obj
{-# INLINE recordParseJSON' #-}
instance {-# OVERLAPPING #-}
(Selector s, FromJSON a) =>
RecordFromJSON' arity (S1 s (Rec0 a)) where
recordParseJSON' :: forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (S1 s (Rec0 a) a)
recordParseJSON' args :: String :* (String :* (Options :* FromArgs arity a))
args@(String
_ :* String
_ :* Options
opts :* FromArgs arity a
_) Object
obj =
Maybe (Rec0 a a)
-> (Options -> FromArgs arity a -> Value -> Parser (Rec0 a a))
-> (String :* (String :* (Options :* FromArgs arity a)))
-> Object
-> Parser (M1 S s (Rec0 a) a)
forall (s :: Meta) arity a (f :: * -> *) i.
Selector s =>
Maybe (f a)
-> (Options -> FromArgs arity a -> Value -> Parser (f a))
-> (String :* (String :* (Options :* FromArgs arity a)))
-> Object
-> Parser (M1 i s f a)
recordParseJSONImpl (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Options -> Bool
allowOmittedFields Options
opts) Maybe () -> Maybe (Rec0 a a) -> Maybe (Rec0 a a)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> Rec0 a a) -> Maybe a -> Maybe (Rec0 a a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Rec0 a a
forall k i c (p :: k). c -> K1 i c p
K1 Maybe a
forall a. FromJSON a => Maybe a
omittedField) Options -> FromArgs arity a -> Value -> Parser (Rec0 a a)
forall a. Options -> FromArgs arity a -> Value -> Parser (Rec0 a a)
forall arity (f :: * -> *) a.
GFromJSON arity f =>
Options -> FromArgs arity a -> Value -> Parser (f a)
gParseJSON String :* (String :* (Options :* FromArgs arity a))
args Object
obj
{-# INLINE recordParseJSON' #-}
instance {-# OVERLAPPING #-}
(Selector s, GFromJSON One (Rec1 f), FromJSON1 f) =>
RecordFromJSON' One (S1 s (Rec1 f)) where
recordParseJSON' :: forall a.
(String :* (String :* (Options :* FromArgs One a)))
-> Object -> Parser (S1 s (Rec1 f) a)
recordParseJSON' args :: String :* (String :* (Options :* FromArgs One a))
args@(String
_ :* String
_ :* Options
opts :* From1Args Maybe a
o Value -> Parser a
_ Value -> Parser [a]
_) Object
obj =
Maybe (Rec1 f a)
-> (Options -> FromArgs One a -> Value -> Parser (Rec1 f a))
-> (String :* (String :* (Options :* FromArgs One a)))
-> Object
-> Parser (M1 S s (Rec1 f) a)
forall (s :: Meta) arity a (f :: * -> *) i.
Selector s =>
Maybe (f a)
-> (Options -> FromArgs arity a -> Value -> Parser (f a))
-> (String :* (String :* (Options :* FromArgs arity a)))
-> Object
-> Parser (M1 i s f a)
recordParseJSONImpl (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Options -> Bool
allowOmittedFields Options
opts) Maybe () -> Maybe (Rec1 f a) -> Maybe (Rec1 f a)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (f a -> Rec1 f a) -> Maybe (f a) -> Maybe (Rec1 f a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> Rec1 f a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 (Maybe a -> Maybe (f a)
forall a. Maybe a -> Maybe (f a)
forall (f :: * -> *) a. FromJSON1 f => Maybe a -> Maybe (f a)
liftOmittedField Maybe a
o)) Options -> FromArgs One a -> Value -> Parser (Rec1 f a)
forall a. Options -> FromArgs One a -> Value -> Parser (Rec1 f a)
forall arity (f :: * -> *) a.
GFromJSON arity f =>
Options -> FromArgs arity a -> Value -> Parser (f a)
gParseJSON String :* (String :* (Options :* FromArgs One a))
args Object
obj
{-# INLINE recordParseJSON' #-}
instance {-# OVERLAPPING #-}
(Selector s, GFromJSON One Par1) =>
RecordFromJSON' One (S1 s Par1) where
recordParseJSON' :: forall a.
(String :* (String :* (Options :* FromArgs One a)))
-> Object -> Parser (S1 s Par1 a)
recordParseJSON' args :: String :* (String :* (Options :* FromArgs One a))
args@(String
_ :* String
_ :* Options
opts :* From1Args Maybe a
o Value -> Parser a
_ Value -> Parser [a]
_) Object
obj =
Maybe (Par1 a)
-> (Options -> FromArgs One a -> Value -> Parser (Par1 a))
-> (String :* (String :* (Options :* FromArgs One a)))
-> Object
-> Parser (M1 S s Par1 a)
forall (s :: Meta) arity a (f :: * -> *) i.
Selector s =>
Maybe (f a)
-> (Options -> FromArgs arity a -> Value -> Parser (f a))
-> (String :* (String :* (Options :* FromArgs arity a)))
-> Object
-> Parser (M1 i s f a)
recordParseJSONImpl (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Options -> Bool
allowOmittedFields Options
opts) Maybe () -> Maybe (Par1 a) -> Maybe (Par1 a)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> Par1 a) -> Maybe a -> Maybe (Par1 a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Par1 a
forall p. p -> Par1 p
Par1 Maybe a
o) Options -> FromArgs One a -> Value -> Parser (Par1 a)
forall a. Options -> FromArgs One a -> Value -> Parser (Par1 a)
forall arity (f :: * -> *) a.
GFromJSON arity f =>
Options -> FromArgs arity a -> Value -> Parser (f a)
gParseJSON String :* (String :* (Options :* FromArgs One a))
args Object
obj
{-# INLINE recordParseJSON' #-}
recordParseJSONImpl :: forall s arity a f i
. (Selector s)
=> Maybe (f a)
-> (Options -> FromArgs arity a -> Value -> Parser (f a))
-> (ConName :* TypeName :* Options :* FromArgs arity a)
-> Object -> Parser (M1 i s f a)
recordParseJSONImpl :: forall (s :: Meta) arity a (f :: * -> *) i.
Selector s =>
Maybe (f a)
-> (Options -> FromArgs arity a -> Value -> Parser (f a))
-> (String :* (String :* (Options :* FromArgs arity a)))
-> Object
-> Parser (M1 i s f a)
recordParseJSONImpl Maybe (f a)
mdef Options -> FromArgs arity a -> Value -> Parser (f a)
parseVal (String
cname :* String
tname :* Options
opts :* FromArgs arity a
fargs) Object
obj =
Maybe (M1 i s f a) -> Parser (M1 i s f a) -> Parser (M1 i s f a)
handleMissingKey (f a -> M1 i s f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 i s f a) -> Maybe (f a) -> Maybe (M1 i s f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f a)
mdef) (Parser (M1 i s f a) -> Parser (M1 i s f a))
-> Parser (M1 i s f a) -> Parser (M1 i s f a)
forall a b. (a -> b) -> a -> b
$ do
Value
fv <- String -> String -> Parser Value -> Parser Value
forall a. String -> String -> Parser a -> Parser a
contextCons String
cname String
tname (Object
obj Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
label)
f a -> M1 i s f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 i s f a) -> Parser (f a) -> Parser (M1 i s f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options -> FromArgs arity a -> Value -> Parser (f a)
parseVal Options
opts FromArgs arity a
fargs Value
fv Parser (f a) -> JSONPathElement -> Parser (f a)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
label
where
handleMissingKey :: Maybe (M1 i s f a) -> Parser (M1 i s f a) -> Parser (M1 i s f a)
handleMissingKey Maybe (M1 i s f a)
Nothing Parser (M1 i s f a)
p = Parser (M1 i s f a)
p
handleMissingKey (Just M1 i s f a
def) Parser (M1 i s f a)
p = if Key
label Key -> Object -> Bool
forall a. Key -> KeyMap a -> Bool
`KM.member` Object
obj then Parser (M1 i s f a)
p else M1 i s f a -> Parser (M1 i s f a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure M1 i s f a
def
label :: Key
label = String -> Key
Key.fromString (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ Options -> String -> String
fieldLabelModifier Options
opts String
sname
sname :: String
sname = M1 Any s Any Any -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t s f a -> String
selName (M1 _i s _f _p
forall {k} {_i} {_f :: k -> *} {_p :: k}. M1 _i s _f _p
forall a. HasCallStack => a
undefined :: M1 _i s _f _p)
{-# INLINE recordParseJSONImpl #-}
productParseJSON0
:: forall f arity a. (ProductFromJSON arity f, ProductSize f)
=> ConName :* TypeName :* Options :* FromArgs arity a
-> Value -> Parser (f a)
productParseJSON0 :: forall (f :: * -> *) arity a.
(ProductFromJSON arity f, ProductSize f) =>
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (f a)
productParseJSON0 p :: String :* (String :* (Options :* FromArgs arity a))
p@(String
cname :* String
tname :* Options
_ :* FromArgs arity a
_) =
String -> (Array -> Parser (f a)) -> Value -> Parser (f a)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray (String -> String -> String
showCons String
cname String
tname) ((Array -> Parser (f a)) -> Value -> Parser (f a))
-> (Array -> Parser (f a)) -> Value -> Parser (f a)
forall a b. (a -> b) -> a -> b
$ \Array
arr ->
let lenArray :: Int
lenArray = Array -> Int
forall a. Vector a -> Int
V.length Array
arr
lenProduct :: Int
lenProduct = (Tagged2 f Int -> Int
forall (s :: * -> *) b. Tagged2 s b -> b
unTagged2 :: Tagged2 f Int -> Int)
Tagged2 f Int
forall (f :: * -> *). ProductSize f => Tagged2 f Int
productSize in
if Int
lenArray Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lenProduct
then (String :* (String :* (Options :* FromArgs arity a)))
-> Array -> Int -> Int -> Parser (f a)
forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Array -> Int -> Int -> Parser (f a)
forall arity (f :: * -> *) a.
ProductFromJSON arity f =>
(String :* (String :* (Options :* FromArgs arity a)))
-> Array -> Int -> Int -> Parser (f a)
productParseJSON String :* (String :* (Options :* FromArgs arity a))
p Array
arr Int
0 Int
lenProduct
else String -> String -> Parser (f a) -> Parser (f a)
forall a. String -> String -> Parser a -> Parser a
contextCons String
cname String
tname (Parser (f a) -> Parser (f a)) -> Parser (f a) -> Parser (f a)
forall a b. (a -> b) -> a -> b
$
String -> Parser (f a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (f a)) -> String -> Parser (f a)
forall a b. (a -> b) -> a -> b
$ String
"expected an Array of length " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
lenProduct String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
", but encountered an Array of length " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
lenArray
class ProductFromJSON arity f where
productParseJSON :: ConName :* TypeName :* Options :* FromArgs arity a
-> Array -> Int -> Int
-> Parser (f a)
instance ( ProductFromJSON arity a
, ProductFromJSON arity b
) => ProductFromJSON arity (a :*: b) where
productParseJSON :: forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Array -> Int -> Int -> Parser ((:*:) a b a)
productParseJSON String :* (String :* (Options :* FromArgs arity a))
p Array
arr Int
ix Int
len =
a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (a a -> b a -> (:*:) a b a)
-> Parser (a a) -> Parser (b a -> (:*:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String :* (String :* (Options :* FromArgs arity a)))
-> Array -> Int -> Int -> Parser (a a)
forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Array -> Int -> Int -> Parser (a a)
forall arity (f :: * -> *) a.
ProductFromJSON arity f =>
(String :* (String :* (Options :* FromArgs arity a)))
-> Array -> Int -> Int -> Parser (f a)
productParseJSON String :* (String :* (Options :* FromArgs arity a))
p Array
arr Int
ix Int
lenL
Parser (b a -> (:*:) a b a) -> Parser (b a) -> Parser ((:*:) a b a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String :* (String :* (Options :* FromArgs arity a)))
-> Array -> Int -> Int -> Parser (b a)
forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Array -> Int -> Int -> Parser (b a)
forall arity (f :: * -> *) a.
ProductFromJSON arity f =>
(String :* (String :* (Options :* FromArgs arity a)))
-> Array -> Int -> Int -> Parser (f a)
productParseJSON String :* (String :* (Options :* FromArgs arity a))
p Array
arr Int
ixR Int
lenR
where
lenL :: Int
lenL = Int
len Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1
ixR :: Int
ixR = Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lenL
lenR :: Int
lenR = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lenL
instance (GFromJSON arity a) => ProductFromJSON arity (S1 s a) where
productParseJSON :: forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Array -> Int -> Int -> Parser (S1 s a a)
productParseJSON (String
_ :* String
_ :* Options
opts :* FromArgs arity a
fargs) Array
arr Int
ix Int
_ =
a a -> M1 S s a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> M1 S s a a) -> Parser (a a) -> Parser (M1 S s a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options -> FromArgs arity a -> Value -> Parser (a a)
forall a. Options -> FromArgs arity a -> Value -> Parser (a a)
forall arity (f :: * -> *) a.
GFromJSON arity f =>
Options -> FromArgs arity a -> Value -> Parser (f a)
gParseJSON Options
opts FromArgs arity a
fargs (Array -> Int -> Value
forall a. Vector a -> Int -> a
V.unsafeIndex Array
arr Int
ix) Parser (a a) -> JSONPathElement -> Parser (a a)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Int -> JSONPathElement
Index Int
ix
{-# INLINE productParseJSON #-}
class FromPair arity f where
parsePair :: Key :* TypeName :* Options :* FromArgs arity a
-> Value
-> Maybe (Parser (f a))
instance ( FromPair arity a
, FromPair arity b
) => FromPair arity (a :+: b) where
parsePair :: forall a.
(Key :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser ((:+:) a b a))
parsePair Key :* (String :* (Options :* FromArgs arity a))
p Value
pair =
((a a -> (:+:) a b a) -> Parser (a a) -> Parser ((:+:) a b a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (Parser (a a) -> Parser ((:+:) a b a))
-> Maybe (Parser (a a)) -> Maybe (Parser ((:+:) a b a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Key :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (a a))
forall a.
(Key :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (a a))
forall arity (f :: * -> *) a.
FromPair arity f =>
(Key :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (f a))
parsePair Key :* (String :* (Options :* FromArgs arity a))
p Value
pair) Maybe (Parser ((:+:) a b a))
-> Maybe (Parser ((:+:) a b a)) -> Maybe (Parser ((:+:) a b a))
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((b a -> (:+:) a b a) -> Parser (b a) -> Parser ((:+:) a b a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (Parser (b a) -> Parser ((:+:) a b a))
-> Maybe (Parser (b a)) -> Maybe (Parser ((:+:) a b a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Key :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (b a))
forall a.
(Key :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (b a))
forall arity (f :: * -> *) a.
FromPair arity f =>
(Key :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (f a))
parsePair Key :* (String :* (Options :* FromArgs arity a))
p Value
pair)
{-# INLINE parsePair #-}
instance ( Constructor c
, ConsFromJSON arity a
) => FromPair arity (C1 c a) where
parsePair :: forall a.
(Key :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (C1 c a a))
parsePair (Key
tag :* p :: String :* (Options :* FromArgs arity a)
p@(String
_ :* Options
opts :* FromArgs arity a
_)) Value
v
| Key
tag Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
tag' = Parser (C1 c a a) -> Maybe (Parser (C1 c a a))
forall a. a -> Maybe a
Just (Parser (C1 c a a) -> Maybe (Parser (C1 c a a)))
-> Parser (C1 c a a) -> Maybe (Parser (C1 c a a))
forall a b. (a -> b) -> a -> b
$ a a -> C1 c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> C1 c a a) -> Parser (a a) -> Parser (C1 c a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (a a)
forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (a a)
forall arity (f :: * -> *) a.
ConsFromJSON arity f =>
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (f a)
consParseJSON (String
cname String
-> (String :* (Options :* FromArgs arity a))
-> String :* (String :* (Options :* FromArgs arity a))
forall a b. a -> b -> a :* b
:* String :* (Options :* FromArgs arity a)
p) Value
v
| Bool
otherwise = Maybe (Parser (C1 c a a))
forall a. Maybe a
Nothing
where
tag' :: Key
tag' = String -> Key
Key.fromString (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ Options -> String -> String
constructorTagModifier Options
opts String
cname
cname :: String
cname = M1 Any c Any Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t c f a -> String
conName (M1 _i c _a _p
forall {k} {_i} {_a :: k -> *} {_p :: k}. M1 _i c _a _p
forall a. HasCallStack => a
undefined :: M1 _i c _a _p)
{-# INLINE parsePair #-}
class FromUntaggedValue arity f where
parseUntaggedValue :: TypeName :* Options :* FromArgs arity a
-> Value
-> Parser (f a)
instance
( FromUntaggedValue arity a
, FromUntaggedValue arity b
) => FromUntaggedValue arity (a :+: b)
where
parseUntaggedValue :: forall a.
(String :* (Options :* FromArgs arity a))
-> Value -> Parser ((:+:) a b a)
parseUntaggedValue String :* (Options :* FromArgs arity a)
p Value
value =
a a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (a a -> (:+:) a b a) -> Parser (a a) -> Parser ((:+:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String :* (Options :* FromArgs arity a)) -> Value -> Parser (a a)
forall a.
(String :* (Options :* FromArgs arity a)) -> Value -> Parser (a a)
forall arity (f :: * -> *) a.
FromUntaggedValue arity f =>
(String :* (Options :* FromArgs arity a)) -> Value -> Parser (f a)
parseUntaggedValue String :* (Options :* FromArgs arity a)
p Value
value Parser ((:+:) a b a)
-> Parser ((:+:) a b a) -> Parser ((:+:) a b a)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
b a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (b a -> (:+:) a b a) -> Parser (b a) -> Parser ((:+:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String :* (Options :* FromArgs arity a)) -> Value -> Parser (b a)
forall a.
(String :* (Options :* FromArgs arity a)) -> Value -> Parser (b a)
forall arity (f :: * -> *) a.
FromUntaggedValue arity f =>
(String :* (Options :* FromArgs arity a)) -> Value -> Parser (f a)
parseUntaggedValue String :* (Options :* FromArgs arity a)
p Value
value
{-# INLINE parseUntaggedValue #-}
instance {-# OVERLAPPABLE #-}
( ConsFromJSON arity a
, Constructor c
) => FromUntaggedValue arity (C1 c a)
where
parseUntaggedValue :: forall a.
(String :* (Options :* FromArgs arity a))
-> Value -> Parser (C1 c a a)
parseUntaggedValue String :* (Options :* FromArgs arity a)
p = (a a -> C1 c a a) -> Parser (a a) -> Parser (C1 c a a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a a -> C1 c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Parser (a a) -> Parser (C1 c a a))
-> (Value -> Parser (a a)) -> Value -> Parser (C1 c a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (a a)
forall a.
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (a a)
forall arity (f :: * -> *) a.
ConsFromJSON arity f =>
(String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (f a)
consParseJSON (String
cname String
-> (String :* (Options :* FromArgs arity a))
-> String :* (String :* (Options :* FromArgs arity a))
forall a b. a -> b -> a :* b
:* String :* (Options :* FromArgs arity a)
p)
where
cname :: String
cname = M1 Any c Any Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t c f a -> String
conName (M1 _i c _f _p
forall {k} {_i} {_f :: k -> *} {_p :: k}. M1 _i c _f _p
forall a. HasCallStack => a
undefined :: M1 _i c _f _p)
{-# INLINE parseUntaggedValue #-}
instance {-# OVERLAPPING #-}
( Constructor c )
=> FromUntaggedValue arity (C1 c U1)
where
parseUntaggedValue :: forall a.
(String :* (Options :* FromArgs arity a))
-> Value -> Parser (C1 c U1 a)
parseUntaggedValue (String
tname :* Options
opts :* FromArgs arity a
_) Value
v =
String -> String -> Parser (C1 c U1 a) -> Parser (C1 c U1 a)
forall a. String -> String -> Parser a -> Parser a
contextCons String
cname String
tname (Parser (C1 c U1 a) -> Parser (C1 c U1 a))
-> Parser (C1 c U1 a) -> Parser (C1 c U1 a)
forall a b. (a -> b) -> a -> b
$ case Value
v of
String Text
tag
| Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tag' -> C1 c U1 a -> Parser (C1 c U1 a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (C1 c U1 a -> Parser (C1 c U1 a))
-> C1 c U1 a -> Parser (C1 c U1 a)
forall a b. (a -> b) -> a -> b
$ U1 a -> C1 c U1 a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 U1 a
forall k (p :: k). U1 p
U1
| Bool
otherwise -> Text -> Parser (C1 c U1 a)
fail_ Text
tag
Value
_ -> String -> Value -> Parser (C1 c U1 a)
forall a. String -> Value -> Parser a
typeMismatch String
"String" Value
v
where
tag' :: Text
tag' = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Options -> String -> String
constructorTagModifier Options
opts String
cname
cname :: String
cname = M1 Any c Any Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t c f a -> String
conName (M1 _i c _f _p
forall {k} {_i} {_f :: k -> *} {_p :: k}. M1 _i c _f _p
forall a. HasCallStack => a
undefined :: M1 _i c _f _p)
fail_ :: Text -> Parser (C1 c U1 a)
fail_ Text
tag = String -> Parser (C1 c U1 a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (C1 c U1 a)) -> String -> Parser (C1 c U1 a)
forall a b. (a -> b) -> a -> b
$
String
"expected tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
tag' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but found tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
tag
{-# INLINE parseUntaggedValue #-}
instance FromJSON2 Const where
liftParseJSON2 :: forall a b.
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Maybe b
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (Const a b)
liftParseJSON2 Maybe a
_ Value -> Parser a
p Value -> Parser [a]
_ Maybe b
_ Value -> Parser b
_ Value -> Parser [b]
_ = (Value -> Parser a) -> Value -> Parser (Const a b)
forall a b. Coercible a b => a -> b
coerce Value -> Parser a
p
liftOmittedField2 :: forall a b. Maybe a -> Maybe b -> Maybe (Const a b)
liftOmittedField2 Maybe a
o Maybe b
_ = Maybe a -> Maybe (Const a b)
forall a b. Coercible a b => a -> b
coerce Maybe a
o
instance FromJSON a => FromJSON1 (Const a) where
liftParseJSON :: forall a.
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (Const a a)
liftParseJSON Maybe a
_ Value -> Parser a
_ Value -> Parser [a]
_ = (Value -> Parser a) -> Value -> Parser (Const a a)
forall a b. Coercible a b => a -> b
coerce (forall a. FromJSON a => Value -> Parser a
parseJSON @a)
liftOmittedField :: forall a. Maybe a -> Maybe (Const a a)
liftOmittedField Maybe a
_ = Maybe a -> Maybe (Const a a)
forall a b. Coercible a b => a -> b
coerce (forall a. FromJSON a => Maybe a
omittedField @a)
instance FromJSON a => FromJSON (Const a b) where
parseJSON :: Value -> Parser (Const a b)
parseJSON = (Value -> Parser a) -> Value -> Parser (Const a b)
forall a b. Coercible a b => a -> b
coerce (forall a. FromJSON a => Value -> Parser a
parseJSON @a)
omittedField :: Maybe (Const a b)
omittedField = Maybe a -> Maybe (Const a b)
forall a b. Coercible a b => a -> b
coerce (forall a. FromJSON a => Maybe a
omittedField @a)
instance (FromJSON a, FromJSONKey a) => FromJSONKey (Const a b) where
fromJSONKey :: FromJSONKeyFunction (Const a b)
fromJSONKey = FromJSONKeyFunction a -> FromJSONKeyFunction (Const a b)
forall a b. Coercible a b => a -> b
coerce (forall a. FromJSONKey a => FromJSONKeyFunction a
fromJSONKey @a)
instance FromJSON1 Maybe where
liftParseJSON :: forall a.
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (Maybe a)
liftParseJSON Maybe a
_ Value -> Parser a
_ Value -> Parser [a]
_ Value
Null = Maybe a -> Parser (Maybe a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
liftParseJSON Maybe a
_ Value -> Parser a
p Value -> Parser [a]
_ Value
a = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
p Value
a
liftOmittedField :: forall a. Maybe a -> Maybe (Maybe a)
liftOmittedField Maybe a
_ = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
instance (FromJSON a) => FromJSON (Maybe a) where
parseJSON :: Value -> Parser (Maybe a)
parseJSON = Value -> Parser (Maybe a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
omittedField :: Maybe (Maybe a)
omittedField = Maybe (Maybe a)
forall (f :: * -> *) a. (FromJSON1 f, FromJSON a) => Maybe (f a)
omittedField1
instance FromJSON2 Either where
liftParseJSON2 :: forall a b.
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Maybe b
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (Either a b)
liftParseJSON2 Maybe a
_ Value -> Parser a
pA Value -> Parser [a]
_ Maybe b
_ Value -> Parser b
pB Value -> Parser [b]
_ (Object (Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList -> [(Key
key, Value
value)]))
| Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
left = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Parser a -> Parser (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
pA Value
value Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
left
| Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
right = b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Parser b -> Parser (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser b
pB Value
value Parser b -> JSONPathElement -> Parser b
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
right
where
left, right :: Key
left :: Key
left = Key
"Left"
right :: Key
right = Key
"Right"
liftParseJSON2 Maybe a
_ Value -> Parser a
_ Value -> Parser [a]
_ Maybe b
_ Value -> Parser b
_ Value -> Parser [b]
_ Value
_ = String -> Parser (Either a b)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Either a b)) -> String -> Parser (Either a b)
forall a b. (a -> b) -> a -> b
$
String
"expected an object with a single property " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"where the property key should be either " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\"Left\" or \"Right\""
instance (FromJSON a) => FromJSON1 (Either a) where
liftParseJSON :: forall a.
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (Either a a)
liftParseJSON = Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (Either a a)
forall a b.
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Maybe b
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (Either a b)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Maybe b
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Maybe a
forall a. FromJSON a => Maybe a
omittedField Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [a]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
instance (FromJSON a, FromJSON b) => FromJSON (Either a b) where
parseJSON :: Value -> Parser (Either a b)
parseJSON = Value -> Parser (Either a b)
forall (f :: * -> * -> *) a b.
(FromJSON2 f, FromJSON a, FromJSON b) =>
Value -> Parser (f a b)
parseJSON2
instance FromJSON Void where
parseJSON :: Value -> Parser Void
parseJSON Value
_ = String -> Parser Void
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot parse Void"
instance FromJSONKey Void where
fromJSONKey :: FromJSONKeyFunction Void
fromJSONKey = (Text -> Parser Void) -> FromJSONKeyFunction Void
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Void) -> FromJSONKeyFunction Void)
-> (Text -> Parser Void) -> FromJSONKeyFunction Void
forall a b. (a -> b) -> a -> b
$ \Text
_ -> String -> Parser Void
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot parse Void"
instance FromJSON Bool where
parseJSON :: Value -> Parser Bool
parseJSON (Bool Bool
b) = Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
parseJSON Value
v = String -> Value -> Parser Bool
forall a. String -> Value -> Parser a
typeMismatch String
"Bool" Value
v
instance FromJSONKey Bool where
fromJSONKey :: FromJSONKeyFunction Bool
fromJSONKey = (Text -> Parser Bool) -> FromJSONKeyFunction Bool
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Bool) -> FromJSONKeyFunction Bool)
-> (Text -> Parser Bool) -> FromJSONKeyFunction Bool
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
Text
"true" -> Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Text
"false" -> Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Text
_ -> String -> Parser Bool
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Bool) -> String -> Parser Bool
forall a b. (a -> b) -> a -> b
$ String
"cannot parse key " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" into Bool"
instance FromJSON Ordering where
parseJSON :: Value -> Parser Ordering
parseJSON = String -> (Text -> Parser Ordering) -> Value -> Parser Ordering
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Ordering" ((Text -> Parser Ordering) -> Value -> Parser Ordering)
-> (Text -> Parser Ordering) -> Value -> Parser Ordering
forall a b. (a -> b) -> a -> b
$ \Text
s ->
case Text
s of
Text
"LT" -> Ordering -> Parser Ordering
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
LT
Text
"EQ" -> Ordering -> Parser Ordering
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
EQ
Text
"GT" -> Ordering -> Parser Ordering
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
GT
Text
_ -> String -> Parser Ordering
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Ordering) -> String -> Parser Ordering
forall a b. (a -> b) -> a -> b
$ String
"parsing Ordering failed, unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
s String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" (expected \"LT\", \"EQ\", or \"GT\")"
instance FromJSON () where
parseJSON :: Value -> Parser ()
parseJSON Value
_ = () -> Parser ()
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
omittedField :: Maybe ()
omittedField = () -> Maybe ()
forall a. a -> Maybe a
Just ()
instance FromJSON Char where
parseJSON :: Value -> Parser Char
parseJSON = String -> (Text -> Parser Char) -> Value -> Parser Char
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Char" Text -> Parser Char
parseChar
parseJSONList :: Value -> Parser String
parseJSONList (String Text
s) = String -> Parser String
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> String
T.unpack Text
s)
parseJSONList Value
v = String -> Value -> Parser String
forall a. String -> Value -> Parser a
typeMismatch String
"String" Value
v
parseChar :: Text -> Parser Char
parseChar :: Text -> Parser Char
parseChar Text
t =
if Text -> Int -> Ordering
T.compareLength Text
t Int
1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
then Char -> Parser Char
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Parser Char) -> Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
T.head Text
t
else String -> Parser Char -> Parser Char
forall a. String -> Parser a -> Parser a
prependContext String
"Char" (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ String -> Parser Char
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected a string of length 1"
instance FromJSON Double where
parseJSON :: Value -> Parser Double
parseJSON = String -> Value -> Parser Double
forall a. RealFloat a => String -> Value -> Parser a
parseRealFloat String
"Double"
instance FromJSONKey Double where
fromJSONKey :: FromJSONKeyFunction Double
fromJSONKey = (Text -> Parser Double) -> FromJSONKeyFunction Double
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Double) -> FromJSONKeyFunction Double)
-> (Text -> Parser Double) -> FromJSONKeyFunction Double
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
Text
"NaN" -> Double -> Parser Double
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0)
Text
"+inf" -> Double -> Parser Double
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0)
Text
"-inf" -> Double -> Parser Double
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Double
forall a. Num a => a -> a
negate Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0)
Text
_ -> Scientific -> Double
forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat (Scientific -> Double) -> Parser Scientific -> Parser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser Scientific
parseScientificText Text
t
instance FromJSON Float where
parseJSON :: Value -> Parser Float
parseJSON = String -> Value -> Parser Float
forall a. RealFloat a => String -> Value -> Parser a
parseRealFloat String
"Float"
instance FromJSONKey Float where
fromJSONKey :: FromJSONKeyFunction Float
fromJSONKey = (Text -> Parser Float) -> FromJSONKeyFunction Float
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Float) -> FromJSONKeyFunction Float)
-> (Text -> Parser Float) -> FromJSONKeyFunction Float
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
Text
"NaN" -> Float -> Parser Float
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float
0Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0)
Text
"+inf" -> Float -> Parser Float
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0)
Text
"-inf" -> Float -> Parser Float
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float -> Float
forall a. Num a => a -> a
negate Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0)
Text
_ -> Scientific -> Float
forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat (Scientific -> Float) -> Parser Scientific -> Parser Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser Scientific
parseScientificText Text
t
instance (FromJSON a, Integral a) => FromJSON (Ratio a) where
parseJSON :: Value -> Parser (Ratio a)
parseJSON (Number Scientific
x)
| Int
exp10 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1024
, Int
exp10 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= -Int
1024 = Ratio a -> Parser (Ratio a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ratio a -> Parser (Ratio a)) -> Ratio a -> Parser (Ratio a)
forall a b. (a -> b) -> a -> b
$! Scientific -> Ratio a
forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
x
| Bool
otherwise = String -> Parser (Ratio a) -> Parser (Ratio a)
forall a. String -> Parser a -> Parser a
prependContext String
"Ratio" (Parser (Ratio a) -> Parser (Ratio a))
-> Parser (Ratio a) -> Parser (Ratio a)
forall a b. (a -> b) -> a -> b
$ String -> Parser (Ratio a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
where
exp10 :: Int
exp10 = Scientific -> Int
base10Exponent Scientific
x
msg :: String
msg = String
"found a number with exponent " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
exp10
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but it must not be greater than 1024 or less than -1024"
parseJSON Value
o = Value -> Parser (Ratio a)
objParser Value
o
where
objParser :: Value -> Parser (Ratio a)
objParser = String -> (Object -> Parser (Ratio a)) -> Value -> Parser (Ratio a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Rational" ((Object -> Parser (Ratio a)) -> Value -> Parser (Ratio a))
-> (Object -> Parser (Ratio a)) -> Value -> Parser (Ratio a)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
a
numerator <- Object
obj Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"numerator"
a
denominator <- Object
obj Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"denominator"
if a
denominator a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
then String -> Parser (Ratio a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Ratio denominator was 0"
else Ratio a -> Parser (Ratio a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ratio a -> Parser (Ratio a)) -> Ratio a -> Parser (Ratio a)
forall a b. (a -> b) -> a -> b
$ a
numerator a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% a
denominator
instance HasResolution a => FromJSON (Fixed a) where
parseJSON :: Value -> Parser (Fixed a)
parseJSON = String -> Parser (Fixed a) -> Parser (Fixed a)
forall a. String -> Parser a -> Parser a
prependContext String
"Fixed" (Parser (Fixed a) -> Parser (Fixed a))
-> (Value -> Parser (Fixed a)) -> Value -> Parser (Fixed a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scientific -> Parser (Fixed a)) -> Value -> Parser (Fixed a)
forall a. (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific' (Fixed a -> Parser (Fixed a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fixed a -> Parser (Fixed a))
-> (Scientific -> Fixed a) -> Scientific -> Parser (Fixed a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Fixed a
forall a b. (Real a, Fractional b) => a -> b
realToFrac)
instance FromJSON Int where
parseJSON :: Value -> Parser Int
parseJSON = String -> Value -> Parser Int
forall a. (Bounded a, Integral a) => String -> Value -> Parser a
parseBoundedIntegral String
"Int"
instance FromJSONKey Int where
fromJSONKey :: FromJSONKeyFunction Int
fromJSONKey = (Text -> Parser Int) -> FromJSONKeyFunction Int
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Int) -> FromJSONKeyFunction Int)
-> (Text -> Parser Int) -> FromJSONKeyFunction Int
forall a b. (a -> b) -> a -> b
$ String -> Text -> Parser Int
forall a. (Bounded a, Integral a) => String -> Text -> Parser a
parseBoundedIntegralText String
"Int"
instance FromJSON Integer where
parseJSON :: Value -> Parser Integer
parseJSON = String -> Value -> Parser Integer
forall a. Integral a => String -> Value -> Parser a
parseIntegral String
"Integer"
instance FromJSONKey Integer where
fromJSONKey :: FromJSONKeyFunction Integer
fromJSONKey = (Text -> Parser Integer) -> FromJSONKeyFunction Integer
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Integer) -> FromJSONKeyFunction Integer)
-> (Text -> Parser Integer) -> FromJSONKeyFunction Integer
forall a b. (a -> b) -> a -> b
$ String -> Text -> Parser Integer
forall a. Integral a => String -> Text -> Parser a
parseIntegralText String
"Integer"
instance FromJSON Natural where
parseJSON :: Value -> Parser Natural
parseJSON Value
value = do
Integer
integer <- String -> Value -> Parser Integer
forall a. Integral a => String -> Value -> Parser a
parseIntegral String
"Natural" Value
value
Integer -> Parser Natural
parseNatural Integer
integer
instance FromJSONKey Natural where
fromJSONKey :: FromJSONKeyFunction Natural
fromJSONKey = (Text -> Parser Natural) -> FromJSONKeyFunction Natural
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Natural) -> FromJSONKeyFunction Natural)
-> (Text -> Parser Natural) -> FromJSONKeyFunction Natural
forall a b. (a -> b) -> a -> b
$ \Text
text -> do
Integer
integer <- String -> Text -> Parser Integer
forall a. Integral a => String -> Text -> Parser a
parseIntegralText String
"Natural" Text
text
Integer -> Parser Natural
parseNatural Integer
integer
parseNatural :: Integer -> Parser Natural
parseNatural :: Integer -> Parser Natural
parseNatural Integer
integer =
if Integer
integer Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then
String -> Parser Natural
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Natural) -> String -> Parser Natural
forall a b. (a -> b) -> a -> b
$ String
"parsing Natural failed, unexpected negative number " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
integer
else
Natural -> Parser Natural
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Parser Natural) -> Natural -> Parser Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
integer
instance FromJSON Int8 where
parseJSON :: Value -> Parser Int8
parseJSON = String -> Value -> Parser Int8
forall a. (Bounded a, Integral a) => String -> Value -> Parser a
parseBoundedIntegral String
"Int8"
instance FromJSONKey Int8 where
fromJSONKey :: FromJSONKeyFunction Int8
fromJSONKey = (Text -> Parser Int8) -> FromJSONKeyFunction Int8
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Int8) -> FromJSONKeyFunction Int8)
-> (Text -> Parser Int8) -> FromJSONKeyFunction Int8
forall a b. (a -> b) -> a -> b
$ String -> Text -> Parser Int8
forall a. (Bounded a, Integral a) => String -> Text -> Parser a
parseBoundedIntegralText String
"Int8"
instance FromJSON Int16 where
parseJSON :: Value -> Parser Int16
parseJSON = String -> Value -> Parser Int16
forall a. (Bounded a, Integral a) => String -> Value -> Parser a
parseBoundedIntegral String
"Int16"
instance FromJSONKey Int16 where
fromJSONKey :: FromJSONKeyFunction Int16
fromJSONKey = (Text -> Parser Int16) -> FromJSONKeyFunction Int16
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Int16) -> FromJSONKeyFunction Int16)
-> (Text -> Parser Int16) -> FromJSONKeyFunction Int16
forall a b. (a -> b) -> a -> b
$ String -> Text -> Parser Int16
forall a. (Bounded a, Integral a) => String -> Text -> Parser a
parseBoundedIntegralText String
"Int16"
instance FromJSON Int32 where
parseJSON :: Value -> Parser Int32
parseJSON = String -> Value -> Parser Int32
forall a. (Bounded a, Integral a) => String -> Value -> Parser a
parseBoundedIntegral String
"Int32"
instance FromJSONKey Int32 where
fromJSONKey :: FromJSONKeyFunction Int32
fromJSONKey = (Text -> Parser Int32) -> FromJSONKeyFunction Int32
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Int32) -> FromJSONKeyFunction Int32)
-> (Text -> Parser Int32) -> FromJSONKeyFunction Int32
forall a b. (a -> b) -> a -> b
$ String -> Text -> Parser Int32
forall a. (Bounded a, Integral a) => String -> Text -> Parser a
parseBoundedIntegralText String
"Int32"
instance FromJSON Int64 where
parseJSON :: Value -> Parser Int64
parseJSON = String -> Value -> Parser Int64
forall a. (Bounded a, Integral a) => String -> Value -> Parser a
parseBoundedIntegral String
"Int64"
instance FromJSONKey Int64 where
fromJSONKey :: FromJSONKeyFunction Int64
fromJSONKey = (Text -> Parser Int64) -> FromJSONKeyFunction Int64
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Int64) -> FromJSONKeyFunction Int64)
-> (Text -> Parser Int64) -> FromJSONKeyFunction Int64
forall a b. (a -> b) -> a -> b
$ String -> Text -> Parser Int64
forall a. (Bounded a, Integral a) => String -> Text -> Parser a
parseBoundedIntegralText String
"Int64"
instance FromJSON Word where
parseJSON :: Value -> Parser Word
parseJSON = String -> Value -> Parser Word
forall a. (Bounded a, Integral a) => String -> Value -> Parser a
parseBoundedIntegral String
"Word"
instance FromJSONKey Word where
fromJSONKey :: FromJSONKeyFunction Word
fromJSONKey = (Text -> Parser Word) -> FromJSONKeyFunction Word
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Word) -> FromJSONKeyFunction Word)
-> (Text -> Parser Word) -> FromJSONKeyFunction Word
forall a b. (a -> b) -> a -> b
$ String -> Text -> Parser Word
forall a. (Bounded a, Integral a) => String -> Text -> Parser a
parseBoundedIntegralText String
"Word"
instance FromJSON Word8 where
parseJSON :: Value -> Parser Word8
parseJSON = String -> Value -> Parser Word8
forall a. (Bounded a, Integral a) => String -> Value -> Parser a
parseBoundedIntegral String
"Word8"
instance FromJSONKey Word8 where
fromJSONKey :: FromJSONKeyFunction Word8
fromJSONKey = (Text -> Parser Word8) -> FromJSONKeyFunction Word8
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Word8) -> FromJSONKeyFunction Word8)
-> (Text -> Parser Word8) -> FromJSONKeyFunction Word8
forall a b. (a -> b) -> a -> b
$ String -> Text -> Parser Word8
forall a. (Bounded a, Integral a) => String -> Text -> Parser a
parseBoundedIntegralText String
"Word8"
instance FromJSON Word16 where
parseJSON :: Value -> Parser Word16
parseJSON = String -> Value -> Parser Word16
forall a. (Bounded a, Integral a) => String -> Value -> Parser a
parseBoundedIntegral String
"Word16"
instance FromJSONKey Word16 where
fromJSONKey :: FromJSONKeyFunction Word16
fromJSONKey = (Text -> Parser Word16) -> FromJSONKeyFunction Word16
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Word16) -> FromJSONKeyFunction Word16)
-> (Text -> Parser Word16) -> FromJSONKeyFunction Word16
forall a b. (a -> b) -> a -> b
$ String -> Text -> Parser Word16
forall a. (Bounded a, Integral a) => String -> Text -> Parser a
parseBoundedIntegralText String
"Word16"
instance FromJSON Word32 where
parseJSON :: Value -> Parser Word32
parseJSON = String -> Value -> Parser Word32
forall a. (Bounded a, Integral a) => String -> Value -> Parser a
parseBoundedIntegral String
"Word32"
instance FromJSONKey Word32 where
fromJSONKey :: FromJSONKeyFunction Word32
fromJSONKey = (Text -> Parser Word32) -> FromJSONKeyFunction Word32
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Word32) -> FromJSONKeyFunction Word32)
-> (Text -> Parser Word32) -> FromJSONKeyFunction Word32
forall a b. (a -> b) -> a -> b
$ String -> Text -> Parser Word32
forall a. (Bounded a, Integral a) => String -> Text -> Parser a
parseBoundedIntegralText String
"Word32"
instance FromJSON Word64 where
parseJSON :: Value -> Parser Word64
parseJSON = String -> Value -> Parser Word64
forall a. (Bounded a, Integral a) => String -> Value -> Parser a
parseBoundedIntegral String
"Word64"
instance FromJSONKey Word64 where
fromJSONKey :: FromJSONKeyFunction Word64
fromJSONKey = (Text -> Parser Word64) -> FromJSONKeyFunction Word64
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Word64) -> FromJSONKeyFunction Word64)
-> (Text -> Parser Word64) -> FromJSONKeyFunction Word64
forall a b. (a -> b) -> a -> b
$ String -> Text -> Parser Word64
forall a. (Bounded a, Integral a) => String -> Text -> Parser a
parseBoundedIntegralText String
"Word64"
instance FromJSON CTime where
parseJSON :: Value -> Parser CTime
parseJSON = (Int64 -> CTime) -> Parser Int64 -> Parser CTime
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b