mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 13:02:11 +03:00
b2f683f56d
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8447 Co-authored-by: Daniel Harvey <4729125+danieljharvey@users.noreply.github.com> Co-authored-by: Nicolas Beaussart <7281023+beaussan@users.noreply.github.com> Co-authored-by: Antoine Leblanc <1618949+nicuveo@users.noreply.github.com> Co-authored-by: Varun Choudhary <68095256+Varun-Choudhary@users.noreply.github.com> Co-authored-by: ananya-2410 <107847554+ananya-2410@users.noreply.github.com> Co-authored-by: Matthew Goodwin <49927862+m4ttheweric@users.noreply.github.com> Co-authored-by: Abhijeet Khangarot <26903230+abhi40308@users.noreply.github.com> Co-authored-by: Puru Gupta <32328846+purugupta99@users.noreply.github.com> Co-authored-by: Gil Mizrahi <8547573+soupi@users.noreply.github.com> Co-authored-by: Rob Dominguez <24390149+robertjdominguez@users.noreply.github.com> GitOrigin-RevId: ddef9d54bfad6b7d5dc51251dbe47eac43995da3
84 lines
2.8 KiB
Haskell
84 lines
2.8 KiB
Haskell
{-# LANGUAGE MonadComprehensions #-}
|
|
|
|
-- | Planning T-SQL queries and subscriptions.
|
|
module Hasura.Backends.BigQuery.Plan
|
|
( planNoPlan,
|
|
)
|
|
where
|
|
|
|
import Control.Monad.Validate
|
|
import Data.Aeson.Text
|
|
import Data.List.NonEmpty qualified as NE
|
|
import Data.Map.Strict qualified as Map
|
|
import Data.Text.Extended
|
|
import Data.Text.Lazy qualified as LT
|
|
import Hasura.Backends.BigQuery.FromIr as BigQuery
|
|
import Hasura.Backends.BigQuery.Types
|
|
import Hasura.Base.Error qualified as E
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.IR
|
|
import Hasura.RQL.Types.Column qualified as RQL
|
|
import Hasura.SQL.Backend
|
|
import Hasura.SQL.Types
|
|
import Hasura.Session
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Top-level planner
|
|
|
|
planNoPlan ::
|
|
MonadError E.QErr m =>
|
|
FromIrConfig ->
|
|
UserInfo ->
|
|
QueryDB 'BigQuery Void (UnpreparedValue 'BigQuery) ->
|
|
m Select
|
|
planNoPlan fromIrConfig userInfo queryDB = do
|
|
rootField <- traverse (prepareValueNoPlan (_uiSession userInfo)) queryDB
|
|
|
|
(select, FromIrWriter {fromIrWriterLogicalModels}) <-
|
|
runValidate (BigQuery.runFromIr fromIrConfig (BigQuery.fromRootField rootField))
|
|
`onLeft` (E.throw400 E.NotSupported . (tshow :: NonEmpty Error -> Text))
|
|
|
|
-- Logical models used within this query need to be converted into CTEs.
|
|
-- These need to come before any other CTEs in case those CTEs also depend on
|
|
-- the logical models.
|
|
let logicalModels :: Maybe With
|
|
logicalModels = do
|
|
ctes <- NE.nonEmpty (Map.toList fromIrWriterLogicalModels)
|
|
pure (With [Aliased query (toTxt name) | (name, query) <- ctes])
|
|
|
|
pure select {selectWith = logicalModels <> selectWith select}
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Resolving values
|
|
|
|
-- | Prepare a value without any query planning; we just execute the
|
|
-- query with the values embedded.
|
|
prepareValueNoPlan ::
|
|
(MonadError E.QErr m) =>
|
|
SessionVariables ->
|
|
UnpreparedValue 'BigQuery ->
|
|
m Expression
|
|
prepareValueNoPlan sessionVariables =
|
|
\case
|
|
UVLiteral x -> pure x
|
|
UVSession -> pure globalSessionExpression
|
|
-- To be honest, I'm not sure if it's indeed the JSON_VALUE operator we need here...
|
|
UVSessionVar typ text ->
|
|
case typ of
|
|
CollectableTypeScalar scalarType ->
|
|
pure
|
|
( CastExpression
|
|
( JsonValueExpression
|
|
globalSessionExpression
|
|
(FieldPath RootPath (toTxt text))
|
|
)
|
|
scalarType
|
|
)
|
|
CollectableTypeArray {} ->
|
|
throwError $ E.internalError "Cannot currently prepare array types in BigQuery."
|
|
UVParameter _ RQL.ColumnValue {..} -> pure (ValueExpression cvValue)
|
|
where
|
|
globalSessionExpression =
|
|
ValueExpression
|
|
(StringValue (LT.toStrict (encodeToLazyText sessionVariables)))
|