{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif

#include "incoherent-compat.h"
#include "overlapping-compat.h"

-- TODO: Drop this when we remove support for Data.Attoparsec.Number
{-# OPTIONS_GHC -fno-warn-deprecations #-}

module Data.Aeson.Types.FromJSON
    (
    -- * Core JSON classes
      FromJSON(..)
    -- * Liftings to unary and binary type constructors
    , FromJSON1(..)
    , parseJSON1
    , FromJSON2(..)
    , parseJSON2
    -- * Generic JSON classes
    , GFromJSON(..)
    , FromArgs(..)
    , genericParseJSON
    , genericLiftParseJSON
    -- * Classes and types for map keys
    , FromJSONKey(..)
    , FromJSONKeyFunction(..)
    , fromJSONKeyCoerce
    , coerceFromJSONKeyFunction
    , mapFromJSONKeyFunction

    , GFromJSONKey()
    , genericFromJSONKey

    -- * List functions
    , listParser

    -- * Inspecting @'Value's@
    , withObject
    , withText
    , withArray
    , withScientific
    , withBool
    , withEmbeddedJSON

    -- * Functions
    , fromJSON
    , ifromJSON
    , typeMismatch
    , unexpected
    , parseField
    , parseFieldMaybe
    , parseFieldMaybe'
    , explicitParseField
    , explicitParseFieldMaybe
    , explicitParseFieldMaybe'
    , parseIndexedJSON
    -- ** Operators
    , (.:)
    , (.:?)
    , (.:!)
    , (.!=)

    -- * Internal
    , parseOptionalFieldWith
    ) where

import Prelude.Compat

import Control.Applicative ((<|>), Const(..), liftA2)
import Control.Monad (zipWithM)
import Data.Aeson.Internal.Functions (mapKey)
import Data.Aeson.Parser.Internal (eitherDecodeWith, jsonEOF)
import Data.Aeson.Types.Generic
import Data.Aeson.Types.Internal
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.Hashable (Hashable(..))
import Data.Int (Int16, Int32, Int64, Int8)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (fromMaybe)
import Data.Semigroup ((<>))
import Data.Proxy (Proxy(..))
import Data.Ratio ((%), Ratio)
import Data.Scientific (Scientific, base10Exponent)
import Data.Tagged (Tagged(..))
import Data.Text (Text, pack, unpack)
import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))
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.Vector (Vector)
import Data.Version (Version, parseVersion)
import Data.Void (Void)
import Data.Word (Word16, Word32, Word64, Word8)
import Foreign.Storable (Storable)
import Foreign.C.Types (CTime (..))
import GHC.Generics
import Numeric.Natural (Natural)
import Text.ParserCombinators.ReadP (readP_to_S)
import Unsafe.Coerce (unsafeCoerce)
import qualified Data.Aeson.Compat as Compat
import qualified Data.Aeson.Parser.Time as Time
import qualified Data.Attoparsec.ByteString.Char8 as A (endOfInput, parseOnly, scientific)
import qualified Data.DList as DList
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.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as LT
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 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

#if MIN_VERSION_primitive(0,6,4)
#if !MIN_VERSION_primitive(0,7,0)
import qualified Data.Primitive.UnliftedArray as PM
#endif
import qualified Data.Primitive.PrimArray as PM
#endif

#ifndef HAS_COERCIBLE
#define HAS_COERCIBLE (__GLASGOW_HASKELL__ >= 707)
#endif

#if HAS_COERCIBLE
import Data.Coerce (Coercible, coerce)
coerce' :: Coercible a b => a -> b
coerce' :: a -> b
coerce' = a -> b
forall a b. Coercible a b => a -> b
coerce
#else
coerce' :: a -> b
coerce' = unsafeCoerce
#endif

parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a
parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a
parseIndexedJSON p :: Value -> Parser a
p idx :: Int
idx value :: 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
{-# INLINE parseIndexedJSON #-}

parseIndexedJSONPair :: (Value -> Parser a) -> (Value -> Parser b) -> Int -> Value -> Parser (a, b)
parseIndexedJSONPair :: (Value -> Parser a)
-> (Value -> Parser b) -> Int -> Value -> Parser (a, b)
parseIndexedJSONPair keyParser :: Value -> Parser a
keyParser valParser :: Value -> Parser b
valParser idx :: Int
idx value :: 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 "(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
$ \ab :: 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
== 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 0 Array
ab
                      Parser (b -> (a, b)) -> Parser b -> Parser (a, 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 1 Array
ab
             else String -> Parser (a, b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a, b)) -> String -> Parser (a, b)
forall a b. (a -> b) -> a -> b
$ "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]
++ " into a pair"
{-# INLINE parseIndexedJSONPair #-}

parseJSONElemAtIndex :: (Value -> Parser a) -> Int -> V.Vector Value -> Parser a
parseJSONElemAtIndex :: (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex p :: Value -> Parser a
p idx :: Int
idx ary :: 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 :: String -> Value -> Parser a
parseRealFloat _    (Number s :: Scientific
s) = 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 _    Null       = a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (0a -> a -> a
forall a. Fractional a => a -> a -> a
/0)
parseRealFloat name :: String
name v :: 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)
{-# INLINE parseRealFloat #-}

parseIntegralFromScientific :: forall a. Integral a => Scientific -> Parser a
parseIntegralFromScientific :: Scientific -> Parser a
parseIntegralFromScientific s :: 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 x :: a
x -> a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
        Left _  -> 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
$ "unexpected floating number " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show Scientific
s
{-# INLINE parseIntegralFromScientific #-}

parseIntegral :: Integral a => String -> Value -> Parser a
parseIntegral :: String -> Value -> Parser a
parseIntegral name :: 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
{-# INLINE parseIntegral #-}

parseBoundedIntegralFromScientific :: (Bounded a, Integral a) => Scientific -> Parser a
parseBoundedIntegralFromScientific :: Scientific -> Parser a
parseBoundedIntegralFromScientific s :: 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 (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ "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 (f :: * -> *) a. Applicative f => a -> f a
pure
    (Scientific -> Maybe a
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Scientific.toBoundedInteger Scientific
s)
{-# INLINE parseBoundedIntegralFromScientific #-}

parseBoundedIntegral :: (Bounded a, Integral a) => String -> Value -> Parser a
parseBoundedIntegral :: String -> Value -> Parser a
parseBoundedIntegral name :: 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
{-# INLINE parseBoundedIntegral #-}

parseScientificText :: Text -> Parser Scientific
parseScientificText :: Text -> Parser Scientific
parseScientificText
    = (String -> Parser Scientific)
-> (Scientific -> Parser Scientific)
-> Either String Scientific
-> Parser Scientific
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser Scientific
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Scientific -> Parser Scientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Either String Scientific -> Parser Scientific)
-> (Text -> Either String Scientific) -> Text -> Parser Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Scientific -> ByteString -> Either String Scientific
forall a. Parser a -> ByteString -> Either String a
A.parseOnly (Parser Scientific
A.scientific Parser Scientific -> Parser ByteString () -> Parser Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput)
    (ByteString -> Either String Scientific)
-> (Text -> ByteString) -> Text -> Either String Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

parseIntegralText :: Integral a => String -> Text -> Parser a
parseIntegralText :: String -> Text -> Parser a
parseIntegralText name :: String
name t :: 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Scientific -> Parser Scientific
rejectLargeExponent
        Parser Scientific -> (Scientific -> Parser a) -> Parser a
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 s :: Scientific
s = (Scientific -> Parser Scientific) -> Value -> Parser Scientific
forall a. (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific' Scientific -> Parser Scientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> Value
Number Scientific
s)
{-# INLINE parseIntegralText #-}

parseBoundedIntegralText :: (Bounded a, Integral a) => String -> Text -> Parser a
parseBoundedIntegralText :: String -> Text -> Parser a
parseBoundedIntegralText name :: String
name t :: 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 (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 -> Text -> Parser (Maybe a)
parseOptionalFieldWith :: (Value -> Parser (Maybe a)) -> Object -> Text -> Parser (Maybe a)
parseOptionalFieldWith pj :: Value -> Parser (Maybe a)
pj obj :: Object
obj key :: Text
key =
    case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
key Object
obj of
     Nothing -> Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
     Just v :: Value
v  -> Value -> Parser (Maybe a)
pj Value
v Parser (Maybe a) -> JSONPathElement -> Parser (Maybe a)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Text -> JSONPathElement
Key Text
key
{-# INLINE parseOptionalFieldWith #-}

-------------------------------------------------------------------------------
-- Generics
-------------------------------------------------------------------------------

-- | Class of generic representation types that can be converted from JSON.
class GFromJSON arity f where
    -- | This method (applied to 'defaultOptions') is used as the
    -- default generic implementation of 'parseJSON' (if the @arity@ is 'Zero')
    -- or 'liftParseJSON' (if the @arity@ is 'One').
    gParseJSON :: Options -> FromArgs arity a -> Value -> Parser (f a)

-- | A 'FromArgs' value either stores nothing (for 'FromJSON') or it stores the
-- two function arguments that decode occurrences of the type parameter (for
-- 'FromJSON1').
data FromArgs arity a where
    NoFromArgs :: FromArgs Zero a
    From1Args  :: (Value -> Parser a) -> (Value -> Parser [a]) -> FromArgs One a

-- | A configurable generic JSON decoder. This function applied to
-- 'defaultOptions' is used as the default for 'parseJSON' when the
-- type is an instance of 'Generic'.
genericParseJSON :: (Generic a, GFromJSON Zero (Rep a))
                 => Options -> Value -> Parser a
genericParseJSON :: Options -> Value -> Parser a
genericParseJSON opts :: Options
opts = (Rep a Any -> a) -> Parser (Rep a Any) -> Parser a
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
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 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

-- | A configurable generic JSON decoder. This function applied to
-- 'defaultOptions' is used as the default for 'liftParseJSON' when the
-- type is an instance of 'Generic1'.
genericLiftParseJSON :: (Generic1 f, GFromJSON One (Rep1 f))
                     => Options -> (Value -> Parser a) -> (Value -> Parser [a])
                     -> Value -> Parser (f a)
genericLiftParseJSON :: Options
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
genericLiftParseJSON opts :: Options
opts pj :: Value -> Parser a
pj pjl :: Value -> Parser [a]
pjl = (Rep1 f a -> f a) -> Parser (Rep1 f a) -> Parser (f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 arity (f :: * -> *) a.
GFromJSON arity f =>
Options -> FromArgs arity a -> Value -> Parser (f a)
gParseJSON Options
opts ((Value -> Parser a) -> (Value -> Parser [a]) -> FromArgs One a
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromArgs One a
From1Args Value -> Parser a
pj Value -> Parser [a]
pjl)

-------------------------------------------------------------------------------
-- Class
-------------------------------------------------------------------------------

-- | A type that can be converted from JSON, with the possibility of
-- failure.
--
-- In many cases, you can get the compiler to generate parsing code
-- for you (see below).  To begin, let's cover writing an instance by
-- hand.
--
-- There are various reasons a conversion could fail.  For example, an
-- 'Object' could be missing a required key, an 'Array' could be of
-- the wrong size, or a value could be of an incompatible type.
--
-- The basic ways to signal a failed conversion are as follows:
--
-- * 'fail' yields a custom error message: it is the recommended way of
-- reporting a failure;
--
-- * 'Control.Applicative.empty' (or 'Control.Monad.mzero') is uninformative:
-- use it when the error is meant to be caught by some @('<|>')@;
--
-- * 'typeMismatch' can be used to report a failure when the encountered value
-- is not of the expected JSON type; 'unexpected' is an appropriate alternative
-- when more than one type may be expected, or to keep the expected type
-- implicit.
--
-- 'prependFailure' (or 'modifyFailure') add more information to a parser's
-- error messages.
--
-- An example type and instance using 'typeMismatch' and 'prependFailure':
--
-- @
-- \-- Allow ourselves to write 'Text' literals.
-- {-\# LANGUAGE OverloadedStrings #-}
--
-- data Coord = Coord { x :: Double, y :: Double }
--
-- instance 'FromJSON' Coord where
--     'parseJSON' ('Object' v) = Coord
--         '<$>' v '.:' \"x\"
--         '<*>' v '.:' \"y\"
--
--     \-- We do not expect a non-'Object' value here.
--     \-- We could use 'Control.Applicative.empty' to fail, but 'typeMismatch'
--     \-- gives a much more informative error message.
--     'parseJSON' invalid    =
--         'prependFailure' "parsing Coord failed, "
--             ('typeMismatch' \"Object\" invalid)
-- @
--
-- For this common case of only being concerned with a single
-- type of JSON value, the functions 'withObject', 'withScientific', etc.
-- are provided. Their use is to be preferred when possible, since
-- they are more terse. Using 'withObject', we can rewrite the above instance
-- (assuming the same language extension and data type) as:
--
-- @
-- instance 'FromJSON' Coord where
--     'parseJSON' = 'withObject' \"Coord\" $ \\v -> Coord
--         '<$>' v '.:' \"x\"
--         '<*>' v '.:' \"y\"
-- @
--
-- Instead of manually writing your 'FromJSON' instance, there are two options
-- to do it automatically:
--
-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
-- instance at compile time. The generated instance is optimized for your type
-- so it will probably be more efficient than the following option.
--
-- * The compiler can provide a default generic implementation for
-- 'parseJSON'.
--
-- To use the second, simply add a @deriving 'Generic'@ clause to your
-- datatype and declare a 'FromJSON' instance for your datatype without giving
-- a definition for 'parseJSON'.
--
-- For example, the previous example can be simplified to just:
--
-- @
-- {-\# LANGUAGE DeriveGeneric \#-}
--
-- import "GHC.Generics"
--
-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
--
-- instance 'FromJSON' Coord
-- @
--
-- The default implementation will be equivalent to
-- @parseJSON = 'genericParseJSON' 'defaultOptions'@; if you need different
-- options, you can customize the generic decoding by defining:
--
-- @
-- customOptions = 'defaultOptions'
--                 { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
--                 }
--
-- instance 'FromJSON' Coord where
--     'parseJSON' = 'genericParseJSON' customOptions
-- @
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 "[]" ((Array -> Parser [a]) -> Value -> Parser [a])
-> (Array -> Parser [a]) -> Value -> Parser [a]
forall a b. (a -> b) -> a -> b
$ \a :: 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) [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

-------------------------------------------------------------------------------
--  Classes and types for map keys
-------------------------------------------------------------------------------

-- | Read the docs for 'ToJSONKey' first. This class is a conversion
--   in the opposite direction. If you have a newtype wrapper around 'Text',
--   the recommended way to define instances is with generalized newtype deriving:
--
--   > newtype SomeId = SomeId { getSomeId :: Text }
--   >   deriving (Eq,Ord,Hashable,FromJSONKey)
--
--   If you have a sum of nullary constructors, you may use the generic
--   implementation:
--
-- @
-- data Color = Red | Green | Blue
--   deriving Generic
--
-- instance 'FromJSONKey' Color where
--   'fromJSONKey' = 'genericFromJSONKey' 'defaultJSONKeyOptions'
-- @
class FromJSONKey a where
    -- | Strategy for parsing the key of a map-like container.
    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

    -- | This is similar in spirit to the 'readList' method of 'Read'.
    --   It makes it possible to give 'String' keys special treatment
    --   without using @OverlappingInstances@. End users should always
    --   be able to use the default implementation of this method.
    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

-- | With GHC 7.8+ we carry around @'Coercible' 'Text' a@ dictionary,
-- to give us an assurance that the program will not segfault.
-- Unfortunately we cannot enforce that the 'Eq' instances or the
-- 'Hashable' instances for 'Text' and @a@ agree.
--
-- At the moment this type is intentionally not exported. 'FromJSONKeyFunction'
-- can be inspected, but cannot be constructed.
data CoerceText a where
#if HAS_COERCIBLE
    CoerceText :: Coercible Text a => CoerceText a
#else
    CoerceText :: CoerceText a
#endif

-- | This type is related to 'ToJSONKeyFunction'. If 'FromJSONKeyValue' is used in the
--   'FromJSONKey' instance, then 'ToJSONKeyValue' should be used in the 'ToJSONKey'
--   instance. The other three data constructors for this type all correspond to
--   'ToJSONKeyText'. Strictly speaking, 'FromJSONKeyTextParser' is more powerful than
--   'FromJSONKeyText', which is in turn more powerful than 'FromJSONKeyCoerce'.
--   For performance reasons, these exist as three options instead of one.
data FromJSONKeyFunction a
    = FromJSONKeyCoerce !(CoerceText a)
      -- ^ uses 'coerce' ('unsafeCoerce' in older GHCs)
    | FromJSONKeyText !(Text -> a)
      -- ^ conversion from 'Text' that always succeeds
    | FromJSONKeyTextParser !(Text -> Parser a)
      -- ^ conversion from 'Text' that may fail
    | FromJSONKeyValue !(Value -> Parser a)
      -- ^ conversion for non-textual keys

-- | Only law abiding up to interpretation
instance Functor FromJSONKeyFunction where
    fmap :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
fmap h :: a -> b
h (FromJSONKeyCoerce CoerceText) = (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 h :: a -> b
h (FromJSONKeyText f :: 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 h :: a -> b
h (FromJSONKeyTextParser f :: Text -> Parser a
f)      = (Text -> Parser b) -> FromJSONKeyFunction b
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((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 h :: a -> b
h (FromJSONKeyValue f :: Value -> Parser a
f)           = (Value -> Parser b) -> FromJSONKeyFunction b
forall a. (Value -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyValue ((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)

-- | Construct 'FromJSONKeyFunction' for types coercible from 'Text'. This
-- conversion is still unsafe, as 'Hashable' and 'Eq' instances of @a@ should be
-- compatible with 'Text' i.e. hash values should be equal for wrapped values as well.
-- This property will always be maintained if the 'Hashable' and 'Eq' instances
-- are derived with generalized newtype deriving.
-- compatible with 'Text' i.e. hash values be equal for wrapped values as well.
--
-- On pre GHC 7.8 this is unconstrainted function.
fromJSONKeyCoerce ::
#if HAS_COERCIBLE
    Coercible Text a =>
#endif
    FromJSONKeyFunction a
fromJSONKeyCoerce :: FromJSONKeyFunction a
fromJSONKeyCoerce = CoerceText a -> FromJSONKeyFunction a
forall a. CoerceText a -> FromJSONKeyFunction a
FromJSONKeyCoerce CoerceText a
forall a. Coercible Text a => CoerceText a
CoerceText

-- | Semantically the same as @coerceFromJSONKeyFunction = fmap coerce = coerce@.
--
-- See note on 'fromJSONKeyCoerce'.
coerceFromJSONKeyFunction ::
#if HAS_COERCIBLE
    Coercible a b =>
#endif
    FromJSONKeyFunction a -> FromJSONKeyFunction b
#if HAS_COERCIBLE
coerceFromJSONKeyFunction :: FromJSONKeyFunction a -> FromJSONKeyFunction b
coerceFromJSONKeyFunction = FromJSONKeyFunction a -> FromJSONKeyFunction b
forall a b. Coercible a b => a -> b
coerce
#else
coerceFromJSONKeyFunction (FromJSONKeyCoerce CoerceText) = FromJSONKeyCoerce CoerceText
coerceFromJSONKeyFunction (FromJSONKeyText f)            = FromJSONKeyText (coerce' . f)
coerceFromJSONKeyFunction (FromJSONKeyTextParser f)      = FromJSONKeyTextParser (fmap coerce' . f)
coerceFromJSONKeyFunction (FromJSONKeyValue f)           = FromJSONKeyValue (fmap coerce' . f)
#endif

{-# RULES
  "FromJSONKeyCoerce: fmap id"     forall (x :: FromJSONKeyFunction a).
                                   fmap id x = x
  #-}
#if HAS_COERCIBLE
{-# RULES
  "FromJSONKeyCoerce: fmap coerce" forall x .
                                   fmap coerce x = coerceFromJSONKeyFunction x
  #-}
#endif

-- | Same as 'fmap'. Provided for the consistency with 'ToJSONKeyFunction'.
mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
mapFromJSONKeyFunction = (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

-- | 'fromJSONKey' for 'Generic' types.
-- These types must be sums of nullary constructors, whose names will be used
-- as keys for JSON objects.
--
-- See also 'genericToJSONKey'.
--
-- === __Example__
--
-- @
-- data Color = Red | Green | Blue
--   deriving 'Generic'
--
-- instance 'FromJSONKey' Color where
--   'fromJSONKey' = 'genericFromJSONKey' 'defaultJSONKeyOptions'
-- @
genericFromJSONKey :: forall a. (Generic a, GFromJSONKey (Rep a))
             => JSONKeyOptions
             -> FromJSONKeyFunction a
genericFromJSONKey :: JSONKeyOptions -> FromJSONKeyFunction a
genericFromJSONKey opts :: 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
$ \t :: Text
t ->
    case (String -> String) -> Text -> Maybe (Rep a Any)
forall k (f :: k -> *) (a :: k).
SumFromString f =>
(String -> String) -> Text -> Maybe (f a)
parseSumFromString (JSONKeyOptions -> String -> String
keyModifier JSONKeyOptions
opts) Text
t of
        Nothing -> 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
$
            "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]
++ ", expected one of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
cnames
        Just k :: Rep a Any
k -> 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
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

-------------------------------------------------------------------------------
-- Functions needed for documentation
-------------------------------------------------------------------------------

-- | Fail parsing due to a type mismatch, with a descriptive message.
--
-- The following wrappers should generally be prefered:
-- 'withObject', 'withArray', 'withText', 'withBool'.
--
-- ==== Error message example
--
-- > typeMismatch "Object" (String "oops")
-- > -- Error: "expected Object, but encountered String"
typeMismatch :: String -- ^ The name of the JSON type being parsed
                       -- (@\"Object\"@, @\"Array\"@, @\"String\"@, @\"Number\"@,
                       -- @\"Boolean\"@, or @\"Null\"@).
             -> Value  -- ^ The actual value encountered.
             -> Parser a
typeMismatch :: String -> Value -> Parser a
typeMismatch expected :: String
expected actual :: Value
actual =
    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
$ "expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expected String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", but encountered " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
typeOf Value
actual

-- | Fail parsing due to a type mismatch, when the expected types are implicit.
--
-- ==== Error message example
--
-- > unexpected (String "oops")
-- > -- Error: "unexpected String"
unexpected :: Value -> Parser a
unexpected :: Value -> Parser a
unexpected actual :: Value
actual = 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
$ "unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
typeOf Value
actual

-- | JSON type of a value, name of the head constructor.
typeOf :: Value -> String
typeOf :: Value -> String
typeOf v :: Value
v = case Value
v of
    Object _ -> "Object"
    Array _  -> "Array"
    String _ -> "String"
    Number _ -> "Number"
    Bool _   -> "Boolean"
    Null     -> "Null"

-------------------------------------------------------------------------------
-- Lifings of FromJSON and ToJSON to unary and binary type constructors
-------------------------------------------------------------------------------

-- | Lifting of the 'FromJSON' class to unary type constructors.
--
-- Instead of manually writing your 'FromJSON1' instance, there are two options
-- to do it automatically:
--
-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
-- instance at compile time. The generated instance is optimized for your type
-- so it will probably be more efficient than the following option.
--
-- * The compiler can provide a default generic implementation for
-- 'liftParseJSON'.
--
-- To use the second, simply add a @deriving 'Generic1'@ clause to your
-- datatype and declare a 'FromJSON1' instance for your datatype without giving
-- a definition for 'liftParseJSON'.
--
-- For example:
--
-- @
-- {-\# LANGUAGE DeriveGeneric \#-}
--
-- import "GHC.Generics"
--
-- data Pair a b = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
--
-- instance 'FromJSON' a => 'FromJSON1' (Pair a)
-- @
--
-- If the default implementation doesn't give exactly the results you want,
-- you can customize the generic decoding with only a tiny amount of
-- effort, using 'genericLiftParseJSON' with your preferred 'Options':
--
-- @
-- customOptions = 'defaultOptions'
--                 { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
--                 }
--
-- instance 'FromJSON' a => 'FromJSON1' (Pair a) where
--     'liftParseJSON' = 'genericLiftParseJSON' customOptions
-- @
class FromJSON1 f where
    liftParseJSON :: (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (f a)

    default liftParseJSON :: (Generic1 f, GFromJSON One (Rep1 f))
                          => (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (f a)
    liftParseJSON = Options
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
forall (f :: * -> *) a.
(Generic1 f, GFromJSON One (Rep1 f)) =>
Options
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
genericLiftParseJSON Options
defaultOptions

    liftParseJSONList :: (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser [f a]
    liftParseJSONList f :: Value -> Parser a
f g :: Value -> Parser [a]
g v :: Value
v = (Value -> Parser (f a)) -> Value -> Parser [f a]
forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser ((Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON Value -> Parser a
f Value -> Parser [a]
g) Value
v

-- | Lift the standard 'parseJSON' function through the type constructor.
parseJSON1 :: (FromJSON1 f, FromJSON a) => Value -> Parser (f a)
parseJSON1 :: Value -> Parser (f a)
parseJSON1 = (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [a]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
{-# INLINE parseJSON1 #-}

-- | Lifting of the 'FromJSON' class to binary type constructors.
--
-- Instead of manually writing your 'FromJSON2' instance, "Data.Aeson.TH"
-- provides Template Haskell functions which will derive an instance at compile time.

-- The compiler cannot provide a default generic implementation for 'liftParseJSON2',
-- unlike 'parseJSON' and 'liftParseJSON'.
class FromJSON2 f where
    liftParseJSON2
        :: (Value -> Parser a)
        -> (Value -> Parser [a])
        -> (Value -> Parser b)
        -> (Value -> Parser [b])
        -> Value -> Parser (f a b)
    liftParseJSONList2
        :: (Value -> Parser a)
        -> (Value -> Parser [a])
        -> (Value -> Parser b)
        -> (Value -> Parser [b])
        -> Value -> Parser [f a b]
    liftParseJSONList2 fa :: Value -> Parser a
fa ga :: Value -> Parser [a]
ga fb :: Value -> Parser b
fb gb :: 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 "[]" ((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
$ \vals :: Array
vals ->
        (Vector (f a b) -> [f a b])
-> Parser (Vector (f a b)) -> Parser [f a 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 ((Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser a
fa Value -> Parser [a]
ga Value -> Parser b
fb Value -> Parser [b]
gb) Array
vals)

-- | Lift the standard 'parseJSON' function through the type constructor.
parseJSON2 :: (FromJSON2 f, FromJSON a, FromJSON b) => Value -> Parser (f a b)
parseJSON2 :: Value -> Parser (f a b)
parseJSON2 = (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [a]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [b]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
{-# INLINE parseJSON2 #-}

-------------------------------------------------------------------------------
-- List functions
-------------------------------------------------------------------------------

-- | Helper function to use with 'liftParseJSON'. See 'Data.Aeson.ToJSON.listEncoding'.
listParser :: (Value -> Parser a) -> Value -> Parser [a]
listParser :: (Value -> Parser a) -> Value -> Parser [a]
listParser f :: Value -> Parser a
f (Array xs :: Array
xs) = (Vector a -> [a]) -> Parser (Vector a) -> Parser [a]
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 _ v :: Value
v          = String -> Value -> Parser [a]
forall a. String -> Value -> Parser a
typeMismatch "Array" Value
v
{-# INLINE listParser #-}

-------------------------------------------------------------------------------
-- [] instances
-------------------------------------------------------------------------------

instance FromJSON1 [] where
    liftParseJSON :: (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser [a]
liftParseJSON _ p' :: Value -> Parser [a]
p' = Value -> Parser [a]
p'
    {-# INLINE liftParseJSON #-}

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

-------------------------------------------------------------------------------
-- Functions
-------------------------------------------------------------------------------

-- | Add context to a failure message, indicating the name of the structure
-- being parsed.
--
-- > prependContext "MyType" (fail "[error message]")
-- > -- Error: "parsing MyType failed, [error message]"
prependContext :: String -> Parser a -> Parser a
prependContext :: String -> Parser a -> Parser a
prependContext name :: String
name = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependFailure ("parsing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ " failed, ")

-- | @'withObject' name f value@ applies @f@ to the 'Object' when @value@
-- is an 'Data.Aeson.Object' and fails otherwise.
--
-- ==== Error message example
--
-- > withObject "MyType" f (String "oops")
-- > -- Error: "parsing MyType failed, expected Object, but encountered String"
withObject :: String -> (Object -> Parser a) -> Value -> Parser a
withObject :: String -> (Object -> Parser a) -> Value -> Parser a
withObject _    f :: Object -> Parser a
f (Object obj :: Object
obj) = Object -> Parser a
f Object
obj
withObject name :: String
name _ v :: 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 "Object" Value
v)
{-# INLINE withObject #-}

-- | @'withText' name f value@ applies @f@ to the 'Text' when @value@ is a
-- 'Data.Aeson.String' and fails otherwise.
--
-- ==== Error message example
--
-- > withText "MyType" f Null
-- > -- Error: "parsing MyType failed, expected String, but encountered Null"
withText :: String -> (Text -> Parser a) -> Value -> Parser a
withText :: String -> (Text -> Parser a) -> Value -> Parser a
withText _    f :: Text -> Parser a
f (String txt :: Text
txt) = Text -> Parser a
f Text
txt
withText name :: String
name _ v :: 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" Value
v)
{-# INLINE withText #-}

-- | @'withArray' expected f value@ applies @f@ to the 'Array' when @value@ is
-- an 'Data.Aeson.Array' and fails otherwise.
--
-- ==== Error message example
--
-- > withArray "MyType" f (String "oops")
-- > -- Error: "parsing MyType failed, expected Array, but encountered String"
withArray :: String -> (Array -> Parser a) -> Value -> Parser a
withArray :: String -> (Array -> Parser a) -> Value -> Parser a
withArray _    f :: Array -> Parser a
f (Array arr :: Array
arr) = Array -> Parser a
f Array
arr
withArray name :: String
name _ v :: 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 "Array" Value
v)
{-# INLINE withArray #-}

-- | @'withScientific' name f value@ applies @f@ to the 'Scientific' number
-- when @value@ is a 'Data.Aeson.Number' and fails using 'typeMismatch'
-- otherwise.
--
-- /Warning/: If you are converting from a scientific to an unbounded
-- type such as 'Integer' you may want to add a restriction on the
-- size of the exponent (see 'withBoundedScientific') to prevent
-- malicious input from filling up the memory of the target system.
--
-- ==== Error message example
--
-- > withScientific "MyType" f (String "oops")
-- > -- Error: "parsing MyType failed, expected Number, but encountered String"
withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific _ f :: Scientific -> Parser a
f (Number scientific :: Scientific
scientific) = Scientific -> Parser a
f Scientific
scientific
withScientific name :: String
name _ v :: 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 "Number" Value
v)
{-# INLINE withScientific #-}

-- | A variant of 'withScientific' which doesn't use 'prependContext', so that
-- such context can be added separately in a way that also applies when the
-- continuation @f :: Scientific -> Parser a@ fails.
--
-- /Warning/: If you are converting from a scientific to an unbounded
-- type such as 'Integer' you may want to add a restriction on the
-- size of the exponent (see 'withBoundedScientific') to prevent
-- malicious input from filling up the memory of the target system.
--
-- ==== Error message examples
--
-- > withScientific' f (String "oops")
-- > -- Error: "unexpected String"
-- >
-- > prependContext "MyType" (withScientific' f (String "oops"))
-- > -- Error: "parsing MyType failed, unexpected String"
withScientific' :: (Scientific -> Parser a) -> Value -> Parser a
withScientific' :: (Scientific -> Parser a) -> Value -> Parser a
withScientific' f :: Scientific -> Parser a
f v :: Value
v = case Value
v of
    Number n :: Scientific
n -> Scientific -> Parser a
f Scientific
n
    _ -> String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch "Number" Value
v
{-# INLINE withScientific' #-}

-- | @'withBoundedScientific' name f value@ applies @f@ to the 'Scientific' number
-- when @value@ is a 'Number' with exponent less than or equal to 1024.
withBoundedScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific name :: String
name f :: Scientific -> Parser a
f v :: 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
{-# INLINE withBoundedScientific #-}

-- | A variant of 'withBoundedScientific' which doesn't use 'prependContext',
-- so that such context can be added separately in a way that also applies
-- when the continuation @f :: Scientific -> Parser a@ fails.
withBoundedScientific' :: (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific' :: (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific' f :: Scientific -> Parser a
f v :: 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
{-# INLINE withBoundedScientific' #-}

-- | A variant of 'withBoundedScientific_' parameterized by a function to apply
-- to the 'Parser' in case of failure.
withBoundedScientific_ :: (Parser a -> Parser a) -> (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific_ :: (Parser a -> Parser a)
-> (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific_ whenFail :: Parser a -> Parser a
whenFail f :: Scientific -> Parser a
f v :: Value
v@(Number scientific :: Scientific
scientific) =
    if Int
exponent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1024
    then Parser a -> Parser a
whenFail (String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg)
    else Scientific -> Parser a
f Scientific
scientific
  where
    exponent :: Int
exponent = Scientific -> Int
base10Exponent Scientific
scientific
    msg :: String
msg = "found a number with exponent " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
exponent String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", but it must not be greater than 1024"
withBoundedScientific_ whenFail :: Parser a -> Parser a
whenFail _ v :: Value
v =
    Parser a -> Parser a
whenFail (String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch "Number" Value
v)
{-# INLINE withBoundedScientific_ #-}

-- | @'withBool' expected f value@ applies @f@ to the 'Bool' when @value@ is a
-- 'Boolean' and fails otherwise.
--
-- ==== Error message example
--
-- > withBool "MyType" f (String "oops")
-- > -- Error: "parsing MyType failed, expected Boolean, but encountered String"
withBool :: String -> (Bool -> Parser a) -> Value -> Parser a
withBool :: String -> (Bool -> Parser a) -> Value -> Parser a
withBool _    f :: Bool -> Parser a
f (Bool arr :: Bool
arr) = Bool -> Parser a
f Bool
arr
withBool name :: String
name _ v :: 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 "Boolean" Value
v)
{-# INLINE withBool #-}

-- | Decode a nested JSON-encoded string.
withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a
withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a
withEmbeddedJSON _ innerParser :: Value -> Parser a
innerParser (String txt :: 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 (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
eitherDecode (ByteString -> ByteString
Compat.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
txt)
    where
        eitherDecode :: ByteString -> Either String Value
eitherDecode = Either (JSONPath, String) Value -> Either String Value
forall b. Either (JSONPath, String) b -> Either String b
eitherFormatError (Either (JSONPath, String) Value -> Either String Value)
-> (ByteString -> Either (JSONPath, String) Value)
-> ByteString
-> Either String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Value
-> (Value -> IResult Value)
-> ByteString
-> Either (JSONPath, String) Value
forall a.
Parser Value
-> (Value -> IResult a)
-> ByteString
-> Either (JSONPath, String) a
eitherDecodeWith Parser Value
jsonEOF Value -> IResult Value
forall a. FromJSON a => Value -> IResult a
ifromJSON
        eitherFormatError :: Either (JSONPath, String) b -> Either String b
eitherFormatError = ((JSONPath, String) -> Either String b)
-> (b -> Either String b)
-> Either (JSONPath, String) b
-> Either String b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b)
-> ((JSONPath, String) -> String)
-> (JSONPath, String)
-> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JSONPath -> String -> String) -> (JSONPath, String) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry JSONPath -> String -> String
formatError) b -> Either String b
forall a b. b -> Either a b
Right
withEmbeddedJSON name :: String
name _ v :: 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" Value
v)
{-# INLINE withEmbeddedJSON #-}

-- | Convert a value from JSON, failing if the types do not match.
fromJSON :: (FromJSON a) => Value -> Result a
fromJSON :: 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
{-# INLINE fromJSON #-}

-- | Convert a value from JSON, failing if the types do not match.
ifromJSON :: (FromJSON a) => Value -> IResult a
ifromJSON :: 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
{-# INLINE ifromJSON #-}

-- | Retrieve the value associated with the given key of an 'Object'.
-- The result is 'empty' if the key is not present or the value cannot
-- be converted to the desired type.
--
-- This accessor is appropriate if the key and value /must/ be present
-- in an object for it to be valid.  If the key and value are
-- optional, use '.:?' instead.
(.:) :: (FromJSON a) => Object -> Text -> Parser a
.: :: Object -> Text -> Parser a
(.:) = (Value -> Parser a) -> Object -> Text -> Parser a
forall a. (Value -> Parser a) -> Object -> Text -> Parser a
explicitParseField Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON
{-# INLINE (.:) #-}

-- | Retrieve the value associated with the given key of an 'Object'. The
-- result is 'Nothing' if the key is not present or if its value is 'Null',
-- or 'empty' if the value cannot be converted to the desired type.
--
-- This accessor is most useful if the key and value can be absent
-- from an object without affecting its validity.  If the key and
-- value are mandatory, use '.:' instead.
(.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
.:? :: Object -> Text -> Parser (Maybe a)
(.:?) = (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)
forall a. (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)
explicitParseFieldMaybe Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON
{-# INLINE (.:?) #-}

-- | Retrieve the value associated with the given key of an 'Object'.
-- The result is 'Nothing' if the key is not present or 'empty' if the
-- value cannot be converted to the desired type.
--
-- This differs from '.:?' by attempting to parse 'Null' the same as any
-- other JSON value, instead of interpreting it as 'Nothing'.
(.:!) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
.:! :: Object -> Text -> Parser (Maybe a)
(.:!) = (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)
forall a. (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)
explicitParseFieldMaybe' Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON
{-# INLINE (.:!) #-}

-- | Function variant of '.:'.
parseField :: (FromJSON a) => Object -> Text -> Parser a
parseField :: Object -> Text -> Parser a
parseField = Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
(.:)
{-# INLINE parseField #-}

-- | Function variant of '.:?'.
parseFieldMaybe :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
parseFieldMaybe :: Object -> Text -> Parser (Maybe a)
parseFieldMaybe = Object -> Text -> Parser (Maybe a)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
(.:?)
{-# INLINE parseFieldMaybe #-}

-- | Function variant of '.:!'.
parseFieldMaybe' :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
parseFieldMaybe' :: Object -> Text -> Parser (Maybe a)
parseFieldMaybe' = Object -> Text -> Parser (Maybe a)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
(.:!)
{-# INLINE parseFieldMaybe' #-}

-- | Variant of '.:' with explicit parser function.
--
-- E.g. @'explicitParseField' 'parseJSON1' :: ('FromJSON1' f, 'FromJSON' a) -> 'Object' -> 'Text' -> 'Parser' (f a)@
explicitParseField :: (Value -> Parser a) -> Object -> Text -> Parser a
explicitParseField :: (Value -> Parser a) -> Object -> Text -> Parser a
explicitParseField p :: Value -> Parser a
p obj :: Object
obj key :: Text
key = case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
key Object
obj of
    Nothing -> 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
$ "key " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ " not found"
    Just v :: Value
v  -> Value -> Parser a
p Value
v Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Text -> JSONPathElement
Key Text
key
{-# INLINE explicitParseField #-}

-- | Variant of '.:?' with explicit parser function.
explicitParseFieldMaybe :: (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)
explicitParseFieldMaybe :: (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)
explicitParseFieldMaybe p :: Value -> Parser a
p obj :: Object
obj key :: Text
key = case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
key Object
obj of
    Nothing -> Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just v :: Value
v  -> (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Maybe a)
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON 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
<?> Text -> JSONPathElement
Key Text
key -- listParser isn't used by maybe instance.
{-# INLINE explicitParseFieldMaybe #-}

-- | Variant of '.:!' with explicit parser function.
explicitParseFieldMaybe' :: (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)
explicitParseFieldMaybe' :: (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)
explicitParseFieldMaybe' p :: Value -> Parser a
p obj :: Object
obj key :: Text
key = case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
key Object
obj of
    Nothing -> Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just v :: 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
<?> Text -> JSONPathElement
Key Text
key
{-# INLINE explicitParseFieldMaybe' #-}

-- | Helper for use in combination with '.:?' to provide default
-- values for optional JSON object fields.
--
-- This combinator is most useful if the key and value can be absent
-- from an object without affecting its validity and we know a default
-- value to assign in that case.  If the key and value are mandatory,
-- use '.:' instead.
--
-- Example usage:
--
-- @ v1 <- o '.:?' \"opt_field_with_dfl\" .!= \"default_val\"
-- v2 <- o '.:'  \"mandatory_field\"
-- v3 <- o '.:?' \"opt_field2\"
-- @
(.!=) :: Parser (Maybe a) -> a -> Parser a
pmval :: Parser (Maybe a)
pmval .!= :: Parser (Maybe a) -> a -> Parser a
.!= val :: 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
{-# INLINE (.!=) #-}

--------------------------------------------------------------------------------
-- Generic parseJSON
-------------------------------------------------------------------------------

instance GFromJSON arity V1 where
    -- Whereof we cannot format, thereof we cannot parse:
    gParseJSON :: Options -> FromArgs arity a -> Value -> Parser (V1 a)
gParseJSON _ _ _ = String -> Parser (V1 a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Attempted to parse empty type"


instance OVERLAPPABLE_ (GFromJSON arity a) => GFromJSON arity (M1 i c a) where
    -- Meta-information, which is not handled elsewhere, is just added to the
    -- parsed value:
    gParseJSON :: Options -> FromArgs arity a -> Value -> Parser (M1 i c a a)
gParseJSON opts :: Options
opts fargs :: FromArgs arity a
fargs = (a a -> M1 i c a a) -> Parser (a a) -> Parser (M1 i c a a)
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 arity (f :: * -> *) a.
GFromJSON arity f =>
Options -> FromArgs arity a -> Value -> Parser (f a)
gParseJSON Options
opts FromArgs arity a
fargs

-- Information for error messages

type TypeName = String
type ConName = String

-- | Add the name of the type being parsed to a parser's error messages.
contextType :: TypeName -> Parser a -> Parser a
contextType :: String -> Parser a -> Parser a
contextType = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependContext

-- | Add the tagKey that will be looked up while building an ADT
-- | Produce the error equivalent to
-- | Left "Error in $: parsing T failed, expected an object with keys "tag" and
-- | "contents", where "tag" i-- |s associated to one of ["Foo", "Bar"],
-- | The parser returned error was: could not find key "tag"
contextTag :: Text -> [String] -> Parser a -> Parser a
contextTag :: Text -> [String] -> Parser a -> Parser a
contextTag tagKey :: Text
tagKey cnames :: [String]
cnames = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependFailure
  ("expected Object with key \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
tagKey String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++
  " 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]
++ ", ")

-- | Add the name of the constructor being parsed to a parser's error messages.
contextCons :: ConName -> TypeName -> Parser a -> Parser a
contextCons :: String -> String -> Parser a -> Parser a
contextCons cname :: String
cname tname :: String
tname = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependContext (String -> String -> String
showCons String
cname String
tname)

-- | Render a constructor as @\"MyType(MyConstructor)\"@.
showCons :: ConName -> TypeName -> String
showCons :: String -> String -> String
showCons cname :: String
cname tname :: String
tname = String
tname String -> String -> String
forall a. [a] -> [a] -> [a]
++ "(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cname String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"

--------------------------------------------------------------------------------

-- Parsing single fields

instance (FromJSON a) => GFromJSON arity (K1 i a) where
    -- Constant values are decoded using their FromJSON instance:
    gParseJSON :: Options -> FromArgs arity a -> Value -> Parser (K1 i a a)
gParseJSON _opts :: Options
_opts _ = (a -> K1 i a a) -> Parser a -> Parser (K1 i a a)
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

instance GFromJSON One Par1 where
    -- Direct occurrences of the last type parameter are decoded with the
    -- function passed in as an argument:
    gParseJSON :: Options -> FromArgs One a -> Value -> Parser (Par1 a)
gParseJSON _opts :: Options
_opts (From1Args pj :: Value -> Parser a
pj _) = (a -> Par1 a) -> Parser a -> Parser (Par1 a)
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

instance (FromJSON1 f) => GFromJSON One (Rec1 f) where
    -- Recursive occurrences of the last type parameter are decoded using their
    -- FromJSON1 instance:
    gParseJSON :: Options -> FromArgs One a -> Value -> Parser (Rec1 f a)
gParseJSON _opts :: Options
_opts (From1Args pj :: Value -> Parser a
pj pjl :: Value -> Parser [a]
pjl) = (f a -> Rec1 f a) -> Parser (f a) -> Parser (Rec1 f a)
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
. (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON Value -> Parser a
pj Value -> Parser [a]
pjl

instance (FromJSON1 f, GFromJSON One g) => GFromJSON One (f :.: g) where
    -- If an occurrence of the last type parameter is nested inside two
    -- composed types, it is decoded by using the outermost type's FromJSON1
    -- instance to generically decode the innermost type:
    gParseJSON :: Options -> FromArgs One a -> Value -> Parser ((:.:) f g a)
gParseJSON opts :: Options
opts fargs :: FromArgs One a
fargs =
        let gpj :: Value -> Parser (g a)
gpj = 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 (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
. (Value -> Parser (g a))
-> (Value -> Parser [g a]) -> Value -> Parser (f (g a))
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON 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)

--------------------------------------------------------------------------------

instance (GFromJSON' arity a, Datatype d) => GFromJSON arity (D1 d a) where
    -- Meta-information, which is not handled elsewhere, is just added to the
    -- parsed value:
    gParseJSON :: Options -> FromArgs arity a -> Value -> Parser (D1 d a a)
gParseJSON opts :: Options
opts fargs :: FromArgs arity a
fargs = (a a -> D1 d a a) -> Parser (a a) -> Parser (D1 d a a)
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 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
moduleName M1 Any d Any Any
proxy String -> String -> String
forall a. [a] -> [a] -> [a]
++ "." 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
datatypeName M1 Any d Any Any
proxy
        proxy :: M1 Any d Any Any
proxy = forall k _i (_f :: k -> *) (_p :: k). M1 _i d _f _p
forall a. HasCallStack => a
undefined :: M1 _i d _f _p

-- | 'GFromJSON', after unwrapping the 'D1' constructor, now carrying the data
-- type's name.
class GFromJSON' arity f where
    gParseJSON' :: TypeName :* Options :* FromArgs arity a
                -> Value
                -> Parser (f a)

-- | Single constructor.
instance ( ConsFromJSON arity a
         , AllNullary         (C1 c a) allNullary
         , ParseSum     arity (C1 c a) allNullary
         , Constructor c
         ) => GFromJSON' arity (C1 c a) where
    -- The option 'tagSingleConstructors' determines whether to wrap
    -- a single-constructor type.
    gParseJSON' :: (String :* (Options :* FromArgs arity a))
-> Value -> Parser (C1 c a a)
gParseJSON' p :: String :* (Options :* FromArgs arity a)
p@(_ :* opts :: Options
opts :* _)
        | Options -> Bool
tagSingleConstructors Options
opts
            = (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 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 (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 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
conName (forall k _i (_f :: k -> *) (_p :: k). M1 _i c _f _p
forall a. HasCallStack => a
undefined :: M1 _i c _f _p)

-- | Multiple constructors.
instance ( AllNullary          (a :+: b) allNullary
         , ParseSum      arity (a :+: b) allNullary
         ) => GFromJSON' arity (a :+: b) where
    -- If all constructors of a sum datatype are nullary and the
    -- 'allNullaryToStringTag' option is set they are expected to be
    -- encoded as strings.  This distinction is made by 'parseSum':
    gParseJSON' :: (String :* (Options :* FromArgs arity a))
-> Value -> Parser ((:+:) a b a)
gParseJSON' p :: String :* (Options :* FromArgs arity a)
p =
        (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 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

--------------------------------------------------------------------------------

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 :: (String :* (Options :* FromArgs arity a))
-> Value -> Tagged True (Parser (f a))
parseSum p :: String :* (Options :* FromArgs arity a)
p@(tname :: String
tname :* opts :: Options
opts :* _)
        | 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

instance ( ConstructorNames        f
         , FromPair          arity f
         , FromTaggedObject  arity f
         , FromUntaggedValue arity f
         ) => ParseSum       arity f False where
    parseSum :: (String :* (Options :* FromArgs arity a))
-> Value -> Tagged False (Parser (f a))
parseSum p :: 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

--------------------------------------------------------------------------------

parseAllNullarySum :: (SumFromString f, ConstructorNames f)
                   => TypeName -> Options -> Value -> Parser (f a)
parseAllNullarySum :: String -> Options -> Value -> Parser (f a)
parseAllNullarySum tname :: String
tname opts :: 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
$ \tag :: 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 (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 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 tag :: 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
$ \cnames :: [String]
cnames ->
        "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]
++
        ", 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

-- | Fail with an informative error message about a mismatched tag.
-- The error message is parameterized by the list of expected tags,
-- to be inferred from the result type of the parser.
failWithCTags
  :: forall f a t. ConstructorNames f
  => TypeName -> (String -> t) -> ([t] -> String) -> Parser (f a)
failWithCTags :: String -> (String -> t) -> ([t] -> String) -> Parser (f a)
failWithCTags tname :: String
tname modifier :: String -> t
modifier f :: [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 (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 :: (String -> String) -> Text -> Maybe ((:+:) a b a)
parseSumFromString opts :: String -> String
opts key :: 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 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 (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 k (f :: k -> *) (a :: k).
SumFromString f =>
(String -> String) -> Text -> Maybe (f a)
parseSumFromString String -> String
opts Text
key)

instance (Constructor c) => SumFromString (C1 c U1) where
    parseSumFromString :: (String -> String) -> Text -> Maybe (C1 c U1 a)
parseSumFromString modifier :: String -> String
modifier key :: 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
conName (forall k _i (_f :: k -> *) (_p :: k). M1 _i c _f _p
forall a. HasCallStack => a
undefined :: M1 _i c _f _p)

-- For genericFromJSONKey
instance SumFromString a => SumFromString (D1 d a) where
    parseSumFromString :: (String -> String) -> Text -> Maybe (D1 d a a)
parseSumFromString modifier :: String -> String
modifier key :: Text
key = a a -> D1 d a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> D1 d a a) -> Maybe (a a) -> Maybe (D1 d a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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

-- | List of all constructor tags.
constructorTags :: ConstructorNames a => (String -> t) -> Tagged2 a [t]
constructorTags :: (String -> t) -> Tagged2 a [t]
constructorTags modifier :: String -> t
modifier =
    (DList t -> [t]) -> Tagged2 a (DList t) -> Tagged2 a [t]
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 (a :: * -> *) t.
ConstructorNames a =>
(String -> t) -> Tagged2 a (DList t)
constructorNames' String -> t
modifier)

-- | List of all constructor names of an ADT, after a given conversion
-- function. (Better inlining.)
class ConstructorNames a where
    constructorNames' :: (String -> t) -> Tagged2 a (DList.DList t)

instance (ConstructorNames a, ConstructorNames b) => ConstructorNames (a :+: b) where
    constructorNames' :: (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 (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 (a :: * -> *) t.
ConstructorNames a =>
(String -> t) -> Tagged2 a (DList t)
constructorNames' (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 :: Tagged2 a (DList t)
-> Tagged2 b (DList t) -> Tagged2 (a :+: b) (DList t)
append (Tagged2 xs :: DList t
xs) (Tagged2 ys :: 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)

instance Constructor c => ConstructorNames (C1 c a) where
    constructorNames' :: (String -> t) -> Tagged2 (C1 c a) (DList t)
constructorNames' f :: String -> t
f = DList t -> Tagged2 (C1 c a) (DList t)
forall (s :: * -> *) b. b -> Tagged2 s b
Tagged2 (t -> DList t
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
conName (forall k _i (_f :: k -> *) (_p :: k). M1 _i c _f _p
forall a. HasCallStack => a
undefined :: M1 _i c _f _p)

-- For genericFromJSONKey
instance ConstructorNames a => ConstructorNames (D1 d a) where
    constructorNames' :: (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 (a :: * -> *) t.
ConstructorNames a =>
(String -> t) -> Tagged2 a (DList t)
constructorNames'
      where
        retag :: Tagged2 a u -> Tagged2 (D1 d a) u
        retag :: Tagged2 a u -> Tagged2 (D1 d a) u
retag (Tagged2 x :: u
x) = u -> Tagged2 (D1 d a) u
forall (s :: * -> *) b. b -> Tagged2 s b
Tagged2 u
x

--------------------------------------------------------------------------------
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 :: (String :* (Options :* FromArgs arity c)) -> Value -> Parser (f c)
parseNonAllNullarySum p :: String :* (Options :* FromArgs arity c)
p@(tname :: String
tname :* opts :: Options
opts :* _) =
    case Options -> SumEncoding
sumEncoding Options
opts of
      TaggedObject{..} ->
          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
$ \obj :: 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
. Text -> [String] -> Parser Text -> Parser Text
forall a. Text -> [String] -> Parser a -> Parser a
contextTag Text
tagKey [String]
cnames_ (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
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
<?> Text -> JSONPathElement
Key Text
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 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 :: Text
tagKey = String -> Text
pack String
tagFieldName
          badTag :: Text -> Parser (f c)
badTag tag :: 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
$ \cnames :: [String]
cnames ->
              "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]
++
              ", 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])

      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
$ \obj :: Object
obj -> case Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
H.toList Object
obj of
              [(tag :: Text
tag, v :: 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 (Text -> Parser (f c)
badTag Text
tag) (Parser (f c) -> JSONPathElement -> Parser (f c)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Text -> JSONPathElement
Key Text
tag) (Maybe (Parser (f c)) -> Parser (f c))
-> Maybe (Parser (f c)) -> Parser (f c)
forall a b. (a -> b) -> a -> b
$
                  (Text :* (String :* (Options :* FromArgs arity c)))
-> Value -> Maybe (Parser (f c))
forall arity (f :: * -> *) a.
FromPair arity f =>
(Text :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (f a))
parsePair (Text
tag Text
-> (String :* (Options :* FromArgs arity c))
-> Text :* (String :* (Options :* FromArgs arity c))
forall a b. a -> b -> a :* b
:* String :* (Options :* FromArgs arity c)
p) Value
v
              _ -> 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 (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (f c)) -> String -> Parser (f c)
forall a b. (a -> b) -> a -> b
$
                  "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 k v. HashMap k v -> Int
H.size Object
obj) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " pairs"
        where
          badTag :: Text -> Parser (f c)
badTag tag :: 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
$ \cnames :: [String]
cnames ->
              "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]
++ ", but found tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
tag

      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
$ \arr :: Array
arr -> case Array -> Int
forall a. Vector a -> Int
V.length Array
arr of
              2 | String tag :: Text
tag <- Array -> Int -> Value
forall a. Vector a -> Int -> a
V.unsafeIndex Array
arr 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 0) (Parser (f c) -> JSONPathElement -> Parser (f c)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Int -> JSONPathElement
Index 1) (Maybe (Parser (f c)) -> Parser (f c))
-> Maybe (Parser (f c)) -> Parser (f c)
forall a b. (a -> b) -> a -> b
$
                      (Text :* (String :* (Options :* FromArgs arity c)))
-> Value -> Maybe (Parser (f c))
forall arity (f :: * -> *) a.
FromPair arity f =>
(Text :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (f a))
parsePair (Text
tag Text
-> (String :* (Options :* FromArgs arity c))
-> Text :* (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 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 (m :: * -> *) a. MonadFail m => String -> m a
fail "tag element is not a String" Parser (f c) -> JSONPathElement -> Parser (f c)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Int -> JSONPathElement
Index 0
              len :: 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 (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (f c)) -> String -> Parser (f c)
forall a b. (a -> b) -> a -> b
$
                  "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 tag :: 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
$ \cnames :: [String]
cnames ->
              "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]
++ ", but found tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
tag

      UntaggedValue -> (String :* (Options :* FromArgs arity c)) -> Value -> Parser (f c)
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
    -- The first two components of the parameter tuple are: the constructor tag
    -- to match against, and the contents field name.
    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 :: (Text :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Maybe (Parser ((:+:) a b a))
parseFromTaggedObject p :: Text :* (String :* (String :* (Options :* FromArgs arity a)))
p obj :: Object
obj =
            ((a a -> (:+:) a b a) -> Parser (a a) -> Parser ((:+:) a b a)
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 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
            ((b a -> (:+:) a b a) -> Parser (b a) -> Parser ((:+:) a b a)
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 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)

instance ( IsRecord                f isRecord
         , FromTaggedObject' arity f isRecord
         , Constructor c
         ) => FromTaggedObject arity (C1 c f) where
    parseFromTaggedObject :: (Text :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Maybe (Parser (C1 c f a))
parseFromTaggedObject (tag :: Text
tag :* contentsFieldName :: String
contentsFieldName :* p :: String :* (Options :* FromArgs arity a)
p@(_ :* opts :: Options
opts :* _))
        | 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 (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
.
            (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 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
conName (forall k _i (_f :: k -> *) (_p :: k). M1 _i c _f _p
forall a. HasCallStack => a
undefined :: M1 _i c _f _p)

--------------------------------------------------------------------------------

class FromTaggedObject' arity f isRecord where
    -- The first component of the parameter tuple is the contents field name.
    parseFromTaggedObject'
        :: String :* ConName :* TypeName :* Options :* FromArgs arity a
        -> Object -> Tagged isRecord (Parser (f a))

instance (RecordFromJSON arity f) => FromTaggedObject' arity f True where
    -- Records are unpacked in the tagged object
    parseFromTaggedObject' :: (String :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Tagged True (Parser (f a))
parseFromTaggedObject' (_ :* p :: 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
. (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

instance (ConsFromJSON arity f) => FromTaggedObject' arity f False where
    -- Nonnullary nonrecords are encoded in the contents field
    parseFromTaggedObject' :: (String :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Tagged False (Parser (f a))
parseFromTaggedObject' p :: String :* (String :* (String :* (Options :* FromArgs arity a)))
p obj :: 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 -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
key)
        (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
<?> Text -> JSONPathElement
Key Text
key
      where
        key :: Text
key = String -> Text
pack String
contentsFieldName
        contentsFieldName :: String
contentsFieldName :* p' :: String :* (String :* (Options :* FromArgs arity a))
p'@(cname :: String
cname :* tname :: String
tname :* _) = String :* (String :* (String :* (Options :* FromArgs arity a)))
p

instance OVERLAPPING_ FromTaggedObject' arity U1 False where
    -- Nullary constructors don't need a contents field
    parseFromTaggedObject' :: (String :* (String :* (String :* (Options :* FromArgs arity a))))
-> Object -> Tagged False (Parser (U1 a))
parseFromTaggedObject' _ _ = Parser (U1 a) -> Tagged False (Parser (U1 a))
forall k (s :: k) b. b -> Tagged s b
Tagged (U1 a -> Parser (U1 a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a
forall k (p :: k). U1 p
U1)

--------------------------------------------------------------------------------

-- | Constructors need to be decoded differently depending on whether they're
-- a record or not. This distinction is made by 'ConsParseJSON'.
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 :: (String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (f a)
consParseJSON p :: String :* (String :* (Options :* FromArgs arity a))
p =
      (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 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

instance OVERLAPPING_
         ( GFromJSON arity a, RecordFromJSON arity (S1 s a)
         ) => ConsFromJSON' arity (S1 s a) True where
    consParseJSON' :: (String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Tagged True (Parser (S1 s a a))
consParseJSON' p :: String :* (String :* (Options :* FromArgs arity a))
p@(cname :: String
cname :* tname :: String
tname :* opts :: Options
opts :* fargs :: 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 (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 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) ((String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (S1 s 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)

instance RecordFromJSON arity f => ConsFromJSON' arity f True where
    consParseJSON' :: (String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Tagged True (Parser (f a))
consParseJSON' p :: String :* (String :* (Options :* FromArgs arity a))
p@(cname :: String
cname :* tname :: String
tname :* _) =
        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) ((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)

instance OVERLAPPING_
         ConsFromJSON' arity U1 False where
    -- Empty constructors are expected to be encoded as an empty array:
    consParseJSON' :: (String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Tagged False (Parser (U1 a))
consParseJSON' (cname :: String
cname :* tname :: String
tname :* _) v :: 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 a :: Array
a | Array -> Bool
forall a. Vector a -> Bool
V.null Array
a -> U1 a -> Parser (U1 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
            _ -> String -> Value -> Parser (U1 a)
forall a. String -> Value -> Parser a
typeMismatch "Array" Value
v
      where
        fail_ :: Vector a -> m a
fail_ a :: Vector a
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
$
            "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)

instance OVERLAPPING_
         GFromJSON arity f => ConsFromJSON' arity (S1 s f) False where
    consParseJSON' :: (String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Tagged False (Parser (S1 s f a))
consParseJSON' (_ :* _ :* opts :: Options
opts :* fargs :: 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 (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 arity (f :: * -> *) a.
GFromJSON arity f =>
Options -> FromArgs arity a -> Value -> Parser (f a)
gParseJSON Options
opts FromArgs arity a
fargs

instance (ProductFromJSON arity f, ProductSize f
         ) => ConsFromJSON' arity f False where
    consParseJSON' :: (String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Tagged False (Parser (f a))
consParseJSON' p :: 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

--------------------------------------------------------------------------------

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 :: (String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser ((:*:) a b a)
recordParseJSON p :: String :* (String :* (Options :* FromArgs arity a))
p obj :: 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 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (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

instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>
         RecordFromJSON arity (S1 s a) where
    recordParseJSON :: (String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (S1 s a a)
recordParseJSON (cname :: String
cname :* tname :: String
tname :* opts :: Options
opts :* fargs :: FromArgs arity a
fargs) obj :: Object
obj = 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 -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
label)
        a a -> S1 s a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> S1 s a a) -> Parser (a a) -> Parser (S1 s a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Value
fv Parser (a a) -> JSONPathElement -> Parser (a a)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Text -> JSONPathElement
Key Text
label
      where
        label :: Text
label = String -> Text
pack (String -> Text) -> String -> Text
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
selName (forall k _i (_f :: k -> *) (_p :: k). M1 _i s _f _p
forall a. HasCallStack => a
undefined :: M1 _i s _f _p)

instance INCOHERENT_ (Selector s, FromJSON a) =>
         RecordFromJSON arity (S1 s (K1 i (Maybe a))) where
    recordParseJSON :: (String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (S1 s (K1 i (Maybe a)) a)
recordParseJSON (_ :* _ :* opts :: Options
opts :* _) obj :: Object
obj = K1 i (Maybe a) a -> S1 s (K1 i (Maybe a)) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i (Maybe a) a -> S1 s (K1 i (Maybe a)) a)
-> (Maybe a -> K1 i (Maybe a) a)
-> Maybe a
-> S1 s (K1 i (Maybe a)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> K1 i (Maybe a) a
forall k i c (p :: k). c -> K1 i c p
K1 (Maybe a -> S1 s (K1 i (Maybe a)) a)
-> Parser (Maybe a) -> Parser (S1 s (K1 i (Maybe a)) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe a)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? String -> Text
pack String
label
      where
        label :: String
label = 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
selName (forall k _i (_f :: k -> *) (_p :: k). M1 _i s _f _p
forall a. HasCallStack => a
undefined :: M1 _i s _f _p)

-- Parse an Option like a Maybe.
instance INCOHERENT_ (Selector s, FromJSON a) =>
         RecordFromJSON arity (S1 s (K1 i (Semigroup.Option a))) where
    recordParseJSON :: (String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (S1 s (K1 i (Option a)) a)
recordParseJSON p :: String :* (String :* (Options :* FromArgs arity a))
p obj :: Object
obj = S1 s (K1 i (Maybe a)) a -> S1 s (K1 i (Option a)) a
forall k (p :: k).
S1 s (K1 i (Maybe a)) p -> S1 s (K1 i (Option a)) p
wrap (S1 s (K1 i (Maybe a)) a -> S1 s (K1 i (Option a)) a)
-> Parser (S1 s (K1 i (Maybe a)) a)
-> Parser (S1 s (K1 i (Option a)) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String :* (String :* (Options :* FromArgs arity a)))
-> Object -> Parser (S1 s (K1 i (Maybe 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
      where
        wrap :: S1 s (K1 i (Maybe a)) p -> S1 s (K1 i (Semigroup.Option a)) p
        wrap :: S1 s (K1 i (Maybe a)) p -> S1 s (K1 i (Option a)) p
wrap (M1 (K1 a :: Maybe a
a)) = K1 i (Option a) p -> S1 s (K1 i (Option a)) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Option a -> K1 i (Option a) p
forall k i c (p :: k). c -> K1 i c p
K1 (Maybe a -> Option a
forall a. Maybe a -> Option a
Semigroup.Option Maybe a
a))

--------------------------------------------------------------------------------

productParseJSON0
    :: forall f arity a. (ProductFromJSON arity f, ProductSize f)
    => ConName :* TypeName :* Options :* FromArgs arity a
    -> Value -> Parser (f a)
    -- Products are expected to be encoded to an array. Here we check whether we
    -- got an array of the same size as the product, then parse each of the
    -- product's elements using productParseJSON:
productParseJSON0 :: (String :* (String :* (Options :* FromArgs arity a)))
-> Value -> Parser (f a)
productParseJSON0 p :: String :* (String :* (Options :* FromArgs arity a))
p@(cname :: String
cname :* tname :: String
tname :* _ :* _) =
    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
$ \arr :: 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 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 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 (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (f a)) -> String -> Parser (f a)
forall a b. (a -> b) -> a -> b
$ "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]
++
                    ", 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 :: (String :* (String :* (Options :* FromArgs arity a)))
-> Array -> Int -> Int -> Parser ((:*:) a b a)
productParseJSON p :: String :* (String :* (Options :* FromArgs arity a))
p arr :: Array
arr ix :: Int
ix len :: 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 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 (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 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` 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 :: (String :* (String :* (Options :* FromArgs arity a)))
-> Array -> Int -> Int -> Parser (S1 s a a)
productParseJSON (_ :* _ :* opts :: Options
opts :* fargs :: FromArgs arity a
fargs) arr :: Array
arr ix :: Int
ix _ =
        a a -> S1 s a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> S1 s a a) -> Parser (a a) -> Parser (S1 s a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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

--------------------------------------------------------------------------------

class FromPair arity f where
    -- The first component of the parameter tuple is the tag to match.
    parsePair :: Text :* TypeName :* Options :* FromArgs arity a
              -> Value
              -> Maybe (Parser (f a))

instance ( FromPair arity a
         , FromPair arity b
         ) => FromPair arity (a :+: b) where
    parsePair :: (Text :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser ((:+:) a b a))
parsePair p :: Text :* (String :* (Options :* FromArgs arity a))
p pair :: Value
pair =
        ((a a -> (:+:) a b a) -> Parser (a a) -> Parser ((:+:) a b a)
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 :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (a a))
forall arity (f :: * -> *) a.
FromPair arity f =>
(Text :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (f a))
parsePair Text :* (String :* (Options :* FromArgs arity a))
p Value
pair) Maybe (Parser ((:+:) a b a))
-> Maybe (Parser ((:+:) a b a)) -> Maybe (Parser ((:+:) a b 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 (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 :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (b a))
forall arity (f :: * -> *) a.
FromPair arity f =>
(Text :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (f a))
parsePair Text :* (String :* (Options :* FromArgs arity a))
p Value
pair)

instance ( Constructor c
         , ConsFromJSON arity a
         ) => FromPair arity (C1 c a) where
    parsePair :: (Text :* (String :* (Options :* FromArgs arity a)))
-> Value -> Maybe (Parser (C1 c a a))
parsePair (tag :: Text
tag :* p :: String :* (Options :* FromArgs arity a)
p@(_ :* opts :: Options
opts :* _)) v :: Value
v
        | Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
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 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' :: 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
conName (forall k _i (_a :: k -> *) (_p :: k). M1 _i c _a _p
forall a. HasCallStack => a
undefined :: M1 _i c _a _p)

--------------------------------------------------------------------------------

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 :: (String :* (Options :* FromArgs arity a))
-> Value -> Parser ((:+:) a b a)
parseUntaggedValue p :: String :* (Options :* FromArgs arity a)
p value :: 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 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 (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 arity (f :: * -> *) a.
FromUntaggedValue arity f =>
(String :* (Options :* FromArgs arity a)) -> Value -> Parser (f a)
parseUntaggedValue String :* (Options :* FromArgs arity a)
p Value
value

instance OVERLAPPABLE_
    ( ConsFromJSON arity a
    , Constructor c
    ) => FromUntaggedValue arity (C1 c a)
  where
    parseUntaggedValue :: (String :* (Options :* FromArgs arity a))
-> Value -> Parser (C1 c a a)
parseUntaggedValue p :: String :* (Options :* FromArgs arity a)
p = (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
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 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
conName (forall k _i (_f :: k -> *) (_p :: k). M1 _i c _f _p
forall a. HasCallStack => a
undefined :: M1 _i c _f _p)

instance OVERLAPPING_
    ( Constructor c )
    => FromUntaggedValue arity (C1 c U1)
  where
    parseUntaggedValue :: (String :* (Options :* FromArgs arity a))
-> Value -> Parser (C1 c U1 a)
parseUntaggedValue (tname :: String
tname :* opts :: Options
opts :* _) v :: 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 tag :: 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 (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
            _ -> String -> Value -> Parser (C1 c U1 a)
forall a. String -> Value -> Parser a
typeMismatch "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
conName (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_ tag :: Text
tag = String -> Parser (C1 c U1 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
$
          "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]
++ ", but found tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
tag

-------------------------------------------------------------------------------
-- Instances
-------------------------------------------------------------------------------

-------------------------------------------------------------------------------
-- base
-------------------------------------------------------------------------------


instance FromJSON2 Const where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (Const a b)
liftParseJSON2 p :: Value -> Parser a
p _ _ _ = (a -> Const a b) -> Parser a -> Parser (Const a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Const a b
forall k a (b :: k). a -> Const a b
Const (Parser a -> Parser (Const a b))
-> (Value -> Parser a) -> Value -> Parser (Const a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
p
    {-# INLINE liftParseJSON2 #-}

instance FromJSON a => FromJSON1 (Const a) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Const a a)
liftParseJSON _ _ = (a -> Const a a) -> Parser a -> Parser (Const a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Const a a
forall k a (b :: k). a -> Const a b
Const (Parser a -> Parser (Const a a))
-> (Value -> Parser a) -> Value -> Parser (Const a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON
    {-# INLINE liftParseJSON #-}

instance FromJSON a => FromJSON (Const a b) where
    {-# INLINE parseJSON #-}
    parseJSON :: Value -> Parser (Const a b)
parseJSON = (a -> Const a b) -> Parser a -> Parser (Const a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Const a b
forall k a (b :: k). a -> Const a b
Const (Parser a -> Parser (Const a b))
-> (Value -> Parser a) -> Value -> Parser (Const a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON


instance FromJSON1 Maybe where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Maybe a)
liftParseJSON _ _ Null = Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    liftParseJSON p :: Value -> Parser a
p _ 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
    {-# INLINE liftParseJSON #-}

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
    {-# INLINE parseJSON #-}



instance FromJSON2 Either where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (Either a b)
liftParseJSON2 pA :: Value -> Parser a
pA _ pB :: Value -> Parser b
pB _ (Object (Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
H.toList -> [(key :: Text
key, value :: Value
value)]))
        | Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
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
<?> Text -> JSONPathElement
Key Text
left
        | Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
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
<?> Text -> JSONPathElement
Key Text
right
      where
        left, right :: Text
        left :: Text
left  = "Left"
        right :: Text
right = "Right"

    liftParseJSON2 _ _ _ _ _ = String -> Parser (Either a b)
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
$
        "expected an object with a single property " String -> String -> String
forall a. [a] -> [a] -> [a]
++
        "where the property key should be either " String -> String -> String
forall a. [a] -> [a] -> [a]
++
        "\"Left\" or \"Right\""
    {-# INLINE liftParseJSON2 #-}

instance (FromJSON a) => FromJSON1 (Either a) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Either a a)
liftParseJSON = (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (Either a a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [a]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE liftParseJSON #-}

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
    {-# INLINE parseJSON #-}

instance FromJSON Void where
    parseJSON :: Value -> Parser Void
parseJSON _ = String -> Parser Void
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Cannot parse Void"
    {-# INLINE parseJSON #-}

instance FromJSON Bool where
    parseJSON :: Value -> Parser Bool
parseJSON (Bool b :: Bool
b) = Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
    parseJSON v :: Value
v = String -> Value -> Parser Bool
forall a. String -> Value -> Parser a
typeMismatch "Bool" Value
v
    {-# INLINE parseJSON #-}

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
$ \t :: Text
t -> case Text
t of
        "true"  -> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        "false" -> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        _       -> String -> Parser Bool
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Bool) -> String -> Parser Bool
forall a b. (a -> b) -> a -> b
$ "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]
++ " 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 "Ordering" ((Text -> Parser Ordering) -> Value -> Parser Ordering)
-> (Text -> Parser Ordering) -> Value -> Parser Ordering
forall a b. (a -> b) -> a -> b
$ \s :: Text
s ->
    case Text
s of
      "LT" -> Ordering -> Parser Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
LT
      "EQ" -> Ordering -> Parser Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
EQ
      "GT" -> Ordering -> Parser Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
GT
      _ -> String -> Parser Ordering
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Ordering) -> String -> Parser Ordering
forall a b. (a -> b) -> a -> b
$ "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]
++
                  " (expected \"LT\", \"EQ\", or \"GT\")"

instance FromJSON () where
    parseJSON :: Value -> Parser ()
parseJSON = String -> (Array -> Parser ()) -> Value -> Parser ()
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "()" ((Array -> Parser ()) -> Value -> Parser ())
-> (Array -> Parser ()) -> Value -> Parser ()
forall a b. (a -> b) -> a -> b
$ \v :: Array
v ->
                  if Array -> Bool
forall a. Vector a -> Bool
V.null Array
v
                    then () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                    else String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
prependContext "()" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "expected an empty array"
    {-# INLINE parseJSON #-}

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 "Char" Text -> Parser Char
parseChar
    {-# INLINE parseJSON #-}

    parseJSONList :: Value -> Parser String
parseJSONList (String s :: Text
s) = String -> Parser String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> String
T.unpack Text
s)
    parseJSONList v :: Value
v = String -> Value -> Parser String
forall a. String -> Value -> Parser a
typeMismatch "String" Value
v
    {-# INLINE parseJSONList #-}

parseChar :: Text -> Parser Char
parseChar :: Text -> Parser Char
parseChar t :: Text
t =
    if Text -> Int -> Ordering
T.compareLength Text
t 1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
      then Char -> Parser Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Parser Char) -> Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
t
      else String -> Parser Char -> Parser Char
forall a. String -> Parser a -> Parser a
prependContext "Char" (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ String -> Parser Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "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 "Double"
    {-# INLINE parseJSON #-}

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
$ \t :: Text
t -> case Text
t of
        "NaN"       -> Double -> Parser Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/0)
        "Infinity"  -> Double -> Parser Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/0)
        "-Infinity" -> Double -> Parser Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Double
forall a. Num a => a -> a
negate 1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/0)
        _           -> 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 "Float"
    {-# INLINE parseJSON #-}

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
$ \t :: Text
t -> case Text
t of
        "NaN"       -> Float -> Parser Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure (0Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/0)
        "Infinity"  -> Float -> Parser Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure (1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/0)
        "-Infinity" -> Float -> Parser Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float -> Float
forall a. Num a => a -> a
negate 1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/0)
        _           -> 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 = String -> (Object -> Parser (Ratio a)) -> Value -> Parser (Ratio a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Rational" ((Object -> Parser (Ratio a)) -> Value -> Parser (Ratio a))
-> (Object -> Parser (Ratio a)) -> Value -> Parser (Ratio a)
forall a b. (a -> b) -> a -> b
$ \obj :: Object
obj -> do
        a
numerator <- Object
obj Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: "numerator"
        a
denominator <- Object
obj Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: "denominator"
        if a
denominator a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0
        then String -> Parser (Ratio a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Ratio denominator was 0"
        else Ratio a -> Parser (Ratio 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
    {-# INLINE parseJSON #-}

-- | This instance includes a bounds check to prevent maliciously
-- large inputs to fill up the memory of the target system. You can
-- newtype 'Scientific' and provide your own instance using
-- 'withScientific' if you want to allow larger inputs.
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 "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 (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)
    {-# INLINE parseJSON #-}

instance FromJSON Int where
    parseJSON :: Value -> Parser Int
parseJSON = String -> Value -> Parser Int
forall a. (Bounded a, Integral a) => String -> Value -> Parser a
parseBoundedIntegral "Int"
    {-# INLINE parseJSON #-}

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 "Int"

-- | This instance includes a bounds check to prevent maliciously
-- large inputs to fill up the memory of the target system. You can
-- newtype 'Scientific' and provide your own instance using
-- 'withScientific' if you want to allow larger inputs.
instance FromJSON Integer where
    parseJSON :: Value -> Parser Integer
parseJSON = String -> Value -> Parser Integer
forall a. Integral a => String -> Value -> Parser a
parseIntegral "Integer"
    {-# INLINE parseJSON #-}

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 "Integer"

instance FromJSON Natural where
    parseJSON :: Value -> Parser Natural
parseJSON value :: Value
value = do
        Integer
integer <- String -> Value -> Parser Integer
forall a. Integral a => String -> Value -> Parser a
parseIntegral "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
text -> do
        Integer
integer <- String -> Text -> Parser Integer
forall a. Integral a => String -> Text -> Parser a
parseIntegralText "Natural" Text
text
        Integer -> Parser Natural
parseNatural Integer
integer

parseNatural :: Integer -> Parser Natural
parseNatural :: Integer -> Parser Natural
parseNatural integer :: Integer
integer =
    if Integer
integer Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0 then
        String -> Parser Natural
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Natural) -> String -> Parser Natural
forall a b. (a -> b) -> a -> b
$ "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 (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 "Int8"
    {-# INLINE parseJSON #-}

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 "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 "Int16"
    {-# INLINE parseJSON #-}

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 "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 "Int32"
    {-# INLINE parseJSON #-}

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 "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 "Int64"
    {-# INLINE parseJSON #-}

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 "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 "Word"
    {-# INLINE parseJSON #-}

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 "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 "Word8"
    {-# INLINE parseJSON #-}

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 "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 "Word16"
    {-# INLINE parseJSON #-}

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 "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 "Word32"
    {-# INLINE parseJSON #-}

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 "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 "Word64"
    {-# INLINE parseJSON #-}

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 "Word64"

instance FromJSON CTime where
    parseJSON :: Value -> Parser CTime
parseJSON = (Int64 -> CTime) -> Parser Int64 -> Parser CTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CTime
CTime (Parser Int64 -> Parser CTime)
-> (Value -> Parser Int64) -> Value -> Parser CTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Int64
forall a. FromJSON a => Value -> Parser a
parseJSON
    {-# INLINE parseJSON #-}

instance FromJSON Text where
    parseJSON :: Value -> Parser Text
parseJSON = String -> (Text -> Parser Text) -> Value -> Parser Text
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "Text" Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE parseJSON #-}

instance FromJSONKey Text where
    fromJSONKey :: FromJSONKeyFunction Text
fromJSONKey = FromJSONKeyFunction Text
forall a. Coercible Text a => FromJSONKeyFunction a
fromJSONKeyCoerce


instance FromJSON LT.Text where
    parseJSON :: Value -> Parser Text
parseJSON = String -> (Text -> Parser Text) -> Value -> Parser Text
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "Lazy Text" ((Text -> Parser Text) -> Value -> Parser Text)
-> (Text -> Parser Text) -> Value -> Parser Text
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text) -> (Text -> Text) -> Text -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.fromStrict
    {-# INLINE parseJSON #-}

instance FromJSONKey LT.Text where
    fromJSONKey :: FromJSONKeyFunction Text
fromJSONKey = (Text -> Text) -> FromJSONKeyFunction Text
forall a. (Text -> a) -> FromJSONKeyFunction a
FromJSONKeyText Text -> Text
LT.fromStrict


instance FromJSON Version where
    parseJSON :: Value -> Parser Version
parseJSON = String -> (Text -> Parser Version) -> Value -> Parser Version
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "Version" Text -> Parser Version
parseVersionText
    {-# INLINE parseJSON #-}

instance FromJSONKey Version where
    fromJSONKey :: FromJSONKeyFunction Version
fromJSONKey = (Text -> Parser Version) -> FromJSONKeyFunction Version
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser Text -> Parser Version
parseVersionText

parseVersionText :: Text -> Parser Version
parseVersionText :: Text -> Parser Version
parseVersionText = [(Version, String)] -> Parser Version
forall (m :: * -> *) a a. MonadFail m => [(a, [a])] -> m a
go ([(Version, String)] -> Parser Version)
-> (Text -> [(Version, String)]) -> Text -> Parser Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadP Version -> ReadS Version
forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
parseVersion ReadS Version -> (Text -> String) -> Text -> [(Version, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
  where
    go :: [(a, [a])] -> m a
go [(v :: a
v,[])] = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
    go (_ : xs :: [(a, [a])]
xs) = [(a, [a])] -> m a
go [(a, [a])]
xs
    go _        = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "parsing Version failed"

-------------------------------------------------------------------------------
-- semigroups NonEmpty
-------------------------------------------------------------------------------

instance FromJSON1 NonEmpty where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (NonEmpty a)
liftParseJSON p :: Value -> Parser a
p _ = String
-> (Array -> Parser (NonEmpty a)) -> Value -> Parser (NonEmpty a)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "NonEmpty" ((Array -> Parser (NonEmpty a)) -> Value -> Parser (NonEmpty a))
-> (Array -> Parser (NonEmpty a)) -> Value -> Parser (NonEmpty a)
forall a b. (a -> b) -> a -> b
$
        (Parser [a] -> ([a] -> Parser (NonEmpty a)) -> Parser (NonEmpty a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> Parser (NonEmpty a)
forall (m :: * -> *) a. MonadFail m => [a] -> m (NonEmpty a)
ne) (Parser [a] -> Parser (NonEmpty a))
-> (Array -> Parser [a]) -> Array -> Parser (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Parser a] -> Parser [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
Tr.sequence ([Parser a] -> Parser [a])
-> (Array -> [Parser a]) -> Array -> Parser [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Value -> Parser a) -> [Int] -> [Value] -> [Parser a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((Value -> Parser a) -> Int -> Value -> Parser a
forall a. (Value -> Parser a) -> Int -> Value -> Parser a
parseIndexedJSON Value -> Parser a
p) [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
      where
        ne :: [a] -> m (NonEmpty a)
ne []     = String -> m (NonEmpty a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "parsing NonEmpty failed, unexpected empty list"
        ne (x :: a
x:xs :: [a]
xs) = NonEmpty a -> m (NonEmpty a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs)
    {-# INLINE liftParseJSON #-}

instance (FromJSON a) => FromJSON (NonEmpty a) where
    parseJSON :: Value -> Parser (NonEmpty a)
parseJSON = Value -> Parser (NonEmpty a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}

-------------------------------------------------------------------------------
-- scientific
-------------------------------------------------------------------------------

instance FromJSON Scientific where
    parseJSON :: Value -> Parser Scientific
parseJSON = String
-> (Scientific -> Parser Scientific) -> Value -> Parser Scientific
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific "Scientific" Scientific -> Parser Scientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE parseJSON #-}

-------------------------------------------------------------------------------
-- DList
-------------------------------------------------------------------------------

instance FromJSON1 DList.DList where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (DList a)
liftParseJSON p :: Value -> Parser a
p _ = String -> (Array -> Parser (DList a)) -> Value -> Parser (DList a)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "DList" ((Array -> Parser (DList a)) -> Value -> Parser (DList a))
-> (Array -> Parser (DList a)) -> Value -> Parser (DList a)
forall a b. (a -> b) -> a -> b
$
      ([a] -> DList a) -> Parser [a] -> Parser (DList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> DList a
forall a. [a] -> DList a
DList.fromList (Parser [a] -> Parser (DList a))
-> (Array -> Parser [a]) -> Array -> Parser (DList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Parser a] -> Parser [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
Tr.sequence ([Parser a] -> Parser [a])
-> (Array -> [Parser a]) -> Array -> Parser [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Value -> Parser a) -> [Int] -> [Value] -> [Parser a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((Value -> Parser a) -> Int -> Value -> Parser a
forall a. (Value -> Parser a) -> Int -> Value -> Parser a
parseIndexedJSON Value -> Parser a
p) [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
    {-# INLINE liftParseJSON #-}

instance (FromJSON a) => FromJSON (DList.DList a) where
    parseJSON :: Value -> Parser (DList a)
parseJSON = Value -> Parser (DList a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}

-------------------------------------------------------------------------------
-- tranformers - Functors
-------------------------------------------------------------------------------

instance FromJSON1 Identity where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Identity a)
liftParseJSON p :: Value -> Parser a
p _ a :: Value
a = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> Parser a -> Parser (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
p Value
a
    {-# INLINE liftParseJSON #-}

    liftParseJSONList :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [Identity a]
liftParseJSONList _ p :: Value -> Parser [a]
p a :: Value
a = (a -> Identity a) -> [a] -> [Identity a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Identity a
forall a. a -> Identity a
Identity ([a] -> [Identity a]) -> Parser [a] -> Parser [Identity a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [a]
p Value
a
    {-# INLINE liftParseJSONList #-}

instance (FromJSON a) => FromJSON (Identity a) where
    parseJSON :: Value -> Parser (Identity a)
parseJSON = Value -> Parser (Identity a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}

    parseJSONList :: Value -> Parser [Identity a]
parseJSONList = (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [Identity a]
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [f a]
liftParseJSONList Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [a]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE parseJSONList #-}

instance (FromJSONKey a) => FromJSONKey (Identity a) where
    fromJSONKey :: FromJSONKeyFunction (Identity a)
fromJSONKey = FromJSONKeyFunction a -> FromJSONKeyFunction (Identity a)
forall a b.
Coercible a b =>
FromJSONKeyFunction a -> FromJSONKeyFunction b
coerceFromJSONKeyFunction (FromJSONKeyFunction a
forall a. FromJSONKey a => FromJSONKeyFunction a
fromJSONKey :: FromJSONKeyFunction a)
    fromJSONKeyList :: FromJSONKeyFunction [Identity a]
fromJSONKeyList = FromJSONKeyFunction [a] -> FromJSONKeyFunction [Identity a]
forall a b.
Coercible a b =>
FromJSONKeyFunction a -> FromJSONKeyFunction b
coerceFromJSONKeyFunction (FromJSONKeyFunction [a]
forall a. FromJSONKey a => FromJSONKeyFunction [a]
fromJSONKeyList :: FromJSONKeyFunction [a])


instance (FromJSON1 f, FromJSON1 g) => FromJSON1 (Compose f g) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Compose f g a)
liftParseJSON p :: Value -> Parser a
p pl :: Value -> Parser [a]
pl a :: Value
a = f (g a) -> Compose f g a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g a) -> Compose f g a)
-> Parser (f (g a)) -> Parser (Compose f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser (g a))
-> (Value -> Parser [g a]) -> Value -> Parser (f (g a))
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON Value -> Parser (g a)
g Value -> Parser [g a]
gl Value
a
      where
        g :: Value -> Parser (g a)
g  = (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (g a)
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON Value -> Parser a
p Value -> Parser [a]
pl
        gl :: Value -> Parser [g a]
gl = (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [g a]
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [f a]
liftParseJSONList Value -> Parser a
p Value -> Parser [a]
pl
    {-# INLINE liftParseJSON #-}

    liftParseJSONList :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [Compose f g a]
liftParseJSONList p :: Value -> Parser a
p pl :: Value -> Parser [a]
pl a :: Value
a = (f (g a) -> Compose f g a) -> [f (g a)] -> [Compose f g a]
forall a b. (a -> b) -> [a] -> [b]
map f (g a) -> Compose f g a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ([f (g a)] -> [Compose f g a])
-> Parser [f (g a)] -> Parser [Compose f g a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser (g a))
-> (Value -> Parser [g a]) -> Value -> Parser [f (g a)]
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [f a]
liftParseJSONList Value -> Parser (g a)
g Value -> Parser [g a]
gl Value
a
      where
        g :: Value -> Parser (g a)
g  = (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (g a)
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON Value -> Parser a
p Value -> Parser [a]
pl
        gl :: Value -> Parser [g a]
gl = (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [g a]
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [f a]
liftParseJSONList Value -> Parser a
p Value -> Parser [a]
pl
    {-# INLINE liftParseJSONList #-}

instance (FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (Compose f g a) where
    parseJSON :: Value -> Parser (Compose f g a)
parseJSON = Value -> Parser (Compose f g a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}

    parseJSONList :: Value -> Parser [Compose f g a]
parseJSONList = (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [Compose f g a]
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [f a]
liftParseJSONList Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [a]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE parseJSONList #-}


instance (FromJSON1 f, FromJSON1 g) => FromJSON1 (Product f g) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Product f g a)
liftParseJSON p :: Value -> Parser a
p pl :: Value -> Parser [a]
pl a :: Value
a = (f a -> g a -> Product f g a) -> (f a, g a) -> Product f g a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry f a -> g a -> Product f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair ((f a, g a) -> Product f g a)
-> Parser (f a, g a) -> Parser (Product f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser (f a))
-> (Value -> Parser [f a])
-> (Value -> Parser (g a))
-> (Value -> Parser [g a])
-> Value
-> Parser (f a, g a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser (f a)
px Value -> Parser [f a]
pxl Value -> Parser (g a)
py Value -> Parser [g a]
pyl Value
a
      where
        px :: Value -> Parser (f a)
px  = (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON Value -> Parser a
p Value -> Parser [a]
pl
        pxl :: Value -> Parser [f a]
pxl = (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [f a]
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [f a]
liftParseJSONList Value -> Parser a
p Value -> Parser [a]
pl
        py :: Value -> Parser (g a)
py  = (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (g a)
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON Value -> Parser a
p Value -> Parser [a]
pl
        pyl :: Value -> Parser [g a]
pyl = (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [g a]
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [f a]
liftParseJSONList Value -> Parser a
p Value -> Parser [a]
pl
    {-# INLINE liftParseJSON #-}

instance (FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (Product f g a) where
    parseJSON :: Value -> Parser (Product f g a)
parseJSON = Value -> Parser (Product f g a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}


instance (FromJSON1 f, FromJSON1 g) => FromJSON1 (Sum f g) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Sum f g a)
liftParseJSON p :: Value -> Parser a
p pl :: Value -> Parser [a]
pl (Object (Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
H.toList -> [(key :: Text
key, value :: Value
value)]))
        | Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
inl = f a -> Sum f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (f a -> Sum f g a) -> Parser (f a) -> Parser (Sum f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON Value -> Parser a
p Value -> Parser [a]
pl Value
value Parser (f a) -> JSONPathElement -> Parser (f a)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Text -> JSONPathElement
Key Text
inl
        | Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
inr = g a -> Sum f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (g a -> Sum f g a) -> Parser (g a) -> Parser (Sum f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (g a)
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON Value -> Parser a
p Value -> Parser [a]
pl Value
value Parser (g a) -> JSONPathElement -> Parser (g a)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Text -> JSONPathElement
Key Text
inl
      where
        inl, inr :: Text
        inl :: Text
inl = "InL"
        inr :: Text
inr = "InR"

    liftParseJSON _ _ _ = String -> Parser (Sum f g a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Sum f g a)) -> String -> Parser (Sum f g a)
forall a b. (a -> b) -> a -> b
$
        "parsing Sum failed, expected an object with a single property " String -> String -> String
forall a. [a] -> [a] -> [a]
++
        "where the property key should be either " String -> String -> String
forall a. [a] -> [a] -> [a]
++
        "\"InL\" or \"InR\""
    {-# INLINE liftParseJSON #-}

instance (FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (Sum f g a) where
    parseJSON :: Value -> Parser (Sum f g a)
parseJSON = Value -> Parser (Sum f g a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}

-------------------------------------------------------------------------------
-- containers
-------------------------------------------------------------------------------

instance FromJSON1 Seq.Seq where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Seq a)
liftParseJSON p :: Value -> Parser a
p _ = String -> (Array -> Parser (Seq a)) -> Value -> Parser (Seq a)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "Seq" ((Array -> Parser (Seq a)) -> Value -> Parser (Seq a))
-> (Array -> Parser (Seq a)) -> Value -> Parser (Seq a)
forall a b. (a -> b) -> a -> b
$
      ([a] -> Seq a) -> Parser [a] -> Parser (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList (Parser [a] -> Parser (Seq a))
-> (Array -> Parser [a]) -> Array -> Parser (Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Parser a] -> Parser [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
Tr.sequence ([Parser a] -> Parser [a])
-> (Array -> [Parser a]) -> Array -> Parser [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Value -> Parser a) -> [Int] -> [Value] -> [Parser a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((Value -> Parser a) -> Int -> Value -> Parser a
forall a. (Value -> Parser a) -> Int -> Value -> Parser a
parseIndexedJSON Value -> Parser a
p) [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
    {-# INLINE liftParseJSON #-}

instance (FromJSON a) => FromJSON (Seq.Seq a) where
    parseJSON :: Value -> Parser (Seq a)
parseJSON = Value -> Parser (Seq a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}


instance (Ord a, FromJSON a) => FromJSON (Set.Set a) where
    parseJSON :: Value -> Parser (Set a)
parseJSON = ([a] -> Set a) -> Parser [a] -> Parser (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList (Parser [a] -> Parser (Set a))
-> (Value -> Parser [a]) -> Value -> Parser (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
parseJSON
    {-# INLINE parseJSON #-}


instance FromJSON IntSet.IntSet where
    parseJSON :: Value -> Parser IntSet
parseJSON = ([Int] -> IntSet) -> Parser [Int] -> Parser IntSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int] -> IntSet
IntSet.fromList (Parser [Int] -> Parser IntSet)
-> (Value -> Parser [Int]) -> Value -> Parser IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser [Int]
forall a. FromJSON a => Value -> Parser a
parseJSON
    {-# INLINE parseJSON #-}


instance FromJSON1 IntMap.IntMap where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (IntMap a)
liftParseJSON p :: Value -> Parser a
p pl :: Value -> Parser [a]
pl = ([(Int, a)] -> IntMap a) -> Parser [(Int, a)] -> Parser (IntMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
IntMap.fromList (Parser [(Int, a)] -> Parser (IntMap a))
-> (Value -> Parser [(Int, a)]) -> Value -> Parser (IntMap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser (Int, a))
-> (Value -> Parser [(Int, a)]) -> Value -> Parser [(Int, a)]
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON Value -> Parser (Int, a)
p' Value -> Parser [(Int, a)]
pl'
      where
        p' :: Value -> Parser (Int, a)
p'  = (Value -> Parser Int)
-> (Value -> Parser [Int])
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (Int, a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2     Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [Int]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList Value -> Parser a
p Value -> Parser [a]
pl
        pl' :: Value -> Parser [(Int, a)]
pl' = (Value -> Parser Int)
-> (Value -> Parser [Int])
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser [(Int, a)]
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser [f a b]
liftParseJSONList2 Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [Int]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList Value -> Parser a
p Value -> Parser [a]
pl
    {-# INLINE liftParseJSON #-}

instance FromJSON a => FromJSON (IntMap.IntMap a) where
    parseJSON :: Value -> Parser (IntMap a)
parseJSON = ([(Int, a)] -> IntMap a) -> Parser [(Int, a)] -> Parser (IntMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
IntMap.fromList (Parser [(Int, a)] -> Parser (IntMap a))
-> (Value -> Parser [(Int, a)]) -> Value -> Parser (IntMap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser [(Int, a)]
forall a. FromJSON a => Value -> Parser a
parseJSON
    {-# INLINE parseJSON #-}


instance (FromJSONKey k, Ord k) => FromJSON1 (M.Map k) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Map k a)
liftParseJSON p :: Value -> Parser a
p _ = case FromJSONKeyFunction k
forall a. FromJSONKey a => FromJSONKeyFunction a
fromJSONKey of
        FromJSONKeyCoerce _ -> String -> (Object -> Parser (Map k a)) -> Value -> Parser (Map k a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Map" ((Object -> Parser (Map k a)) -> Value -> Parser (Map k a))
-> (Object -> Parser (Map k a)) -> Value -> Parser (Map k a)
forall a b. (a -> b) -> a -> b
$
            (HashMap Text a -> Map k a)
-> Parser (HashMap Text a) -> Parser (Map k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> a -> Map k a -> Map k a)
-> Map k a -> HashMap Text a -> Map k a
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
H.foldrWithKey (k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (k -> a -> Map k a -> Map k a)
-> (Text -> k) -> Text -> a -> Map k a -> Map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> k
forall a b. a -> b
unsafeCoerce) Map k a
forall k a. Map k a
M.empty) (Parser (HashMap Text a) -> Parser (Map k a))
-> (Object -> Parser (HashMap Text a))
-> Object
-> Parser (Map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Value -> Parser a) -> Object -> Parser (HashMap Text a)
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
H.traverseWithKey (\k :: Text
k v :: Value
v -> Value -> Parser a
p Value
v Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Text -> JSONPathElement
Key Text
k)
        FromJSONKeyText f :: Text -> k
f -> String -> (Object -> Parser (Map k a)) -> Value -> Parser (Map k a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Map" ((Object -> Parser (Map k a)) -> Value -> Parser (Map k a))
-> (Object -> Parser (Map k a)) -> Value -> Parser (Map k a)
forall a b. (a -> b) -> a -> b
$
            (HashMap Text a -> Map k a)
-> Parser (HashMap Text a) -> Parser (Map k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> a -> Map k a -> Map k a)
-> Map k a -> HashMap Text a -> Map k a
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
H.foldrWithKey (k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (k -> a -> Map k a -> Map k a)
-> (Text -> k) -> Text -> a -> Map k a -> Map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> k
f) Map k a
forall k a. Map k a
M.empty) (Parser (HashMap Text a) -> Parser (Map k a))
-> (Object -> Parser (HashMap Text a))
-> Object
-> Parser (Map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Value -> Parser a) -> Object -> Parser (HashMap Text a)
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
H.traverseWithKey (\k :: Text
k v :: Value
v -> Value -> Parser a
p Value
v Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Text -> JSONPathElement
Key Text
k)
        FromJSONKeyTextParser f :: Text -> Parser k
f -> String -> (Object -> Parser (Map k a)) -> Value -> Parser (Map k a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Map" ((Object -> Parser (Map k a)) -> Value -> Parser (Map k a))
-> (Object -> Parser (Map k a)) -> Value -> Parser (Map k a)
forall a b. (a -> b) -> a -> b
$
            (Text -> Value -> Parser (Map k a) -> Parser (Map k a))
-> Parser (Map k a) -> Object -> Parser (Map k a)
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
H.foldrWithKey (\k :: Text
k v :: Value
v m :: Parser (Map k a)
m -> k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (k -> a -> Map k a -> Map k a)
-> Parser k -> Parser (a -> Map k a -> Map k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser k
f Text
k Parser k -> JSONPathElement -> Parser k
forall a. Parser a -> JSONPathElement -> Parser a
<?> Text -> JSONPathElement
Key Text
k Parser (a -> Map k a -> Map k a)
-> Parser a -> Parser (Map k a -> Map k a)
forall (f :: * -> *) a b. Applicative f => 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
<?> Text -> JSONPathElement
Key Text
k Parser (Map k a -> Map k a) -> Parser (Map k a) -> Parser (Map k a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Map k a)
m) (Map k a -> Parser (Map k a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map k a
forall k a. Map k a
M.empty)
        FromJSONKeyValue f :: Value -> Parser k
f -> String -> (Array -> Parser (Map k a)) -> Value -> Parser (Map k a)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "Map" ((Array -> Parser (Map k a)) -> Value -> Parser (Map k a))
-> (Array -> Parser (Map k a)) -> Value -> Parser (Map k a)
forall a b. (a -> b) -> a -> b
$ \arr :: Array
arr ->
            ([(k, a)] -> Map k a) -> Parser [(k, a)] -> Parser (Map k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (Parser [(k, a)] -> Parser (Map k a))
-> (Array -> Parser [(k, a)]) -> Array -> Parser (Map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Parser (k, a)] -> Parser [(k, a)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
Tr.sequence ([Parser (k, a)] -> Parser [(k, a)])
-> (Array -> [Parser (k, a)]) -> Array -> Parser [(k, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                (Int -> Value -> Parser (k, a))
-> [Int] -> [Value] -> [Parser (k, a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((Value -> Parser k)
-> (Value -> Parser a) -> Int -> Value -> Parser (k, a)
forall a b.
(Value -> Parser a)
-> (Value -> Parser b) -> Int -> Value -> Parser (a, b)
parseIndexedJSONPair Value -> Parser k
f Value -> Parser a
p) [0..] ([Value] -> [Parser (k, a)])
-> (Array -> [Value]) -> Array -> [Parser (k, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall a. Vector a -> [a]
V.toList (Array -> Parser (Map k a)) -> Array -> Parser (Map k a)
forall a b. (a -> b) -> a -> b
$ Array
arr
    {-# INLINE liftParseJSON #-}

instance (FromJSONKey k, Ord k, FromJSON v) => FromJSON (M.Map k v) where
    parseJSON :: Value -> Parser (Map k v)
parseJSON = Value -> Parser (Map k v)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}


instance FromJSON1 Tree.Tree where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Tree a)
liftParseJSON p :: Value -> Parser a
p pl :: Value -> Parser [a]
pl = Value -> Parser (Tree a)
go
      where
        go :: Value -> Parser (Tree a)
go v :: Value
v = (a -> Forest a -> Tree a) -> (a, Forest a) -> Tree a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
Tree.Node ((a, Forest a) -> Tree a)
-> Parser (a, Forest a) -> Parser (Tree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser (Forest a))
-> (Value -> Parser [Forest a])
-> Value
-> Parser (a, Forest a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser a
p Value -> Parser [a]
pl Value -> Parser (Forest a)
p' Value -> Parser [Forest a]
pl' Value
v

        p' :: Value -> Parser (Forest a)
p' = (Value -> Parser (Tree a))
-> (Value -> Parser (Forest a)) -> Value -> Parser (Forest a)
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON Value -> Parser (Tree a)
go ((Value -> Parser (Tree a)) -> Value -> Parser (Forest a)
forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser Value -> Parser (Tree a)
go)
        pl' :: Value -> Parser [Forest a]
pl'= (Value -> Parser (Tree a))
-> (Value -> Parser (Forest a)) -> Value -> Parser [Forest a]
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [f a]
liftParseJSONList Value -> Parser (Tree a)
go ((Value -> Parser (Tree a)) -> Value -> Parser (Forest a)
forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser Value -> Parser (Tree a)
go)

instance (FromJSON v) => FromJSON (Tree.Tree v) where
    parseJSON :: Value -> Parser (Tree v)
parseJSON = Value -> Parser (Tree v)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}

-------------------------------------------------------------------------------
-- uuid
-------------------------------------------------------------------------------

instance FromJSON UUID.UUID where
    parseJSON :: Value -> Parser UUID
parseJSON = String -> (Text -> Parser UUID) -> Value -> Parser UUID
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "UUID" ((Text -> Parser UUID) -> Value -> Parser UUID)
-> (Text -> Parser UUID) -> Value -> Parser UUID
forall a b. (a -> b) -> a -> b
$
        Parser UUID -> (UUID -> Parser UUID) -> Maybe UUID -> Parser UUID
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser UUID
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "invalid UUID") UUID -> Parser UUID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe UUID -> Parser UUID)
-> (Text -> Maybe UUID) -> Text -> Parser UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe UUID
UUID.fromText

instance FromJSONKey UUID.UUID where
    fromJSONKey :: FromJSONKeyFunction UUID
fromJSONKey = (Text -> Parser UUID) -> FromJSONKeyFunction UUID
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser UUID) -> FromJSONKeyFunction UUID)
-> (Text -> Parser UUID) -> FromJSONKeyFunction UUID
forall a b. (a -> b) -> a -> b
$
        Parser UUID -> (UUID -> Parser UUID) -> Maybe UUID -> Parser UUID
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser UUID
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "invalid UUID") UUID -> Parser UUID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe UUID -> Parser UUID)
-> (Text -> Maybe UUID) -> Text -> Parser UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe UUID
UUID.fromText

-------------------------------------------------------------------------------
-- vector
-------------------------------------------------------------------------------

instance FromJSON1 Vector where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Vector a)
liftParseJSON p :: Value -> Parser a
p _ = String
-> (Array -> Parser (Vector a)) -> Value -> Parser (Vector a)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "Vector" ((Array -> Parser (Vector a)) -> Value -> Parser (Vector a))
-> (Array -> Parser (Vector a)) -> Value -> Parser (Vector a)
forall a b. (a -> b) -> a -> b
$
        ((Int, Value) -> Parser a)
-> Vector (Int, Value) -> Parser (Vector a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM ((Int -> Value -> Parser a) -> (Int, Value) -> Parser a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> Value -> Parser a) -> (Int, Value) -> Parser a)
-> (Int -> Value -> Parser a) -> (Int, Value) -> Parser a
forall a b. (a -> b) -> a -> b
$ (Value -> Parser a) -> Int -> Value -> Parser a
forall a. (Value -> Parser a) -> Int -> Value -> Parser a
parseIndexedJSON Value -> Parser a
p) (Vector (Int, Value) -> Parser (Vector a))
-> (Array -> Vector (Int, Value)) -> Array -> Parser (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> Vector (Int, Value)
forall a. Vector a -> Vector (Int, a)
V.indexed
    {-# INLINE liftParseJSON #-}

instance (FromJSON a) => FromJSON (Vector a) where
    parseJSON :: Value -> Parser (Vector a)
parseJSON = Value -> Parser (Vector a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}


vectorParseJSON :: (FromJSON a, VG.Vector w a) => String -> Value -> Parser (w a)
vectorParseJSON :: String -> Value -> Parser (w a)
vectorParseJSON s :: String
s = String -> (Array -> Parser (w a)) -> Value -> Parser (w a)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
s ((Array -> Parser (w a)) -> Value -> Parser (w a))
-> (Array -> Parser (w a)) -> Value -> Parser (w a)
forall a b. (a -> b) -> a -> b
$ (Vector a -> w a) -> Parser (Vector a) -> Parser (w a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> w a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
V.convert (Parser (Vector a) -> Parser (w a))
-> (Array -> Parser (Vector a)) -> Array -> Parser (w a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Value) -> Parser a)
-> Vector (Int, Value) -> Parser (Vector a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM ((Int -> Value -> Parser a) -> (Int, Value) -> Parser a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> Value -> Parser a) -> (Int, Value) -> Parser a)
-> (Int -> Value -> Parser a) -> (Int, Value) -> Parser a
forall a b. (a -> b) -> a -> b
$ (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) (Vector (Int, Value) -> Parser (Vector a))
-> (Array -> Vector (Int, Value)) -> Array -> Parser (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> Vector (Int, Value)
forall a. Vector a -> Vector (Int, a)
V.indexed
{-# INLINE vectorParseJSON #-}

instance (Storable a, FromJSON a) => FromJSON (VS.Vector a) where
    parseJSON :: Value -> Parser (Vector a)
parseJSON = String -> Value -> Parser (Vector a)
forall a (w :: * -> *).
(FromJSON a, Vector w a) =>
String -> Value -> Parser (w a)
vectorParseJSON "Data.Vector.Storable.Vector"

instance (VP.Prim a, FromJSON a) => FromJSON (VP.Vector a) where
    parseJSON :: Value -> Parser (Vector a)
parseJSON = String -> Value -> Parser (Vector a)
forall a (w :: * -> *).
(FromJSON a, Vector w a) =>
String -> Value -> Parser (w a)
vectorParseJSON "Data.Vector.Primitive.Vector"
    {-# INLINE parseJSON #-}

instance (VG.Vector VU.Vector a, FromJSON a) => FromJSON (VU.Vector a) where
    parseJSON :: Value -> Parser (Vector a)
parseJSON = String -> Value -> Parser (Vector a)
forall a (w :: * -> *).
(FromJSON a, Vector w a) =>
String -> Value -> Parser (w a)
vectorParseJSON "Data.Vector.Unboxed.Vector"
    {-# INLINE parseJSON #-}

-------------------------------------------------------------------------------
-- unordered-containers
-------------------------------------------------------------------------------

instance (Eq a, Hashable a, FromJSON a) => FromJSON (HashSet.HashSet a) where
    parseJSON :: Value -> Parser (HashSet a)
parseJSON = ([a] -> HashSet a) -> Parser [a] -> Parser (HashSet a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList (Parser [a] -> Parser (HashSet a))
-> (Value -> Parser [a]) -> Value -> Parser (HashSet a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
parseJSON
    {-# INLINE parseJSON #-}


instance (FromJSONKey k, Eq k, Hashable k) => FromJSON1 (H.HashMap k) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (HashMap k a)
liftParseJSON p :: Value -> Parser a
p _ = case FromJSONKeyFunction k
forall a. FromJSONKey a => FromJSONKeyFunction a
fromJSONKey of
        FromJSONKeyCoerce _ -> String
-> (Object -> Parser (HashMap k a))
-> Value
-> Parser (HashMap k a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "HashMap ~Text" ((Object -> Parser (HashMap k a)) -> Value -> Parser (HashMap k a))
-> (Object -> Parser (HashMap k a))
-> Value
-> Parser (HashMap k a)
forall a b. (a -> b) -> a -> b
$
            Parser (HashMap Text a) -> Parser (HashMap k a)
forall v. Parser (HashMap Text v) -> Parser (HashMap k v)
uc (Parser (HashMap Text a) -> Parser (HashMap k a))
-> (Object -> Parser (HashMap Text a))
-> Object
-> Parser (HashMap k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Value -> Parser a) -> Object -> Parser (HashMap Text a)
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
H.traverseWithKey (\k :: Text
k v :: Value
v -> Value -> Parser a
p Value
v Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Text -> JSONPathElement
Key Text
k)
        FromJSONKeyText f :: Text -> k
f -> String
-> (Object -> Parser (HashMap k a))
-> Value
-> Parser (HashMap k a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "HashMap" ((Object -> Parser (HashMap k a)) -> Value -> Parser (HashMap k a))
-> (Object -> Parser (HashMap k a))
-> Value
-> Parser (HashMap k a)
forall a b. (a -> b) -> a -> b
$
            (HashMap Text a -> HashMap k a)
-> Parser (HashMap Text a) -> Parser (HashMap k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> k) -> HashMap Text a -> HashMap k a
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
mapKey Text -> k
f) (Parser (HashMap Text a) -> Parser (HashMap k a))
-> (Object -> Parser (HashMap Text a))
-> Object
-> Parser (HashMap k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Value -> Parser a) -> Object -> Parser (HashMap Text a)
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
H.traverseWithKey (\k :: Text
k v :: Value
v -> Value -> Parser a
p Value
v Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Text -> JSONPathElement
Key Text
k)
        FromJSONKeyTextParser f :: Text -> Parser k
f -> String
-> (Object -> Parser (HashMap k a))
-> Value
-> Parser (HashMap k a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "HashMap" ((Object -> Parser (HashMap k a)) -> Value -> Parser (HashMap k a))
-> (Object -> Parser (HashMap k a))
-> Value
-> Parser (HashMap k a)
forall a b. (a -> b) -> a -> b
$
            (Text -> Value -> Parser (HashMap k a) -> Parser (HashMap k a))
-> Parser (HashMap k a) -> Object -> Parser (HashMap k a)
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
H.foldrWithKey (\k :: Text
k v :: Value
v m :: Parser (HashMap k a)
m -> k -> a -> HashMap k a -> HashMap k a
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert (k -> a -> HashMap k a -> HashMap k a)
-> Parser k -> Parser (a -> HashMap k a -> HashMap k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser k
f Text
k Parser k -> JSONPathElement -> Parser k
forall a. Parser a -> JSONPathElement -> Parser a
<?> Text -> JSONPathElement
Key Text
k Parser (a -> HashMap k a -> HashMap k a)
-> Parser a -> Parser (HashMap k a -> HashMap k a)
forall (f :: * -> *) a b. Applicative f => 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
<?> Text -> JSONPathElement
Key Text
k Parser (HashMap k a -> HashMap k a)
-> Parser (HashMap k a) -> Parser (HashMap k a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (HashMap k a)
m) (HashMap k a -> Parser (HashMap k a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap k a
forall k v. HashMap k v
H.empty)
        FromJSONKeyValue f :: Value -> Parser k
f -> String
-> (Array -> Parser (HashMap k a)) -> Value -> Parser (HashMap k a)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "Map" ((Array -> Parser (HashMap k a)) -> Value -> Parser (HashMap k a))
-> (Array -> Parser (HashMap k a)) -> Value -> Parser (HashMap k a)
forall a b. (a -> b) -> a -> b
$ \arr :: Array
arr ->
            ([(k, a)] -> HashMap k a)
-> Parser [(k, a)] -> Parser (HashMap k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, a)] -> HashMap k a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList (Parser [(k, a)] -> Parser (HashMap k a))
-> (Array -> Parser [(k, a)]) -> Array -> Parser (HashMap k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Parser (k, a)] -> Parser [(k, a)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
Tr.sequence ([Parser (k, a)] -> Parser [(k, a)])
-> (Array -> [Parser (k, a)]) -> Array -> Parser [(k, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                (Int -> Value -> Parser (k, a))
-> [Int] -> [Value] -> [Parser (k, a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((Value -> Parser k)
-> (Value -> Parser a) -> Int -> Value -> Parser (k, a)
forall a b.
(Value -> Parser a)
-> (Value -> Parser b) -> Int -> Value -> Parser (a, b)
parseIndexedJSONPair Value -> Parser k
f Value -> Parser a
p) [0..] ([Value] -> [Parser (k, a)])
-> (Array -> [Value]) -> Array -> [Parser (k, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall a. Vector a -> [a]
V.toList (Array -> Parser (HashMap k a)) -> Array -> Parser (HashMap k a)
forall a b. (a -> b) -> a -> b
$ Array
arr
      where
        uc :: Parser (H.HashMap Text v) -> Parser (H.HashMap k v)
        uc :: Parser (HashMap Text v) -> Parser (HashMap k v)
uc = Parser (HashMap Text v) -> Parser (HashMap k v)
forall a b. a -> b
unsafeCoerce

instance (FromJSON v, FromJSONKey k, Eq k, Hashable k) => FromJSON (H.HashMap k v) where
    parseJSON :: Value -> Parser (HashMap k v)
parseJSON = Value -> Parser (HashMap k v)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}

-------------------------------------------------------------------------------
-- aeson
-------------------------------------------------------------------------------

instance FromJSON Value where
    parseJSON :: Value -> Parser Value
parseJSON = Value -> Parser Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE parseJSON #-}

instance FromJSON DotNetTime where
    parseJSON :: Value -> Parser DotNetTime
parseJSON = String -> (Text -> Parser DotNetTime) -> Value -> Parser DotNetTime
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "DotNetTime" ((Text -> Parser DotNetTime) -> Value -> Parser DotNetTime)
-> (Text -> Parser DotNetTime) -> Value -> Parser DotNetTime
forall a b. (a -> b) -> a -> b
$ \t :: Text
t ->
        let (s :: Text
s,m :: Text
m) = Int -> Text -> (Text, Text)
T.splitAt (Text -> Int
T.length Text
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- 5) Text
t
            t' :: Text
t'    = [Text] -> Text
T.concat [Text
s,".",Text
m]
        in case Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale "/Date(%s%Q)/" (Text -> String
unpack Text
t') of
             Just d :: UTCTime
d -> DotNetTime -> Parser DotNetTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> DotNetTime
DotNetTime UTCTime
d)
             _      -> String -> Parser DotNetTime
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "could not parse .NET time"
    {-# INLINE parseJSON #-}

-------------------------------------------------------------------------------
-- primitive
-------------------------------------------------------------------------------

#if MIN_VERSION_base(4,7,0)
instance FromJSON a => FromJSON (PM.Array a) where
  -- note: we could do better than this if vector exposed the data
  -- constructor in Data.Vector.
  parseJSON :: Value -> Parser (Array a)
parseJSON = ([a] -> Array a) -> Parser [a] -> Parser (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Array a
forall l. IsList l => [Item l] -> l
Exts.fromList (Parser [a] -> Parser (Array a))
-> (Value -> Parser [a]) -> Value -> Parser (Array a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
parseJSON

instance FromJSON a => FromJSON (PM.SmallArray a) where
  parseJSON :: Value -> Parser (SmallArray a)
parseJSON = ([a] -> SmallArray a) -> Parser [a] -> Parser (SmallArray a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> SmallArray a
forall l. IsList l => [Item l] -> l
Exts.fromList (Parser [a] -> Parser (SmallArray a))
-> (Value -> Parser [a]) -> Value -> Parser (SmallArray a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
parseJSON

#if MIN_VERSION_primitive(0,6,4)
instance (PM.Prim a,FromJSON a) => FromJSON (PM.PrimArray a) where
  parseJSON :: Value -> Parser (PrimArray a)
parseJSON = ([a] -> PrimArray a) -> Parser [a] -> Parser (PrimArray a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> PrimArray a
forall l. IsList l => [Item l] -> l
Exts.fromList (Parser [a] -> Parser (PrimArray a))
-> (Value -> Parser [a]) -> Value -> Parser (PrimArray a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
parseJSON

#if !MIN_VERSION_primitive(0,7,0)
instance (PM.PrimUnlifted a,FromJSON a) => FromJSON (PM.UnliftedArray a) where
  parseJSON = fmap Exts.fromList . parseJSON
#endif
#endif
#endif

-------------------------------------------------------------------------------
-- time
-------------------------------------------------------------------------------

instance FromJSON Day where
    parseJSON :: Value -> Parser Day
parseJSON = String -> (Text -> Parser Day) -> Value -> Parser Day
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "Day" (Parser Day -> Text -> Parser Day
forall a. Parser a -> Text -> Parser a
Time.run Parser Day
Time.day)

instance FromJSONKey Day where
    fromJSONKey :: FromJSONKeyFunction Day
fromJSONKey = (Text -> Parser Day) -> FromJSONKeyFunction Day
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser (Parser Day -> Text -> Parser Day
forall a. Parser a -> Text -> Parser a
Time.run Parser Day
Time.day)


instance FromJSON TimeOfDay where
    parseJSON :: Value -> Parser TimeOfDay
parseJSON = String -> (Text -> Parser TimeOfDay) -> Value -> Parser TimeOfDay
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "TimeOfDay" (Parser TimeOfDay -> Text -> Parser TimeOfDay
forall a. Parser a -> Text -> Parser a
Time.run Parser TimeOfDay
Time.timeOfDay)

instance FromJSONKey TimeOfDay where
    fromJSONKey :: FromJSONKeyFunction TimeOfDay
fromJSONKey = (Text -> Parser TimeOfDay) -> FromJSONKeyFunction TimeOfDay
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser (Parser TimeOfDay -> Text -> Parser TimeOfDay
forall a. Parser a -> Text -> Parser a
Time.run Parser TimeOfDay
Time.timeOfDay)


instance FromJSON LocalTime where
    parseJSON :: Value -> Parser LocalTime
parseJSON = String -> (Text -> Parser LocalTime) -> Value -> Parser LocalTime
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "LocalTime" (Parser LocalTime -> Text -> Parser LocalTime
forall a. Parser a -> Text -> Parser a
Time.run Parser LocalTime
Time.localTime)

instance FromJSONKey LocalTime where
    fromJSONKey :: FromJSONKeyFunction LocalTime
fromJSONKey = (Text -> Parser LocalTime) -> FromJSONKeyFunction LocalTime
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser (Parser LocalTime -> Text -> Parser LocalTime
forall a. Parser a -> Text -> Parser a
Time.run Parser LocalTime
Time.localTime)


-- | Supported string formats:
--
-- @YYYY-MM-DD HH:MM Z@
-- @YYYY-MM-DD HH:MM:SS Z@
-- @YYYY-MM-DD HH:MM:SS.SSS Z@
--
-- The first space may instead be a @T@, and the second space is
-- optional.  The @Z@ represents UTC.  The @Z@ may be replaced with a
-- time zone offset of the form @+0000@ or @-08:00@, where the first
-- two digits are hours, the @:@ is optional and the second two digits
-- (also optional) are minutes.
instance FromJSON ZonedTime where
    parseJSON :: Value -> Parser ZonedTime
parseJSON = String -> (Text -> Parser ZonedTime) -> Value -> Parser ZonedTime
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "ZonedTime" (Parser ZonedTime -> Text -> Parser ZonedTime
forall a. Parser a -> Text -> Parser a
Time.run Parser ZonedTime
Time.zonedTime)

instance FromJSONKey ZonedTime where
    fromJSONKey :: FromJSONKeyFunction ZonedTime
fromJSONKey = (Text -> Parser ZonedTime) -> FromJSONKeyFunction ZonedTime
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser (Parser ZonedTime -> Text -> Parser ZonedTime
forall a. Parser a -> Text -> Parser a
Time.run Parser ZonedTime
Time.zonedTime)


instance FromJSON UTCTime where
    parseJSON :: Value -> Parser UTCTime
parseJSON = String -> (Text -> Parser UTCTime) -> Value -> Parser UTCTime
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "UTCTime" (Parser UTCTime -> Text -> Parser UTCTime
forall a. Parser a -> Text -> Parser a
Time.run Parser UTCTime
Time.utcTime)

instance FromJSONKey UTCTime where
    fromJSONKey :: FromJSONKeyFunction UTCTime
fromJSONKey = (Text -> Parser UTCTime) -> FromJSONKeyFunction UTCTime
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser (Parser UTCTime -> Text -> Parser UTCTime
forall a. Parser a -> Text -> Parser a
Time.run Parser UTCTime
Time.utcTime)


-- | This instance includes a bounds check to prevent maliciously
-- large inputs to fill up the memory of the target system. You can
-- newtype 'Scientific' and provide your own instance using
-- 'withScientific' if you want to allow larger inputs.
instance FromJSON NominalDiffTime where
    parseJSON :: Value -> Parser NominalDiffTime
parseJSON = String
-> (Scientific -> Parser NominalDiffTime)
-> Value
-> Parser NominalDiffTime
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific "NominalDiffTime" ((Scientific -> Parser NominalDiffTime)
 -> Value -> Parser NominalDiffTime)
-> (Scientific -> Parser NominalDiffTime)
-> Value
-> Parser NominalDiffTime
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Parser NominalDiffTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NominalDiffTime -> Parser NominalDiffTime)
-> (Scientific -> NominalDiffTime)
-> Scientific
-> Parser NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac
    {-# INLINE parseJSON #-}


-- | This instance includes a bounds check to prevent maliciously
-- large inputs to fill up the memory of the target system. You can
-- newtype 'Scientific' and provide your own instance using
-- 'withScientific' if you want to allow larger inputs.
instance FromJSON DiffTime where
    parseJSON :: Value -> Parser DiffTime
parseJSON = String
-> (Scientific -> Parser DiffTime) -> Value -> Parser DiffTime
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withBoundedScientific "DiffTime" ((Scientific -> Parser DiffTime) -> Value -> Parser DiffTime)
-> (Scientific -> Parser DiffTime) -> Value -> Parser DiffTime
forall a b. (a -> b) -> a -> b
$ DiffTime -> Parser DiffTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiffTime -> Parser DiffTime)
-> (Scientific -> DiffTime) -> Scientific -> Parser DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac
    {-# INLINE parseJSON #-}

instance FromJSON SystemTime where
    parseJSON :: Value -> Parser SystemTime
parseJSON v :: Value
v = String -> Parser SystemTime -> Parser SystemTime
forall a. String -> Parser a -> Parser a
prependContext "SystemTime" (Parser SystemTime -> Parser SystemTime)
-> Parser SystemTime -> Parser SystemTime
forall a b. (a -> b) -> a -> b
$ do
        Fixed E9
n <- Value -> Parser (Fixed E9)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
        let n' :: Integer
n' = Fixed E9 -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Fixed E9
n Fixed E9 -> Fixed E9 -> Fixed E9
forall a. Num a => a -> a -> a
* Integer -> Fixed E9
forall a. Num a => Integer -> a
fromInteger (Fixed E9 -> Integer
forall a (p :: * -> *). HasResolution a => p a -> Integer
resolution Fixed E9
n) :: Nano)
        let (secs :: Integer
secs, nano :: Integer
nano) = Integer
n' Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Fixed E9 -> Integer
forall a (p :: * -> *). HasResolution a => p a -> Integer
resolution Fixed E9
n
        SystemTime -> Parser SystemTime
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Word32 -> SystemTime
MkSystemTime (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
secs) (Integer -> Word32
forall a. Num a => Integer -> a
fromInteger Integer
nano))

instance FromJSON CalendarDiffTime where
    parseJSON :: Value -> Parser CalendarDiffTime
parseJSON = String
-> (Object -> Parser CalendarDiffTime)
-> Value
-> Parser CalendarDiffTime
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "CalendarDiffTime" ((Object -> Parser CalendarDiffTime)
 -> Value -> Parser CalendarDiffTime)
-> (Object -> Parser CalendarDiffTime)
-> Value
-> Parser CalendarDiffTime
forall a b. (a -> b) -> a -> b
$ \obj :: Object
obj -> Integer -> NominalDiffTime -> CalendarDiffTime
CalendarDiffTime
        (Integer -> NominalDiffTime -> CalendarDiffTime)
-> Parser Integer -> Parser (NominalDiffTime -> CalendarDiffTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: "months"
        Parser (NominalDiffTime -> CalendarDiffTime)
-> Parser NominalDiffTime -> Parser CalendarDiffTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser NominalDiffTime
forall a. FromJSON a => Object -> Text -> Parser a
.: "time"

instance FromJSON CalendarDiffDays where
    parseJSON :: Value -> Parser CalendarDiffDays
parseJSON = String
-> (Object -> Parser CalendarDiffDays)
-> Value
-> Parser CalendarDiffDays
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "CalendarDiffDays" ((Object -> Parser CalendarDiffDays)
 -> Value -> Parser CalendarDiffDays)
-> (Object -> Parser CalendarDiffDays)
-> Value
-> Parser CalendarDiffDays
forall a b. (a -> b) -> a -> b
$ \obj :: Object
obj -> Integer -> Integer -> CalendarDiffDays
CalendarDiffDays
        (Integer -> Integer -> CalendarDiffDays)
-> Parser Integer -> Parser (Integer -> CalendarDiffDays)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: "months"
        Parser (Integer -> CalendarDiffDays)
-> Parser Integer -> Parser CalendarDiffDays
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: "days"

instance FromJSON DayOfWeek where
    parseJSON :: Value -> Parser DayOfWeek
parseJSON = String -> (Text -> Parser DayOfWeek) -> Value -> Parser DayOfWeek
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "DaysOfWeek" Text -> Parser DayOfWeek
parseDayOfWeek

parseDayOfWeek :: T.Text -> Parser DayOfWeek
parseDayOfWeek :: Text -> Parser DayOfWeek
parseDayOfWeek t :: Text
t = case Text -> Text
T.toLower Text
t of
    "monday"    -> DayOfWeek -> Parser DayOfWeek
forall (m :: * -> *) a. Monad m => a -> m a
return DayOfWeek
Monday
    "tuesday"   -> DayOfWeek -> Parser DayOfWeek
forall (m :: * -> *) a. Monad m => a -> m a
return DayOfWeek
Tuesday
    "wednesday" -> DayOfWeek -> Parser DayOfWeek
forall (m :: * -> *) a. Monad m => a -> m a
return DayOfWeek
Wednesday
    "thursday"  -> DayOfWeek -> Parser DayOfWeek
forall (m :: * -> *) a. Monad m => a -> m a
return DayOfWeek
Thursday
    "friday"    -> DayOfWeek -> Parser DayOfWeek
forall (m :: * -> *) a. Monad m => a -> m a
return DayOfWeek
Friday
    "saturday"  -> DayOfWeek -> Parser DayOfWeek
forall (m :: * -> *) a. Monad m => a -> m a
return DayOfWeek
Saturday
    "sunday"    -> DayOfWeek -> Parser DayOfWeek
forall (m :: * -> *) a. Monad m => a -> m a
return DayOfWeek
Sunday
    _           -> String -> Parser DayOfWeek
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid week day"

instance FromJSONKey DayOfWeek where
    fromJSONKey :: FromJSONKeyFunction DayOfWeek
fromJSONKey = (Text -> Parser DayOfWeek) -> FromJSONKeyFunction DayOfWeek
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser Text -> Parser DayOfWeek
parseDayOfWeek

-------------------------------------------------------------------------------
-- base Monoid/Semigroup
-------------------------------------------------------------------------------

instance FromJSON1 Monoid.Dual where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Dual a)
liftParseJSON p :: Value -> Parser a
p _ = (a -> Dual a) -> Parser a -> Parser (Dual a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Dual a
forall a. a -> Dual a
Monoid.Dual (Parser a -> Parser (Dual a))
-> (Value -> Parser a) -> Value -> Parser (Dual a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
p
    {-# INLINE liftParseJSON #-}

instance FromJSON a => FromJSON (Monoid.Dual a) where
    parseJSON :: Value -> Parser (Dual a)
parseJSON = Value -> Parser (Dual a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}


instance FromJSON1 Monoid.First where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (First a)
liftParseJSON p :: Value -> Parser a
p p' :: Value -> Parser [a]
p' = (Maybe a -> First a) -> Parser (Maybe a) -> Parser (First a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> First a
forall a. Maybe a -> First a
Monoid.First (Parser (Maybe a) -> Parser (First a))
-> (Value -> Parser (Maybe a)) -> Value -> Parser (First a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Maybe a)
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON Value -> Parser a
p Value -> Parser [a]
p'
    {-# INLINE liftParseJSON #-}

instance FromJSON a => FromJSON (Monoid.First a) where
    parseJSON :: Value -> Parser (First a)
parseJSON = Value -> Parser (First a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}


instance FromJSON1 Monoid.Last where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Last a)
liftParseJSON p :: Value -> Parser a
p p' :: Value -> Parser [a]
p' = (Maybe a -> Last a) -> Parser (Maybe a) -> Parser (Last a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Last a
forall a. Maybe a -> Last a
Monoid.Last (Parser (Maybe a) -> Parser (Last a))
-> (Value -> Parser (Maybe a)) -> Value -> Parser (Last a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Maybe a)
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON Value -> Parser a
p Value -> Parser [a]
p'
    {-# INLINE liftParseJSON #-}

instance FromJSON a => FromJSON (Monoid.Last a) where
    parseJSON :: Value -> Parser (Last a)
parseJSON = Value -> Parser (Last a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}


instance FromJSON1 Semigroup.Min where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Min a)
liftParseJSON p :: Value -> Parser a
p _ a :: Value
a = a -> Min a
forall a. a -> Min a
Semigroup.Min (a -> Min a) -> Parser a -> Parser (Min a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
p Value
a
    {-# INLINE liftParseJSON #-}

    liftParseJSONList :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [Min a]
liftParseJSONList _ p :: Value -> Parser [a]
p a :: Value
a = (a -> Min a) -> [a] -> [Min a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Min a
forall a. a -> Min a
Semigroup.Min ([a] -> [Min a]) -> Parser [a] -> Parser [Min a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [a]
p Value
a
    {-# INLINE liftParseJSONList #-}

instance (FromJSON a) => FromJSON (Semigroup.Min a) where
    parseJSON :: Value -> Parser (Min a)
parseJSON = Value -> Parser (Min a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}

    parseJSONList :: Value -> Parser [Min a]
parseJSONList = (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [Min a]
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [f a]
liftParseJSONList Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [a]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE parseJSONList #-}


instance FromJSON1 Semigroup.Max where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Max a)
liftParseJSON p :: Value -> Parser a
p _ a :: Value
a = a -> Max a
forall a. a -> Max a
Semigroup.Max (a -> Max a) -> Parser a -> Parser (Max a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
p Value
a
    {-# INLINE liftParseJSON #-}

    liftParseJSONList :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [Max a]
liftParseJSONList _ p :: Value -> Parser [a]
p a :: Value
a = (a -> Max a) -> [a] -> [Max a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Max a
forall a. a -> Max a
Semigroup.Max ([a] -> [Max a]) -> Parser [a] -> Parser [Max a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [a]
p Value
a
    {-# INLINE liftParseJSONList #-}

instance (FromJSON a) => FromJSON (Semigroup.Max a) where
    parseJSON :: Value -> Parser (Max a)
parseJSON = Value -> Parser (Max a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}

    parseJSONList :: Value -> Parser [Max a]
parseJSONList = (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [Max a]
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [f a]
liftParseJSONList Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [a]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE parseJSONList #-}


instance FromJSON1 Semigroup.First where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (First a)
liftParseJSON p :: Value -> Parser a
p _ a :: Value
a = a -> First a
forall a. a -> First a
Semigroup.First (a -> First a) -> Parser a -> Parser (First a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
p Value
a
    {-# INLINE liftParseJSON #-}

    liftParseJSONList :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [First a]
liftParseJSONList _ p :: Value -> Parser [a]
p a :: Value
a = (a -> First a) -> [a] -> [First a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> First a
forall a. a -> First a
Semigroup.First ([a] -> [First a]) -> Parser [a] -> Parser [First a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [a]
p Value
a
    {-# INLINE liftParseJSONList #-}

instance (FromJSON a) => FromJSON (Semigroup.First a) where
    parseJSON :: Value -> Parser (First a)
parseJSON = Value -> Parser (First a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}

    parseJSONList :: Value -> Parser [First a]
parseJSONList = (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [First a]
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [f a]
liftParseJSONList Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [a]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE parseJSONList #-}


instance FromJSON1 Semigroup.Last where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Last a)
liftParseJSON p :: Value -> Parser a
p _ a :: Value
a = a -> Last a
forall a. a -> Last a
Semigroup.Last (a -> Last a) -> Parser a -> Parser (Last a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
p Value
a
    {-# INLINE liftParseJSON #-}

    liftParseJSONList :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [Last a]
liftParseJSONList _ p :: Value -> Parser [a]
p a :: Value
a = (a -> Last a) -> [a] -> [Last a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Last a
forall a. a -> Last a
Semigroup.Last ([a] -> [Last a]) -> Parser [a] -> Parser [Last a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [a]
p Value
a
    {-# INLINE liftParseJSONList #-}

instance (FromJSON a) => FromJSON (Semigroup.Last a) where
    parseJSON :: Value -> Parser (Last a)
parseJSON = Value -> Parser (Last a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}

    parseJSONList :: Value -> Parser [Last a]
parseJSONList = (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [Last a]
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [f a]
liftParseJSONList Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [a]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE parseJSONList #-}


instance FromJSON1 Semigroup.WrappedMonoid where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (WrappedMonoid a)
liftParseJSON p :: Value -> Parser a
p _ a :: Value
a = a -> WrappedMonoid a
forall m. m -> WrappedMonoid m
Semigroup.WrapMonoid (a -> WrappedMonoid a) -> Parser a -> Parser (WrappedMonoid a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
p Value
a
    {-# INLINE liftParseJSON #-}

    liftParseJSONList :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [WrappedMonoid a]
liftParseJSONList _ p :: Value -> Parser [a]
p a :: Value
a = (a -> WrappedMonoid a) -> [a] -> [WrappedMonoid a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> WrappedMonoid a
forall m. m -> WrappedMonoid m
Semigroup.WrapMonoid ([a] -> [WrappedMonoid a])
-> Parser [a] -> Parser [WrappedMonoid a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [a]
p Value
a
    {-# INLINE liftParseJSONList #-}

instance (FromJSON a) => FromJSON (Semigroup.WrappedMonoid a) where
    parseJSON :: Value -> Parser (WrappedMonoid a)
parseJSON = Value -> Parser (WrappedMonoid a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}

    parseJSONList :: Value -> Parser [WrappedMonoid a]
parseJSONList = (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [WrappedMonoid a]
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser [f a]
liftParseJSONList Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [a]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE parseJSONList #-}


instance FromJSON1 Semigroup.Option where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Option a)
liftParseJSON p :: Value -> Parser a
p p' :: Value -> Parser [a]
p' = (Maybe a -> Option a) -> Parser (Maybe a) -> Parser (Option a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Option a
forall a. Maybe a -> Option a
Semigroup.Option (Parser (Maybe a) -> Parser (Option a))
-> (Value -> Parser (Maybe a)) -> Value -> Parser (Option a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Maybe a)
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON Value -> Parser a
p Value -> Parser [a]
p'
    {-# INLINE liftParseJSON #-}

instance FromJSON a => FromJSON (Semigroup.Option a) where
    parseJSON :: Value -> Parser (Option a)
parseJSON = Value -> Parser (Option a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}

-------------------------------------------------------------------------------
-- tagged
-------------------------------------------------------------------------------

instance FromJSON1 Proxy where
    {-# INLINE liftParseJSON #-}
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Proxy a)
liftParseJSON _ _ = String -> Proxy a -> Value -> Parser (Proxy a)
forall a. String -> a -> Value -> Parser a
fromNull "Proxy" Proxy a
forall k (t :: k). Proxy t
Proxy

instance FromJSON (Proxy a) where
    {-# INLINE parseJSON #-}
    parseJSON :: Value -> Parser (Proxy a)
parseJSON = String -> Proxy a -> Value -> Parser (Proxy a)
forall a. String -> a -> Value -> Parser a
fromNull "Proxy" Proxy a
forall k (t :: k). Proxy t
Proxy

fromNull :: String -> a -> Value -> Parser a
fromNull :: String -> a -> Value -> Parser a
fromNull _ a :: a
a Null = a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
fromNull c :: String
c _ v :: Value
v    = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
prependContext String
c (String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch "Null" Value
v)

instance FromJSON2 Tagged where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (Tagged a b)
liftParseJSON2 _ _ p :: Value -> Parser b
p _ = (b -> Tagged a b) -> Parser b -> Parser (Tagged a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Tagged a b
forall k (s :: k) b. b -> Tagged s b
Tagged (Parser b -> Parser (Tagged a b))
-> (Value -> Parser b) -> Value -> Parser (Tagged a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser b
p
    {-# INLINE liftParseJSON2 #-}

instance FromJSON1 (Tagged a) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (Tagged a a)
liftParseJSON p :: Value -> Parser a
p _ = (a -> Tagged a a) -> Parser a -> Parser (Tagged a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Tagged a a
forall k (s :: k) b. b -> Tagged s b
Tagged (Parser a -> Parser (Tagged a a))
-> (Value -> Parser a) -> Value -> Parser (Tagged a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
p
    {-# INLINE liftParseJSON #-}

instance FromJSON b => FromJSON (Tagged a b) where
    parseJSON :: Value -> Parser (Tagged a b)
parseJSON = Value -> Parser (Tagged a b)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
    {-# INLINE parseJSON #-}

instance FromJSONKey b => FromJSONKey (Tagged a b) where
    fromJSONKey :: FromJSONKeyFunction (Tagged a b)
fromJSONKey = FromJSONKeyFunction b -> FromJSONKeyFunction (Tagged a b)
forall a b.
Coercible a b =>
FromJSONKeyFunction a -> FromJSONKeyFunction b
coerceFromJSONKeyFunction (FromJSONKeyFunction b
forall a. FromJSONKey a => FromJSONKeyFunction a
fromJSONKey :: FromJSONKeyFunction b)
    fromJSONKeyList :: FromJSONKeyFunction [Tagged a b]
fromJSONKeyList = (([b] -> [Tagged a b])
-> FromJSONKeyFunction [b] -> FromJSONKeyFunction [Tagged a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([b] -> [Tagged a b])
 -> FromJSONKeyFunction [b] -> FromJSONKeyFunction [Tagged a b])
-> ((b -> Tagged a b) -> [b] -> [Tagged a b])
-> (b -> Tagged a b)
-> FromJSONKeyFunction [b]
-> FromJSONKeyFunction [Tagged a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Tagged a b) -> [b] -> [Tagged a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) b -> Tagged a b
forall k (s :: k) b. b -> Tagged s b
Tagged FromJSONKeyFunction [b]
forall a. FromJSONKey a => FromJSONKeyFunction [a]
fromJSONKeyList

-------------------------------------------------------------------------------
-- Instances for converting from map keys
-------------------------------------------------------------------------------

instance (FromJSON a, FromJSON b) => FromJSONKey (a,b)
instance (FromJSON a, FromJSON b, FromJSON c) => FromJSONKey (a,b,c)
instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSONKey (a,b,c,d)

instance FromJSONKey Char where
    fromJSONKey :: FromJSONKeyFunction Char
fromJSONKey = (Text -> Parser Char) -> FromJSONKeyFunction Char
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser Text -> Parser Char
parseChar
    fromJSONKeyList :: FromJSONKeyFunction String
fromJSONKeyList = (Text -> String) -> FromJSONKeyFunction String
forall a. (Text -> a) -> FromJSONKeyFunction a
FromJSONKeyText Text -> String
T.unpack

instance (FromJSONKey a, FromJSON a) => FromJSONKey [a] where
    fromJSONKey :: FromJSONKeyFunction [a]
fromJSONKey = FromJSONKeyFunction [a]
forall a. FromJSONKey a => FromJSONKeyFunction [a]
fromJSONKeyList

-------------------------------------------------------------------------------
-- Tuple instances, see tuple-instances-from.hs
-------------------------------------------------------------------------------

instance FromJSON2 (,) where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (a, b)
liftParseJSON2 pA :: Value -> Parser a
pA _ pB :: Value -> Parser b
pB _ = String -> (Array -> Parser (a, b)) -> Value -> Parser (a, b)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "(a, b)" ((Array -> Parser (a, b)) -> Value -> Parser (a, b))
-> (Array -> Parser (a, b)) -> Value -> Parser (a, b)
forall a b. (a -> b) -> a -> b
$ \t :: Array
t ->
        let n :: Int
n = Array -> Int
forall a. Vector a -> Int
V.length Array
t
        in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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
pA 0 Array
t
                Parser (b -> (a, b)) -> Parser b -> Parser (a, 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
pB 1 Array
t
            else String -> Parser (a, b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a, b)) -> String -> Parser (a, b)
forall a b. (a -> b) -> a -> b
$ "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]
++ " into a tuple of length 2"
    {-# INLINE liftParseJSON2 #-}

instance (FromJSON a) => FromJSON1 ((,) a) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (a, a)
liftParseJSON = (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [a]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE liftParseJSON #-}

instance (FromJSON a, FromJSON b) => FromJSON (a, b) where
    parseJSON :: Value -> Parser (a, b)
parseJSON = Value -> Parser (a, b)
forall (f :: * -> * -> *) a b.
(FromJSON2 f, FromJSON a, FromJSON b) =>
Value -> Parser (f a b)
parseJSON2
    {-# INLINE parseJSON #-}


instance (FromJSON a) => FromJSON2 ((,,) a) where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (a, a, b)
liftParseJSON2 pB :: Value -> Parser a
pB _ pC :: Value -> Parser b
pC _ = String -> (Array -> Parser (a, a, b)) -> Value -> Parser (a, a, b)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "(a, b, c)" ((Array -> Parser (a, a, b)) -> Value -> Parser (a, a, b))
-> (Array -> Parser (a, a, b)) -> Value -> Parser (a, a, b)
forall a b. (a -> b) -> a -> b
$ \t :: Array
t ->
        let n :: Int
n = Array -> Int
forall a. Vector a -> Int
V.length Array
t
        in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 3
            then (,,)
                (a -> a -> b -> (a, a, b))
-> Parser a -> Parser (a -> b -> (a, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 0 Array
t
                Parser (a -> b -> (a, a, b)) -> Parser a -> Parser (b -> (a, a, b))
forall (f :: * -> *) a b. Applicative f => 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
pB 1 Array
t
                Parser (b -> (a, a, b)) -> Parser b -> Parser (a, a, 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
pC 2 Array
t
            else String -> Parser (a, a, b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a, a, b)) -> String -> Parser (a, a, b)
forall a b. (a -> b) -> a -> b
$ "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]
++ " into a tuple of length 3"
    {-# INLINE liftParseJSON2 #-}

instance (FromJSON a, FromJSON b) => FromJSON1 ((,,) a b) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (a, b, a)
liftParseJSON = (Value -> Parser b)
-> (Value -> Parser [b])
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [b]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE liftParseJSON #-}

instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a, b, c) where
    parseJSON :: Value -> Parser (a, b, c)
parseJSON = Value -> Parser (a, b, c)
forall (f :: * -> * -> *) a b.
(FromJSON2 f, FromJSON a, FromJSON b) =>
Value -> Parser (f a b)
parseJSON2
    {-# INLINE parseJSON #-}


instance (FromJSON a, FromJSON b) => FromJSON2 ((,,,) a b) where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (a, b, a, b)
liftParseJSON2 pC :: Value -> Parser a
pC _ pD :: Value -> Parser b
pD _ = String
-> (Array -> Parser (a, b, a, b)) -> Value -> Parser (a, b, a, b)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "(a, b, c, d)" ((Array -> Parser (a, b, a, b)) -> Value -> Parser (a, b, a, b))
-> (Array -> Parser (a, b, a, b)) -> Value -> Parser (a, b, a, b)
forall a b. (a -> b) -> a -> b
$ \t :: Array
t ->
        let n :: Int
n = Array -> Int
forall a. Vector a -> Int
V.length Array
t
        in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 4
            then (,,,)
                (a -> b -> a -> b -> (a, b, a, b))
-> Parser a -> Parser (b -> a -> b -> (a, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 0 Array
t
                Parser (b -> a -> b -> (a, b, a, b))
-> Parser b -> Parser (a -> b -> (a, b, a, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 1 Array
t
                Parser (a -> b -> (a, b, a, b))
-> Parser a -> Parser (b -> (a, b, a, b))
forall (f :: * -> *) a b. Applicative f => 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
pC 2 Array
t
                Parser (b -> (a, b, a, b)) -> Parser b -> Parser (a, b, a, 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
pD 3 Array
t
            else String -> Parser (a, b, a, b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a, b, a, b)) -> String -> Parser (a, b, a, b)
forall a b. (a -> b) -> a -> b
$ "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]
++ " into a tuple of length 4"
    {-# INLINE liftParseJSON2 #-}

instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON1 ((,,,) a b c) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (a, b, c, a)
liftParseJSON = (Value -> Parser c)
-> (Value -> Parser [c])
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser c
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [c]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE liftParseJSON #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON (a, b, c, d) where
    parseJSON :: Value -> Parser (a, b, c, d)
parseJSON = Value -> Parser (a, b, c, d)
forall (f :: * -> * -> *) a b.
(FromJSON2 f, FromJSON a, FromJSON b) =>
Value -> Parser (f a b)
parseJSON2
    {-# INLINE parseJSON #-}


instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON2 ((,,,,) a b c) where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (a, b, c, a, b)
liftParseJSON2 pD :: Value -> Parser a
pD _ pE :: Value -> Parser b
pE _ = String
-> (Array -> Parser (a, b, c, a, b))
-> Value
-> Parser (a, b, c, a, b)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "(a, b, c, d, e)" ((Array -> Parser (a, b, c, a, b))
 -> Value -> Parser (a, b, c, a, b))
-> (Array -> Parser (a, b, c, a, b))
-> Value
-> Parser (a, b, c, a, b)
forall a b. (a -> b) -> a -> b
$ \t :: Array
t ->
        let n :: Int
n = Array -> Int
forall a. Vector a -> Int
V.length Array
t
        in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 5
            then (,,,,)
                (a -> b -> c -> a -> b -> (a, b, c, a, b))
-> Parser a -> Parser (b -> c -> a -> b -> (a, b, c, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 0 Array
t
                Parser (b -> c -> a -> b -> (a, b, c, a, b))
-> Parser b -> Parser (c -> a -> b -> (a, b, c, a, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 1 Array
t
                Parser (c -> a -> b -> (a, b, c, a, b))
-> Parser c -> Parser (a -> b -> (a, b, c, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser c) -> Int -> Array -> Parser c
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser c
forall a. FromJSON a => Value -> Parser a
parseJSON 2 Array
t
                Parser (a -> b -> (a, b, c, a, b))
-> Parser a -> Parser (b -> (a, b, c, a, b))
forall (f :: * -> *) a b. Applicative f => 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
pD 3 Array
t
                Parser (b -> (a, b, c, a, b)) -> Parser b -> Parser (a, b, c, a, 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
pE 4 Array
t
            else String -> Parser (a, b, c, a, b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a, b, c, a, b))
-> String -> Parser (a, b, c, a, b)
forall a b. (a -> b) -> a -> b
$ "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]
++ " into a tuple of length 5"
    {-# INLINE liftParseJSON2 #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON1 ((,,,,) a b c d) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (a, b, c, d, a)
liftParseJSON = (Value -> Parser d)
-> (Value -> Parser [d])
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser d
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [d]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE liftParseJSON #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) => FromJSON (a, b, c, d, e) where
    parseJSON :: Value -> Parser (a, b, c, d, e)
parseJSON = Value -> Parser (a, b, c, d, e)
forall (f :: * -> * -> *) a b.
(FromJSON2 f, FromJSON a, FromJSON b) =>
Value -> Parser (f a b)
parseJSON2
    {-# INLINE parseJSON #-}


instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON2 ((,,,,,) a b c d) where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (a, b, c, d, a, b)
liftParseJSON2 pE :: Value -> Parser a
pE _ pF :: Value -> Parser b
pF _ = String
-> (Array -> Parser (a, b, c, d, a, b))
-> Value
-> Parser (a, b, c, d, a, b)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "(a, b, c, d, e, f)" ((Array -> Parser (a, b, c, d, a, b))
 -> Value -> Parser (a, b, c, d, a, b))
-> (Array -> Parser (a, b, c, d, a, b))
-> Value
-> Parser (a, b, c, d, a, b)
forall a b. (a -> b) -> a -> b
$ \t :: Array
t ->
        let n :: Int
n = Array -> Int
forall a. Vector a -> Int
V.length Array
t
        in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 6
            then (,,,,,)
                (a -> b -> c -> d -> a -> b -> (a, b, c, d, a, b))
-> Parser a -> Parser (b -> c -> d -> a -> b -> (a, b, c, d, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 0 Array
t
                Parser (b -> c -> d -> a -> b -> (a, b, c, d, a, b))
-> Parser b -> Parser (c -> d -> a -> b -> (a, b, c, d, a, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 1 Array
t
                Parser (c -> d -> a -> b -> (a, b, c, d, a, b))
-> Parser c -> Parser (d -> a -> b -> (a, b, c, d, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser c) -> Int -> Array -> Parser c
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser c
forall a. FromJSON a => Value -> Parser a
parseJSON 2 Array
t
                Parser (d -> a -> b -> (a, b, c, d, a, b))
-> Parser d -> Parser (a -> b -> (a, b, c, d, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser d) -> Int -> Array -> Parser d
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser d
forall a. FromJSON a => Value -> Parser a
parseJSON 3 Array
t
                Parser (a -> b -> (a, b, c, d, a, b))
-> Parser a -> Parser (b -> (a, b, c, d, a, b))
forall (f :: * -> *) a b. Applicative f => 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
pE 4 Array
t
                Parser (b -> (a, b, c, d, a, b))
-> Parser b -> Parser (a, b, c, d, a, 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
pF 5 Array
t
            else String -> Parser (a, b, c, d, a, b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a, b, c, d, a, b))
-> String -> Parser (a, b, c, d, a, b)
forall a b. (a -> b) -> a -> b
$ "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]
++ " into a tuple of length 6"
    {-# INLINE liftParseJSON2 #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) => FromJSON1 ((,,,,,) a b c d e) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (a, b, c, d, e, a)
liftParseJSON = (Value -> Parser e)
-> (Value -> Parser [e])
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser e
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [e]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE liftParseJSON #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f) => FromJSON (a, b, c, d, e, f) where
    parseJSON :: Value -> Parser (a, b, c, d, e, f)
parseJSON = Value -> Parser (a, b, c, d, e, f)
forall (f :: * -> * -> *) a b.
(FromJSON2 f, FromJSON a, FromJSON b) =>
Value -> Parser (f a b)
parseJSON2
    {-# INLINE parseJSON #-}


instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) => FromJSON2 ((,,,,,,) a b c d e) where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (a, b, c, d, e, a, b)
liftParseJSON2 pF :: Value -> Parser a
pF _ pG :: Value -> Parser b
pG _ = String
-> (Array -> Parser (a, b, c, d, e, a, b))
-> Value
-> Parser (a, b, c, d, e, a, b)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "(a, b, c, d, e, f, g)" ((Array -> Parser (a, b, c, d, e, a, b))
 -> Value -> Parser (a, b, c, d, e, a, b))
-> (Array -> Parser (a, b, c, d, e, a, b))
-> Value
-> Parser (a, b, c, d, e, a, b)
forall a b. (a -> b) -> a -> b
$ \t :: Array
t ->
        let n :: Int
n = Array -> Int
forall a. Vector a -> Int
V.length Array
t
        in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 7
            then (,,,,,,)
                (a -> b -> c -> d -> e -> a -> b -> (a, b, c, d, e, a, b))
-> Parser a
-> Parser (b -> c -> d -> e -> a -> b -> (a, b, c, d, e, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 0 Array
t
                Parser (b -> c -> d -> e -> a -> b -> (a, b, c, d, e, a, b))
-> Parser b
-> Parser (c -> d -> e -> a -> b -> (a, b, c, d, e, a, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 1 Array
t
                Parser (c -> d -> e -> a -> b -> (a, b, c, d, e, a, b))
-> Parser c -> Parser (d -> e -> a -> b -> (a, b, c, d, e, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser c) -> Int -> Array -> Parser c
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser c
forall a. FromJSON a => Value -> Parser a
parseJSON 2 Array
t
                Parser (d -> e -> a -> b -> (a, b, c, d, e, a, b))
-> Parser d -> Parser (e -> a -> b -> (a, b, c, d, e, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser d) -> Int -> Array -> Parser d
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser d
forall a. FromJSON a => Value -> Parser a
parseJSON 3 Array
t
                Parser (e -> a -> b -> (a, b, c, d, e, a, b))
-> Parser e -> Parser (a -> b -> (a, b, c, d, e, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser e) -> Int -> Array -> Parser e
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser e
forall a. FromJSON a => Value -> Parser a
parseJSON 4 Array
t
                Parser (a -> b -> (a, b, c, d, e, a, b))
-> Parser a -> Parser (b -> (a, b, c, d, e, a, b))
forall (f :: * -> *) a b. Applicative f => 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
pF 5 Array
t
                Parser (b -> (a, b, c, d, e, a, b))
-> Parser b -> Parser (a, b, c, d, e, a, 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
pG 6 Array
t
            else String -> Parser (a, b, c, d, e, a, b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a, b, c, d, e, a, b))
-> String -> Parser (a, b, c, d, e, a, b)
forall a b. (a -> b) -> a -> b
$ "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]
++ " into a tuple of length 7"
    {-# INLINE liftParseJSON2 #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f) => FromJSON1 ((,,,,,,) a b c d e f) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (a, b, c, d, e, f, a)
liftParseJSON = (Value -> Parser f)
-> (Value -> Parser [f])
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, f, a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser f
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [f]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE liftParseJSON #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g) => FromJSON (a, b, c, d, e, f, g) where
    parseJSON :: Value -> Parser (a, b, c, d, e, f, g)
parseJSON = Value -> Parser (a, b, c, d, e, f, g)
forall (f :: * -> * -> *) a b.
(FromJSON2 f, FromJSON a, FromJSON b) =>
Value -> Parser (f a b)
parseJSON2
    {-# INLINE parseJSON #-}


instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f) => FromJSON2 ((,,,,,,,) a b c d e f) where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (a, b, c, d, e, f, a, b)
liftParseJSON2 pG :: Value -> Parser a
pG _ pH :: Value -> Parser b
pH _ = String
-> (Array -> Parser (a, b, c, d, e, f, a, b))
-> Value
-> Parser (a, b, c, d, e, f, a, b)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "(a, b, c, d, e, f, g, h)" ((Array -> Parser (a, b, c, d, e, f, a, b))
 -> Value -> Parser (a, b, c, d, e, f, a, b))
-> (Array -> Parser (a, b, c, d, e, f, a, b))
-> Value
-> Parser (a, b, c, d, e, f, a, b)
forall a b. (a -> b) -> a -> b
$ \t :: Array
t ->
        let n :: Int
n = Array -> Int
forall a. Vector a -> Int
V.length Array
t
        in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 8
            then (,,,,,,,)
                (a -> b -> c -> d -> e -> f -> a -> b -> (a, b, c, d, e, f, a, b))
-> Parser a
-> Parser
     (b -> c -> d -> e -> f -> a -> b -> (a, b, c, d, e, f, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 0 Array
t
                Parser
  (b -> c -> d -> e -> f -> a -> b -> (a, b, c, d, e, f, a, b))
-> Parser b
-> Parser (c -> d -> e -> f -> a -> b -> (a, b, c, d, e, f, a, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 1 Array
t
                Parser (c -> d -> e -> f -> a -> b -> (a, b, c, d, e, f, a, b))
-> Parser c
-> Parser (d -> e -> f -> a -> b -> (a, b, c, d, e, f, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser c) -> Int -> Array -> Parser c
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser c
forall a. FromJSON a => Value -> Parser a
parseJSON 2 Array
t
                Parser (d -> e -> f -> a -> b -> (a, b, c, d, e, f, a, b))
-> Parser d
-> Parser (e -> f -> a -> b -> (a, b, c, d, e, f, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser d) -> Int -> Array -> Parser d
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser d
forall a. FromJSON a => Value -> Parser a
parseJSON 3 Array
t
                Parser (e -> f -> a -> b -> (a, b, c, d, e, f, a, b))
-> Parser e -> Parser (f -> a -> b -> (a, b, c, d, e, f, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser e) -> Int -> Array -> Parser e
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser e
forall a. FromJSON a => Value -> Parser a
parseJSON 4 Array
t
                Parser (f -> a -> b -> (a, b, c, d, e, f, a, b))
-> Parser f -> Parser (a -> b -> (a, b, c, d, e, f, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser f) -> Int -> Array -> Parser f
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser f
forall a. FromJSON a => Value -> Parser a
parseJSON 5 Array
t
                Parser (a -> b -> (a, b, c, d, e, f, a, b))
-> Parser a -> Parser (b -> (a, b, c, d, e, f, a, b))
forall (f :: * -> *) a b. Applicative f => 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
pG 6 Array
t
                Parser (b -> (a, b, c, d, e, f, a, b))
-> Parser b -> Parser (a, b, c, d, e, f, a, 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
pH 7 Array
t
            else String -> Parser (a, b, c, d, e, f, a, b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a, b, c, d, e, f, a, b))
-> String -> Parser (a, b, c, d, e, f, a, b)
forall a b. (a -> b) -> a -> b
$ "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]
++ " into a tuple of length 8"
    {-# INLINE liftParseJSON2 #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g) => FromJSON1 ((,,,,,,,) a b c d e f g) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, f, g, a)
liftParseJSON = (Value -> Parser g)
-> (Value -> Parser [g])
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, f, g, a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser g
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [g]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE liftParseJSON #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h) => FromJSON (a, b, c, d, e, f, g, h) where
    parseJSON :: Value -> Parser (a, b, c, d, e, f, g, h)
parseJSON = Value -> Parser (a, b, c, d, e, f, g, h)
forall (f :: * -> * -> *) a b.
(FromJSON2 f, FromJSON a, FromJSON b) =>
Value -> Parser (f a b)
parseJSON2
    {-# INLINE parseJSON #-}


instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g) => FromJSON2 ((,,,,,,,,) a b c d e f g) where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (a, b, c, d, e, f, g, a, b)
liftParseJSON2 pH :: Value -> Parser a
pH _ pI :: Value -> Parser b
pI _ = String
-> (Array -> Parser (a, b, c, d, e, f, g, a, b))
-> Value
-> Parser (a, b, c, d, e, f, g, a, b)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "(a, b, c, d, e, f, g, h, i)" ((Array -> Parser (a, b, c, d, e, f, g, a, b))
 -> Value -> Parser (a, b, c, d, e, f, g, a, b))
-> (Array -> Parser (a, b, c, d, e, f, g, a, b))
-> Value
-> Parser (a, b, c, d, e, f, g, a, b)
forall a b. (a -> b) -> a -> b
$ \t :: Array
t ->
        let n :: Int
n = Array -> Int
forall a. Vector a -> Int
V.length Array
t
        in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 9
            then (,,,,,,,,)
                (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> a
 -> b
 -> (a, b, c, d, e, f, g, a, b))
-> Parser a
-> Parser
     (b
      -> c -> d -> e -> f -> g -> a -> b -> (a, b, c, d, e, f, g, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 0 Array
t
                Parser
  (b
   -> c -> d -> e -> f -> g -> a -> b -> (a, b, c, d, e, f, g, a, b))
-> Parser b
-> Parser
     (c -> d -> e -> f -> g -> a -> b -> (a, b, c, d, e, f, g, a, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 1 Array
t
                Parser
  (c -> d -> e -> f -> g -> a -> b -> (a, b, c, d, e, f, g, a, b))
-> Parser c
-> Parser
     (d -> e -> f -> g -> a -> b -> (a, b, c, d, e, f, g, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser c) -> Int -> Array -> Parser c
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser c
forall a. FromJSON a => Value -> Parser a
parseJSON 2 Array
t
                Parser (d -> e -> f -> g -> a -> b -> (a, b, c, d, e, f, g, a, b))
-> Parser d
-> Parser (e -> f -> g -> a -> b -> (a, b, c, d, e, f, g, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser d) -> Int -> Array -> Parser d
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser d
forall a. FromJSON a => Value -> Parser a
parseJSON 3 Array
t
                Parser (e -> f -> g -> a -> b -> (a, b, c, d, e, f, g, a, b))
-> Parser e
-> Parser (f -> g -> a -> b -> (a, b, c, d, e, f, g, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser e) -> Int -> Array -> Parser e
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser e
forall a. FromJSON a => Value -> Parser a
parseJSON 4 Array
t
                Parser (f -> g -> a -> b -> (a, b, c, d, e, f, g, a, b))
-> Parser f -> Parser (g -> a -> b -> (a, b, c, d, e, f, g, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser f) -> Int -> Array -> Parser f
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser f
forall a. FromJSON a => Value -> Parser a
parseJSON 5 Array
t
                Parser (g -> a -> b -> (a, b, c, d, e, f, g, a, b))
-> Parser g -> Parser (a -> b -> (a, b, c, d, e, f, g, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser g) -> Int -> Array -> Parser g
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser g
forall a. FromJSON a => Value -> Parser a
parseJSON 6 Array
t
                Parser (a -> b -> (a, b, c, d, e, f, g, a, b))
-> Parser a -> Parser (b -> (a, b, c, d, e, f, g, a, b))
forall (f :: * -> *) a b. Applicative f => 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
pH 7 Array
t
                Parser (b -> (a, b, c, d, e, f, g, a, b))
-> Parser b -> Parser (a, b, c, d, e, f, g, a, 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
pI 8 Array
t
            else String -> Parser (a, b, c, d, e, f, g, a, b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a, b, c, d, e, f, g, a, b))
-> String -> Parser (a, b, c, d, e, f, g, a, b)
forall a b. (a -> b) -> a -> b
$ "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]
++ " into a tuple of length 9"
    {-# INLINE liftParseJSON2 #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h) => FromJSON1 ((,,,,,,,,) a b c d e f g h) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, f, g, h, a)
liftParseJSON = (Value -> Parser h)
-> (Value -> Parser [h])
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, f, g, h, a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser h
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [h]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE liftParseJSON #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i) => FromJSON (a, b, c, d, e, f, g, h, i) where
    parseJSON :: Value -> Parser (a, b, c, d, e, f, g, h, i)
parseJSON = Value -> Parser (a, b, c, d, e, f, g, h, i)
forall (f :: * -> * -> *) a b.
(FromJSON2 f, FromJSON a, FromJSON b) =>
Value -> Parser (f a b)
parseJSON2
    {-# INLINE parseJSON #-}


instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h) => FromJSON2 ((,,,,,,,,,) a b c d e f g h) where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (a, b, c, d, e, f, g, h, a, b)
liftParseJSON2 pI :: Value -> Parser a
pI _ pJ :: Value -> Parser b
pJ _ = String
-> (Array -> Parser (a, b, c, d, e, f, g, h, a, b))
-> Value
-> Parser (a, b, c, d, e, f, g, h, a, b)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "(a, b, c, d, e, f, g, h, i, j)" ((Array -> Parser (a, b, c, d, e, f, g, h, a, b))
 -> Value -> Parser (a, b, c, d, e, f, g, h, a, b))
-> (Array -> Parser (a, b, c, d, e, f, g, h, a, b))
-> Value
-> Parser (a, b, c, d, e, f, g, h, a, b)
forall a b. (a -> b) -> a -> b
$ \t :: Array
t ->
        let n :: Int
n = Array -> Int
forall a. Vector a -> Int
V.length Array
t
        in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 10
            then (,,,,,,,,,)
                (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> a
 -> b
 -> (a, b, c, d, e, f, g, h, a, b))
-> Parser a
-> Parser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 0 Array
t
                Parser
  (b
   -> c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, a, b))
-> Parser b
-> Parser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, a, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 1 Array
t
                Parser
  (c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, a, b))
-> Parser c
-> Parser
     (d -> e -> f -> g -> h -> a -> b -> (a, b, c, d, e, f, g, h, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser c) -> Int -> Array -> Parser c
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser c
forall a. FromJSON a => Value -> Parser a
parseJSON 2 Array
t
                Parser
  (d -> e -> f -> g -> h -> a -> b -> (a, b, c, d, e, f, g, h, a, b))
-> Parser d
-> Parser
     (e -> f -> g -> h -> a -> b -> (a, b, c, d, e, f, g, h, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser d) -> Int -> Array -> Parser d
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser d
forall a. FromJSON a => Value -> Parser a
parseJSON 3 Array
t
                Parser
  (e -> f -> g -> h -> a -> b -> (a, b, c, d, e, f, g, h, a, b))
-> Parser e
-> Parser (f -> g -> h -> a -> b -> (a, b, c, d, e, f, g, h, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser e) -> Int -> Array -> Parser e
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser e
forall a. FromJSON a => Value -> Parser a
parseJSON 4 Array
t
                Parser (f -> g -> h -> a -> b -> (a, b, c, d, e, f, g, h, a, b))
-> Parser f
-> Parser (g -> h -> a -> b -> (a, b, c, d, e, f, g, h, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser f) -> Int -> Array -> Parser f
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser f
forall a. FromJSON a => Value -> Parser a
parseJSON 5 Array
t
                Parser (g -> h -> a -> b -> (a, b, c, d, e, f, g, h, a, b))
-> Parser g
-> Parser (h -> a -> b -> (a, b, c, d, e, f, g, h, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser g) -> Int -> Array -> Parser g
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser g
forall a. FromJSON a => Value -> Parser a
parseJSON 6 Array
t
                Parser (h -> a -> b -> (a, b, c, d, e, f, g, h, a, b))
-> Parser h -> Parser (a -> b -> (a, b, c, d, e, f, g, h, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser h) -> Int -> Array -> Parser h
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser h
forall a. FromJSON a => Value -> Parser a
parseJSON 7 Array
t
                Parser (a -> b -> (a, b, c, d, e, f, g, h, a, b))
-> Parser a -> Parser (b -> (a, b, c, d, e, f, g, h, a, b))
forall (f :: * -> *) a b. Applicative f => 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
pI 8 Array
t
                Parser (b -> (a, b, c, d, e, f, g, h, a, b))
-> Parser b -> Parser (a, b, c, d, e, f, g, h, a, 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
pJ 9 Array
t
            else String -> Parser (a, b, c, d, e, f, g, h, a, b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a, b, c, d, e, f, g, h, a, b))
-> String -> Parser (a, b, c, d, e, f, g, h, a, b)
forall a b. (a -> b) -> a -> b
$ "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]
++ " into a tuple of length 10"
    {-# INLINE liftParseJSON2 #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i) => FromJSON1 ((,,,,,,,,,) a b c d e f g h i) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, a)
liftParseJSON = (Value -> Parser i)
-> (Value -> Parser [i])
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser i
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [i]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE liftParseJSON #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) => FromJSON (a, b, c, d, e, f, g, h, i, j) where
    parseJSON :: Value -> Parser (a, b, c, d, e, f, g, h, i, j)
parseJSON = Value -> Parser (a, b, c, d, e, f, g, h, i, j)
forall (f :: * -> * -> *) a b.
(FromJSON2 f, FromJSON a, FromJSON b) =>
Value -> Parser (f a b)
parseJSON2
    {-# INLINE parseJSON #-}


instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i) => FromJSON2 ((,,,,,,,,,,) a b c d e f g h i) where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, a, b)
liftParseJSON2 pJ :: Value -> Parser a
pJ _ pK :: Value -> Parser b
pK _ = String
-> (Array -> Parser (a, b, c, d, e, f, g, h, i, a, b))
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, a, b)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "(a, b, c, d, e, f, g, h, i, j, k)" ((Array -> Parser (a, b, c, d, e, f, g, h, i, a, b))
 -> Value -> Parser (a, b, c, d, e, f, g, h, i, a, b))
-> (Array -> Parser (a, b, c, d, e, f, g, h, i, a, b))
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, a, b)
forall a b. (a -> b) -> a -> b
$ \t :: Array
t ->
        let n :: Int
n = Array -> Int
forall a. Vector a -> Int
V.length Array
t
        in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 11
            then (,,,,,,,,,,)
                (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> a
 -> b
 -> (a, b, c, d, e, f, g, h, i, a, b))
-> Parser a
-> Parser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 0 Array
t
                Parser
  (b
   -> c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, a, b))
-> Parser b
-> Parser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, a, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 1 Array
t
                Parser
  (c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, a, b))
-> Parser c
-> Parser
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser c) -> Int -> Array -> Parser c
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser c
forall a. FromJSON a => Value -> Parser a
parseJSON 2 Array
t
                Parser
  (d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, a, b))
-> Parser d
-> Parser
     (e
      -> f -> g -> h -> i -> a -> b -> (a, b, c, d, e, f, g, h, i, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser d) -> Int -> Array -> Parser d
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser d
forall a. FromJSON a => Value -> Parser a
parseJSON 3 Array
t
                Parser
  (e
   -> f -> g -> h -> i -> a -> b -> (a, b, c, d, e, f, g, h, i, a, b))
-> Parser e
-> Parser
     (f -> g -> h -> i -> a -> b -> (a, b, c, d, e, f, g, h, i, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser e) -> Int -> Array -> Parser e
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser e
forall a. FromJSON a => Value -> Parser a
parseJSON 4 Array
t
                Parser
  (f -> g -> h -> i -> a -> b -> (a, b, c, d, e, f, g, h, i, a, b))
-> Parser f
-> Parser
     (g -> h -> i -> a -> b -> (a, b, c, d, e, f, g, h, i, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser f) -> Int -> Array -> Parser f
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser f
forall a. FromJSON a => Value -> Parser a
parseJSON 5 Array
t
                Parser (g -> h -> i -> a -> b -> (a, b, c, d, e, f, g, h, i, a, b))
-> Parser g
-> Parser (h -> i -> a -> b -> (a, b, c, d, e, f, g, h, i, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser g) -> Int -> Array -> Parser g
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser g
forall a. FromJSON a => Value -> Parser a
parseJSON 6 Array
t
                Parser (h -> i -> a -> b -> (a, b, c, d, e, f, g, h, i, a, b))
-> Parser h
-> Parser (i -> a -> b -> (a, b, c, d, e, f, g, h, i, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser h) -> Int -> Array -> Parser h
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser h
forall a. FromJSON a => Value -> Parser a
parseJSON 7 Array
t
                Parser (i -> a -> b -> (a, b, c, d, e, f, g, h, i, a, b))
-> Parser i -> Parser (a -> b -> (a, b, c, d, e, f, g, h, i, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser i) -> Int -> Array -> Parser i
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser i
forall a. FromJSON a => Value -> Parser a
parseJSON 8 Array
t
                Parser (a -> b -> (a, b, c, d, e, f, g, h, i, a, b))
-> Parser a -> Parser (b -> (a, b, c, d, e, f, g, h, i, a, b))
forall (f :: * -> *) a b. Applicative f => 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
pJ 9 Array
t
                Parser (b -> (a, b, c, d, e, f, g, h, i, a, b))
-> Parser b -> Parser (a, b, c, d, e, f, g, h, i, a, 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
pK 10 Array
t
            else String -> Parser (a, b, c, d, e, f, g, h, i, a, b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a, b, c, d, e, f, g, h, i, a, b))
-> String -> Parser (a, b, c, d, e, f, g, h, i, a, b)
forall a b. (a -> b) -> a -> b
$ "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]
++ " into a tuple of length 11"
    {-# INLINE liftParseJSON2 #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) => FromJSON1 ((,,,,,,,,,,) a b c d e f g h i j) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, a)
liftParseJSON = (Value -> Parser j)
-> (Value -> Parser [j])
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser j
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [j]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE liftParseJSON #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k) => FromJSON (a, b, c, d, e, f, g, h, i, j, k) where
    parseJSON :: Value -> Parser (a, b, c, d, e, f, g, h, i, j, k)
parseJSON = Value -> Parser (a, b, c, d, e, f, g, h, i, j, k)
forall (f :: * -> * -> *) a b.
(FromJSON2 f, FromJSON a, FromJSON b) =>
Value -> Parser (f a b)
parseJSON2
    {-# INLINE parseJSON #-}


instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) => FromJSON2 ((,,,,,,,,,,,) a b c d e f g h i j) where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, a, b)
liftParseJSON2 pK :: Value -> Parser a
pK _ pL :: Value -> Parser b
pL _ = String
-> (Array -> Parser (a, b, c, d, e, f, g, h, i, j, a, b))
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, a, b)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "(a, b, c, d, e, f, g, h, i, j, k, l)" ((Array -> Parser (a, b, c, d, e, f, g, h, i, j, a, b))
 -> Value -> Parser (a, b, c, d, e, f, g, h, i, j, a, b))
-> (Array -> Parser (a, b, c, d, e, f, g, h, i, j, a, b))
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, a, b)
forall a b. (a -> b) -> a -> b
$ \t :: Array
t ->
        let n :: Int
n = Array -> Int
forall a. Vector a -> Int
V.length Array
t
        in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 12
            then (,,,,,,,,,,,)
                (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> a
 -> b
 -> (a, b, c, d, e, f, g, h, i, j, a, b))
-> Parser a
-> Parser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 0 Array
t
                Parser
  (b
   -> c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, a, b))
-> Parser b
-> Parser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, a, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 1 Array
t
                Parser
  (c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, a, b))
-> Parser c
-> Parser
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser c) -> Int -> Array -> Parser c
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser c
forall a. FromJSON a => Value -> Parser a
parseJSON 2 Array
t
                Parser
  (d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, a, b))
-> Parser d
-> Parser
     (e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser d) -> Int -> Array -> Parser d
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser d
forall a. FromJSON a => Value -> Parser a
parseJSON 3 Array
t
                Parser
  (e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, a, b))
-> Parser e
-> Parser
     (f
      -> g
      -> h
      -> i
      -> j
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser e) -> Int -> Array -> Parser e
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser e
forall a. FromJSON a => Value -> Parser a
parseJSON 4 Array
t
                Parser
  (f
   -> g
   -> h
   -> i
   -> j
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, a, b))
-> Parser f
-> Parser
     (g
      -> h -> i -> j -> a -> b -> (a, b, c, d, e, f, g, h, i, j, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser f) -> Int -> Array -> Parser f
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser f
forall a. FromJSON a => Value -> Parser a
parseJSON 5 Array
t
                Parser
  (g
   -> h -> i -> j -> a -> b -> (a, b, c, d, e, f, g, h, i, j, a, b))
-> Parser g
-> Parser
     (h -> i -> j -> a -> b -> (a, b, c, d, e, f, g, h, i, j, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser g) -> Int -> Array -> Parser g
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser g
forall a. FromJSON a => Value -> Parser a
parseJSON 6 Array
t
                Parser
  (h -> i -> j -> a -> b -> (a, b, c, d, e, f, g, h, i, j, a, b))
-> Parser h
-> Parser
     (i -> j -> a -> b -> (a, b, c, d, e, f, g, h, i, j, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser h) -> Int -> Array -> Parser h
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser h
forall a. FromJSON a => Value -> Parser a
parseJSON 7 Array
t
                Parser (i -> j -> a -> b -> (a, b, c, d, e, f, g, h, i, j, a, b))
-> Parser i
-> Parser (j -> a -> b -> (a, b, c, d, e, f, g, h, i, j, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser i) -> Int -> Array -> Parser i
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser i
forall a. FromJSON a => Value -> Parser a
parseJSON 8 Array
t
                Parser (j -> a -> b -> (a, b, c, d, e, f, g, h, i, j, a, b))
-> Parser j
-> Parser (a -> b -> (a, b, c, d, e, f, g, h, i, j, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser j) -> Int -> Array -> Parser j
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser j
forall a. FromJSON a => Value -> Parser a
parseJSON 9 Array
t
                Parser (a -> b -> (a, b, c, d, e, f, g, h, i, j, a, b))
-> Parser a -> Parser (b -> (a, b, c, d, e, f, g, h, i, j, a, b))
forall (f :: * -> *) a b. Applicative f => 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
pK 10 Array
t
                Parser (b -> (a, b, c, d, e, f, g, h, i, j, a, b))
-> Parser b -> Parser (a, b, c, d, e, f, g, h, i, j, a, 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
pL 11 Array
t
            else String -> Parser (a, b, c, d, e, f, g, h, i, j, a, b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a, b, c, d, e, f, g, h, i, j, a, b))
-> String -> Parser (a, b, c, d, e, f, g, h, i, j, a, b)
forall a b. (a -> b) -> a -> b
$ "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]
++ " into a tuple of length 12"
    {-# INLINE liftParseJSON2 #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k) => FromJSON1 ((,,,,,,,,,,,) a b c d e f g h i j k) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, k, a)
liftParseJSON = (Value -> Parser k)
-> (Value -> Parser [k])
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, k, a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser k
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [k]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE liftParseJSON #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l) where
    parseJSON :: Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, l)
parseJSON = Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, l)
forall (f :: * -> * -> *) a b.
(FromJSON2 f, FromJSON a, FromJSON b) =>
Value -> Parser (f a b)
parseJSON2
    {-# INLINE parseJSON #-}


instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k) => FromJSON2 ((,,,,,,,,,,,,) a b c d e f g h i j k) where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, k, a, b)
liftParseJSON2 pL :: Value -> Parser a
pL _ pM :: Value -> Parser b
pM _ = String
-> (Array -> Parser (a, b, c, d, e, f, g, h, i, j, k, a, b))
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, k, a, b)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "(a, b, c, d, e, f, g, h, i, j, k, l, m)" ((Array -> Parser (a, b, c, d, e, f, g, h, i, j, k, a, b))
 -> Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, a, b))
-> (Array -> Parser (a, b, c, d, e, f, g, h, i, j, k, a, b))
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, k, a, b)
forall a b. (a -> b) -> a -> b
$ \t :: Array
t ->
        let n :: Int
n = Array -> Int
forall a. Vector a -> Int
V.length Array
t
        in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 13
            then (,,,,,,,,,,,,)
                (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> a
 -> b
 -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
-> Parser a
-> Parser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 0 Array
t
                Parser
  (b
   -> c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
-> Parser b
-> Parser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, a, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 1 Array
t
                Parser
  (c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
-> Parser c
-> Parser
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser c) -> Int -> Array -> Parser c
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser c
forall a. FromJSON a => Value -> Parser a
parseJSON 2 Array
t
                Parser
  (d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
-> Parser d
-> Parser
     (e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser d) -> Int -> Array -> Parser d
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser d
forall a. FromJSON a => Value -> Parser a
parseJSON 3 Array
t
                Parser
  (e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
-> Parser e
-> Parser
     (f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser e) -> Int -> Array -> Parser e
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser e
forall a. FromJSON a => Value -> Parser a
parseJSON 4 Array
t
                Parser
  (f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
-> Parser f
-> Parser
     (g
      -> h
      -> i
      -> j
      -> k
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser f) -> Int -> Array -> Parser f
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser f
forall a. FromJSON a => Value -> Parser a
parseJSON 5 Array
t
                Parser
  (g
   -> h
   -> i
   -> j
   -> k
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
-> Parser g
-> Parser
     (h
      -> i
      -> j
      -> k
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser g) -> Int -> Array -> Parser g
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser g
forall a. FromJSON a => Value -> Parser a
parseJSON 6 Array
t
                Parser
  (h
   -> i
   -> j
   -> k
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
-> Parser h
-> Parser
     (i -> j -> k -> a -> b -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser h) -> Int -> Array -> Parser h
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser h
forall a. FromJSON a => Value -> Parser a
parseJSON 7 Array
t
                Parser
  (i -> j -> k -> a -> b -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
-> Parser i
-> Parser
     (j -> k -> a -> b -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser i) -> Int -> Array -> Parser i
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser i
forall a. FromJSON a => Value -> Parser a
parseJSON 8 Array
t
                Parser
  (j -> k -> a -> b -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
-> Parser j
-> Parser (k -> a -> b -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser j) -> Int -> Array -> Parser j
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser j
forall a. FromJSON a => Value -> Parser a
parseJSON 9 Array
t
                Parser (k -> a -> b -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
-> Parser k
-> Parser (a -> b -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser k) -> Int -> Array -> Parser k
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser k
forall a. FromJSON a => Value -> Parser a
parseJSON 10 Array
t
                Parser (a -> b -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
-> Parser a
-> Parser (b -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
forall (f :: * -> *) a b. Applicative f => 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
pL 11 Array
t
                Parser (b -> (a, b, c, d, e, f, g, h, i, j, k, a, b))
-> Parser b -> Parser (a, b, c, d, e, f, g, h, i, j, k, a, 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
pM 12 Array
t
            else String -> Parser (a, b, c, d, e, f, g, h, i, j, k, a, b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a, b, c, d, e, f, g, h, i, j, k, a, b))
-> String -> Parser (a, b, c, d, e, f, g, h, i, j, k, a, b)
forall a b. (a -> b) -> a -> b
$ "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]
++ " into a tuple of length 13"
    {-# INLINE liftParseJSON2 #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l) => FromJSON1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, k, l, a)
liftParseJSON = (Value -> Parser l)
-> (Value -> Parser [l])
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, k, l, a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser l
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [l]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE liftParseJSON #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l, m) where
    parseJSON :: Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m)
parseJSON = Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m)
forall (f :: * -> * -> *) a b.
(FromJSON2 f, FromJSON a, FromJSON b) =>
Value -> Parser (f a b)
parseJSON2
    {-# INLINE parseJSON #-}


instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l) => FromJSON2 ((,,,,,,,,,,,,,) a b c d e f g h i j k l) where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, k, l, a, b)
liftParseJSON2 pM :: Value -> Parser a
pM _ pN :: Value -> Parser b
pN _ = String
-> (Array -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, k, l, a, b)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "(a, b, c, d, e, f, g, h, i, j, k, l, m, n)" ((Array -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
 -> Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> (Array -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, k, l, a, b)
forall a b. (a -> b) -> a -> b
$ \t :: Array
t ->
        let n :: Int
n = Array -> Int
forall a. Vector a -> Int
V.length Array
t
        in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 14
            then (,,,,,,,,,,,,,)
                (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> a
 -> b
 -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> Parser a
-> Parser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 0 Array
t
                Parser
  (b
   -> c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> Parser b
-> Parser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, a, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 1 Array
t
                Parser
  (c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> Parser c
-> Parser
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser c) -> Int -> Array -> Parser c
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser c
forall a. FromJSON a => Value -> Parser a
parseJSON 2 Array
t
                Parser
  (d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> Parser d
-> Parser
     (e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser d) -> Int -> Array -> Parser d
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser d
forall a. FromJSON a => Value -> Parser a
parseJSON 3 Array
t
                Parser
  (e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> Parser e
-> Parser
     (f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser e) -> Int -> Array -> Parser e
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser e
forall a. FromJSON a => Value -> Parser a
parseJSON 4 Array
t
                Parser
  (f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> Parser f
-> Parser
     (g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser f) -> Int -> Array -> Parser f
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser f
forall a. FromJSON a => Value -> Parser a
parseJSON 5 Array
t
                Parser
  (g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> Parser g
-> Parser
     (h
      -> i
      -> j
      -> k
      -> l
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser g) -> Int -> Array -> Parser g
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser g
forall a. FromJSON a => Value -> Parser a
parseJSON 6 Array
t
                Parser
  (h
   -> i
   -> j
   -> k
   -> l
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> Parser h
-> Parser
     (i
      -> j
      -> k
      -> l
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser h) -> Int -> Array -> Parser h
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser h
forall a. FromJSON a => Value -> Parser a
parseJSON 7 Array
t
                Parser
  (i
   -> j
   -> k
   -> l
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> Parser i
-> Parser
     (j
      -> k -> l -> a -> b -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser i) -> Int -> Array -> Parser i
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser i
forall a. FromJSON a => Value -> Parser a
parseJSON 8 Array
t
                Parser
  (j
   -> k -> l -> a -> b -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> Parser j
-> Parser
     (k -> l -> a -> b -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser j) -> Int -> Array -> Parser j
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser j
forall a. FromJSON a => Value -> Parser a
parseJSON 9 Array
t
                Parser
  (k -> l -> a -> b -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> Parser k
-> Parser
     (l -> a -> b -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser k) -> Int -> Array -> Parser k
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser k
forall a. FromJSON a => Value -> Parser a
parseJSON 10 Array
t
                Parser (l -> a -> b -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> Parser l
-> Parser (a -> b -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser l) -> Int -> Array -> Parser l
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser l
forall a. FromJSON a => Value -> Parser a
parseJSON 11 Array
t
                Parser (a -> b -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> Parser a
-> Parser (b -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
forall (f :: * -> *) a b. Applicative f => 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
pM 12 Array
t
                Parser (b -> (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> Parser b -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, a, 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
pN 13 Array
t
            else String -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, a, b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, a, b))
-> String -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, a, b)
forall a b. (a -> b) -> a -> b
$ "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]
++ " into a tuple of length 14"
    {-# INLINE liftParseJSON2 #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m) => FromJSON1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, a)
liftParseJSON = (Value -> Parser m)
-> (Value -> Parser [m])
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser m
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [m]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE liftParseJSON #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m, FromJSON n) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where
    parseJSON :: Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
parseJSON = Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
forall (f :: * -> * -> *) a b.
(FromJSON2 f, FromJSON a, FromJSON b) =>
Value -> Parser (f a b)
parseJSON2
    {-# INLINE parseJSON #-}


instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m) => FromJSON2 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m) where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b)
liftParseJSON2 pN :: Value -> Parser a
pN _ pO :: Value -> Parser b
pO _ = String
-> (Array -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray "(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)" ((Array -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
 -> Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> (Array -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b)
forall a b. (a -> b) -> a -> b
$ \t :: Array
t ->
        let n :: Int
n = Array -> Int
forall a. Vector a -> Int
V.length Array
t
        in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 15
            then (,,,,,,,,,,,,,,)
                (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> a
 -> b
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> Parser a
-> Parser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 0 Array
t
                Parser
  (b
   -> c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> m
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> Parser b
-> Parser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, 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
forall a. FromJSON a => Value -> Parser a
parseJSON 1 Array
t
                Parser
  (c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> m
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> Parser c
-> Parser
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser c) -> Int -> Array -> Parser c
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser c
forall a. FromJSON a => Value -> Parser a
parseJSON 2 Array
t
                Parser
  (d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> m
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> Parser d
-> Parser
     (e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser d) -> Int -> Array -> Parser d
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser d
forall a. FromJSON a => Value -> Parser a
parseJSON 3 Array
t
                Parser
  (e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> m
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> Parser e
-> Parser
     (f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser e) -> Int -> Array -> Parser e
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser e
forall a. FromJSON a => Value -> Parser a
parseJSON 4 Array
t
                Parser
  (f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> m
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> Parser f
-> Parser
     (g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser f) -> Int -> Array -> Parser f
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser f
forall a. FromJSON a => Value -> Parser a
parseJSON 5 Array
t
                Parser
  (g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> m
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> Parser g
-> Parser
     (h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser g) -> Int -> Array -> Parser g
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser g
forall a. FromJSON a => Value -> Parser a
parseJSON 6 Array
t
                Parser
  (h
   -> i
   -> j
   -> k
   -> l
   -> m
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> Parser h
-> Parser
     (i
      -> j
      -> k
      -> l
      -> m
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser h) -> Int -> Array -> Parser h
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser h
forall a. FromJSON a => Value -> Parser a
parseJSON 7 Array
t
                Parser
  (i
   -> j
   -> k
   -> l
   -> m
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> Parser i
-> Parser
     (j
      -> k
      -> l
      -> m
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser i) -> Int -> Array -> Parser i
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser i
forall a. FromJSON a => Value -> Parser a
parseJSON 8 Array
t
                Parser
  (j
   -> k
   -> l
   -> m
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> Parser j
-> Parser
     (k
      -> l
      -> m
      -> a
      -> b
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser j) -> Int -> Array -> Parser j
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser j
forall a. FromJSON a => Value -> Parser a
parseJSON 9 Array
t
                Parser
  (k
   -> l
   -> m
   -> a
   -> b
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> Parser k
-> Parser
     (l -> m -> a -> b -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser k) -> Int -> Array -> Parser k
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser k
forall a. FromJSON a => Value -> Parser a
parseJSON 10 Array
t
                Parser
  (l -> m -> a -> b -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> Parser l
-> Parser
     (m -> a -> b -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser l) -> Int -> Array -> Parser l
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser l
forall a. FromJSON a => Value -> Parser a
parseJSON 11 Array
t
                Parser
  (m -> a -> b -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> Parser m
-> Parser (a -> b -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser m) -> Int -> Array -> Parser m
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser m
forall a. FromJSON a => Value -> Parser a
parseJSON 12 Array
t
                Parser (a -> b -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> Parser a
-> Parser (b -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
forall (f :: * -> *) a b. Applicative f => 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
pN 13 Array
t
                Parser (b -> (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> Parser b -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, a, 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
pO 14 Array
t
            else String -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b))
-> String -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, a, b)
forall a b. (a -> b) -> a -> b
$ "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]
++ " into a tuple of length 15"
    {-# INLINE liftParseJSON2 #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m, FromJSON n) => FromJSON1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, a)
liftParseJSON = (Value -> Parser n)
-> (Value -> Parser [n])
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, a)
forall (f :: * -> * -> *) a b.
FromJSON2 f =>
(Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (f a b)
liftParseJSON2 Value -> Parser n
forall a. FromJSON a => Value -> Parser a
parseJSON Value -> Parser [n]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    {-# INLINE liftParseJSON #-}

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m, FromJSON n, FromJSON o) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where
    parseJSON :: Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
parseJSON = Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
forall (f :: * -> * -> *) a b.
(FromJSON2 f, FromJSON a, FromJSON b) =>
Value -> Parser (f a b)
parseJSON2
    {-# INLINE parseJSON #-}