mirror of
https://github.com/Airsequel/AirGQL.git
synced 2025-07-27 13:41:13 +03:00
Rename a few fields to match the Hasura api
This commit is contained in:
parent
41f1752983
commit
d54896341a
4 changed files with 219 additions and 102 deletions
source/AirGQL
|
|
@ -40,6 +40,7 @@ import Protolude (
|
|||
(<=),
|
||||
(>),
|
||||
(>=),
|
||||
(||),
|
||||
)
|
||||
import Protolude qualified as P
|
||||
|
||||
|
|
@ -213,33 +214,36 @@ getColNamesQuoted columnEntries =
|
|||
opAndValToSql :: HashMap.HashMap Text Value -> [Text]
|
||||
opAndValToSql operatorAndValue =
|
||||
case HashMap.toList operatorAndValue of
|
||||
[("eq", value)] ->
|
||||
pure $
|
||||
if value == Null
|
||||
then " IS NULL"
|
||||
else " == " <> gqlValueToSQLText value
|
||||
[("neq", value)] ->
|
||||
if value == Null
|
||||
then pure " IS NOT NULL"
|
||||
else
|
||||
[ " != " <> gqlValueToSQLText value
|
||||
, " IS NULL"
|
||||
]
|
||||
[("in", List values)] ->
|
||||
let listValues = values <&> gqlValueToSQLText & intercalate ","
|
||||
in [" IN (" <> listValues <> ")"]
|
||||
[("nin", List values)] ->
|
||||
let listValues = values <&> gqlValueToSQLText & intercalate ","
|
||||
in [" NOT IN (" <> listValues <> ")"]
|
||||
<> if P.elem Null values
|
||||
then []
|
||||
else [" IS NULL"]
|
||||
[("gt", value)] -> [" > " <> gqlValueToSQLText value]
|
||||
[("gte", value)] -> [" >= " <> gqlValueToSQLText value]
|
||||
[("lt", value)] -> [" < " <> gqlValueToSQLText value]
|
||||
[("lte", value)] -> [" <= " <> gqlValueToSQLText value]
|
||||
[("like", value)] -> [" like " <> gqlValueToSQLText value]
|
||||
[("ilike", value)] -> [" like " <> gqlValueToSQLText value]
|
||||
[(op, value)]
|
||||
| op == "eq" || op == "_eq" ->
|
||||
pure $
|
||||
if value == Null
|
||||
then " IS NULL"
|
||||
else " == " <> gqlValueToSQLText value
|
||||
| op == "neq" || op == "_neq" ->
|
||||
if value == Null
|
||||
then pure " IS NOT NULL"
|
||||
else
|
||||
[ " != " <> gqlValueToSQLText value
|
||||
, " IS NULL"
|
||||
]
|
||||
| op == "in" || op == "_in"
|
||||
, List values <- value ->
|
||||
let listValues = values <&> gqlValueToSQLText & intercalate ","
|
||||
in [" IN (" <> listValues <> ")"]
|
||||
| op == "nin" || op == "_nin"
|
||||
, List values <- value ->
|
||||
let listValues = values <&> gqlValueToSQLText & intercalate ","
|
||||
in [" NOT IN (" <> listValues <> ")"]
|
||||
<> if P.elem Null values
|
||||
then []
|
||||
else [" IS NULL"]
|
||||
| op == "gt" || op == "_gt" -> [" > " <> gqlValueToSQLText value]
|
||||
| op == "gte" || op == "_gte" -> [" >= " <> gqlValueToSQLText value]
|
||||
| op == "lt" || op == "_lt" -> [" < " <> gqlValueToSQLText value]
|
||||
| op == "lte" || op == "_lte" -> [" <= " <> gqlValueToSQLText value]
|
||||
| op == "like" || op == "_like" -> [" like " <> gqlValueToSQLText value]
|
||||
| op == "ilike" || op == "_ilike" -> [" like " <> gqlValueToSQLText value]
|
||||
filter -> do
|
||||
throw $
|
||||
userError $
|
||||
|
|
@ -451,16 +455,21 @@ rowsToGraphQL dbId table updatedRows =
|
|||
& List
|
||||
|
||||
|
||||
-- Attempts to find and decode an argument, given its current name, and a list
|
||||
-- of deprecated older names.
|
||||
tryGetArg
|
||||
:: forall m a
|
||||
. (FromGraphQL a)
|
||||
=> (MonadIO m)
|
||||
=> Text
|
||||
-> [Text]
|
||||
-> HashMap Text Value
|
||||
-> m (Maybe a)
|
||||
tryGetArg name args = do
|
||||
tryGetArg name alts args = do
|
||||
case HashMap.lookup name args of
|
||||
Nothing -> pure Nothing
|
||||
Nothing -> case alts of
|
||||
alt : others -> tryGetArg alt others args
|
||||
[] -> pure Nothing
|
||||
Just value ->
|
||||
case fromGraphQL value of
|
||||
Just decoded -> pure $ Just decoded
|
||||
|
|
@ -470,15 +479,17 @@ tryGetArg name args = do
|
|||
"Argument " <> T.unpack name <> " has invalid format"
|
||||
|
||||
|
||||
-- Similar to `tryGetArg`, but will error out on failure.
|
||||
getArg
|
||||
:: forall m a
|
||||
. (FromGraphQL a)
|
||||
=> (MonadIO m)
|
||||
=> Text
|
||||
-> [Text]
|
||||
-> HashMap Text Value
|
||||
-> m a
|
||||
getArg name args = do
|
||||
result <- tryGetArg name args
|
||||
getArg name alts args = do
|
||||
result <- tryGetArg name alts args
|
||||
case result of
|
||||
Just value -> pure value
|
||||
Nothing ->
|
||||
|
|
@ -487,16 +498,18 @@ getArg name args = do
|
|||
"Argument " <> T.unpack name <> " not found"
|
||||
|
||||
|
||||
-- Similar to `tryGetArg`, but will return a custom value on failure.
|
||||
getArgWithDefault
|
||||
:: forall m a
|
||||
. (FromGraphQL a)
|
||||
=> (MonadIO m)
|
||||
=> Text
|
||||
-> [Text]
|
||||
-> HashMap Text Value
|
||||
-> a
|
||||
-> m a
|
||||
getArgWithDefault name args def =
|
||||
tryGetArg name args <&> P.fromMaybe def
|
||||
getArgWithDefault name alts args def =
|
||||
tryGetArg name alts args <&> P.fromMaybe def
|
||||
|
||||
|
||||
executeUpdateMutation
|
||||
|
|
@ -608,13 +621,8 @@ queryType connection accessMode dbId tables = do
|
|||
|
||||
rows :: [[SQLData]] <- case context.arguments of
|
||||
Arguments args -> do
|
||||
filterElements <- case args & HashMap.lookup "filter" of
|
||||
Nothing -> pure []
|
||||
Just colToFilter -> case colToFilter of
|
||||
Object filterObj -> case HashMap.toList filterObj of
|
||||
[] -> P.throwIO $ userError "Error: Filter must not be empty"
|
||||
filterElements -> pure filterElements
|
||||
_ -> pure []
|
||||
filterElements :: HashMap Text Value <-
|
||||
getArgWithDefault "where" ["filter"] args HashMap.empty
|
||||
|
||||
orderElements :: [(Name, Value)] <-
|
||||
case args & HashMap.lookup "order_by" of
|
||||
|
|
@ -678,7 +686,7 @@ queryType connection accessMode dbId tables = do
|
|||
[ "SELECT COUNT() FROM"
|
||||
, quoteKeyword table.name
|
||||
, "\n"
|
||||
, getWhereClause filterElements
|
||||
, getWhereClause $ HashMap.toList filterElements
|
||||
]
|
||||
|
||||
-- Will be equal `Just numRows` when the number of
|
||||
|
|
@ -720,7 +728,7 @@ queryType connection accessMode dbId tables = do
|
|||
connection
|
||||
table.name
|
||||
table.columns
|
||||
filterElements
|
||||
(HashMap.toList filterElements)
|
||||
orderElements
|
||||
paginationMb
|
||||
|
||||
|
|
@ -849,7 +857,7 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
|
|||
-- [ { name: "John", email: "john@example.com" }
|
||||
-- , { name: "Eve", email: "eve@example.com" }
|
||||
-- ]
|
||||
values :: [HashMap Text Value] <- getArg "objects" argMap
|
||||
values :: [HashMap Text Value] <- getArg "objects" [] argMap
|
||||
let
|
||||
-- All colums that are contained in the entries
|
||||
containedColumns :: [Text]
|
||||
|
|
@ -866,12 +874,12 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
|
|||
<&> (\name -> ":" <> doubleXEncodeGql name)
|
||||
|
||||
onConflictArg :: [HashMap Text Value] <-
|
||||
getArgWithDefault "on_conflict" argMap []
|
||||
getArgWithDefault "on_conflict" [] argMap []
|
||||
|
||||
onConflictClauses <- P.for onConflictArg $ \fields -> do
|
||||
let
|
||||
getColumnList fieldName =
|
||||
getArgWithDefault fieldName fields []
|
||||
getArgWithDefault fieldName [] fields []
|
||||
<&> P.mapMaybe
|
||||
( \case
|
||||
Enum columnName -> Just columnName
|
||||
|
|
@ -895,7 +903,7 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
|
|||
<> " = :"
|
||||
<> doubleXEncodeGql column
|
||||
|
||||
filterElements <- getArgWithDefault "where" fields mempty
|
||||
filterElements <- getArgWithDefault "where" ["filter"] fields mempty
|
||||
|
||||
pure $
|
||||
"ON CONFLICT ("
|
||||
|
|
@ -983,8 +991,8 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
|
|||
context <- ask
|
||||
let Arguments args = context.arguments
|
||||
liftIO $ do
|
||||
filterObj <- getArg "filter" args
|
||||
pairsToSet <- getArg "set" args
|
||||
filterObj <- getArg "where" ["filter"] args
|
||||
pairsToSet <- getArg "set" [] args
|
||||
(numOfChanges, updatedRows) <- case HashMap.toList filterObj of
|
||||
[] -> P.throwIO $ userError "Error: Filter must not be empty"
|
||||
filterElements ->
|
||||
|
|
@ -1002,11 +1010,16 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
|
|||
let Arguments args = context.arguments
|
||||
let filterElements =
|
||||
args
|
||||
& HashMap.delete "set"
|
||||
& HashMap.delete (encodeOutsidePKNames table "_set")
|
||||
& HashMap.delete (encodeOutsidePKNames table "set")
|
||||
& getByPKFilterElements
|
||||
|
||||
liftIO $ do
|
||||
pairsToSet <- getArg (encodeOutsidePKNames table "set") args
|
||||
pairsToSet <-
|
||||
getArg
|
||||
(encodeOutsidePKNames table "_set")
|
||||
[encodeOutsidePKNames table "set"]
|
||||
args
|
||||
(numOfChanges, updatedRows) <-
|
||||
executeUpdateMutation
|
||||
connection
|
||||
|
|
@ -1023,7 +1036,7 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
|
|||
let Arguments args = context.arguments
|
||||
|
||||
liftIO $ do
|
||||
filterElements <- getArg "filter" args
|
||||
filterElements <- getArg "where" ["filter"] args
|
||||
let sqlQuery =
|
||||
Query $
|
||||
P.unlines
|
||||
|
|
|
|||
|
|
@ -114,22 +114,30 @@ filterType table = do
|
|||
let colName = columnEntry.column_name_gql
|
||||
let typeName = columnTypeName columnEntry
|
||||
let type_ = columnType columnEntry
|
||||
Type.inputValue colName $
|
||||
Type.withDescription ("Compare to a(n) " <> typeName) $
|
||||
Type.inputObject
|
||||
(typeName <> "Comparison")
|
||||
[ Type.inputValue "eq" type_
|
||||
, Type.inputValue "neq" type_
|
||||
, Type.inputValue "gt" type_
|
||||
, Type.inputValue "gte" type_
|
||||
, Type.inputValue "lt" type_
|
||||
, Type.inputValue "lte" type_
|
||||
, Type.inputValue "like" type_
|
||||
, Type.inputValue "ilike" type_
|
||||
, Type.inputValue "in" $ Type.list type_
|
||||
, Type.inputValue "nin" $ Type.list type_
|
||||
|
||||
let comparisonField name ty =
|
||||
[ Type.deprecatedInputValue "Unify naming with Hasura" $
|
||||
Type.inputValue name ty
|
||||
, Type.inputValue ("_" <> name) ty
|
||||
]
|
||||
|
||||
Type.inputValue colName
|
||||
$ Type.withDescription ("Compare to a(n) " <> typeName)
|
||||
$ Type.inputObject
|
||||
(typeName <> "Comparison")
|
||||
$ P.fold
|
||||
[ comparisonField "eq" type_
|
||||
, comparisonField "neq" type_
|
||||
, comparisonField "gt" type_
|
||||
, comparisonField "gte" type_
|
||||
, comparisonField "lt" type_
|
||||
, comparisonField "lte" type_
|
||||
, comparisonField "like" type_
|
||||
, comparisonField "ilike" type_
|
||||
, comparisonField "in" $ Type.list type_
|
||||
, comparisonField "nin" $ Type.list type_
|
||||
]
|
||||
|
||||
Type.inputObject
|
||||
(doubleXEncodeGql table.name <> "_filter")
|
||||
fieldsWithComparisonExp
|
||||
|
|
@ -175,9 +183,12 @@ tableQueryField table =
|
|||
(Type.nonNull $ Type.list $ Type.nonNull $ tableRowType table)
|
||||
& Type.fieldWithDescription ("Rows from the table \"" <> table.name <> "\"")
|
||||
& Type.withArguments
|
||||
[ Type.inputValue "filter" (filterType table)
|
||||
( Type.inputValue "filter" (filterType table)
|
||||
& Type.inputValueWithDescription "Filter to select specific rows"
|
||||
, Type.inputValue "order_by" (Type.list orderType)
|
||||
& Type.renameInputValue "where" "Unify naming with Hasura"
|
||||
)
|
||||
& Type.withArguments
|
||||
[ Type.inputValue "order_by" (Type.list orderType)
|
||||
& Type.inputValueWithDescription "Columns used to sort the data"
|
||||
, Type.inputValue "limit" Type.typeInt
|
||||
& Type.inputValueWithDescription "Limit the number of returned rows"
|
||||
|
|
@ -359,15 +370,19 @@ tableUpdateField accessMode table = do
|
|||
& Type.fieldWithDescription
|
||||
("Update rows in table \"" <> table.name <> "\"")
|
||||
& Type.withArguments
|
||||
[ Type.inputValue
|
||||
( Type.inputValue
|
||||
"set"
|
||||
(Type.nonNull $ tableSetInput table)
|
||||
& Type.inputValueWithDescription "Fields to be updated"
|
||||
, Type.inputValue
|
||||
& Type.renameInputValue "_set" "Unify naming with Hasura"
|
||||
)
|
||||
& Type.withArguments
|
||||
( Type.inputValue
|
||||
"filter"
|
||||
(Type.nonNull $ filterType table)
|
||||
& Type.inputValueWithDescription "Filter to select rows to be updated"
|
||||
]
|
||||
& Type.renameInputValue "where" "Unify naming with Hasura"
|
||||
)
|
||||
|
||||
|
||||
tableUpdateFieldByPk
|
||||
|
|
@ -409,11 +424,12 @@ tableDeleteField accessMode table = do
|
|||
& Type.fieldWithDescription
|
||||
("Delete rows in table \"" <> table.name <> "\"")
|
||||
& Type.withArguments
|
||||
[ Type.inputValue
|
||||
( Type.inputValue
|
||||
"filter"
|
||||
(Type.nonNull $ filterType table)
|
||||
& Type.inputValueWithDescription "Filter to select rows to be deleted"
|
||||
]
|
||||
& Type.renameInputValue "where" "Unify naming with Hasura"
|
||||
)
|
||||
|
||||
|
||||
tableDeleteFieldByPK
|
||||
|
|
|
|||
|
|
@ -30,6 +30,7 @@ import Control.Exception qualified as Exception
|
|||
import Data.HashMap.Strict qualified as HashMap
|
||||
import Data.Text qualified as T
|
||||
import GHC.IO.Exception (userError)
|
||||
import Language.GraphQL.Class (ToGraphQL (toGraphQL))
|
||||
import Language.GraphQL.Error (ResolverException (ResolverException))
|
||||
import Language.GraphQL.Type qualified as Type
|
||||
import Language.GraphQL.Type.In qualified as In
|
||||
|
|
@ -120,7 +121,7 @@ makeType =
|
|||
$ HashMap.fromList
|
||||
$ ("__typename", typenameResolver) : resolvers
|
||||
_ -> do
|
||||
Left $ "invalid type in out position: " <> show ty.kind
|
||||
Left $ "invalid type in out position: " <> show (toGraphQL ty)
|
||||
|
||||
-- Creates a field which looks up it's value in the object returned by the
|
||||
-- parent resolver.
|
||||
|
|
@ -152,7 +153,7 @@ makeType =
|
|||
_ -> pure ()
|
||||
|
||||
case HashMap.lookup field.name obj of
|
||||
Just value -> pure value
|
||||
Just value -> field.customResolver value
|
||||
Nothing -> defaultValue
|
||||
_ -> defaultValue
|
||||
in
|
||||
|
|
@ -219,4 +220,4 @@ makeInType ty = do
|
|||
ty.description
|
||||
$ HashMap.fromList gqlFields
|
||||
_ -> do
|
||||
Left $ "invalid type in input position: " <> show ty.kind
|
||||
Left $ "invalid type in input position: " <> show (toGraphQL ty)
|
||||
|
|
|
|||
|
|
@ -16,9 +16,12 @@ module AirGQL.Introspection.Types (
|
|||
enumValueWithDescription,
|
||||
field,
|
||||
fieldWithDescription,
|
||||
deprecatedField,
|
||||
inputObject,
|
||||
inputValue,
|
||||
inputValueWithDescription,
|
||||
deprecatedInputValue,
|
||||
renameInputValue,
|
||||
list,
|
||||
nonNull,
|
||||
object,
|
||||
|
|
@ -40,13 +43,15 @@ module AirGQL.Introspection.Types (
|
|||
import Protolude (
|
||||
Bool (False, True),
|
||||
Generic,
|
||||
IO,
|
||||
Maybe (Just, Nothing),
|
||||
MonadReader (ask),
|
||||
MonadState (get, put),
|
||||
Monoid (mempty),
|
||||
Show,
|
||||
State,
|
||||
Text,
|
||||
execState,
|
||||
filter,
|
||||
for_,
|
||||
not,
|
||||
pure,
|
||||
|
|
@ -54,8 +59,10 @@ import Protolude (
|
|||
when,
|
||||
($),
|
||||
(&),
|
||||
(/=),
|
||||
(<$>),
|
||||
(<>),
|
||||
(==),
|
||||
)
|
||||
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
|
|
@ -71,7 +78,7 @@ data Schema = Schema
|
|||
, mutationType :: Maybe IntrospectionType
|
||||
, directives :: [Directive]
|
||||
}
|
||||
deriving (Show, Generic)
|
||||
deriving (Generic)
|
||||
|
||||
|
||||
instance ToGraphQL Schema where
|
||||
|
|
@ -98,14 +105,14 @@ data TypeKind
|
|||
| InputObject Name [InputValue]
|
||||
| List IntrospectionType
|
||||
| NonNull IntrospectionType
|
||||
deriving (Show, Generic)
|
||||
deriving (Generic)
|
||||
|
||||
|
||||
data IntrospectionType = IType
|
||||
{ kind :: TypeKind
|
||||
, description :: Maybe Text
|
||||
}
|
||||
deriving (Show, Generic)
|
||||
deriving (Generic)
|
||||
|
||||
|
||||
instance ToGraphQL IntrospectionType where
|
||||
|
|
@ -214,8 +221,11 @@ data Field = Field
|
|||
, type_ :: IntrospectionType
|
||||
, isDeprecated :: Bool
|
||||
, deprecationReason :: Maybe Text
|
||||
, -- Allows injecting custom logic into the resulting resolver. The function
|
||||
-- is given the value of the field in the parent object.
|
||||
customResolver :: Value.Value -> Value.Resolve IO
|
||||
}
|
||||
deriving (Show, Generic)
|
||||
deriving (Generic)
|
||||
|
||||
|
||||
instance ToGraphQL Field where
|
||||
|
|
@ -231,14 +241,6 @@ instance ToGraphQL Field where
|
|||
]
|
||||
|
||||
|
||||
fieldWithDescription :: Text -> Field -> Field
|
||||
fieldWithDescription newDesc (Field{..}) =
|
||||
Field
|
||||
{ description = Just newDesc
|
||||
, ..
|
||||
}
|
||||
|
||||
|
||||
field :: Text -> IntrospectionType -> Field
|
||||
field fieldName fieldType =
|
||||
Field
|
||||
|
|
@ -248,6 +250,24 @@ field fieldName fieldType =
|
|||
, type_ = fieldType
|
||||
, isDeprecated = False
|
||||
, deprecationReason = Nothing
|
||||
, customResolver = pure
|
||||
}
|
||||
|
||||
|
||||
fieldWithDescription :: Text -> Field -> Field
|
||||
fieldWithDescription newDesc (Field{..}) =
|
||||
Field
|
||||
{ description = Just newDesc
|
||||
, ..
|
||||
}
|
||||
|
||||
|
||||
deprecatedField :: Text -> Field -> Field
|
||||
deprecatedField reason (Field{..}) =
|
||||
Field
|
||||
{ isDeprecated = True
|
||||
, deprecationReason = Just reason
|
||||
, ..
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -260,8 +280,10 @@ data InputValue = InputValue
|
|||
, description :: Maybe Text
|
||||
, type_ :: IntrospectionType
|
||||
, defaultValue :: Maybe Value.Value
|
||||
, isDeprecated :: Bool
|
||||
, deprecationReason :: Maybe Text
|
||||
}
|
||||
deriving (Show, Generic)
|
||||
deriving (Generic)
|
||||
|
||||
|
||||
instance ToGraphQL InputValue where
|
||||
|
|
@ -278,6 +300,8 @@ instance ToGraphQL InputValue where
|
|||
Nothing -> Value.Null
|
||||
Just s -> Value.String $ show s
|
||||
)
|
||||
, ("isDeprecated", toGraphQL value.isDeprecated)
|
||||
, ("deprecationReason", toGraphQL value.deprecationReason)
|
||||
]
|
||||
|
||||
|
||||
|
|
@ -288,6 +312,8 @@ inputValue fieldName fieldType =
|
|||
, description = Nothing
|
||||
, type_ = fieldType
|
||||
, defaultValue = Nothing
|
||||
, isDeprecated = False
|
||||
, deprecationReason = Nothing
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -307,13 +333,37 @@ withDefaultValue newValue (InputValue{..}) =
|
|||
}
|
||||
|
||||
|
||||
deprecatedInputValue :: Text -> InputValue -> InputValue
|
||||
deprecatedInputValue reason (InputValue{..}) =
|
||||
InputValue
|
||||
{ isDeprecated = True
|
||||
, deprecationReason = Just reason
|
||||
, ..
|
||||
}
|
||||
|
||||
|
||||
-- Rename an input value, deprecating the old version.
|
||||
renameInputValue :: Text -> Text -> InputValue -> [InputValue]
|
||||
renameInputValue to reason (InputValue{..}) =
|
||||
[ InputValue
|
||||
{ name = to
|
||||
, ..
|
||||
}
|
||||
, InputValue
|
||||
{ isDeprecated = True
|
||||
, deprecationReason = Just reason
|
||||
, ..
|
||||
}
|
||||
]
|
||||
|
||||
|
||||
data EnumValue = EnumValue
|
||||
{ name :: Text
|
||||
, description :: Maybe Text
|
||||
, isDeprecated :: Bool
|
||||
, deprecationReason :: Maybe Text
|
||||
}
|
||||
deriving (Show, Generic)
|
||||
deriving (Generic)
|
||||
|
||||
|
||||
instance ToGraphQL EnumValue where
|
||||
|
|
@ -358,7 +408,7 @@ data Directive = Directive
|
|||
, args :: [InputValue]
|
||||
, isRepeatable :: Bool
|
||||
}
|
||||
deriving (Generic, Show)
|
||||
deriving (Generic)
|
||||
|
||||
|
||||
instance ToGraphQL Directive where
|
||||
|
|
@ -486,7 +536,8 @@ typeField =
|
|||
"__Field"
|
||||
[ field "name" $ nonNull typeString
|
||||
, field "description" typeString
|
||||
, field "args" $ nonNull $ list $ nonNull typeInputValue
|
||||
, field "args" (nonNull $ list $ nonNull typeInputValue)
|
||||
& typeWithDeprecatedFilter
|
||||
, field "type" $ nonNull typeIntrospectionType
|
||||
, field "isDeprecated" $ nonNull typeBool
|
||||
, field "deprecationReason" typeString
|
||||
|
|
@ -507,6 +558,8 @@ typeInputValue =
|
|||
& fieldWithDescription
|
||||
"A GraphQL-formatted string representing \
|
||||
\the default value for this input value."
|
||||
, field "isDeprecated" $ nonNull typeBool
|
||||
, field "deprecationReason" typeString
|
||||
]
|
||||
& withDescription
|
||||
"Arguments provided to Fields or Directives and the input \
|
||||
|
|
@ -574,16 +627,11 @@ typeIntrospectionType =
|
|||
, field "interfaces" $ list $ nonNull typeIntrospectionType
|
||||
, field "possibleTypes" $ list $ nonNull typeIntrospectionType
|
||||
, field "fields" (list $ nonNull typeField)
|
||||
& withArguments
|
||||
[ inputValue "includeDeprecated" typeBool
|
||||
& withDefaultValue (toGraphQL False)
|
||||
]
|
||||
& typeWithDeprecatedFilter
|
||||
, field "enumValues" (list $ nonNull typeEnumValue)
|
||||
& withArguments
|
||||
[ inputValue "includeDeprecated" typeBool
|
||||
& withDefaultValue (toGraphQL False)
|
||||
]
|
||||
, field "inputFields" $ list $ nonNull typeInputValue
|
||||
& typeWithDeprecatedFilter
|
||||
, field "inputFields" (list $ nonNull typeInputValue)
|
||||
& typeWithDeprecatedFilter
|
||||
, field "ofType" typeIntrospectionType
|
||||
]
|
||||
& withDescription
|
||||
|
|
@ -636,7 +684,11 @@ typeDirective =
|
|||
"__Directive"
|
||||
[ field "name" $ nonNull typeString
|
||||
, field "description" typeString
|
||||
, field "args" $ nonNull $ list $ nonNull typeInputValue
|
||||
, field "args" (nonNull $ list $ nonNull typeInputValue)
|
||||
& withArguments
|
||||
[ inputValue "includeDeprecated" typeBool
|
||||
& withDefaultValue (toGraphQL False)
|
||||
]
|
||||
, field "isRepeatable" $ nonNull typeBool
|
||||
, field "locations" $ nonNull $ list $ nonNull typeDirectiveLocation
|
||||
]
|
||||
|
|
@ -700,3 +752,38 @@ typeDirectiveLocation =
|
|||
& withDescription
|
||||
"A Directive can be adjacent to many parts of the GraphQL language, \
|
||||
\a __DirectiveLocation describes one such possible adjacencies."
|
||||
|
||||
|
||||
-- Internal helper which adds custom logic to a resolver for handling the
|
||||
-- `includeDeprecated` filter.
|
||||
typeWithDeprecatedFilter :: Field -> Field
|
||||
typeWithDeprecatedFilter Field{..} =
|
||||
Field
|
||||
{ args =
|
||||
args
|
||||
<> [ inputValue "includeDeprecated" typeBool
|
||||
& withDefaultValue (toGraphQL False)
|
||||
]
|
||||
, customResolver = \case
|
||||
Value.List values -> do
|
||||
context <- ask
|
||||
let
|
||||
Value.Arguments gqlArgs = context.arguments
|
||||
includeDeprecated = HashMap.lookup "includeDeprecated" gqlArgs
|
||||
filtered =
|
||||
if includeDeprecated == Just (Value.Boolean True)
|
||||
then values
|
||||
else
|
||||
filter
|
||||
( \case
|
||||
Value.Object fields ->
|
||||
HashMap.lookup "isDeprecated" fields
|
||||
/= Just (Value.Boolean True)
|
||||
_ -> True
|
||||
)
|
||||
values
|
||||
|
||||
customResolver $ Value.List filtered
|
||||
o -> customResolver o
|
||||
, ..
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue