ddd/airgql
ddd/airgql
1
Fork 0
mirror of https://github.com/Airsequel/AirGQL.git synced 2025-07-11 01:14:54 +03:00
Code Activity

Merge pull request from feramhq/hasura-comparison-docs-page

Browse source 
Support more of Hasura's syntax
This commit is contained in:
Adrian Sieber 2025-05-04 21:50:21 +00:00 • committed by GitHub
commit be818d626c
7 changed files with 265 additions and 3113 deletions

116
source/AirGQL/GraphQL.hs
View file

@ -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" ["set"] args
(numOfChanges, updatedRows) <- case HashMap.toList filterObj of
[] -> P.throwIO $ userError "Error: Filter must not be empty"
filterElements ->
@ -1002,11 +1010,17 @@ 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 +1037,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

83
source/AirGQL/Introspection.hs
View file

@ -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)
(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)
(filterType table)
& Type.inputValueWithDescription "Filter to select rows to be updated"
]
& Type.renameInputValue "where" "Unify naming with Hasura"
)
tableUpdateFieldByPk
@ -378,14 +393,6 @@ tableUpdateFieldByPk
tableUpdateFieldByPk accessMode tables table = do
pkArguments <- tablePKArguments table
let arguments =
[ Type.inputValue
(encodeOutsidePKNames table "set")
(Type.nonNull $ tableSetInput table)
& Type.inputValueWithDescription "Fields to be updated"
]
<> pkArguments
pure $
Type.field
( "update_"
@ -398,7 +405,16 @@ tableUpdateFieldByPk accessMode tables table = do
(Type.nonNull $ mutationByPkResponseType accessMode table)
& Type.fieldWithDescription
("Update row in table \"" <> table.name <> "\" by PK")
& Type.withArguments arguments
& Type.withArguments pkArguments
& Type.withArguments
( Type.inputValue
(encodeOutsidePKNames table "set")
(tableSetInput table)
& Type.inputValueWithDescription "Fields to be updated"
& Type.renameInputValue
(encodeOutsidePKNames table "_set")
"Unify naming with Hasura"
)
tableDeleteField :: AccessMode -> TableEntry -> Type.Field
@ -409,11 +425,12 @@ tableDeleteField accessMode table = do
& Type.fieldWithDescription
("Delete rows in table \"" <> table.name <> "\"")
& Type.withArguments
[ Type.inputValue
( Type.inputValue
"filter"
(Type.nonNull $ filterType table)
(filterType table)
& Type.inputValueWithDescription "Filter to select rows to be deleted"
]
& Type.renameInputValue "where" "Unify naming with Hasura"
)
tableDeleteFieldByPK

28
source/AirGQL/Introspection/Resolver.hs
View file

@ -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
@ -101,7 +102,7 @@ makeType =
if depth >= 30
then
makeConstField
(IType.field field.name IType.typeString)
(IType.field field.name $ IType.nonNull IType.typeString)
(Type.String "Maximum depth exceeded")
else makeChildField (depth + 1) field
pure (field.name, resolver)
@ -111,21 +112,20 @@ makeType =
(IType.field "__typename" $ IType.nonNull IType.typeString)
(Type.String name)
pure
$ Out.NamedObjectType
$ Type.ObjectType
name
ty.description
[]
$ HashMap.fromList
$ ("__typename", typenameResolver) : resolvers
pure $
Out.NamedObjectType $
Type.ObjectType name ty.description [] $
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
-- Creates a field which looks up its value in the object returned by the
-- parent resolver.
makeChildField :: Int -> IType.Field -> Result (Out.Resolver IO)
makeChildField depth field = do
-- These lines are the same as `makeField`, except calling
-- `makeTypeWithDepthMemo` instead of `makeType`
args <- P.for field.args $ \arg -> do
ty <- makeInType arg.type_
pure (arg.name, In.Argument arg.description ty arg.defaultValue)
@ -144,7 +144,7 @@ makeType =
<> "' not found "
else pure Type.Null
case context.values of
result <- case context.values of
Type.Object obj -> do
let errorValue = HashMap.lookup ("__error_" <> field.name) obj
P.for_ errorValue $ \case
@ -155,6 +155,8 @@ makeType =
Just value -> pure value
Nothing -> defaultValue
_ -> defaultValue
field.customResolver result
in
makeTypeWithDepth 0
@ -219,4 +221,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)

141
source/AirGQL/Introspection/Types.hs
View file

@ -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
, ..
}

38
tests/Tests/IntrospectionSpec.hs
View file

@ -101,7 +101,7 @@ main = void $ do
{
"name": "users",
"args": [
{ "name": "filter",
{ "name": "where",
"type": { "name": "users_filter" }
},
{ "name": "order_by",
@ -118,7 +118,7 @@ main = void $ do
{
"name": "songs",
"args": [
{ "name": "filter",
{ "name": "where",
"type": { "name": "songs_filter" }
},
{ "name": "order_by",
@ -235,20 +235,20 @@ main = void $ do
{
"name": "update_users",
"args": [
{ "name": "filter" },
{ "name": "set" }
{ "name": "where" },
{ "name": "_set" }
]
},
{
"name": "update_users_by_pk",
"args": [
{ "name": "email" },
{ "name": "set" }
{ "name": "_set" }
]
},
{
"name": "delete_users",
"args": [ { "name": "filter" } ]
"args": [ { "name": "where" } ]
},
{
"name": "delete_users_by_pk",
@ -261,20 +261,20 @@ main = void $ do
{
"name": "update_songs",
"args": [
{ "name": "filter" },
{ "name": "set" }
{ "name": "where" },
{ "name": "_set" }
]
},
{
"name": "update_songs_by_pk",
"args": [
{ "name": "rowid" },
{ "name": "set" }
{ "name": "_set" }
]
},
{
"name": "delete_songs",
"args": [ { "name": "filter" } ]
"args": [ { "name": "where" } ]
},
{
"name": "delete_songs_by_pk",
@ -626,8 +626,8 @@ main = void $ do
Right result <- graphql schema Nothing mempty introspectionQuery
-- Uncomment to write the new file to disk (for easier diffing)
-- writeFile (testRoot </> "new_introspection_result.json") $
-- decodeUtf8 $
-- P.writeFile (testRoot </> "new_introspection_result.json") $
-- P.decodeUtf8 $
-- BL.toStrict $
-- Ae.encode result
@ -775,7 +775,7 @@ main = void $ do
it "appends _ at the end of argument names to avoid conflicts" $ do
let dbName = "by-pk-arg-names.db"
withTestDbConn dbName $ \conn -> do
SS.execute_ conn [sql| CREATE TABLE foo ("set" INT PRIMARY KEY) |]
SS.execute_ conn [sql| CREATE TABLE foo ("_set" INT PRIMARY KEY) |]
let
introspectionQuery =
@ -804,24 +804,24 @@ main = void $ do
{
"name": "update_foo",
"args": [
{ "name": "set" },
{ "name": "filter" }
{ "name": "_set" },
{ "name": "where" }
]
},
{
"name": "update_foo_by_pk",
"args": [
{ "name": "set" },
{ "name": "set_" }
{ "name": "_set" },
{ "name": "_set_" }
]
},
{
"name": "delete_foo",
"args": [{ "name": "filter" }]
"args": [{ "name": "where" }]
},
{
"name": "delete_foo_by_pk",
"args": [{ "name": "set" }]
"args": [{ "name": "_set" }]
}
]
}

2
tests/Tests/Utils.hs
View file

@ -54,7 +54,7 @@ dbPath = testRoot </> "fixture.db"
-- but some functions still take database IDs as arguments.
-- Example usages include:
-- - Including the ID in error messages
-- - Generating a URL where the user can access a file when it's cell needs
-- - Generating a URL where the user can access a file when its cell needs
-- to be converted to GraphQL
--
-- Those usages don't matter when testing, so we use a dummy ID instead.

2970
tests/introspection_result.json
View file

File diff suppressed because one or more lines are too long