{-# 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.DDL (scalarTypeFromColumnType)
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.BackendType
import Hasura.RQL.Types.Column qualified as RQL
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 :: forall (m :: * -> *).
MonadError QErr m =>
FromIrConfig
-> UserInfo
-> QueryDB 'BigQuery Void (UnpreparedValue 'BigQuery)
-> m Select
planNoPlan FromIrConfig
fromIrConfig UserInfo
userInfo QueryDB 'BigQuery Void (UnpreparedValue 'BigQuery)
queryDB = do
  QueryDB 'BigQuery Void Expression
rootField <- (UnpreparedValue 'BigQuery -> m Expression)
-> QueryDB 'BigQuery Void (UnpreparedValue 'BigQuery)
-> m (QueryDB 'BigQuery Void Expression)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> QueryDB 'BigQuery Void a -> f (QueryDB 'BigQuery Void b)
traverse (SessionVariables -> UnpreparedValue 'BigQuery -> m Expression
forall (m :: * -> *).
MonadError QErr m =>
SessionVariables -> UnpreparedValue 'BigQuery -> m Expression
prepareValueNoPlan (UserInfo -> SessionVariables
_uiSession UserInfo
userInfo)) QueryDB 'BigQuery Void (UnpreparedValue 'BigQuery)
queryDB

  (Select
select, FromIrWriter {Map (Aliased NativeQueryName) (InterpolatedQuery Expression)
fromIrWriterNativeQueries :: Map (Aliased NativeQueryName) (InterpolatedQuery Expression)
fromIrWriterNativeQueries :: FromIrWriter
-> Map (Aliased NativeQueryName) (InterpolatedQuery Expression)
fromIrWriterNativeQueries}) <-
    Validate (NonEmpty Error) (Select, FromIrWriter)
-> Either (NonEmpty Error) (Select, FromIrWriter)
forall e a. Validate e a -> Either e a
runValidate (FromIrConfig
-> FromIr Select
-> Validate (NonEmpty Error) (Select, FromIrWriter)
forall a.
FromIrConfig
-> FromIr a -> Validate (NonEmpty Error) (a, FromIrWriter)
BigQuery.runFromIr FromIrConfig
fromIrConfig (QueryDB 'BigQuery Void Expression -> FromIr Select
BigQuery.fromRootField QueryDB 'BigQuery Void Expression
rootField))
      Either (NonEmpty Error) (Select, FromIrWriter)
-> (NonEmpty Error -> m (Select, FromIrWriter))
-> m (Select, FromIrWriter)
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` (Code -> Text -> m (Select, FromIrWriter)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
E.throw400 Code
E.NotSupported (Text -> m (Select, FromIrWriter))
-> (NonEmpty Error -> Text)
-> NonEmpty Error
-> m (Select, FromIrWriter)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty Error -> Text
forall a. Show a => a -> Text
tshow :: NonEmpty Error -> Text))

  -- Native queries 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 native queries.
  let nativeQueries :: Maybe With
      nativeQueries :: Maybe With
nativeQueries = do
        NonEmpty (Aliased NativeQueryName, InterpolatedQuery Expression)
ctes <- [(Aliased NativeQueryName, InterpolatedQuery Expression)]
-> Maybe
     (NonEmpty (Aliased NativeQueryName, InterpolatedQuery Expression))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty (Map (Aliased NativeQueryName) (InterpolatedQuery Expression)
-> [(Aliased NativeQueryName, InterpolatedQuery Expression)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Aliased NativeQueryName) (InterpolatedQuery Expression)
fromIrWriterNativeQueries)
        With -> Maybe With
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty (Aliased (InterpolatedQuery Expression)) -> With
With [InterpolatedQuery Expression
-> Text -> Aliased (InterpolatedQuery Expression)
forall a. a -> Text -> Aliased a
Aliased InterpolatedQuery Expression
query Text
aliasedAlias | (Aliased {Text
aliasedAlias :: Text
$sel:aliasedAlias:Aliased :: forall a. Aliased a -> Text
aliasedAlias}, InterpolatedQuery Expression
query) <- NonEmpty (Aliased NativeQueryName, InterpolatedQuery Expression)
ctes])

  Select -> m Select
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Select
select {$sel:selectWith:Select :: Maybe With
selectWith = Maybe With
nativeQueries Maybe With -> Maybe With -> Maybe With
forall a. Semigroup a => a -> a -> a
<> Select -> Maybe With
selectWith Select
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 :: forall (m :: * -> *).
MonadError QErr m =>
SessionVariables -> UnpreparedValue 'BigQuery -> m Expression
prepareValueNoPlan SessionVariables
sessionVariables =
  \case
    UVLiteral SQLExpression 'BigQuery
x -> Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SQLExpression 'BigQuery
Expression
x
    UnpreparedValue 'BigQuery
UVSession -> Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression
globalSessionExpression
    -- To be honest, I'm not sure if it's indeed the JSON_VALUE operator we need here...
    UVSessionVar SessionVarType 'BigQuery
typ SessionVariable
text ->
      case SessionVarType 'BigQuery
typ of
        CollectableTypeScalar ScalarType 'BigQuery
scalarType ->
          Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( Expression -> ScalarType -> Expression
CastExpression
                ( Expression -> JsonPath -> Expression
JsonValueExpression
                    Expression
globalSessionExpression
                    (JsonPath -> Text -> JsonPath
FieldPath JsonPath
RootPath (SessionVariable -> Text
forall a. ToTxt a => a -> Text
toTxt SessionVariable
text))
                )
                ScalarType 'BigQuery
ScalarType
scalarType
            )
        CollectableTypeArray {} ->
          QErr -> m Expression
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (QErr -> m Expression) -> QErr -> m Expression
forall a b. (a -> b) -> a -> b
$ Text -> QErr
E.internalError Text
"Cannot currently prepare array types in BigQuery."
    UVParameter Provenance
_ RQL.ColumnValue {ScalarValue 'BigQuery
ColumnType 'BigQuery
cvType :: ColumnType 'BigQuery
cvValue :: ScalarValue 'BigQuery
cvType :: forall (b :: BackendType). ColumnValue b -> ColumnType b
cvValue :: forall (b :: BackendType). ColumnValue b -> ScalarValue b
..} ->
      Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypedValue -> Expression
ValueExpression (ScalarType -> Value -> TypedValue
TypedValue (ColumnType 'BigQuery -> ScalarType
scalarTypeFromColumnType ColumnType 'BigQuery
cvType) ScalarValue 'BigQuery
Value
cvValue))
  where
    globalSessionExpression :: Expression
globalSessionExpression =
      TypedValue -> Expression
ValueExpression
        ( ScalarType -> Value -> TypedValue
TypedValue
            ScalarType
StringScalarType
            (Text -> Value
StringValue (Text -> Text
LT.toStrict (SessionVariables -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText SessionVariables
sessionVariables)))
        )