1
Fork 0
mirror of https://github.com/Airsequel/AirGQL.git synced 2025-08-27 15:15:38 +03:00

Implement _by_pk updates/deletes

This commit is contained in:
prescientmoon 2024-11-19 21:30:43 +01:00
commit c8a5e17f25
2 changed files with 291 additions and 290 deletions

View file

@ -47,6 +47,7 @@ import Protolude qualified as P
import Control.Exception (throw) import Control.Exception (throw)
import Control.Monad.Catch (catchAll) import Control.Monad.Catch (catchAll)
import Data.Aeson (object, (.=)) import Data.Aeson (object, (.=))
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap import Data.HashMap.Strict qualified as HashMap
import Data.List (nub) import Data.List (nub)
import Data.Ord (Ord (min)) import Data.Ord (Ord (min))
@ -91,7 +92,6 @@ import AirGQL.Lib (
canRead, canRead,
canWrite, canWrite,
column_name_gql, column_name_gql,
getColumns,
) )
import AirGQL.Types.OutObjectType ( import AirGQL.Types.OutObjectType (
OutObjectType (OutObjectType, descriptionMb, fields, interfaceTypes, name), OutObjectType (OutObjectType, descriptionMb, fields, interfaceTypes, name),
@ -105,6 +105,7 @@ import AirGQL.Types.Utils (encodeToText)
import AirGQL.Utils (colToFileUrl, collectErrorList, quoteKeyword, quoteText) import AirGQL.Utils (colToFileUrl, collectErrorList, quoteKeyword, quoteText)
import Data.Either.Extra qualified as Either import Data.Either.Extra qualified as Either
import Data.List qualified as List import Data.List qualified as List
import Language.GraphQL.Class (FromGraphQL (fromGraphQL))
-- | Prevent numbers of being shown with exponents (0.01 instead of 1e-2) -- | Prevent numbers of being shown with exponents (0.01 instead of 1e-2)
@ -268,6 +269,25 @@ getWhereClause filterElements =
) )
-- The gql lib does not offer a way to know what properties have
-- been requested at the moment, so we always return every column
getReturningClause :: TableEntry -> Text
getReturningClause table =
"RETURNING "
<> ( table.columns
<&> column_name
<&> quoteKeyword
& intercalate ", "
)
-- | Converts an argument map of (pk, value) pairs into a list of filters
getByPKFilterElements :: HashMap Text Value -> [(Text, Value)]
getByPKFilterElements args = do
(key, value) <- HashMap.toList args
pure (key, Object $ HashMap.singleton "eq" value)
setCaseInsensitive :: Connection -> [(Text, Value)] -> IO () setCaseInsensitive :: Connection -> [(Text, Value)] -> IO ()
setCaseInsensitive connection filterElements = do setCaseInsensitive connection filterElements = do
when when
@ -365,12 +385,12 @@ gqlValueToSQLData = \case
Object obj -> SQLText $ show obj Object obj -> SQLText $ show obj
rowToGraphQL :: Text -> Text -> [ColumnEntry] -> [SQLData] -> Either [(Text, Text)] Value rowToGraphQL :: Text -> TableEntry -> [SQLData] -> Either [(Text, Text)] Value
rowToGraphQL dbId tableName columnEntries row = rowToGraphQL dbId table row =
let let
buildMetadataJson :: Text -> Text -> Text buildMetadataJson :: Text -> Text -> Text
buildMetadataJson colName rowid = buildMetadataJson colName rowid =
object ["url" .= colToFileUrl dbId tableName colName rowid] object ["url" .= colToFileUrl dbId table.name colName rowid]
& encodeToText & encodeToText
parseSqlData :: (ColumnEntry, SQLData) -> Either (Text, Text) (Text, Value) parseSqlData :: (ColumnEntry, SQLData) -> Either (Text, Text) (Text, Value)
@ -405,7 +425,7 @@ rowToGraphQL dbId tableName columnEntries row =
) )
in in
-- => [(ColumnEntry, SQLData)] -- => [(ColumnEntry, SQLData)]
P.zip columnEntries row P.zip table.columns row
-- => [Either (Text, Text) (Text, Value)] -- => [Either (Text, Text) (Text, Value)]
<&> parseSqlData <&> parseSqlData
-- => Either [(Text, Text)] (Text, Value) -- => Either [(Text, Text)] (Text, Value)
@ -418,14 +438,13 @@ rowToGraphQL dbId tableName columnEntries row =
rowsToGraphQL rowsToGraphQL
:: Text :: Text
-> Text -> TableEntry
-> [ColumnEntry]
-> [[SQLData]] -> [[SQLData]]
-> Either [(Text, Text)] Value -> Either [(Text, Text)] Value
rowsToGraphQL dbId tableName columnEntries updatedRows = rowsToGraphQL dbId table updatedRows =
updatedRows updatedRows
-- => [Either [(Text, Text)] Value] -- => [Either [(Text, Text)] Value]
<&> rowToGraphQL dbId tableName columnEntries <&> rowToGraphQL dbId table
-- => Either [[(Text, Text)]] [Value] -- => Either [[(Text, Text)]] [Value]
& collectErrorList & collectErrorList
-- => Either [(Text, Text)] [Value] -- => Either [(Text, Text)] [Value]
@ -450,100 +469,106 @@ colErrorsToUserError = \case
"Multiple errors occurred:\n" <> P.unlines errorLines "Multiple errors occurred:\n" <> P.unlines errorLines
executeSqlMutation tryGetArg
:: forall m a
. (FromGraphQL a)
=> (MonadIO m)
=> Text
-> HashMap Text Value
-> m (Maybe a)
tryGetArg name args = do
case HashMap.lookup name args of
Nothing -> pure Nothing
Just value ->
case fromGraphQL value of
Just decoded -> pure $ Just decoded
Nothing ->
P.throwIO $
userError $
"Argument " <> T.unpack name <> " has invalid format"
getArg
:: forall m a
. (FromGraphQL a)
=> (MonadIO m)
=> Text
-> HashMap Text Value
-> m a
getArg name args = do
result <- tryGetArg name args
case result of
Just value -> pure value
Nothing ->
P.throwIO $
userError $
"Argument " <> T.unpack name <> " not found"
getArgWithDefault
:: forall m a
. (FromGraphQL a)
=> (MonadIO m)
=> Text
-> HashMap Text Value
-> a
-> m a
getArgWithDefault name args def =
tryGetArg name args <&> P.fromMaybe def
executeUpdateMutation
:: Connection :: Connection
-> Text -> TableEntry
-> HashMap.HashMap Text Value -> HashMap Text Value
-> [ColumnEntry]
-> [(Text, Value)] -> [(Text, Value)]
-> IO (Int, [[SQLData]]) -> IO (Int, [[SQLData]])
executeSqlMutation connection tableName args columnEntries filterElements = do executeUpdateMutation connection table args filterElements = do
pairsToSet :: HashMap Text Value <- getArg "set" args
let let
colNamesToUpdateRaw :: [Text] columnsToSet :: [(ColumnEntry, Value)]
colNamesToUpdateRaw = columnsToSet =
case HashMap.lookup "set" args of table.columns
Just (Object dataObj) -> HashMap.keys dataObj & P.mapMaybe
_ -> [] ( \col -> case HashMap.lookup col.column_name_gql pairsToSet of
Just value -> Just (col, value)
_ -> Nothing
)
colNamesToUpdate :: [Text] columnsToSetText :: Text
colNamesToUpdate = columnsToSetText =
columnEntries columnsToSet
<&> column_name <&> (\(col, _) -> quoteKeyword col.column_name <> " = ?")
<&> ( \columnName ->
if doubleXEncodeGql columnName `P.elem` colNamesToUpdateRaw
then Just columnName
else Nothing
)
& P.catMaybes
columnNamesText :: Text
columnNamesText =
columnEntries
<&> column_name
<&> quoteKeyword
& intercalate ", " & intercalate ", "
setText :: Text
setText =
colNamesToUpdate
<&> (\columnName -> quoteKeyword columnName <> " = ?")
& intercalate ", "
valuesToSet :: [SQLData]
valuesToSet =
case HashMap.lookup "set" args of
Just (Object dataObj) ->
columnEntries
<&> column_name
<&> ( \columnName ->
HashMap.lookup
(doubleXEncodeGql columnName)
dataObj
)
& P.catMaybes
<&> gqlValueToSQLData
_ -> []
updatedRows :: [[SQLData]] <- updatedRows :: [[SQLData]] <-
if setText == "" if P.null columnsToSet
then pure [] then pure []
else else liftIO $ do
let let
sqlQuery = sqlQuery =
Query $ Query $
"UPDATE " "UPDATE "
<> quoteKeyword tableName <> quoteKeyword table.name
<> "\n" <> "\n"
<> "SET " <> "SET "
<> setText <> columnsToSetText
<> "\n" <> "\n"
<> getWhereClause filterElements <> getWhereClause filterElements
<> "\n" <> "\n"
<> "RETURNING " <> getReturningClause table
<> columnNamesText
colTypesToUpdate :: [Text]
colTypesToUpdate =
columnEntries
<&> ( \colEntry ->
if doubleXEncodeGql colEntry.column_name
`P.elem` colNamesToUpdateRaw
then Just colEntry.datatype
else Nothing
)
& P.catMaybes
valuesToSetNorm = valuesToSetNorm =
P.zip valuesToSet colTypesToUpdate columnsToSet
<&> \(val, datatype) -> <&> \(col, gqlValue) -> do
if (val == SQLText "{}") let sqlValue = gqlValueToSQLData gqlValue
P.&& ("BLOB" `T.isPrefixOf` T.toUpper datatype) if (sqlValue == SQLText "{}")
P.&& ("BLOB" `T.isPrefixOf` T.toUpper col.datatype)
then SQLBlob "" then SQLBlob ""
else val else sqlValue
in
liftIO $ do setCaseInsensitive connection filterElements
setCaseInsensitive connection filterElements query connection sqlQuery valuesToSetNorm
query connection sqlQuery valuesToSetNorm
liftIO $ liftIO $
changes connection changes connection
@ -706,17 +731,12 @@ queryType connection accessMode dbId tables = do
orderElements orderElements
paginationMb paginationMb
colErrorsToUserError $ rowsToGraphQL dbId table.name table.columns rows colErrorsToUserError $ rowsToGraphQL dbId table rows
getDbEntriesByPK :: TableEntry -> Out.Resolve IO getDbEntriesByPK :: TableEntry -> Out.Resolve IO
getDbEntriesByPK tableEntry = do getDbEntriesByPK tableEntry = do
context <- ask context <- ask
let Arguments args = context.arguments
let
Arguments args = context.arguments
filterElements = do
(key, value) <- HashMap.toList args
pure (key, Object $ HashMap.singleton "eq" value)
-- This query can return at most one row, so we don't worry checking for -- This query can return at most one row, so we don't worry checking for
-- COUNT() and asserting it's within the set limits. -- COUNT() and asserting it's within the set limits.
@ -726,7 +746,7 @@ queryType connection accessMode dbId tables = do
connection connection
tableEntry.name tableEntry.name
tableEntry.columns tableEntry.columns
filterElements (getByPKFilterElements args)
[] []
Nothing Nothing
@ -736,8 +756,7 @@ queryType connection accessMode dbId tables = do
colErrorsToUserError $ colErrorsToUserError $
rowToGraphQL rowToGraphQL
dbId dbId
tableEntry.name tableEntry
tableEntry.columns
row row
getResolvers :: IO (HashMap.HashMap Text (Resolver IO)) getResolvers :: IO (HashMap.HashMap Text (Resolver IO))
@ -806,105 +825,102 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
getColValue rowObj columnName = getColValue rowObj columnName =
HashMap.findWithDefault Null (doubleXEncodeGql columnName) rowObj HashMap.findWithDefault Null (doubleXEncodeGql columnName) rowObj
executeDbInserts :: Text -> ReaderT Out.Context IO Value mutationResponse :: TableEntry -> Int -> [[SQLData]] -> IO Value
executeDbInserts tableName = do mutationResponse table numChanges rows = do
columnEntries <- liftIO $ getColumns dbId connection tableName returning <-
colErrorsToUserError $
rowsToGraphQL dbId table rows
pure $
Object $
HashMap.fromList
[ ("affected_rows", Int $ fromIntegral numChanges)
, ("returning", returning)
]
mutationByPKResponse :: TableEntry -> Int -> Maybe [SQLData] -> IO Value
mutationByPKResponse table numChanges mbRow = do
returning <- case mbRow of
Nothing -> pure Null
Just row ->
colErrorsToUserError $
rowToGraphQL dbId table row
pure $
Object $
HashMap.fromList
[ ("affected_rows", Int $ fromIntegral numChanges)
, ("returning", returning)
]
executeDbInserts :: TableEntry -> ReaderT Out.Context IO Value
executeDbInserts table = do
context <- ask context <- ask
let let
columnNames :: [Text]
columnNames =
columnEntries <&> column_name
columnNamesText :: Text
columnNamesText =
columnNames
<&> quoteKeyword
& intercalate ", "
insertInDb :: Arguments -> ReaderT Out.Context IO (Int, [[SQLData]]) insertInDb :: Arguments -> ReaderT Out.Context IO (Int, [[SQLData]])
insertInDb (Arguments argMap) = do insertInDb (Arguments argMap) = do
-- Yields for example:
-- [ { name: "John", email: "john@example.com" }
-- , { name: "Eve", email: "eve@example.com" }
-- ]
values :: [HashMap Text Value] <- getArg "objects" argMap
let let
-- Yields for example:
-- [ { name: "John", email: "john@example.com" }
-- , { name: "Eve", email: "eve@example.com" }
-- ]
entries =
HashMap.findWithDefault
(List [])
"objects"
argMap
-- All colums that are contained in the entries -- All colums that are contained in the entries
containedColumns :: [Text] containedColumns :: [Text]
containedColumns = containedColumns =
case entries of values
List values -> <&> HashMap.keys
( values & P.concat
<&> \case & nub
Object rowObj -> <&> doubleXDecode
HashMap.keys rowObj
_ -> []
)
& P.concat
& nub
<&> doubleXDecode
_ -> []
boundVariableNames :: [Text] boundVariableNames :: [Text]
boundVariableNames = boundVariableNames =
containedColumns containedColumns
<&> (\name -> ":" <> doubleXEncodeGql name) <&> (\name -> ":" <> doubleXEncodeGql name)
onConflictArg = onConflictArg :: [HashMap Text Value] <-
case HashMap.lookup "on_conflict" argMap of getArgWithDefault "on_conflict" argMap []
Just (List values) -> values
_ -> []
onConflictClauses <- P.for onConflictArg $ \case onConflictClauses <- P.for onConflictArg $ \fields -> do
Object fields -> do let
let getColumnList fieldName =
getColumnList fieldName = do getArgWithDefault fieldName fields []
case HashMap.lookup fieldName fields of <&> P.mapMaybe
Just (List elements) -> do ( \case
element <- elements Enum columnName -> Just columnName
case element of _ -> Nothing
Enum columnName -> pure columnName )
_ -> []
_ -> []
constraint = getColumnList "constraint" constraint <- getColumnList "constraint"
update = getColumnList "update_columns" update <- getColumnList "update_columns"
updateClauses <- P.for update $ \column -> do updateClauses <- P.for update $ \column -> do
when (column `notElem` containedColumns) $ do when (column `notElem` containedColumns) $ do
P.throwIO $ P.throwIO $
userError $ userError $
"Column " "Column "
<> T.unpack column <> T.unpack column
<> " cannot be set on conflicts without being explicitly provided" <> " cannot be set on conflicts without \
\ being explicitly provided"
pure $
quoteKeyword column
<> " = :"
<> doubleXEncodeGql column
let
filterElements = case HashMap.lookup "where" fields of
Just (Object filterObj) -> HashMap.toList filterObj
_ -> []
pure $ pure $
"ON CONFLICT (" quoteKeyword column
<> ( constraint <> " = :"
<&> quoteKeyword <> doubleXEncodeGql column
& intercalate "<>"
) filterElements <- getArgWithDefault "where" fields mempty
<> ")\n DO UPDATE SET \n"
<> intercalate ",\n" updateClauses pure $
<> "\n" "ON CONFLICT ("
<> getWhereClause filterElements <> ( constraint
_ -> pure "" <&> quoteKeyword
& intercalate ", "
)
<> ")\n DO UPDATE SET \n"
<> intercalate ",\n" updateClauses
<> "\n"
<> getWhereClause (HashMap.toList filterElements)
let let
columnList = columnList =
@ -926,28 +942,21 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
<> ")" <> ")"
sqlQuery = sqlQuery =
Query $ Query $
"INSERT INTO " P.unlines
<> quoteKeyword tableName [ "INSERT INTO "
<> columnList <> quoteKeyword table.name
<> insertedValues <> columnList
<> "\n" , insertedValues
<> P.unlines onConflictClauses , P.unlines onConflictClauses
<> "RETURNING " , getReturningClause table
<> ]
-- TODO: Only return the actually requested values
columnNamesText
sqlDataRows :: [[SQLData]] sqlDataRows :: [[SQLData]]
sqlDataRows = sqlDataRows =
case entries of values <&> \rowObj ->
List values -> containedColumns
values <&> \case <&> getColValue rowObj
Object rowObj -> <&> gqlValueToSQLData
containedColumns
<&> getColValue rowObj
<&> gqlValueToSQLData
_ -> []
_ -> []
returnedRows <- returnedRows <-
liftIO $ P.forM sqlDataRows $ \sqlDataRow -> do liftIO $ P.forM sqlDataRows $ \sqlDataRow -> do
@ -956,7 +965,7 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
connection connection
$ Query $ Query
$ "SELECT COUNT() FROM " $ "SELECT COUNT() FROM "
<> quoteKeyword tableName <> quoteKeyword table.name
case numRowsRes of case numRowsRes of
[[numRows]] -> do [[numRows]] -> do
@ -980,106 +989,82 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
pure (P.length sqlDataRows, returnedRows & P.concat) pure (P.length sqlDataRows, returnedRows & P.concat)
(numOfChanges, returnedRows) <- insertInDb context.arguments (numOfChanges, returnedRows) <- insertInDb context.arguments
returning <- liftIO $ mutationResponse table numOfChanges returnedRows
colErrorsToUserError $
rowsToGraphQL dbId tableName columnEntries returnedRows
pure $
Object $
HashMap.fromList
[ ("affected_rows", Int $ fromIntegral numOfChanges)
, ("returning", returning)
]
-- Execute SQL query to update selected entries -- Execute SQL query to update selected entries
executeDbUpdates :: Text -> ReaderT Out.Context IO Value executeDbUpdates :: TableEntry -> ReaderT Out.Context IO Value
executeDbUpdates tableName = do executeDbUpdates table = do
columnEntries <- liftIO $ getColumns dbId connection tableName
context <- ask context <- ask
let Arguments args = context.arguments let Arguments args = context.arguments
liftIO $ do
(numOfChanges, updatedRows) <- case HashMap.lookup "filter" args of filterObj <- getArg "filter" args
Just (Object filterObj) -> case HashMap.toList filterObj of (numOfChanges, updatedRows) <- case HashMap.toList filterObj of
[] -> P.throwIO $ userError "Error: Filter must not be empty" [] -> P.throwIO $ userError "Error: Filter must not be empty"
filterElements -> filterElements ->
liftIO $ executeUpdateMutation
executeSqlMutation connection
connection table
tableName args
args filterElements
columnEntries
filterElements
_ -> pure (0, [])
returning <- mutationResponse table numOfChanges updatedRows
colErrorsToUserError $
rowsToGraphQL dbId tableName columnEntries updatedRows
pure $ executeDbUpdatesByPK :: TableEntry -> ReaderT Out.Context IO Value
Object $ executeDbUpdatesByPK table = do
HashMap.fromList context <- ask
[ ("affected_rows", Int $ fromIntegral (numOfChanges :: Int)) let Arguments args = context.arguments
, ("returning", returning) let filterElements =
] args
& HashMap.delete "set"
& getByPKFilterElements
liftIO $ do
(numOfChanges, updatedRows) <-
executeUpdateMutation
connection
table
args
filterElements
mutationByPKResponse table numOfChanges $ P.head updatedRows
-- Execute SQL query to delete selected entries -- Execute SQL query to delete selected entries
executeDbDeletions :: Text -> ReaderT Out.Context IO Value executeDbDeletions :: TableEntry -> ReaderT Out.Context IO Value
executeDbDeletions tableName = do executeDbDeletions table = do
columnEntries <- liftIO $ getColumns dbId connection tableName
context <- ask context <- ask
let Arguments args = context.arguments
let liftIO $ do
columnNamesText :: Text filterElements <- getArg "filter" args
columnNamesText = let sqlQuery =
columnEntries Query $
<&> column_name P.unlines
<&> quoteKeyword [ "DELETE FROM " <> quoteKeyword table.name
& intercalate ", " , getWhereClause $ HashMap.toList filterElements
, getReturningClause table
]
deleteEntry columnName value = do deletedRows :: [[SQLData]] <- SS.query_ connection sqlQuery
let sqlQuery = numOfChanges <- SS.changes connection
Query $ mutationResponse table numOfChanges deletedRows
"DELETE FROM "
<> quoteKeyword tableName
<> " \
\WHERE "
<> quoteKeyword columnName
<> " = ?\n"
<> "RETURNING "
<> columnNamesText
deletedRows :: [[SQLData]] <-
liftIO $ SS.query connection sqlQuery [value]
numChanges <- liftIO $ changes connection
pure (numChanges, deletedRows) executeDbDeletionsByPK :: TableEntry -> ReaderT Out.Context IO Value
executeDbDeletionsByPK table = do
context <- ask
let Arguments args = context.arguments
(numOfChanges, deletedRows) <- case context.arguments of liftIO $ do
Arguments args -> case HashMap.lookup "filter" args of let sqlQuery =
Just colToFilter -> case colToFilter of Query $
Object filterObj -> case HashMap.toList filterObj of P.unlines
[(columnName, Object operatorAndValue)] -> do [ "DELETE FROM " <> quoteKeyword table.name
case HashMap.toList operatorAndValue of , getWhereClause $ getByPKFilterElements args
[("eq", String value)] -> , getReturningClause table
deleteEntry columnName value ]
[("eq", Int value)] ->
deleteEntry columnName $ show value
_ -> pure (0, [])
_ -> pure (0, [])
_ -> pure (0, [])
Nothing -> pure (0, [])
returning <- deletedRows :: [[SQLData]] <- SS.query_ connection sqlQuery
colErrorsToUserError $ numOfChanges <- SS.changes connection
rowsToGraphQL dbId tableName columnEntries deletedRows mutationByPKResponse table numOfChanges $ P.head deletedRows
pure $
Object $
HashMap.fromList
[ ("affected_rows", Int $ fromIntegral numOfChanges)
, ("returning", returning)
]
getMutationResolvers :: IO (HashMap.HashMap Text (Resolver IO)) getMutationResolvers :: IO (HashMap.HashMap Text (Resolver IO))
getMutationResolvers = do getMutationResolvers = do
@ -1088,19 +1073,29 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
getInsertTableTuple table = getInsertTableTuple table =
makeResolver makeResolver
(Introspection.tableInsertField accessMode table) (Introspection.tableInsertField accessMode table)
(executeDbInserts table.name) (executeDbInserts table)
getUpdateTableTuple :: TableEntry -> IO (Text, Resolver IO) getUpdateTableTuple :: TableEntry -> IO (Text, Resolver IO)
getUpdateTableTuple table = getUpdateTableTuple table =
makeResolver makeResolver
(Introspection.tableUpdateField accessMode table) (Introspection.tableUpdateField accessMode table)
(executeDbUpdates table.name) (executeDbUpdates table)
getUpdateByPKTableTuple :: TableEntry -> IO (Maybe (Text, Resolver IO))
getUpdateByPKTableTuple table =
P.for (Introspection.tableUpdateFieldByPk accessMode table) $ \field ->
makeResolver field (executeDbUpdatesByPK table)
getDeleteTableTuple :: TableEntry -> IO (Text, Resolver IO) getDeleteTableTuple :: TableEntry -> IO (Text, Resolver IO)
getDeleteTableTuple table = getDeleteTableTuple table =
makeResolver makeResolver
(Introspection.tableDeleteField accessMode table) (Introspection.tableDeleteField accessMode table)
(executeDbDeletions table.name) (executeDbDeletions table)
getDeleteByPKTableTuple :: TableEntry -> IO (Maybe (Text, Resolver IO))
getDeleteByPKTableTuple table =
P.for (Introspection.tableDeleteFieldByPK accessMode table) $ \field ->
makeResolver field (executeDbDeletionsByPK table)
getTableTuples :: IO [(Text, Resolver IO)] getTableTuples :: IO [(Text, Resolver IO)]
getTableTuples = getTableTuples =
@ -1110,9 +1105,15 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
(\table -> table.object_type == Table) (\table -> table.object_type == Table)
tables tables
in in
P.for tablesWithoutViews getInsertTableTuple P.fold
<> P.for tablesWithoutViews getUpdateTableTuple [ P.for tablesWithoutViews getInsertTableTuple
<> P.for tablesWithoutViews getDeleteTableTuple , P.for tablesWithoutViews getUpdateTableTuple
, P.for tablesWithoutViews getDeleteTableTuple
, P.for tablesWithoutViews getUpdateByPKTableTuple
<&> P.catMaybes
, P.for tablesWithoutViews getDeleteByPKTableTuple
<&> P.catMaybes
]
getTableTuples <&> HashMap.fromList getTableTuples <&> HashMap.fromList

View file

@ -5,7 +5,9 @@ module AirGQL.Introspection (
tableQueryByPKField, tableQueryByPKField,
tableInsertField, tableInsertField,
tableUpdateField, tableUpdateField,
tableUpdateFieldByPk,
tableDeleteField, tableDeleteField,
tableDeleteFieldByPK,
) )
where where
@ -212,7 +214,7 @@ tableQueryByPKField table = do
mutationResponseType :: AccessMode -> TableEntry -> Type.IntrospectionType mutationResponseType :: AccessMode -> TableEntry -> Type.IntrospectionType
mutationResponseType accessMode table = do mutationResponseType accessMode table = do
let tableName = doubleXEncodeGql table.name let tableName = doubleXEncodeGql table.name
let readFields = let readonlyFields =
if canRead accessMode if canRead accessMode
then then
pure pure
@ -228,7 +230,7 @@ mutationResponseType accessMode table = do
(tableName <> "_mutation_response") (tableName <> "_mutation_response")
( [ Type.field "affected_rows" (Type.nonNull Type.typeInt) ( [ Type.field "affected_rows" (Type.nonNull Type.typeInt)
] ]
<> readFields <> readonlyFields
) )
& Type.withDescription ("Mutation response for " <> table.name) & Type.withDescription ("Mutation response for " <> table.name)
@ -236,21 +238,19 @@ mutationResponseType accessMode table = do
mutationByPkResponseType :: AccessMode -> TableEntry -> Type.IntrospectionType mutationByPkResponseType :: AccessMode -> TableEntry -> Type.IntrospectionType
mutationByPkResponseType accessMode table = do mutationByPkResponseType accessMode table = do
let tableName = doubleXEncodeGql table.name let tableName = doubleXEncodeGql table.name
let readFields = let readonlyFields =
if canRead accessMode if canRead accessMode
then then
pure pure $
$ Type.field Type.field "returning" $
"returning" tableRowType table
$ Type.nonNull
$ tableRowType table
else [] else []
Type.object Type.object
(tableName <> "_mutation_by_pk_response") (tableName <> "_mutation_by_pk_response")
( [ Type.field "affected_rows" (Type.nonNull Type.typeInt) ( [ Type.field "affected_rows" (Type.nonNull Type.typeInt)
] ]
<> readFields <> readonlyFields
) )
& Type.withDescription ("Mutation response for " <> table.name) & Type.withDescription ("Mutation response for " <> table.name)