-- | This module defines the schema dependency gathering aspect of the default
-- implementation of aggregation predicates.
module Hasura.RQL.Types.SchemaCache.AggregationPredicates
  ( defaultGetAggregationPredicateDeps,
  )
where

import Hasura.Prelude
import Hasura.RQL.IR.BoolExp (PartialSQLExp)
import Hasura.RQL.IR.BoolExp.AggregationPredicates
  ( AggregationPredicate (..),
    AggregationPredicatesImplementation (AggregationPredicatesImplementation),
  )
import Hasura.RQL.Types.Relationships.Local
  ( RelInfo (..),
    RelTarget (..),
  )
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.SQL.AnyBackend qualified as AB

defaultGetAggregationPredicateDeps ::
  forall b.
  (GetAggregationPredicatesDeps b) =>
  AggregationPredicatesImplementation b (PartialSQLExp b) ->
  BoolExpM b [SchemaDependency]
defaultGetAggregationPredicateDeps :: forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
AggregationPredicatesImplementation b (PartialSQLExp b)
-> BoolExpM b [SchemaDependency]
defaultGetAggregationPredicateDeps (AggregationPredicatesImplementation RelInfo b
relInfo AnnBoolExp b (PartialSQLExp b)
_rowPermissions AggregationPredicate b (PartialSQLExp b)
functions) = do
  BoolExpCtx {SourceName
source :: SourceName
source :: forall (b :: BackendType). BoolExpCtx b -> SourceName
source, TableName b
currTable :: TableName b
currTable :: forall (b :: BackendType). BoolExpCtx b -> TableName b
currTable} <- BoolExpM b (BoolExpCtx b)
forall r (m :: * -> *). MonadReader r m => m r
ask
  let relationshipName :: RelName
relationshipName = RelInfo b -> RelName
forall (b :: BackendType). RelInfo b -> RelName
riName RelInfo b
relInfo
      relationshipTable :: TableName b
relationshipTable = case RelInfo b -> RelTarget b
forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget RelInfo b
relInfo of
        RelTargetNativeQuery NativeQueryName
_ -> [Char] -> TableName b
forall a. HasCallStack => [Char] -> a
error [Char]
"defaultGetAggregationPredicateDeps RelTargetNativeQuery"
        RelTargetTable TableName b
tn -> TableName b
tn
      schemaDependency :: SchemaDependency
schemaDependency =
        SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
          ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
              (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
              (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @b TableName b
currTable (RelName -> TableObjId b
forall (b :: BackendType). RelName -> TableObjId b
TORel RelName
relationshipName)
          )
          DependencyReason
DROnType
   in (SchemaDependency
schemaDependency SchemaDependency -> [SchemaDependency] -> [SchemaDependency]
forall a. a -> [a] -> [a]
:) ([SchemaDependency] -> [SchemaDependency])
-> BoolExpM b [SchemaDependency] -> BoolExpM b [SchemaDependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BoolExpCtx b -> BoolExpCtx b)
-> BoolExpM b [SchemaDependency] -> BoolExpM b [SchemaDependency]
forall a.
(BoolExpCtx b -> BoolExpCtx b) -> BoolExpM b a -> BoolExpM b a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\BoolExpCtx b
e -> BoolExpCtx b
e {currTable :: TableName b
currTable = TableName b
relationshipTable}) (AggregationPredicate b (PartialSQLExp b)
-> BoolExpM b [SchemaDependency]
getFunctionDeps AggregationPredicate b (PartialSQLExp b)
functions)
  where
    getFunctionDeps :: AggregationPredicate b (PartialSQLExp b) -> BoolExpM b [SchemaDependency]
    getFunctionDeps :: AggregationPredicate b (PartialSQLExp b)
-> BoolExpM b [SchemaDependency]
getFunctionDeps AggregationPredicate {Bool
[OpExpG b (PartialSQLExp b)]
Maybe (AnnBoolExp b (PartialSQLExp b))
Text
AggregationPredicateArguments b
aggPredFunctionName :: Text
aggPredDistinct :: Bool
aggPredFilter :: Maybe (AnnBoolExp b (PartialSQLExp b))
aggPredArguments :: AggregationPredicateArguments b
aggPredPredicate :: [OpExpG b (PartialSQLExp b)]
aggPredFunctionName :: forall (b :: BackendType) field.
AggregationPredicate b field -> Text
aggPredDistinct :: forall (b :: BackendType) field.
AggregationPredicate b field -> Bool
aggPredFilter :: forall (b :: BackendType) field.
AggregationPredicate b field -> Maybe (AnnBoolExp b field)
aggPredArguments :: forall (b :: BackendType) field.
AggregationPredicate b field -> AggregationPredicateArguments b
aggPredPredicate :: forall (b :: BackendType) field.
AggregationPredicate b field -> [OpExpG b field]
..} =
      do
        BoolExpCtx {SourceName
source :: forall (b :: BackendType). BoolExpCtx b -> SourceName
source :: SourceName
source, TableName b
currTable :: forall (b :: BackendType). BoolExpCtx b -> TableName b
currTable :: TableName b
currTable} <- BoolExpM b (BoolExpCtx b)
forall r (m :: * -> *). MonadReader r m => m r
ask
        let filterDeps :: [SchemaDependency]
filterDeps = [SchemaDependency]
-> (AnnBoolExp b (PartialSQLExp b) -> [SchemaDependency])
-> Maybe (AnnBoolExp b (PartialSQLExp b))
-> [SchemaDependency]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (SourceName
-> TableName b
-> AnnBoolExp b (PartialSQLExp b)
-> [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
SourceName
-> TableName b -> AnnBoolExpPartialSQL b -> [SchemaDependency]
getBoolExpDeps SourceName
source TableName b
currTable) Maybe (AnnBoolExp b (PartialSQLExp b))
aggPredFilter
        [SchemaDependency]
predicateDeps <- [OpExpG b (PartialSQLExp b)] -> BoolExpM b [SchemaDependency]
forall (b :: BackendType).
Backend b =>
[OpExpG b (PartialSQLExp b)] -> BoolExpM b [SchemaDependency]
getOpExpDeps [OpExpG b (PartialSQLExp b)]
aggPredPredicate
        [SchemaDependency] -> BoolExpM b [SchemaDependency]
forall a. a -> BoolExpM b a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SchemaDependency] -> BoolExpM b [SchemaDependency])
-> [SchemaDependency] -> BoolExpM b [SchemaDependency]
forall a b. (a -> b) -> a -> b
$ [SchemaDependency]
filterDeps [SchemaDependency] -> [SchemaDependency] -> [SchemaDependency]
forall a. [a] -> [a] -> [a]
++ [SchemaDependency]
predicateDeps