{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}

module Autodocodec.Aeson.Decode
  ( -- * Decoding JSON Values
    parseJSONViaCodec,
    parseJSONVia,

    -- ** Decoding JSON Objects
    parseJSONObjectViaCodec,
    parseJSONObjectVia,

    -- ** Internal
    parseJSONContextVia,
  )
where

import qualified Autodocodec.Aeson.Compat as Compat
import Autodocodec.Class
import Autodocodec.Codec
import Control.Monad
import Data.Aeson as JSON
import Data.Aeson.Types as JSON
import Data.Coerce (coerce)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Map (Map)
import Data.Scientific as Scientific
import Data.Text (Text)
import qualified Data.Text as T
import Data.Vector (Vector)
import qualified Data.Vector as V

-- | Implement 'JSON.parseJSON' via a type's codec.
parseJSONViaCodec :: (HasCodec a) => JSON.Value -> JSON.Parser a
parseJSONViaCodec :: forall a. HasCodec a => Value -> Parser a
parseJSONViaCodec = ValueCodec a a -> Value -> Parser a
forall void a. ValueCodec void a -> Value -> Parser a
parseJSONVia ValueCodec a a
forall value. HasCodec value => JSONCodec value
codec

-- | Implement 'JSON.parseJSON' via a given codec.
parseJSONVia :: ValueCodec void a -> JSON.Value -> JSON.Parser a
parseJSONVia :: forall void a. ValueCodec void a -> Value -> Parser a
parseJSONVia = Codec Value void a -> Value -> Parser a
forall context void a. Codec context void a -> context -> Parser a
parseJSONContextVia

parseJSONObjectViaCodec :: (HasObjectCodec a) => JSON.Object -> JSON.Parser a
parseJSONObjectViaCodec :: forall a. HasObjectCodec a => Object -> Parser a
parseJSONObjectViaCodec = ObjectCodec a a -> Object -> Parser a
forall void a. ObjectCodec void a -> Object -> Parser a
parseJSONObjectVia ObjectCodec a a
forall object. HasObjectCodec object => JSONObjectCodec object
objectCodec

parseJSONObjectVia :: ObjectCodec void a -> JSON.Object -> JSON.Parser a
parseJSONObjectVia :: forall void a. ObjectCodec void a -> Object -> Parser a
parseJSONObjectVia = Codec Object void a -> Object -> Parser a
forall context void a. Codec context void a -> context -> Parser a
parseJSONContextVia

-- | Parse via a general codec.
--
-- You probably won't need this. See 'eitherDecodeViaCodec', 'parseJSONViaCodec' and 'parseJSONVia' instead.
parseJSONContextVia :: Codec context void a -> context -> JSON.Parser a
parseJSONContextVia :: forall context void a. Codec context void a -> context -> Parser a
parseJSONContextVia Codec context void a
codec_ context
context_ =
  ([Char] -> [Char]) -> Parser a -> Parser a
forall a. ([Char] -> [Char]) -> Parser a -> Parser a
modifyFailure (\[Char]
s -> if Char
'\n' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
s then [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s else [Char]
s) (Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$
    context -> Codec context void a -> Parser a
forall context void a. context -> Codec context void a -> Parser a
go context
context_ Codec context void a
codec_
  where
    -- We use type-annotations here for readability of type information that is
    -- gathered to case-matching on GADTs, they aren't strictly necessary.
    go :: context -> Codec context void a -> JSON.Parser a
    go :: forall context void a. context -> Codec context void a -> Parser a
go context
value = \case
      Codec context void a
NullCodec -> case (context
Value
value :: JSON.Value) of
        Value
Null -> Parser () -> Parser a
forall a b. Coercible a b => a -> b
coerce (() -> Parser ()
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () :: JSON.Parser ())
        Value
_ -> [Char] -> Value -> Parser a
forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
"Null" context
Value
value
      BoolCodec Maybe Text
mname -> case Maybe Text
mname of
        Maybe Text
Nothing -> Parser Bool -> Parser a
forall a b. Coercible a b => a -> b
coerce (Value -> Parser Bool
forall a. FromJSON a => Value -> Parser a
parseJSON context
Value
value :: JSON.Parser Bool)
        Just Text
name -> Parser Bool -> Parser a
forall a b. Coercible a b => a -> b
coerce (Parser Bool -> Parser a) -> Parser Bool -> Parser a
forall a b. (a -> b) -> a -> b
$ [Char] -> (Bool -> Parser Bool) -> Value -> Parser Bool
forall a. [Char] -> (Bool -> Parser a) -> Value -> Parser a
withBool (Text -> [Char]
T.unpack Text
name) Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure context
Value
value
      StringCodec Maybe Text
mname -> case Maybe Text
mname of
        Maybe Text
Nothing -> Parser Text -> Parser a
forall a b. Coercible a b => a -> b
coerce (Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON context
Value
value :: JSON.Parser Text)
        Just Text
name -> Parser Text -> Parser a
forall a b. Coercible a b => a -> b
coerce (Parser Text -> Parser a) -> Parser Text -> Parser a
forall a b. (a -> b) -> a -> b
$ [Char] -> (Text -> Parser Text) -> Value -> Parser Text
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText (Text -> [Char]
T.unpack Text
name) Text -> Parser Text
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure context
Value
value
      IntegerCodec Maybe Text
mname Bounds Integer
bounds ->
        Parser Integer -> Parser a
forall a b. Coercible a b => a -> b
coerce (Parser Integer -> Parser a) -> Parser Integer -> Parser a
forall a b. (a -> b) -> a -> b
$
          ( \Integer -> Parser Integer
f -> do
              let safetyBounds :: Bounds Scientific
safetyBounds =
                    Bounds
                      { boundsLower :: Maybe Scientific
boundsLower = Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just (Scientific -> Maybe Scientific) -> Scientific -> Maybe Scientific
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Scientific
scientific (-Integer
1) Int
1024,
                        boundsUpper :: Maybe Scientific
boundsUpper = Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just (Scientific -> Maybe Scientific) -> Scientific -> Maybe Scientific
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Scientific
scientific Integer
1 Int
1024
                      }
                  checkSafetyBounds :: Scientific -> m Scientific
checkSafetyBounds Scientific
s =
                    case Bounds Scientific -> Scientific -> Either [Char] Scientific
forall a. (Show a, Ord a) => Bounds a -> a -> Either [Char] a
checkBounds Bounds Scientific
safetyBounds Scientific
s of
                      Left [Char]
err -> [Char] -> m Scientific
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
err
                      Right Scientific
i' -> Scientific -> m Scientific
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scientific
i'
              Scientific
s <- case Maybe Text
mname of
                Maybe Text
Nothing -> Value -> Parser Scientific
forall a. FromJSON a => Value -> Parser a
parseJSON context
Value
value Parser Scientific
-> (Scientific -> Parser Scientific) -> Parser Scientific
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Scientific -> Parser Scientific
forall {m :: * -> *}. MonadFail m => Scientific -> m Scientific
checkSafetyBounds
                Just Text
name -> [Char]
-> (Scientific -> Parser Scientific) -> Value -> Parser Scientific
forall a. [Char] -> (Scientific -> Parser a) -> Value -> Parser a
withScientific (Text -> [Char]
T.unpack Text
name) Scientific -> Parser Scientific
forall {m :: * -> *}. MonadFail m => Scientific -> m Scientific
checkSafetyBounds context
Value
value
              case Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Scientific.floatingOrInteger Scientific
s :: Either Double Integer of
                Left Double
_ -> [Char] -> Parser Integer
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser Integer) -> [Char] -> Parser Integer
forall a b. (a -> b) -> a -> b
$ [Char]
"Number was not integer: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Scientific -> [Char]
forall a. Show a => a -> [Char]
show Scientific
s
                Right Integer
i -> Integer -> Parser Integer
f (Integer
i :: Integer)
          )
            ( \Integer
i -> case Bounds Integer -> Integer -> Either [Char] Integer
forall a. (Show a, Ord a) => Bounds a -> a -> Either [Char] a
checkBounds Bounds Integer
bounds Integer
i of
                Left [Char]
err -> [Char] -> Parser Integer
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
err
                Right Integer
i' -> Integer -> Parser Integer
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
i'
            )
      NumberCodec Maybe Text
mname Bounds Scientific
bounds ->
        Parser Scientific -> Parser a
forall a b. Coercible a b => a -> b
coerce (Parser Scientific -> Parser a) -> Parser Scientific -> Parser a
forall a b. (a -> b) -> a -> b
$
          ( \Scientific -> Parser Scientific
f -> case Maybe Text
mname of
              Maybe Text
Nothing -> Value -> Parser Scientific
forall a. FromJSON a => Value -> Parser a
parseJSON context
Value
value Parser Scientific
-> (Scientific -> Parser Scientific) -> Parser Scientific
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Scientific -> Parser Scientific
f
              Just Text
name -> [Char]
-> (Scientific -> Parser Scientific) -> Value -> Parser Scientific
forall a. [Char] -> (Scientific -> Parser a) -> Value -> Parser a
withScientific (Text -> [Char]
T.unpack Text
name) Scientific -> Parser Scientific
f context
Value
value
          )
            ( \Scientific
s -> case Bounds Scientific -> Scientific -> Either [Char] Scientific
forall a. (Show a, Ord a) => Bounds a -> a -> Either [Char] a
checkBounds Bounds Scientific
bounds Scientific
s of
                Left [Char]
err -> [Char] -> Parser Scientific
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
err
                Right Scientific
s' -> Scientific -> Parser Scientific
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scientific
s'
            )
      ArrayOfCodec Maybe Text
mname ValueCodec input1 output1
c ->
        ( \Array -> Parser a
f -> case Maybe Text
mname of
            Maybe Text
Nothing -> Value -> Parser Array
forall a. FromJSON a => Value -> Parser a
parseJSON context
Value
value Parser Array -> (Array -> Parser a) -> Parser a
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Array -> Parser a
f
            Just Text
name -> [Char] -> (Array -> Parser a) -> Value -> Parser a
forall a. [Char] -> (Array -> Parser a) -> Value -> Parser a
withArray (Text -> [Char]
T.unpack Text
name) Array -> Parser a
f context
Value
value
        )
          ( \Array
vector ->
              Parser (Vector output1) -> Parser a
forall a b. Coercible a b => a -> b
coerce (Parser (Vector output1) -> Parser a)
-> Parser (Vector output1) -> Parser a
forall a b. (a -> b) -> a -> b
$
                Vector (Int, Value)
-> ((Int, Value) -> Parser output1) -> Parser (Vector output1)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM
                  (Array -> Vector (Int, Value)
forall a. Vector a -> Vector (Int, a)
V.indexed (Array
vector :: Vector JSON.Value))
                  ( \(Int
ix, Value
v) ->
                      Value -> ValueCodec input1 output1 -> Parser output1
forall context void a. context -> Codec context void a -> Parser a
go Value
v ValueCodec input1 output1
c Parser output1 -> JSONPathElement -> Parser output1
forall a. Parser a -> JSONPathElement -> Parser a
JSON.<?> Int -> JSONPathElement
Index Int
ix
                  )
          )
      ObjectOfCodec Maybe Text
mname ObjectCodec void a
c ->
        ( \Object -> Parser a
f -> case Maybe Text
mname of
            Maybe Text
Nothing -> Value -> Parser Object
forall a. FromJSON a => Value -> Parser a
parseJSON context
Value
value Parser Object -> (Object -> Parser a) -> Parser a
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Object -> Parser a
f
            Just Text
name -> [Char] -> (Object -> Parser a) -> Value -> Parser a
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject (Text -> [Char]
T.unpack Text
name) Object -> Parser a
f context
Value
value
        )
          (\Object
object_ -> (Object -> ObjectCodec void a -> Parser a
forall context void a. context -> Codec context void a -> Parser a
`go` ObjectCodec void a
c) (Object
object_ :: JSON.Object))
      HashMapCodec JSONCodec v
c -> Parser (HashMap k v) -> Parser a
forall a b. Coercible a b => a -> b
coerce ((Value -> Parser v)
-> (Value -> Parser [v]) -> Value -> Parser (HashMap k v)
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
Compat.liftParseJSON (Value -> JSONCodec v -> Parser v
forall context void a. context -> Codec context void a -> Parser a
`go` JSONCodec v
c) (Value -> Codec Value [v] [v] -> Parser [v]
forall context void a. context -> Codec context void a -> Parser a
`go` JSONCodec v -> Codec Value [v] [v]
forall input output.
ValueCodec input output -> ValueCodec [input] [output]
listCodec JSONCodec v
c) context
Value
value :: JSON.Parser (HashMap _ _))
      MapCodec JSONCodec v
c -> Parser (Map k v) -> Parser a
forall a b. Coercible a b => a -> b
coerce ((Value -> Parser v)
-> (Value -> Parser [v]) -> Value -> Parser (Map k v)
forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
Compat.liftParseJSON (Value -> JSONCodec v -> Parser v
forall context void a. context -> Codec context void a -> Parser a
`go` JSONCodec v
c) (Value -> Codec Value [v] [v] -> Parser [v]
forall context void a. context -> Codec context void a -> Parser a
`go` JSONCodec v -> Codec Value [v] [v]
forall input output.
ValueCodec input output -> ValueCodec [input] [output]
listCodec JSONCodec v
c) context
Value
value :: JSON.Parser (Map _ _))
      Codec context void a
ValueCodec -> a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Parser a) -> a -> Parser a
forall a b. (a -> b) -> a -> b
$ context -> a
forall a b. Coercible a b => a -> b
coerce context
value
      EqCodec value
expected JSONCodec value
c -> do
        value
actual <- context -> Codec context value value -> Parser value
forall context void a. context -> Codec context void a -> Parser a
go context
value Codec context value value
JSONCodec value
c
        if value
expected value -> value -> Bool
forall a. Eq a => a -> a -> Bool
== value
actual
          then a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (value -> a
forall a b. Coercible a b => a -> b
coerce value
actual)
          else [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser a) -> [Char] -> Parser a
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"Expected", value -> [Char]
forall a. Show a => a -> [Char]
show value
expected, [Char]
"but got", value -> [Char]
forall a. Show a => a -> [Char]
show value
actual]
      BimapCodec oldOutput -> Either [Char] a
f void -> oldInput
_ Codec context oldInput oldOutput
c -> do
        oldOutput
old <- context -> Codec context oldInput oldOutput -> Parser oldOutput
forall context void a. context -> Codec context void a -> Parser a
go context
value Codec context oldInput oldOutput
c
        case oldOutput -> Either [Char] a
f oldOutput
old of
          Left [Char]
err -> [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
err
          Right a
new -> a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
new
      EitherCodec Union
u Codec context input1 output1
c1 Codec context input2 output2
c2 ->
        let leftParser :: context -> Parser (Either output1 output2)
leftParser context
v = output1 -> Either output1 output2
forall a b. a -> Either a b
Left (output1 -> Either output1 output2)
-> Parser output1 -> Parser (Either output1 output2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> context -> Codec context input1 output1 -> Parser output1
forall context void a. context -> Codec context void a -> Parser a
go context
v Codec context input1 output1
c1
            rightParser :: context -> Parser (Either output1 output2)
rightParser context
v = output2 -> Either output1 output2
forall a b. b -> Either a b
Right (output2 -> Either output1 output2)
-> Parser output2 -> Parser (Either output1 output2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> context -> Codec context input2 output2 -> Parser output2
forall context void a. context -> Codec context void a -> Parser a
go context
v Codec context input2 output2
c2
         in Parser (Either output1 output2) -> Parser a
forall a b. Coercible a b => a -> b
coerce (Parser (Either output1 output2) -> Parser a)
-> Parser (Either output1 output2) -> Parser a
forall a b. (a -> b) -> a -> b
$ case Union
u of
              Union
PossiblyJointUnion ->
                case (context -> Parser (Either output1 output2))
-> context -> Either [Char] (Either output1 output2)
forall a b. (a -> Parser b) -> a -> Either [Char] b
parseEither context -> Parser (Either output1 output2)
leftParser context
value of
                  Right Either output1 output2
l -> Either output1 output2 -> Parser (Either output1 output2)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either output1 output2
l
                  Left [Char]
err -> [Char]
-> Parser (Either output1 output2)
-> Parser (Either output1 output2)
forall a. [Char] -> Parser a -> Parser a
prependFailure ([Char]
"  Previous branch failure: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
err [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"\n") (context -> Parser (Either output1 output2)
rightParser context
value)
              Union
DisjointUnion ->
                case ((context -> Parser (Either output1 output2))
-> context -> Either [Char] (Either output1 output2)
forall a b. (a -> Parser b) -> a -> Either [Char] b
parseEither context -> Parser (Either output1 output2)
leftParser context
value, (context -> Parser (Either output1 output2))
-> context -> Either [Char] (Either output1 output2)
forall a b. (a -> Parser b) -> a -> Either [Char] b
parseEither context -> Parser (Either output1 output2)
rightParser context
value) of
                  (Left [Char]
_, Right Either output1 output2
r) -> Either output1 output2 -> Parser (Either output1 output2)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either output1 output2
r
                  (Right Either output1 output2
l, Left [Char]
_) -> Either output1 output2 -> Parser (Either output1 output2)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either output1 output2
l
                  (Right Either output1 output2
_, Right Either output1 output2
_) -> [Char] -> Parser (Either output1 output2)
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Both branches of a disjoint union succeeded."
                  (Left [Char]
lErr, Left [Char]
rErr) ->
                    [Char] -> Parser (Either output1 output2)
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser (Either output1 output2))
-> [Char] -> Parser (Either output1 output2)
forall a b. (a -> b) -> a -> b
$
                      [[Char]] -> [Char]
unlines
                        [ [Char]
"Both branches of a disjoint union failed: ",
                          [[Char]] -> [Char]
unwords [[Char]
"Left:  ", [Char]
lErr],
                          [[Char]] -> [Char]
unwords [[Char]
"Right: ", [Char]
rErr]
                        ]
      DiscriminatedUnionCodec Text
propertyName void -> (Text, ObjectCodec void ())
_ HashMap Text (Text, ObjectCodec Void a)
m -> do
        Text
discriminatorValue <- (context
Object
value :: JSON.Object) Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
JSON..: Text -> Key
Compat.toKey Text
propertyName
        case Text
-> HashMap Text (Text, ObjectCodec Void a)
-> Maybe (Text, ObjectCodec Void a)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
discriminatorValue HashMap Text (Text, ObjectCodec Void a)
m of
          Maybe (Text, ObjectCodec Void a)
Nothing -> [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser a) -> [Char] -> Parser a
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected discriminator value: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
discriminatorValue
          Just (Text
_, ObjectCodec Void a
c) ->
            context -> Codec context Void a -> Parser a
forall context void a. context -> Codec context void a -> Parser a
go context
value Codec context Void a
ObjectCodec Void a
c
      CommentCodec Text
_ ValueCodec void a
c -> context -> Codec context void a -> Parser a
forall context void a. context -> Codec context void a -> Parser a
go context
value Codec context void a
ValueCodec void a
c
      ReferenceCodec Text
_ ValueCodec void a
c -> context -> Codec context void a -> Parser a
forall context void a. context -> Codec context void a -> Parser a
go context
value Codec context void a
ValueCodec void a
c
      RequiredKeyCodec Text
k ValueCodec void a
c Maybe Text
_ -> do
        Value
valueAtKey <- (context
Object
value :: JSON.Object) Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
JSON..: Text -> Key
Compat.toKey Text
k
        Value -> ValueCodec void a -> Parser a
forall context void a. context -> Codec context void a -> Parser a
go Value
valueAtKey ValueCodec void a
c Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
JSON.<?> Key -> JSONPathElement
Key (Text -> Key
Compat.toKey Text
k)
      OptionalKeyCodec Text
k ValueCodec input1 output1
c Maybe Text
_ -> do
        let key :: Key
key = Text -> Key
Compat.toKey Text
k
            mValueAtKey :: Maybe Value
mValueAtKey = Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
Compat.lookupKey Key
key (context
Object
value :: JSON.Object)
        Parser (Maybe output1) -> Parser a
forall a b. Coercible a b => a -> b
coerce (Parser (Maybe output1) -> Parser a)
-> Parser (Maybe output1) -> Parser a
forall a b. (a -> b) -> a -> b
$ Maybe Value -> (Value -> Parser output1) -> Parser (Maybe output1)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Value
mValueAtKey ((Value -> Parser output1) -> Parser (Maybe output1))
-> (Value -> Parser output1) -> Parser (Maybe output1)
forall a b. (a -> b) -> a -> b
$ \Value
valueAtKey -> Value -> ValueCodec input1 output1 -> Parser output1
forall context void a. context -> Codec context void a -> Parser a
go (Value
valueAtKey :: JSON.Value) ValueCodec input1 output1
c Parser output1 -> JSONPathElement -> Parser output1
forall a. Parser a -> JSONPathElement -> Parser a
JSON.<?> Key -> JSONPathElement
Key Key
key
      OptionalKeyWithDefaultCodec Text
k ValueCodec void void
c void
defaultValue Maybe Text
_ -> do
        let key :: Key
key = Text -> Key
Compat.toKey Text
k
            mValueAtKey :: Maybe Value
mValueAtKey = Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
Compat.lookupKey Key
key (context
Object
value :: JSON.Object)
        Parser void -> Parser a
forall a b. Coercible a b => a -> b
coerce (Parser void -> Parser a) -> Parser void -> Parser a
forall a b. (a -> b) -> a -> b
$ case Maybe Value
mValueAtKey of
          Maybe Value
Nothing -> void -> Parser void
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure void
defaultValue
          Just Value
valueAtKey -> Value -> ValueCodec void void -> Parser void
forall context void a. context -> Codec context void a -> Parser a
go (Value
valueAtKey :: JSON.Value) ValueCodec void void
c Parser void -> JSONPathElement -> Parser void
forall a. Parser a -> JSONPathElement -> Parser a
JSON.<?> Key -> JSONPathElement
Key Key
key
      OptionalKeyWithOmittedDefaultCodec Text
k ValueCodec value value
c value
defaultValue Maybe Text
mDoc -> context -> Codec context value a -> Parser a
forall context void a. context -> Codec context void a -> Parser a
go context
value (Codec context value a -> Parser a)
-> Codec context value a -> Parser a
forall a b. (a -> b) -> a -> b
$ Text
-> ValueCodec value value
-> value
-> Maybe Text
-> Codec Object value a
forall output input.
Coercible output input =>
Text
-> ValueCodec input input
-> input
-> Maybe Text
-> Codec Object input output
OptionalKeyWithDefaultCodec Text
k ValueCodec value value
c value
defaultValue Maybe Text
mDoc
      PureCodec a
a -> a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
      ApCodec ObjectCodec void (output1 -> a)
ocf ObjectCodec void output1
oca -> Object -> ObjectCodec void (output1 -> a) -> Parser (output1 -> a)
forall context void a. context -> Codec context void a -> Parser a
go (context
Object
value :: JSON.Object) ObjectCodec void (output1 -> a)
ocf Parser (output1 -> a) -> Parser output1 -> Parser a
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> ObjectCodec void output1 -> Parser output1
forall context void a. context -> Codec context void a -> Parser a
go (context
Object
value :: JSON.Object) ObjectCodec void output1
oca