{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

module Hasura.RemoteSchema.Metadata.RemoteRelationship
  ( ToSchemaRelationshipDef (..),
    trrdRemoteField,
    trrdLhsFields,
    trrdRemoteSchema,
    FieldCall (..),
    RemoteArguments (..),
    RemoteFields (..),
    SchemaRemoteRelationships,
    RemoteSchemaTypeRelationships (..),
    rstrsName,
    rstrsRelationships,
  )
where

import Autodocodec
import Autodocodec qualified as AC
import Autodocodec.Extended (graphQLFieldNameCodec, graphQLValueCodec, hashSetCodec, typeableName)
import Control.Exception.Safe (Typeable)
import Control.Lens (makeLenses)
import Data.Aeson qualified as J
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
import Data.Aeson.TH qualified as J
import Data.Aeson.Types (prependFailure)
import Data.Bifunctor (bimap)
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd.Autodocodec (insertionOrderedElemsCodec)
import Data.HashMap.Strict.InsOrd.Extended qualified as InsOrdHashMap
import Data.Scientific (floatingOrInteger)
import Data.Text qualified as T
import Hasura.Prelude
import Hasura.RQL.Types.Common
import Hasura.RemoteSchema.Metadata.Base
import Language.GraphQL.Draft.Syntax qualified as G

-- | Metadata representation of a relationship to a remote schema.
data ToSchemaRelationshipDef = ToSchemaRelationshipDef
  { -- | Identifier for this mapping.
    ToSchemaRelationshipDef -> RemoteSchemaName
_trrdRemoteSchema :: RemoteSchemaName,
    -- | The lhs fields that must be forwarded to the remote schema.
    ToSchemaRelationshipDef -> HashSet FieldName
_trrdLhsFields :: HashSet FieldName,
    ToSchemaRelationshipDef -> RemoteFields
_trrdRemoteField :: RemoteFields
  }
  deriving stock (Int -> ToSchemaRelationshipDef -> ShowS
[ToSchemaRelationshipDef] -> ShowS
ToSchemaRelationshipDef -> String
(Int -> ToSchemaRelationshipDef -> ShowS)
-> (ToSchemaRelationshipDef -> String)
-> ([ToSchemaRelationshipDef] -> ShowS)
-> Show ToSchemaRelationshipDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToSchemaRelationshipDef -> ShowS
showsPrec :: Int -> ToSchemaRelationshipDef -> ShowS
$cshow :: ToSchemaRelationshipDef -> String
show :: ToSchemaRelationshipDef -> String
$cshowList :: [ToSchemaRelationshipDef] -> ShowS
showList :: [ToSchemaRelationshipDef] -> ShowS
Show, ToSchemaRelationshipDef -> ToSchemaRelationshipDef -> Bool
(ToSchemaRelationshipDef -> ToSchemaRelationshipDef -> Bool)
-> (ToSchemaRelationshipDef -> ToSchemaRelationshipDef -> Bool)
-> Eq ToSchemaRelationshipDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ToSchemaRelationshipDef -> ToSchemaRelationshipDef -> Bool
== :: ToSchemaRelationshipDef -> ToSchemaRelationshipDef -> Bool
$c/= :: ToSchemaRelationshipDef -> ToSchemaRelationshipDef -> Bool
/= :: ToSchemaRelationshipDef -> ToSchemaRelationshipDef -> Bool
Eq, (forall x.
 ToSchemaRelationshipDef -> Rep ToSchemaRelationshipDef x)
-> (forall x.
    Rep ToSchemaRelationshipDef x -> ToSchemaRelationshipDef)
-> Generic ToSchemaRelationshipDef
forall x. Rep ToSchemaRelationshipDef x -> ToSchemaRelationshipDef
forall x. ToSchemaRelationshipDef -> Rep ToSchemaRelationshipDef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ToSchemaRelationshipDef -> Rep ToSchemaRelationshipDef x
from :: forall x. ToSchemaRelationshipDef -> Rep ToSchemaRelationshipDef x
$cto :: forall x. Rep ToSchemaRelationshipDef x -> ToSchemaRelationshipDef
to :: forall x. Rep ToSchemaRelationshipDef x -> ToSchemaRelationshipDef
Generic)

instance NFData ToSchemaRelationshipDef

instance HasCodec ToSchemaRelationshipDef where
  codec :: JSONCodec ToSchemaRelationshipDef
codec =
    Text
-> ObjectCodec ToSchemaRelationshipDef ToSchemaRelationshipDef
-> JSONCodec ToSchemaRelationshipDef
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"ToSchemaRelationshipDef"
      (ObjectCodec ToSchemaRelationshipDef ToSchemaRelationshipDef
 -> JSONCodec ToSchemaRelationshipDef)
-> ObjectCodec ToSchemaRelationshipDef ToSchemaRelationshipDef
-> JSONCodec ToSchemaRelationshipDef
forall a b. (a -> b) -> a -> b
$ RemoteSchemaName
-> HashSet FieldName -> RemoteFields -> ToSchemaRelationshipDef
ToSchemaRelationshipDef
      (RemoteSchemaName
 -> HashSet FieldName -> RemoteFields -> ToSchemaRelationshipDef)
-> Codec Object ToSchemaRelationshipDef RemoteSchemaName
-> Codec
     Object
     ToSchemaRelationshipDef
     (HashSet FieldName -> RemoteFields -> ToSchemaRelationshipDef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec RemoteSchemaName RemoteSchemaName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"remote_schema"
      ObjectCodec RemoteSchemaName RemoteSchemaName
-> (ToSchemaRelationshipDef -> RemoteSchemaName)
-> Codec Object ToSchemaRelationshipDef RemoteSchemaName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ToSchemaRelationshipDef -> RemoteSchemaName
_trrdRemoteSchema
        Codec
  Object
  ToSchemaRelationshipDef
  (HashSet FieldName -> RemoteFields -> ToSchemaRelationshipDef)
-> Codec Object ToSchemaRelationshipDef (HashSet FieldName)
-> Codec
     Object
     ToSchemaRelationshipDef
     (RemoteFields -> ToSchemaRelationshipDef)
forall a b.
Codec Object ToSchemaRelationshipDef (a -> b)
-> Codec Object ToSchemaRelationshipDef a
-> Codec Object ToSchemaRelationshipDef b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ValueCodec (HashSet FieldName) (HashSet FieldName)
-> ObjectCodec (HashSet FieldName) (HashSet FieldName)
forall input output.
Text -> ValueCodec input output -> ObjectCodec input output
requiredFieldWith' Text
"lhs_fields" ValueCodec (HashSet FieldName) (HashSet FieldName)
forall a. (Hashable a, HasCodec a) => JSONCodec (HashSet a)
hashSetCodec
      ObjectCodec (HashSet FieldName) (HashSet FieldName)
-> (ToSchemaRelationshipDef -> HashSet FieldName)
-> Codec Object ToSchemaRelationshipDef (HashSet FieldName)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ToSchemaRelationshipDef -> HashSet FieldName
_trrdLhsFields
        Codec
  Object
  ToSchemaRelationshipDef
  (RemoteFields -> ToSchemaRelationshipDef)
-> Codec Object ToSchemaRelationshipDef RemoteFields
-> ObjectCodec ToSchemaRelationshipDef ToSchemaRelationshipDef
forall a b.
Codec Object ToSchemaRelationshipDef (a -> b)
-> Codec Object ToSchemaRelationshipDef a
-> Codec Object ToSchemaRelationshipDef b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec RemoteFields RemoteFields
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"remote_field"
      ObjectCodec RemoteFields RemoteFields
-> (ToSchemaRelationshipDef -> RemoteFields)
-> Codec Object ToSchemaRelationshipDef RemoteFields
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ToSchemaRelationshipDef -> RemoteFields
_trrdRemoteField

-- | Targeted field in a remote schema relationship.
-- TODO: explain about subfields and why this is a container
newtype RemoteFields = RemoteFields {RemoteFields -> NonEmpty FieldCall
unRemoteFields :: NonEmpty FieldCall}
  deriving (Int -> RemoteFields -> ShowS
[RemoteFields] -> ShowS
RemoteFields -> String
(Int -> RemoteFields -> ShowS)
-> (RemoteFields -> String)
-> ([RemoteFields] -> ShowS)
-> Show RemoteFields
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoteFields -> ShowS
showsPrec :: Int -> RemoteFields -> ShowS
$cshow :: RemoteFields -> String
show :: RemoteFields -> String
$cshowList :: [RemoteFields] -> ShowS
showList :: [RemoteFields] -> ShowS
Show, RemoteFields -> RemoteFields -> Bool
(RemoteFields -> RemoteFields -> Bool)
-> (RemoteFields -> RemoteFields -> Bool) -> Eq RemoteFields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteFields -> RemoteFields -> Bool
== :: RemoteFields -> RemoteFields -> Bool
$c/= :: RemoteFields -> RemoteFields -> Bool
/= :: RemoteFields -> RemoteFields -> Bool
Eq, (forall x. RemoteFields -> Rep RemoteFields x)
-> (forall x. Rep RemoteFields x -> RemoteFields)
-> Generic RemoteFields
forall x. Rep RemoteFields x -> RemoteFields
forall x. RemoteFields -> Rep RemoteFields x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemoteFields -> Rep RemoteFields x
from :: forall x. RemoteFields -> Rep RemoteFields x
$cto :: forall x. Rep RemoteFields x -> RemoteFields
to :: forall x. Rep RemoteFields x -> RemoteFields
Generic)

instance NFData RemoteFields

instance HasCodec RemoteFields where
  codec :: JSONCodec RemoteFields
codec =
    Text -> JSONCodec RemoteFields -> JSONCodec RemoteFields
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"RemoteFields"
      (JSONCodec RemoteFields -> JSONCodec RemoteFields)
-> JSONCodec RemoteFields -> JSONCodec RemoteFields
forall a b. (a -> b) -> a -> b
$ (HashMap Name (RemoteArguments, Maybe RemoteFields)
 -> Either String RemoteFields)
-> (RemoteFields
    -> HashMap Name (RemoteArguments, Maybe RemoteFields))
-> Codec
     Value
     (HashMap Name (RemoteArguments, Maybe RemoteFields))
     (HashMap Name (RemoteArguments, Maybe RemoteFields))
-> JSONCodec RemoteFields
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec HashMap Name (RemoteArguments, Maybe RemoteFields)
-> Either String RemoteFields
dec RemoteFields -> HashMap Name (RemoteArguments, Maybe RemoteFields)
enc
      (Codec
   Value
   (HashMap Name (RemoteArguments, Maybe RemoteFields))
   (HashMap Name (RemoteArguments, Maybe RemoteFields))
 -> JSONCodec RemoteFields)
-> Codec
     Value
     (HashMap Name (RemoteArguments, Maybe RemoteFields))
     (HashMap Name (RemoteArguments, Maybe RemoteFields))
-> JSONCodec RemoteFields
forall a b. (a -> b) -> a -> b
$ JSONCodec (RemoteArguments, Maybe RemoteFields)
-> Codec
     Value
     (HashMap Name (RemoteArguments, Maybe RemoteFields))
     (HashMap Name (RemoteArguments, Maybe RemoteFields))
forall k v.
(Eq k, Hashable k, FromJSONKey k, ToJSONKey k) =>
JSONCodec v -> JSONCodec (HashMap k v)
hashMapCodec JSONCodec (RemoteArguments, Maybe RemoteFields)
argumentsCodec
      Codec
  Value
  (HashMap Name (RemoteArguments, Maybe RemoteFields))
  (HashMap Name (RemoteArguments, Maybe RemoteFields))
-> Text
-> Codec
     Value
     (HashMap Name (RemoteArguments, Maybe RemoteFields))
     (HashMap Name (RemoteArguments, Maybe RemoteFields))
forall input output.
ValueCodec input output -> Text -> ValueCodec input output
<?> Text
"Remote fields are represented by an object that maps each field name to its arguments."
    where
      argumentsCodec :: JSONCodec (RemoteArguments, Maybe RemoteFields)
      argumentsCodec :: JSONCodec (RemoteArguments, Maybe RemoteFields)
argumentsCodec =
        Text
-> ObjectCodec
     (RemoteArguments, Maybe RemoteFields)
     (RemoteArguments, Maybe RemoteFields)
-> JSONCodec (RemoteArguments, Maybe RemoteFields)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"FieldCall"
          (ObjectCodec
   (RemoteArguments, Maybe RemoteFields)
   (RemoteArguments, Maybe RemoteFields)
 -> JSONCodec (RemoteArguments, Maybe RemoteFields))
-> ObjectCodec
     (RemoteArguments, Maybe RemoteFields)
     (RemoteArguments, Maybe RemoteFields)
-> JSONCodec (RemoteArguments, Maybe RemoteFields)
forall a b. (a -> b) -> a -> b
$ (,)
          (RemoteArguments
 -> Maybe RemoteFields -> (RemoteArguments, Maybe RemoteFields))
-> Codec
     Object (RemoteArguments, Maybe RemoteFields) RemoteArguments
-> Codec
     Object
     (RemoteArguments, Maybe RemoteFields)
     (Maybe RemoteFields -> (RemoteArguments, Maybe RemoteFields))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec RemoteArguments RemoteArguments
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"arguments"
          ObjectCodec RemoteArguments RemoteArguments
-> ((RemoteArguments, Maybe RemoteFields) -> RemoteArguments)
-> Codec
     Object (RemoteArguments, Maybe RemoteFields) RemoteArguments
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (RemoteArguments, Maybe RemoteFields) -> RemoteArguments
forall a b. (a, b) -> a
fst
            Codec
  Object
  (RemoteArguments, Maybe RemoteFields)
  (Maybe RemoteFields -> (RemoteArguments, Maybe RemoteFields))
-> Codec
     Object (RemoteArguments, Maybe RemoteFields) (Maybe RemoteFields)
-> ObjectCodec
     (RemoteArguments, Maybe RemoteFields)
     (RemoteArguments, Maybe RemoteFields)
forall a b.
Codec Object (RemoteArguments, Maybe RemoteFields) (a -> b)
-> Codec Object (RemoteArguments, Maybe RemoteFields) a
-> Codec Object (RemoteArguments, Maybe RemoteFields) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe RemoteFields) (Maybe RemoteFields)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField' Text
"field"
          ObjectCodec (Maybe RemoteFields) (Maybe RemoteFields)
-> ((RemoteArguments, Maybe RemoteFields) -> Maybe RemoteFields)
-> Codec
     Object (RemoteArguments, Maybe RemoteFields) (Maybe RemoteFields)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (RemoteArguments, Maybe RemoteFields) -> Maybe RemoteFields
forall a b. (a, b) -> b
snd

      dec :: HashMap G.Name (RemoteArguments, Maybe RemoteFields) -> Either String RemoteFields
      dec :: HashMap Name (RemoteArguments, Maybe RemoteFields)
-> Either String RemoteFields
dec HashMap Name (RemoteArguments, Maybe RemoteFields)
hashmap = case HashMap Name (RemoteArguments, Maybe RemoteFields)
-> [(Name, (RemoteArguments, Maybe RemoteFields))]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Name (RemoteArguments, Maybe RemoteFields)
hashmap of
        [(Name
fieldName, (RemoteArguments
arguments, Maybe RemoteFields
maybeSubField))] ->
          let subfields :: [FieldCall]
subfields = [FieldCall]
-> (RemoteFields -> [FieldCall])
-> Maybe RemoteFields
-> [FieldCall]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (NonEmpty FieldCall -> [FieldCall]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty FieldCall -> [FieldCall])
-> (RemoteFields -> NonEmpty FieldCall)
-> RemoteFields
-> [FieldCall]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteFields -> NonEmpty FieldCall
unRemoteFields) Maybe RemoteFields
maybeSubField
           in RemoteFields -> Either String RemoteFields
forall a b. b -> Either a b
Right
                (RemoteFields -> Either String RemoteFields)
-> RemoteFields -> Either String RemoteFields
forall a b. (a -> b) -> a -> b
$ NonEmpty FieldCall -> RemoteFields
RemoteFields
                (NonEmpty FieldCall -> RemoteFields)
-> NonEmpty FieldCall -> RemoteFields
forall a b. (a -> b) -> a -> b
$ FieldCall {fcName :: Name
fcName = Name
fieldName, fcArguments :: RemoteArguments
fcArguments = RemoteArguments
arguments}
                FieldCall -> [FieldCall] -> NonEmpty FieldCall
forall a. a -> [a] -> NonEmpty a
:| [FieldCall]
subfields
        [] -> String -> Either String RemoteFields
forall a b. a -> Either a b
Left String
"Expecting one single mapping, received none."
        [(Name, (RemoteArguments, Maybe RemoteFields))]
_ -> String -> Either String RemoteFields
forall a b. a -> Either a b
Left String
"Expecting one single mapping, received too many."

      enc :: RemoteFields -> HashMap G.Name (RemoteArguments, Maybe RemoteFields)
      enc :: RemoteFields -> HashMap Name (RemoteArguments, Maybe RemoteFields)
enc (RemoteFields (FieldCall
field :| [FieldCall]
subfields)) =
        Name
-> (RemoteArguments, Maybe RemoteFields)
-> HashMap Name (RemoteArguments, Maybe RemoteFields)
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton (FieldCall -> Name
fcName FieldCall
field) (FieldCall -> RemoteArguments
fcArguments FieldCall
field, NonEmpty FieldCall -> RemoteFields
RemoteFields (NonEmpty FieldCall -> RemoteFields)
-> Maybe (NonEmpty FieldCall) -> Maybe RemoteFields
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldCall] -> Maybe (NonEmpty FieldCall)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [FieldCall]
subfields)

instance J.FromJSON RemoteFields where
  parseJSON :: Value -> Parser RemoteFields
parseJSON = String -> Parser RemoteFields -> Parser RemoteFields
forall a. String -> Parser a -> Parser a
prependFailure String
details (Parser RemoteFields -> Parser RemoteFields)
-> (Value -> Parser RemoteFields) -> Value -> Parser RemoteFields
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty FieldCall -> RemoteFields)
-> Parser (NonEmpty FieldCall) -> Parser RemoteFields
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty FieldCall -> RemoteFields
RemoteFields (Parser (NonEmpty FieldCall) -> Parser RemoteFields)
-> (Value -> Parser (NonEmpty FieldCall))
-> Value
-> Parser RemoteFields
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (NonEmpty FieldCall)
parseRemoteFields
    where
      details :: String
details = String
"Remote fields are represented by an object that maps each field name to its arguments."
      parseRemoteFields :: Value -> Parser (NonEmpty FieldCall)
parseRemoteFields = String
-> (Object -> Parser (NonEmpty FieldCall))
-> Value
-> Parser (NonEmpty FieldCall)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"RemoteFields" \Object
hashmap -> case Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
hashmap of
        [(Key
fieldNameKey, Value
callValue)] -> do
          Name
fieldName <- Value -> Parser Name
forall a. FromJSON a => Value -> Parser a
J.parseJSON (Value -> Parser Name) -> Value -> Parser Name
forall a b. (a -> b) -> a -> b
$ Text -> Value
J.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Text
K.toText Key
fieldNameKey
          Object
callObject <- Value -> Parser Object
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
callValue
          RemoteArguments
arguments <- Object
callObject Object -> Key -> Parser RemoteArguments
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"arguments"
          Maybe Value
maybeSubField <- Object
callObject Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"field"
          [FieldCall]
subFields <-
            [FieldCall] -> Maybe [FieldCall] -> [FieldCall]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [FieldCall] -> [FieldCall])
-> Parser (Maybe [FieldCall]) -> Parser [FieldCall]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
-> (Value -> Parser [FieldCall]) -> Parser (Maybe [FieldCall])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe Value
maybeSubField \Value
fieldValue -> do
              NonEmpty FieldCall
remoteFields <- Value -> Parser (NonEmpty FieldCall)
parseRemoteFields Value
fieldValue
              [FieldCall] -> Parser [FieldCall]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty FieldCall -> [FieldCall]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty FieldCall
remoteFields)
          NonEmpty FieldCall -> Parser (NonEmpty FieldCall)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty FieldCall -> Parser (NonEmpty FieldCall))
-> NonEmpty FieldCall -> Parser (NonEmpty FieldCall)
forall a b. (a -> b) -> a -> b
$ FieldCall {fcName :: Name
fcName = Name
fieldName, fcArguments :: RemoteArguments
fcArguments = RemoteArguments
arguments} FieldCall -> [FieldCall] -> NonEmpty FieldCall
forall a. a -> [a] -> NonEmpty a
:| [FieldCall]
subFields
        [] -> String -> Parser (NonEmpty FieldCall)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expecting one single mapping, received none."
        [(Key, Value)]
_ -> String -> Parser (NonEmpty FieldCall)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expecting one single mapping, received too many."

instance J.ToJSON RemoteFields where
  toJSON :: RemoteFields -> Value
toJSON (RemoteFields NonEmpty FieldCall
fields) = NonEmpty FieldCall -> Value
remoteFieldsJson NonEmpty FieldCall
fields
    where
      remoteFieldsJson :: NonEmpty FieldCall -> Value
remoteFieldsJson (FieldCall
field :| [FieldCall]
subfields) =
        [(Key, Value)] -> Value
J.object
          [ Text -> Key
K.fromText (Name -> Text
G.unName (FieldCall -> Name
fcName FieldCall
field))
              Key -> Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
J..= [(Key, Value)] -> Value
J.object
                ( [Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes
                    [ (Key, Value) -> Maybe (Key, Value)
forall a. a -> Maybe a
Just ((Key, Value) -> Maybe (Key, Value))
-> (Key, Value) -> Maybe (Key, Value)
forall a b. (a -> b) -> a -> b
$ Key
"arguments" Key -> RemoteArguments -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
J..= FieldCall -> RemoteArguments
fcArguments FieldCall
field,
                      [FieldCall] -> Maybe (NonEmpty FieldCall)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [FieldCall]
subfields Maybe (NonEmpty FieldCall)
-> (NonEmpty FieldCall -> (Key, Value)) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \NonEmpty FieldCall
sf -> Key
"field" Key -> Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
J..= NonEmpty FieldCall -> Value
remoteFieldsJson NonEmpty FieldCall
sf
                    ]
                )
          ]

-- | Associates a field name with the arguments it will be passed in the query.
--
-- https://graphql.github.io/graphql-spec/June2018/#sec-Language.Arguments
data FieldCall = FieldCall
  { FieldCall -> Name
fcName :: G.Name,
    FieldCall -> RemoteArguments
fcArguments :: RemoteArguments
  }
  deriving (Int -> FieldCall -> ShowS
[FieldCall] -> ShowS
FieldCall -> String
(Int -> FieldCall -> ShowS)
-> (FieldCall -> String)
-> ([FieldCall] -> ShowS)
-> Show FieldCall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldCall -> ShowS
showsPrec :: Int -> FieldCall -> ShowS
$cshow :: FieldCall -> String
show :: FieldCall -> String
$cshowList :: [FieldCall] -> ShowS
showList :: [FieldCall] -> ShowS
Show, FieldCall -> FieldCall -> Bool
(FieldCall -> FieldCall -> Bool)
-> (FieldCall -> FieldCall -> Bool) -> Eq FieldCall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldCall -> FieldCall -> Bool
== :: FieldCall -> FieldCall -> Bool
$c/= :: FieldCall -> FieldCall -> Bool
/= :: FieldCall -> FieldCall -> Bool
Eq, (forall x. FieldCall -> Rep FieldCall x)
-> (forall x. Rep FieldCall x -> FieldCall) -> Generic FieldCall
forall x. Rep FieldCall x -> FieldCall
forall x. FieldCall -> Rep FieldCall x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FieldCall -> Rep FieldCall x
from :: forall x. FieldCall -> Rep FieldCall x
$cto :: forall x. Rep FieldCall x -> FieldCall
to :: forall x. Rep FieldCall x -> FieldCall
Generic)

instance NFData FieldCall

instance Hashable FieldCall

-- | Arguments to a remote GraphQL fields, represented as a mapping from name to
-- GraphQL Value. Said values can be variable names, in which case they'll be
-- referring to values we're closed over.
-- TODO: expand on this
newtype RemoteArguments = RemoteArguments
  { RemoteArguments -> HashMap Name (Value Name)
getRemoteArguments :: HashMap G.Name (G.Value G.Name)
  }
  deriving (Int -> RemoteArguments -> ShowS
[RemoteArguments] -> ShowS
RemoteArguments -> String
(Int -> RemoteArguments -> ShowS)
-> (RemoteArguments -> String)
-> ([RemoteArguments] -> ShowS)
-> Show RemoteArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoteArguments -> ShowS
showsPrec :: Int -> RemoteArguments -> ShowS
$cshow :: RemoteArguments -> String
show :: RemoteArguments -> String
$cshowList :: [RemoteArguments] -> ShowS
showList :: [RemoteArguments] -> ShowS
Show, RemoteArguments -> RemoteArguments -> Bool
(RemoteArguments -> RemoteArguments -> Bool)
-> (RemoteArguments -> RemoteArguments -> Bool)
-> Eq RemoteArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteArguments -> RemoteArguments -> Bool
== :: RemoteArguments -> RemoteArguments -> Bool
$c/= :: RemoteArguments -> RemoteArguments -> Bool
/= :: RemoteArguments -> RemoteArguments -> Bool
Eq, (forall x. RemoteArguments -> Rep RemoteArguments x)
-> (forall x. Rep RemoteArguments x -> RemoteArguments)
-> Generic RemoteArguments
forall x. Rep RemoteArguments x -> RemoteArguments
forall x. RemoteArguments -> Rep RemoteArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemoteArguments -> Rep RemoteArguments x
from :: forall x. RemoteArguments -> Rep RemoteArguments x
$cto :: forall x. Rep RemoteArguments x -> RemoteArguments
to :: forall x. Rep RemoteArguments x -> RemoteArguments
Generic, RemoteArguments -> ()
(RemoteArguments -> ()) -> NFData RemoteArguments
forall a. (a -> ()) -> NFData a
$crnf :: RemoteArguments -> ()
rnf :: RemoteArguments -> ()
NFData)

instance Hashable RemoteArguments

instance HasCodec RemoteArguments where
  codec :: JSONCodec RemoteArguments
codec =
    Text -> JSONCodec RemoteArguments -> JSONCodec RemoteArguments
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"RemoteArguments"
      (JSONCodec RemoteArguments -> JSONCodec RemoteArguments)
-> JSONCodec RemoteArguments -> JSONCodec RemoteArguments
forall a b. (a -> b) -> a -> b
$ Text -> JSONCodec RemoteArguments -> JSONCodec RemoteArguments
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
CommentCodec Text
"Remote arguments are represented by an object that maps each argument name to its value."
      (JSONCodec RemoteArguments -> JSONCodec RemoteArguments)
-> JSONCodec RemoteArguments -> JSONCodec RemoteArguments
forall a b. (a -> b) -> a -> b
$ (HashMap Name (Value Name) -> RemoteArguments)
-> (RemoteArguments -> HashMap Name (Value Name))
-> Codec
     Value (HashMap Name (Value Name)) (HashMap Name (Value Name))
-> JSONCodec RemoteArguments
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec HashMap Name (Value Name) -> RemoteArguments
RemoteArguments RemoteArguments -> HashMap Name (Value Name)
getRemoteArguments
      (Codec
   Value (HashMap Name (Value Name)) (HashMap Name (Value Name))
 -> JSONCodec RemoteArguments)
-> Codec
     Value (HashMap Name (Value Name)) (HashMap Name (Value Name))
-> JSONCodec RemoteArguments
forall a b. (a -> b) -> a -> b
$ JSONCodec (Value Name)
-> Codec
     Value (HashMap Name (Value Name)) (HashMap Name (Value Name))
forall k v.
(Eq k, Hashable k, FromJSONKey k, ToJSONKey k) =>
JSONCodec v -> JSONCodec (HashMap k v)
hashMapCodec (JSONCodec Name -> JSONCodec (Value Name)
forall var. Typeable var => JSONCodec var -> JSONCodec (Value var)
graphQLValueCodec JSONCodec Name
varCodec)
    where
      varCodec :: JSONCodec Name
varCodec = (Text -> Either String Name)
-> (Name -> Text) -> Codec Value Text Text -> JSONCodec Name
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec Text -> Either String Name
decodeVariable Name -> Text
encodeVariable Codec Value Text Text
textCodec

      decodeVariable :: Text -> Either String Name
decodeVariable Text
text = case Text -> Maybe (Char, Text)
T.uncons Text
text of
        Just (Char
'$', Text
rest)
          | Text -> Bool
T.null Text
rest -> String -> Either String Name
forall a b. a -> Either a b
Left (String -> Either String Name) -> String -> Either String Name
forall a b. (a -> b) -> a -> b
$ String
"Empty variable name"
          | Bool
otherwise ->
              Maybe Name -> Either String Name -> Either String Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing
                (Text -> Maybe Name
G.mkName Text
rest)
                (String -> Either String Name
forall a b. a -> Either a b
Left (String -> Either String Name) -> String -> Either String Name
forall a b. (a -> b) -> a -> b
$ String
"Invalid variable name '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
rest String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'")
        Maybe (Char, Text)
_ -> String -> Either String Name
forall a b. a -> Either a b
Left (String -> Either String Name) -> String -> Either String Name
forall a b. (a -> b) -> a -> b
$ String
"Variable name must start with $"

      encodeVariable :: Name -> Text
encodeVariable Name
name = Text
"$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
G.unName Name
name

instance J.FromJSON RemoteArguments where
  parseJSON :: Value -> Parser RemoteArguments
parseJSON = String -> Parser RemoteArguments -> Parser RemoteArguments
forall a. String -> Parser a -> Parser a
prependFailure String
details (Parser RemoteArguments -> Parser RemoteArguments)
-> (Value -> Parser RemoteArguments)
-> Value
-> Parser RemoteArguments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Name (Value Name) -> RemoteArguments)
-> Parser (HashMap Name (Value Name)) -> Parser RemoteArguments
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HashMap Name (Value Name) -> RemoteArguments
RemoteArguments (Parser (HashMap Name (Value Name)) -> Parser RemoteArguments)
-> (Value -> Parser (HashMap Name (Value Name)))
-> Value
-> Parser RemoteArguments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> (Object -> Parser (HashMap Name (Value Name)))
-> Value
-> Parser (HashMap Name (Value Name))
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"RemoteArguments" Object -> Parser (HashMap Name (Value Name))
parseObjectFieldsToGValue
    where
      details :: String
details = String
"Remote arguments are represented by an object that maps each argument name to its value."

      parseObjectFieldsToGValue :: Object -> Parser (HashMap Name (Value Name))
parseObjectFieldsToGValue Object
keyMap =
        [(Name, Value Name)] -> HashMap Name (Value Name)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Name, Value Name)] -> HashMap Name (Value Name))
-> Parser [(Name, Value Name)]
-> Parser (HashMap Name (Value Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Key, Value)]
-> ((Key, Value) -> Parser (Name, Value Name))
-> Parser [(Name, Value Name)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
keyMap) \(Key -> Text
K.toText -> Text
key, Value
value) -> do
          Name
name <- Text -> Maybe Name
G.mkName Text
key Maybe Name -> Parser Name -> Parser Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` String -> Parser Name
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
T.unpack Text
key String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is an invalid key name")
          Value Name
parsedValue <- Value -> Parser (Value Name)
parseValueAsGValue Value
value
          (Name, Value Name) -> Parser (Name, Value Name)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
name, Value Name
parsedValue)

      parseValueAsGValue :: Value -> Parser (Value Name)
parseValueAsGValue = \case
        J.Object Object
obj ->
          HashMap Name (Value Name) -> Value Name
forall var. HashMap Name (Value var) -> Value var
G.VObject (HashMap Name (Value Name) -> Value Name)
-> Parser (HashMap Name (Value Name)) -> Parser (Value Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser (HashMap Name (Value Name))
parseObjectFieldsToGValue Object
obj
        J.Array Array
array ->
          [Value Name] -> Value Name
forall var. [Value var] -> Value var
G.VList ([Value Name] -> Value Name)
-> (Vector (Value Name) -> [Value Name])
-> Vector (Value Name)
-> Value Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Value Name) -> [Value Name]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector (Value Name) -> Value Name)
-> Parser (Vector (Value Name)) -> Parser (Value Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser (Value Name))
-> Array -> Parser (Vector (Value Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse Value -> Parser (Value Name)
parseValueAsGValue Array
array
        J.String Text
text ->
          case Text -> Maybe (Char, Text)
T.uncons Text
text of
            Just (Char
'$', Text
rest)
              | Text -> Bool
T.null Text
rest -> String -> Parser (Value Name)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Value Name)) -> String -> Parser (Value Name)
forall a b. (a -> b) -> a -> b
$ String
"Empty variable name"
              | Bool
otherwise -> case Text -> Maybe Name
G.mkName Text
rest of
                  Maybe Name
Nothing -> String -> Parser (Value Name)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Value Name)) -> String -> Parser (Value Name)
forall a b. (a -> b) -> a -> b
$ String
"Invalid variable name '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
rest String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'"
                  Just Name
name' -> Value Name -> Parser (Value Name)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value Name -> Parser (Value Name))
-> Value Name -> Parser (Value Name)
forall a b. (a -> b) -> a -> b
$ Name -> Value Name
forall var. var -> Value var
G.VVariable Name
name'
            Maybe (Char, Text)
_ -> Value Name -> Parser (Value Name)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Value Name
forall var. Text -> Value var
G.VString Text
text)
        J.Number !Scientific
scientificNum ->
          Value Name -> Parser (Value Name)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value Name -> Parser (Value Name))
-> Value Name -> Parser (Value Name)
forall a b. (a -> b) -> a -> b
$ case Scientific -> Either Float Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
scientificNum of
            -- this number couldn't be interpreted as an integer
            Left (Float
_ :: Float) -> Scientific -> Value Name
forall var. Scientific -> Value var
G.VFloat Scientific
scientificNum
            -- this number was successfully interpreted as an integer
            Right Integer
n -> Integer -> Value Name
forall var. Integer -> Value var
G.VInt Integer
n
        J.Bool !Bool
boolean ->
          Value Name -> Parser (Value Name)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value Name -> Parser (Value Name))
-> Value Name -> Parser (Value Name)
forall a b. (a -> b) -> a -> b
$ Bool -> Value Name
forall var. Bool -> Value var
G.VBoolean Bool
boolean
        Value
J.Null ->
          Value Name -> Parser (Value Name)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value Name
forall var. Value var
G.VNull

instance J.ToJSON RemoteArguments where
  toJSON :: RemoteArguments -> Value
toJSON (RemoteArguments HashMap Name (Value Name)
fields) = HashMap Name (Value Name) -> Value
fieldsToObject HashMap Name (Value Name)
fields
    where
      fieldsToObject :: HashMap Name (Value Name) -> Value
fieldsToObject =
        Object -> Value
J.Object (Object -> Value)
-> (HashMap Name (Value Name) -> Object)
-> HashMap Name (Value Name)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList ([(Key, Value)] -> Object)
-> (HashMap Name (Value Name) -> [(Key, Value)])
-> HashMap Name (Value Name)
-> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, Value Name) -> (Key, Value))
-> [(Name, Value Name)] -> [(Key, Value)]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> Key)
-> (Value Name -> Value) -> (Name, Value Name) -> (Key, Value)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Text -> Key
K.fromText (Text -> Key) -> (Name -> Text) -> Name -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
G.unName) Value Name -> Value
gValueToValue) ([(Name, Value Name)] -> [(Key, Value)])
-> (HashMap Name (Value Name) -> [(Name, Value Name)])
-> HashMap Name (Value Name)
-> [(Key, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Name (Value Name) -> [(Name, Value Name)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList

      gValueToValue :: Value Name -> Value
gValueToValue =
        \case
          G.VVariable Name
v -> Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Text
"$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
G.unName Name
v)
          G.VInt Integer
i -> Integer -> Value
forall a. ToJSON a => a -> Value
J.toJSON Integer
i
          G.VFloat Scientific
f -> Scientific -> Value
forall a. ToJSON a => a -> Value
J.toJSON Scientific
f
          G.VString Text
s -> Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON Text
s
          G.VBoolean Bool
b -> Bool -> Value
forall a. ToJSON a => a -> Value
J.toJSON Bool
b
          Value Name
G.VNull -> Value
J.Null
          G.VEnum EnumValue
s -> EnumValue -> Value
forall a. ToJSON a => a -> Value
J.toJSON EnumValue
s
          G.VList [Value Name]
list -> [Value] -> Value
forall a. ToJSON a => a -> Value
J.toJSON ((Value Name -> Value) -> [Value Name] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Value Name -> Value
gValueToValue [Value Name]
list)
          G.VObject HashMap Name (Value Name)
obj -> HashMap Name (Value Name) -> Value
fieldsToObject HashMap Name (Value Name)
obj

type RemoteRelationships r = InsOrdHashMap RelName (RemoteRelationshipG r)

data RemoteSchemaTypeRelationships r = RemoteSchemaTypeRelationships
  { forall r. RemoteSchemaTypeRelationships r -> Name
_rstrsName :: G.Name,
    forall r. RemoteSchemaTypeRelationships r -> RemoteRelationships r
_rstrsRelationships :: RemoteRelationships r
  }
  deriving (Int -> RemoteSchemaTypeRelationships r -> ShowS
[RemoteSchemaTypeRelationships r] -> ShowS
RemoteSchemaTypeRelationships r -> String
(Int -> RemoteSchemaTypeRelationships r -> ShowS)
-> (RemoteSchemaTypeRelationships r -> String)
-> ([RemoteSchemaTypeRelationships r] -> ShowS)
-> Show (RemoteSchemaTypeRelationships r)
forall r. Show r => Int -> RemoteSchemaTypeRelationships r -> ShowS
forall r. Show r => [RemoteSchemaTypeRelationships r] -> ShowS
forall r. Show r => RemoteSchemaTypeRelationships r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall r. Show r => Int -> RemoteSchemaTypeRelationships r -> ShowS
showsPrec :: Int -> RemoteSchemaTypeRelationships r -> ShowS
$cshow :: forall r. Show r => RemoteSchemaTypeRelationships r -> String
show :: RemoteSchemaTypeRelationships r -> String
$cshowList :: forall r. Show r => [RemoteSchemaTypeRelationships r] -> ShowS
showList :: [RemoteSchemaTypeRelationships r] -> ShowS
Show, RemoteSchemaTypeRelationships r
-> RemoteSchemaTypeRelationships r -> Bool
(RemoteSchemaTypeRelationships r
 -> RemoteSchemaTypeRelationships r -> Bool)
-> (RemoteSchemaTypeRelationships r
    -> RemoteSchemaTypeRelationships r -> Bool)
-> Eq (RemoteSchemaTypeRelationships r)
forall r.
Eq r =>
RemoteSchemaTypeRelationships r
-> RemoteSchemaTypeRelationships r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall r.
Eq r =>
RemoteSchemaTypeRelationships r
-> RemoteSchemaTypeRelationships r -> Bool
== :: RemoteSchemaTypeRelationships r
-> RemoteSchemaTypeRelationships r -> Bool
$c/= :: forall r.
Eq r =>
RemoteSchemaTypeRelationships r
-> RemoteSchemaTypeRelationships r -> Bool
/= :: RemoteSchemaTypeRelationships r
-> RemoteSchemaTypeRelationships r -> Bool
Eq, (forall x.
 RemoteSchemaTypeRelationships r
 -> Rep (RemoteSchemaTypeRelationships r) x)
-> (forall x.
    Rep (RemoteSchemaTypeRelationships r) x
    -> RemoteSchemaTypeRelationships r)
-> Generic (RemoteSchemaTypeRelationships r)
forall x.
Rep (RemoteSchemaTypeRelationships r) x
-> RemoteSchemaTypeRelationships r
forall x.
RemoteSchemaTypeRelationships r
-> Rep (RemoteSchemaTypeRelationships r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall r x.
Rep (RemoteSchemaTypeRelationships r) x
-> RemoteSchemaTypeRelationships r
forall r x.
RemoteSchemaTypeRelationships r
-> Rep (RemoteSchemaTypeRelationships r) x
$cfrom :: forall r x.
RemoteSchemaTypeRelationships r
-> Rep (RemoteSchemaTypeRelationships r) x
from :: forall x.
RemoteSchemaTypeRelationships r
-> Rep (RemoteSchemaTypeRelationships r) x
$cto :: forall r x.
Rep (RemoteSchemaTypeRelationships r) x
-> RemoteSchemaTypeRelationships r
to :: forall x.
Rep (RemoteSchemaTypeRelationships r) x
-> RemoteSchemaTypeRelationships r
Generic)

instance (HasCodec (RemoteRelationshipG r), Typeable r) => HasCodec (RemoteSchemaTypeRelationships r) where
  codec :: JSONCodec (RemoteSchemaTypeRelationships r)
codec =
    Text
-> ObjectCodec
     (RemoteSchemaTypeRelationships r) (RemoteSchemaTypeRelationships r)
-> JSONCodec (RemoteSchemaTypeRelationships r)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object (Text
"RemoteSchemaMetadata_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall a. Typeable a => Text
forall {k} (a :: k). Typeable a => Text
typeableName @r)
      (ObjectCodec
   (RemoteSchemaTypeRelationships r) (RemoteSchemaTypeRelationships r)
 -> JSONCodec (RemoteSchemaTypeRelationships r))
-> ObjectCodec
     (RemoteSchemaTypeRelationships r) (RemoteSchemaTypeRelationships r)
-> JSONCodec (RemoteSchemaTypeRelationships r)
forall a b. (a -> b) -> a -> b
$ Name -> RemoteRelationships r -> RemoteSchemaTypeRelationships r
forall r.
Name -> RemoteRelationships r -> RemoteSchemaTypeRelationships r
RemoteSchemaTypeRelationships
      (Name -> RemoteRelationships r -> RemoteSchemaTypeRelationships r)
-> Codec Object (RemoteSchemaTypeRelationships r) Name
-> Codec
     Object
     (RemoteSchemaTypeRelationships r)
     (RemoteRelationships r -> RemoteSchemaTypeRelationships r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> JSONCodec Name -> ObjectCodec Name Name
forall input output.
Text -> ValueCodec input output -> ObjectCodec input output
requiredFieldWith' Text
"type_name" JSONCodec Name
graphQLFieldNameCodec
      ObjectCodec Name Name
-> (RemoteSchemaTypeRelationships r -> Name)
-> Codec Object (RemoteSchemaTypeRelationships r) Name
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= RemoteSchemaTypeRelationships r -> Name
forall r. RemoteSchemaTypeRelationships r -> Name
_rstrsName
        Codec
  Object
  (RemoteSchemaTypeRelationships r)
  (RemoteRelationships r -> RemoteSchemaTypeRelationships r)
-> Codec
     Object (RemoteSchemaTypeRelationships r) (RemoteRelationships r)
-> ObjectCodec
     (RemoteSchemaTypeRelationships r) (RemoteSchemaTypeRelationships r)
forall a b.
Codec Object (RemoteSchemaTypeRelationships r) (a -> b)
-> Codec Object (RemoteSchemaTypeRelationships r) a
-> Codec Object (RemoteSchemaTypeRelationships r) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> JSONCodec (RemoteRelationships r)
-> RemoteRelationships r
-> ObjectCodec (RemoteRelationships r) (RemoteRelationships r)
forall output.
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithDefaultWith'
          Text
"relationships"
          ((RemoteRelationshipG r -> RelName)
-> JSONCodec (RemoteRelationships r)
forall k a.
(Hashable k, HasCodec a, ToTxt k) =>
(a -> k) -> JSONCodec (InsOrdHashMap k a)
insertionOrderedElemsCodec RemoteRelationshipG r -> RelName
forall definition. RemoteRelationshipG definition -> RelName
_rrName)
          RemoteRelationships r
forall a. Monoid a => a
mempty
      ObjectCodec (RemoteRelationships r) (RemoteRelationships r)
-> (RemoteSchemaTypeRelationships r -> RemoteRelationships r)
-> Codec
     Object (RemoteSchemaTypeRelationships r) (RemoteRelationships r)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= RemoteSchemaTypeRelationships r -> RemoteRelationships r
forall r. RemoteSchemaTypeRelationships r -> RemoteRelationships r
_rstrsRelationships

instance (J.FromJSON (RemoteRelationshipG r)) => J.FromJSON (RemoteSchemaTypeRelationships r) where
  parseJSON :: Value -> Parser (RemoteSchemaTypeRelationships r)
parseJSON = String
-> (Object -> Parser (RemoteSchemaTypeRelationships r))
-> Value
-> Parser (RemoteSchemaTypeRelationships r)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"RemoteSchemaMetadata" \Object
obj ->
    Name -> RemoteRelationships r -> RemoteSchemaTypeRelationships r
forall r.
Name -> RemoteRelationships r -> RemoteSchemaTypeRelationships r
RemoteSchemaTypeRelationships
      (Name -> RemoteRelationships r -> RemoteSchemaTypeRelationships r)
-> Parser Name
-> Parser
     (RemoteRelationships r -> RemoteSchemaTypeRelationships r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj
      Object -> Key -> Parser Name
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"type_name"
      Parser (RemoteRelationships r -> RemoteSchemaTypeRelationships r)
-> Parser (RemoteRelationships r)
-> Parser (RemoteSchemaTypeRelationships r)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((RemoteRelationshipG r -> RelName)
-> [RemoteRelationshipG r] -> RemoteRelationships r
forall k a. Hashable k => (a -> k) -> [a] -> InsOrdHashMap k a
oMapFromL RemoteRelationshipG r -> RelName
forall definition. RemoteRelationshipG definition -> RelName
_rrName ([RemoteRelationshipG r] -> RemoteRelationships r)
-> Parser [RemoteRelationshipG r] -> Parser (RemoteRelationships r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Maybe [RemoteRelationshipG r])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"relationships" Parser (Maybe [RemoteRelationshipG r])
-> [RemoteRelationshipG r] -> Parser [RemoteRelationshipG r]
forall a. Parser (Maybe a) -> a -> Parser a
J..!= [])

instance (J.ToJSON (RemoteRelationshipG r)) => J.ToJSON (RemoteSchemaTypeRelationships r) where
  toJSON :: RemoteSchemaTypeRelationships r -> Value
toJSON RemoteSchemaTypeRelationships {Name
RemoteRelationships r
_rstrsName :: forall r. RemoteSchemaTypeRelationships r -> Name
_rstrsRelationships :: forall r. RemoteSchemaTypeRelationships r -> RemoteRelationships r
_rstrsName :: Name
_rstrsRelationships :: RemoteRelationships r
..} =
    [(Key, Value)] -> Value
J.object
      [ Key
"type_name" Key -> Name -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
J..= Name
_rstrsName,
        Key
"relationships" Key -> [RemoteRelationshipG r] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
J..= RemoteRelationships r -> [RemoteRelationshipG r]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems RemoteRelationships r
_rstrsRelationships
      ]

type SchemaRemoteRelationships r = InsOrdHashMap G.Name (RemoteSchemaTypeRelationships r)

$(J.deriveJSON hasuraJSON ''ToSchemaRelationshipDef)
$(makeLenses ''RemoteSchemaTypeRelationships)
$(makeLenses ''ToSchemaRelationshipDef)