diff --git a/source/AirGQL/GraphQL.hs b/source/AirGQL/GraphQL.hs
index 2d7abb7..f9c19f4 100644
--- a/source/AirGQL/GraphQL.hs
+++ b/source/AirGQL/GraphQL.hs
@@ -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
diff --git a/source/AirGQL/Introspection.hs b/source/AirGQL/Introspection.hs
index b87ee63..c0232dd 100644
--- a/source/AirGQL/Introspection.hs
+++ b/source/AirGQL/Introspection.hs
@@ -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
diff --git a/source/AirGQL/Introspection/Resolver.hs b/source/AirGQL/Introspection/Resolver.hs
index 95aa6bf..226b689 100644
--- a/source/AirGQL/Introspection/Resolver.hs
+++ b/source/AirGQL/Introspection/Resolver.hs
@@ -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)
diff --git a/source/AirGQL/Introspection/Types.hs b/source/AirGQL/Introspection/Types.hs
index 56b757f..7910d37 100644
--- a/source/AirGQL/Introspection/Types.hs
+++ b/source/AirGQL/Introspection/Types.hs
@@ -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
+ , ..
+ }