mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 20:41:49 +03:00
9921823915
> ## Description -> This PR allows DC agents to define custom aggregate functions for their scalar types. ### Related Issues -> GDC-189 ### Solution and Design > We added a new property `aggregate_functions` to the scalar types capabilities. This allows the agent author to specify a set of aggregate functions supported by each scalar type, along with the function's result type. During GraphQL schema generation, the custom aggregate functions are available via a new method `getCustomAggregateOperators` on the `Backend` type class. Custom functions are merged with the builtin aggregate functions when building GraphQL schemas for table aggregate fields and for `order_by` operators on array relations. ### Steps to test and verify > • Codec tests for aggregate function capabilities have been added to the unit tests. • Some custom aggregate operators have been added to the reference agent and are used in a new test in `api-tests`. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6199 GitOrigin-RevId: e9c0d1617af93847c1493671fdbb794f573bde0c
279 lines
12 KiB
Haskell
279 lines
12 KiB
Haskell
{-# LANGUAGE ApplicativeDo #-}
|
|
{-# LANGUAGE TemplateHaskellQuotes #-}
|
|
|
|
module Hasura.GraphQL.Schema.OrderBy
|
|
( orderByExp,
|
|
)
|
|
where
|
|
|
|
import Data.Has
|
|
import Data.HashMap.Strict.Extended qualified as HashMap
|
|
import Data.Text.Casing qualified as C
|
|
import Data.Text.Extended
|
|
import Hasura.GraphQL.Parser.Class
|
|
import Hasura.GraphQL.Schema.Backend
|
|
import Hasura.GraphQL.Schema.Common
|
|
import Hasura.GraphQL.Schema.NamingCase
|
|
import Hasura.GraphQL.Schema.Parser
|
|
( InputFieldsParser,
|
|
Kind (..),
|
|
Parser,
|
|
)
|
|
import Hasura.GraphQL.Schema.Parser qualified as P
|
|
import Hasura.GraphQL.Schema.Table
|
|
import Hasura.GraphQL.Schema.Typename
|
|
import Hasura.Name qualified as Name
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.IR.OrderBy qualified as IR
|
|
import Hasura.RQL.IR.Select qualified as IR
|
|
import Hasura.RQL.IR.Value qualified as IR
|
|
import Hasura.RQL.Types.Backend
|
|
import Hasura.RQL.Types.Column
|
|
import Hasura.RQL.Types.Common
|
|
import Hasura.RQL.Types.ComputedField
|
|
import Hasura.RQL.Types.Function
|
|
import Hasura.RQL.Types.Relationships.Local
|
|
import Hasura.RQL.Types.SchemaCache hiding (askTableInfo)
|
|
import Hasura.RQL.Types.Source
|
|
import Hasura.RQL.Types.SourceCustomization
|
|
import Hasura.RQL.Types.Table
|
|
import Language.GraphQL.Draft.Syntax qualified as G
|
|
|
|
{-# INLINE orderByOperator #-}
|
|
orderByOperator ::
|
|
forall b n.
|
|
(BackendSchema b, MonadParse n) =>
|
|
NamingCase ->
|
|
SourceInfo b ->
|
|
Parser 'Both n (Maybe (BasicOrderType b, NullsOrderType b))
|
|
orderByOperator tCase sourceInfo = case tCase of
|
|
HasuraCase -> orderByOperatorsHasuraCase @b sourceInfo
|
|
GraphqlCase -> orderByOperatorsGraphqlCase @b sourceInfo
|
|
|
|
-- | Corresponds to an object type for an order by.
|
|
--
|
|
-- > input table_order_by {
|
|
-- > col1: order_by
|
|
-- > col2: order_by
|
|
-- > . .
|
|
-- > . .
|
|
-- > coln: order_by
|
|
-- > obj-rel: <remote-table>_order_by
|
|
-- > }
|
|
orderByExp ::
|
|
forall b r m n.
|
|
MonadBuildSchema b r m n =>
|
|
SourceInfo b ->
|
|
TableInfo b ->
|
|
SchemaT r m (Parser 'Input n [IR.AnnotatedOrderByItemG b (IR.UnpreparedValue b)])
|
|
orderByExp sourceInfo tableInfo = P.memoizeOn 'orderByExp (_siName sourceInfo, tableInfoName tableInfo) $ do
|
|
tCase <- asks getter
|
|
tableGQLName <- getTableIdentifierName tableInfo
|
|
name <- mkTypename $ applyTypeNameCaseIdentifier tCase $ mkTableOrderByTypeName tableGQLName
|
|
let description =
|
|
G.Description $
|
|
"Ordering options when selecting data from " <> tableInfoName tableInfo <<> "."
|
|
tableFields <- tableSelectFields sourceInfo tableInfo
|
|
fieldParsers <- sequenceA . catMaybes <$> traverse (mkField tCase) tableFields
|
|
pure $ concat . catMaybes <$> P.object name (Just description) fieldParsers
|
|
where
|
|
mkField ::
|
|
NamingCase ->
|
|
FieldInfo b ->
|
|
SchemaT r m (Maybe (InputFieldsParser n (Maybe [IR.AnnotatedOrderByItemG b (IR.UnpreparedValue b)])))
|
|
mkField tCase fieldInfo = runMaybeT $ do
|
|
roleName <- retrieve scRole
|
|
case fieldInfo of
|
|
FIColumn columnInfo -> do
|
|
let fieldName = ciName columnInfo
|
|
pure $
|
|
P.fieldOptional
|
|
fieldName
|
|
Nothing
|
|
(orderByOperator @b tCase sourceInfo)
|
|
<&> fmap (pure . mkOrderByItemG @b (IR.AOCColumn columnInfo)) . join
|
|
FIRelationship relationshipInfo -> do
|
|
remoteTableInfo <- askTableInfo sourceInfo $ riRTable relationshipInfo
|
|
perms <- hoistMaybe $ tableSelectPermissions roleName remoteTableInfo
|
|
fieldName <- hoistMaybe $ G.mkName $ relNameToTxt $ riName relationshipInfo
|
|
let newPerms = fmap partialSQLExpToUnpreparedValue <$> spiFilter perms
|
|
case riType relationshipInfo of
|
|
ObjRel -> do
|
|
otherTableParser <- lift $ orderByExp sourceInfo remoteTableInfo
|
|
pure $ do
|
|
otherTableOrderBy <- join <$> P.fieldOptional fieldName Nothing (P.nullable otherTableParser)
|
|
pure $ fmap (map $ fmap $ IR.AOCObjectRelation relationshipInfo newPerms) otherTableOrderBy
|
|
ArrRel -> do
|
|
let aggregateFieldName = applyFieldNameCaseIdentifier tCase $ C.fromAutogeneratedTuple (fieldName, [G.convertNameToSuffix Name._aggregate])
|
|
aggregationParser <- lift $ orderByAggregation sourceInfo remoteTableInfo
|
|
pure $ do
|
|
aggregationOrderBy <- join <$> P.fieldOptional aggregateFieldName Nothing (P.nullable aggregationParser)
|
|
pure $ fmap (map $ fmap $ IR.AOCArrayAggregation relationshipInfo newPerms) aggregationOrderBy
|
|
FIComputedField ComputedFieldInfo {..} -> do
|
|
let ComputedFieldFunction {..} = _cfiFunction
|
|
mkComputedFieldOrderBy =
|
|
let functionArgs =
|
|
flip FunctionArgsExp mempty $
|
|
fromComputedFieldImplicitArguments @b IR.UVSession _cffComputedFieldImplicitArgs
|
|
in IR.ComputedFieldOrderBy _cfiXComputedFieldInfo _cfiName _cffName functionArgs
|
|
fieldName <- hoistMaybe $ G.mkName $ toTxt _cfiName
|
|
guard $ _cffInputArgs == mempty -- No input arguments other than table row and session argument
|
|
case computedFieldReturnType @b _cfiReturnType of
|
|
ReturnsScalar scalarType -> do
|
|
let computedFieldOrderBy = mkComputedFieldOrderBy $ IR.CFOBEScalar scalarType
|
|
pure $
|
|
P.fieldOptional
|
|
fieldName
|
|
Nothing
|
|
(orderByOperator @b tCase sourceInfo)
|
|
<&> fmap (pure . mkOrderByItemG @b (IR.AOCComputedField computedFieldOrderBy)) . join
|
|
ReturnsTable table -> do
|
|
let aggregateFieldName = applyFieldNameCaseIdentifier tCase $ C.fromAutogeneratedTuple (fieldName, [G.convertNameToSuffix Name._aggregate])
|
|
tableInfo' <- askTableInfo sourceInfo table
|
|
perms <- hoistMaybe $ tableSelectPermissions roleName tableInfo'
|
|
let newPerms = fmap partialSQLExpToUnpreparedValue <$> spiFilter perms
|
|
aggregationParser <- lift $ orderByAggregation sourceInfo tableInfo'
|
|
pure $ do
|
|
aggregationOrderBy <- join <$> P.fieldOptional aggregateFieldName Nothing (P.nullable aggregationParser)
|
|
pure $
|
|
fmap
|
|
( map $
|
|
fmap $
|
|
IR.AOCComputedField
|
|
. mkComputedFieldOrderBy
|
|
. IR.CFOBETableAggregation table newPerms
|
|
)
|
|
aggregationOrderBy
|
|
ReturnsOthers -> empty
|
|
FIRemoteRelationship _ -> empty
|
|
|
|
-- FIXME!
|
|
-- those parsers are directly using Postgres' SQL representation of
|
|
-- order, rather than using a general intermediary representation
|
|
|
|
orderByAggregation ::
|
|
forall b r m n.
|
|
MonadBuildSchema b r m n =>
|
|
SourceInfo b ->
|
|
TableInfo b ->
|
|
SchemaT r m (Parser 'Input n [IR.OrderByItemG b (IR.AnnotatedAggregateOrderBy b)])
|
|
orderByAggregation sourceInfo tableInfo = P.memoizeOn 'orderByAggregation (_siName sourceInfo, tableName) do
|
|
-- WIP NOTE
|
|
-- there is heavy duplication between this and Select.tableAggregationFields
|
|
-- it might be worth putting some of it in common, just to avoid issues when
|
|
-- we change one but not the other?
|
|
tableGQLName <- getTableGQLName @b tableInfo
|
|
tCase <- asks getter
|
|
tableIdentifierName <- getTableIdentifierName @b tableInfo
|
|
allColumns <- tableSelectColumns sourceInfo tableInfo
|
|
makeTypename <- asks getter
|
|
let numColumns = mkAgOpsFields tCase $ onlyNumCols allColumns
|
|
compColumns = mkAgOpsFields tCase $ onlyComparableCols allColumns
|
|
numOperatorsAndColumns = HashMap.fromList $ (,numColumns) <$> numericAggOperators
|
|
compOperatorsAndColumns = HashMap.fromList $ (,compColumns) <$> comparisonAggOperators
|
|
customOperatorsAndColumns =
|
|
getCustomAggOpsColumns tCase allColumns <$> getCustomAggregateOperators @b (_siConfiguration sourceInfo)
|
|
allOperatorsAndColumns =
|
|
HashMap.catMaybes $
|
|
HashMap.unionsWith (<>) [numOperatorsAndColumns, compOperatorsAndColumns, customOperatorsAndColumns]
|
|
aggFields =
|
|
fmap (concat . catMaybes . concat) $
|
|
sequenceA $
|
|
catMaybes
|
|
[ -- count
|
|
Just $
|
|
P.fieldOptional
|
|
Name._count
|
|
Nothing
|
|
(orderByOperator @b tCase sourceInfo)
|
|
<&> pure . fmap (pure . mkOrderByItemG @b IR.AAOCount) . join,
|
|
-- other operators
|
|
if null allOperatorsAndColumns
|
|
then Nothing
|
|
else Just $
|
|
for (HashMap.toList allOperatorsAndColumns) \(operator, fields) -> do
|
|
parseOperator makeTypename operator tableGQLName fields
|
|
]
|
|
objectName <- mkTypename $ applyTypeNameCaseIdentifier tCase $ mkTableAggregateOrderByTypeName tableIdentifierName
|
|
let description = G.Description $ "order by aggregate values of table " <>> tableName
|
|
pure $ P.object objectName (Just description) aggFields
|
|
where
|
|
tableName = tableInfoName tableInfo
|
|
|
|
-- Build an InputFieldsParser only if the column list is non-empty
|
|
mkAgOpsFields ::
|
|
NamingCase ->
|
|
[ColumnInfo b] ->
|
|
Maybe (InputFieldsParser n [(ColumnInfo b, (BasicOrderType b, NullsOrderType b))])
|
|
mkAgOpsFields tCase =
|
|
fmap (fmap (catMaybes . toList) . traverse (mkField tCase)) . nonEmpty
|
|
|
|
getCustomAggOpsColumns ::
|
|
NamingCase ->
|
|
[ColumnInfo b] ->
|
|
HashMap (ScalarType b) v ->
|
|
Maybe (InputFieldsParser n [(ColumnInfo b, (BasicOrderType b, NullsOrderType b))])
|
|
getCustomAggOpsColumns tCase columnInfos typeMap =
|
|
columnInfos
|
|
& filter
|
|
( \ColumnInfo {..} ->
|
|
case ciType of
|
|
ColumnEnumReference _ -> False
|
|
ColumnScalar scalarType ->
|
|
HashMap.member scalarType typeMap
|
|
)
|
|
& mkAgOpsFields tCase
|
|
|
|
mkField :: NamingCase -> ColumnInfo b -> InputFieldsParser n (Maybe (ColumnInfo b, (BasicOrderType b, NullsOrderType b)))
|
|
mkField tCase columnInfo =
|
|
P.fieldOptional
|
|
(ciName columnInfo)
|
|
(ciDescription columnInfo)
|
|
(orderByOperator @b tCase sourceInfo)
|
|
<&> fmap (columnInfo,) . join
|
|
|
|
parseOperator ::
|
|
MkTypename ->
|
|
G.Name ->
|
|
G.Name ->
|
|
InputFieldsParser n [(ColumnInfo b, (BasicOrderType b, NullsOrderType b))] ->
|
|
InputFieldsParser n (Maybe [IR.OrderByItemG b (IR.AnnotatedAggregateOrderBy b)])
|
|
parseOperator makeTypename operator tableGQLName columns =
|
|
let opText = G.unName operator
|
|
objectName = runMkTypename makeTypename $ tableGQLName <> Name.__ <> operator <> Name.__order_by
|
|
objectDesc = Just $ G.Description $ "order by " <> opText <> "() on columns of table " <>> tableName
|
|
in P.fieldOptional operator Nothing (P.object objectName objectDesc columns)
|
|
`mapField` map (\(col, info) -> mkOrderByItemG (IR.AAOOp opText col) info)
|
|
|
|
orderByOperatorsHasuraCase ::
|
|
forall b n.
|
|
(BackendSchema b, MonadParse n) =>
|
|
SourceInfo b ->
|
|
Parser 'Both n (Maybe (BasicOrderType b, NullsOrderType b))
|
|
orderByOperatorsHasuraCase = orderByOperator' @b HasuraCase
|
|
|
|
orderByOperatorsGraphqlCase ::
|
|
forall b n.
|
|
(BackendSchema b, MonadParse n) =>
|
|
SourceInfo b ->
|
|
Parser 'Both n (Maybe (BasicOrderType b, NullsOrderType b))
|
|
orderByOperatorsGraphqlCase = orderByOperator' @b GraphqlCase
|
|
|
|
orderByOperator' ::
|
|
forall b n.
|
|
(BackendSchema b, MonadParse n) =>
|
|
NamingCase ->
|
|
SourceInfo b ->
|
|
Parser 'Both n (Maybe (BasicOrderType b, NullsOrderType b))
|
|
orderByOperator' tCase sourceInfo =
|
|
let (sourcePrefix, orderOperators) = orderByOperators @b sourceInfo tCase
|
|
in P.nullable $ P.enum (applyTypeNameCaseCust tCase sourcePrefix) (Just "column ordering options") $ orderOperators
|
|
|
|
mkOrderByItemG :: forall b a. a -> (BasicOrderType b, NullsOrderType b) -> IR.OrderByItemG b a
|
|
mkOrderByItemG column (orderType, nullsOrder) =
|
|
IR.OrderByItemG
|
|
{ obiType = Just orderType,
|
|
obiColumn = column,
|
|
obiNulls = Just nullsOrder
|
|
}
|