1
0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-12-17 20:41:49 +03:00
graphql-engine/server/src-lib/Hasura/GraphQL/Schema/OrderBy.hs
David Overton 9921823915 GDC-189 custom aggregations
>

## 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
2022-10-27 00:44:06 +00:00

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
}