module Hasura.Backends.MSSQL.FromIr.MutationResponse
( mkMutationOutputSelect,
selectMutationOutputAndCheckCondition,
)
where
import Database.ODBC.SQLServer qualified as ODBC
import Hasura.Backends.MSSQL.FromIr (FromIr)
import Hasura.Backends.MSSQL.FromIr.Query (fromSelect)
import Hasura.Backends.MSSQL.Instances.Types ()
import Hasura.Backends.MSSQL.Types.Internal as TSQL
import Hasura.Prelude
import Hasura.RQL.IR qualified as IR
import Hasura.RQL.IR.Returning (MutationOutputG)
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common qualified as IR
import Hasura.RQL.Types.Schema.Options qualified as Options
mkMutationOutputSelect ::
Options.StringifyNumbers ->
Text ->
MutationOutputG 'MSSQL Void Expression ->
FromIr Select
mkMutationOutputSelect :: StringifyNumbers
-> Text -> MutationOutputG 'MSSQL Void Expression -> FromIr Select
mkMutationOutputSelect StringifyNumbers
stringifyNum Text
withAlias = \case
IR.MOutMultirowFields MutFldsG 'MSSQL Void Expression
multiRowFields -> do
[Projection]
projections <- MutFldsG 'MSSQL Void Expression
-> ((FieldName, MutFldG 'MSSQL Void Expression)
-> FromIr Projection)
-> FromIr [Projection]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM MutFldsG 'MSSQL Void Expression
multiRowFields (((FieldName, MutFldG 'MSSQL Void Expression) -> FromIr Projection)
-> FromIr [Projection])
-> ((FieldName, MutFldG 'MSSQL Void Expression)
-> FromIr Projection)
-> FromIr [Projection]
forall a b. (a -> b) -> a -> b
$ \(FieldName
fieldName, MutFldG 'MSSQL Void Expression
field') -> do
let mkProjection :: Select -> Projection
mkProjection = Aliased Expression -> Projection
ExpressionProjection (Aliased Expression -> Projection)
-> (Select -> Aliased Expression) -> Select -> Projection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expression -> Text -> Aliased Expression)
-> Text -> Expression -> Aliased Expression
forall a b c. (a -> b -> c) -> b -> a -> c
flip Expression -> Text -> Aliased Expression
forall a. a -> Text -> Aliased a
Aliased (FieldName -> Text
IR.getFieldNameTxt FieldName
fieldName) (Expression -> Aliased Expression)
-> (Select -> Expression) -> Select -> Aliased Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Select -> Expression
SelectExpression
Select -> Projection
mkProjection (Select -> Projection) -> FromIr Select -> FromIr Projection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case MutFldG 'MSSQL Void Expression
field' of
MutFldG 'MSSQL Void Expression
IR.MCount -> Select -> FromIr Select
forall a. a -> FromIr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Select -> FromIr Select) -> Select -> FromIr Select
forall a b. (a -> b) -> a -> b
$ Select
countSelect
IR.MExp Text
t -> Select -> FromIr Select
forall a. a -> FromIr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Select -> FromIr Select) -> Select -> FromIr Select
forall a b. (a -> b) -> a -> b
$ Text -> Select
textSelect Text
t
IR.MRet AnnFieldsG 'MSSQL Void Expression
returningFields -> JsonAggSelect -> AnnFieldsG 'MSSQL Void Expression -> FromIr Select
mkSelect JsonAggSelect
IR.JASMultipleRows AnnFieldsG 'MSSQL Void Expression
returningFields
let forJson :: For
forJson = ForJson -> For
JsonFor (ForJson -> For) -> ForJson -> For
forall a b. (a -> b) -> a -> b
$ JsonCardinality -> Root -> ForJson
ForJson JsonCardinality
JsonSingleton Root
NoRoot
Select -> FromIr Select
forall a. a -> FromIr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Select
emptySelect {$sel:selectFor:Select :: For
selectFor = For
forJson, $sel:selectProjections:Select :: [Projection]
selectProjections = [Projection]
projections}
IR.MOutSinglerowObject AnnFieldsG 'MSSQL Void Expression
singleRowField -> JsonAggSelect -> AnnFieldsG 'MSSQL Void Expression -> FromIr Select
mkSelect JsonAggSelect
IR.JASSingleObject AnnFieldsG 'MSSQL Void Expression
singleRowField
where
mkSelect ::
IR.JsonAggSelect ->
IR.Fields (IR.AnnFieldG 'MSSQL Void Expression) ->
FromIr Select
mkSelect :: JsonAggSelect -> AnnFieldsG 'MSSQL Void Expression -> FromIr Select
mkSelect JsonAggSelect
jsonAggSelect AnnFieldsG 'MSSQL Void Expression
annFields = do
let annSelect :: AnnSelectG 'MSSQL (AnnFieldG 'MSSQL Void) Expression
annSelect = AnnFieldsG 'MSSQL Void Expression
-> SelectFromG 'MSSQL Expression
-> TablePermG 'MSSQL Expression
-> SelectArgsG 'MSSQL Expression
-> StringifyNumbers
-> Maybe NamingCase
-> AnnSelectG 'MSSQL (AnnFieldG 'MSSQL Void) Expression
forall (b :: BackendType) (f :: * -> *) v.
Fields (f v)
-> SelectFromG b v
-> TablePermG b v
-> SelectArgsG b v
-> StringifyNumbers
-> Maybe NamingCase
-> AnnSelectG b f v
IR.AnnSelectG AnnFieldsG 'MSSQL Void Expression
annFields (FIIdentifier -> SelectFromG 'MSSQL Expression
forall (b :: BackendType) v. FIIdentifier -> SelectFromG b v
IR.FromIdentifier (FIIdentifier -> SelectFromG 'MSSQL Expression)
-> FIIdentifier -> SelectFromG 'MSSQL Expression
forall a b. (a -> b) -> a -> b
$ Text -> FIIdentifier
IR.FIIdentifier Text
withAlias) TablePermG 'MSSQL Expression
forall (backend :: BackendType) v. TablePermG backend v
IR.noTablePermissions SelectArgsG 'MSSQL Expression
forall (backend :: BackendType) v. SelectArgsG backend v
IR.noSelectArgs StringifyNumbers
stringifyNum Maybe NamingCase
forall a. Maybe a
Nothing
JsonAggSelect
-> AnnSelectG 'MSSQL (AnnFieldG 'MSSQL Void) Expression
-> FromIr Select
fromSelect JsonAggSelect
jsonAggSelect AnnSelectG 'MSSQL (AnnFieldG 'MSSQL Void) Expression
annSelect
countSelect :: Select
countSelect :: Select
countSelect =
let countProjection :: Projection
countProjection = Aliased Aggregate -> Projection
AggregateProjection (Aliased Aggregate -> Projection)
-> Aliased Aggregate -> Projection
forall a b. (a -> b) -> a -> b
$ Aggregate -> Text -> Aliased Aggregate
forall a. a -> Text -> Aliased a
Aliased (Countable FieldName -> Aggregate
CountAggregate Countable FieldName
forall name. Countable name
StarCountable) Text
"count"
in Select
emptySelect
{ $sel:selectProjections:Select :: [Projection]
selectProjections = [Projection
countProjection],
$sel:selectFrom:Select :: Maybe From
selectFrom = From -> Maybe From
forall a. a -> Maybe a
Just (From -> Maybe From) -> From -> Maybe From
forall a b. (a -> b) -> a -> b
$ Text -> From
TSQL.FromIdentifier Text
withAlias
}
textSelect :: Text -> Select
textSelect :: Text -> Select
textSelect Text
t =
let textProjection :: Projection
textProjection = Aliased Expression -> Projection
ExpressionProjection (Aliased Expression -> Projection)
-> Aliased Expression -> Projection
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> Aliased Expression
forall a. a -> Text -> Aliased a
Aliased (Value -> Expression
ValueExpression (Text -> Value
ODBC.TextValue Text
t)) Text
"exp"
in Select
emptySelect {$sel:selectProjections:Select :: [Projection]
selectProjections = [Projection
textProjection]}
selectMutationOutputAndCheckCondition :: Text -> Select -> Expression -> Select
selectMutationOutputAndCheckCondition :: Text -> Select -> Expression -> Select
selectMutationOutputAndCheckCondition Text
alias Select
mutationOutputSelect Expression
checkBoolExp =
let mutationOutputProjection :: Projection
mutationOutputProjection =
Aliased Expression -> Projection
ExpressionProjection (Aliased Expression -> Projection)
-> Aliased Expression -> Projection
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> Aliased Expression
forall a. a -> Text -> Aliased a
Aliased (Select -> Expression
SelectExpression Select
mutationOutputSelect) Text
"mutation_response"
checkConstraintProjection :: Projection
checkConstraintProjection =
Aliased Expression -> Projection
ExpressionProjection
(Aliased Expression -> Projection)
-> Aliased Expression -> Projection
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> Aliased Expression
forall a. a -> Text -> Aliased a
Aliased (FunctionApplicationExpression -> Expression
FunctionApplicationExpression (FunctionApplicationExpression -> Expression)
-> FunctionApplicationExpression -> Expression
forall a b. (a -> b) -> a -> b
$ Expression -> Expression -> FunctionApplicationExpression
FunExpISNULL (Select -> Expression
SelectExpression Select
checkConstraintSelect) (Value -> Expression
ValueExpression (Int -> Value
ODBC.IntValue Int
0))) Text
"check_constraint_select"
in Select
emptySelect {$sel:selectProjections:Select :: [Projection]
selectProjections = [Projection
mutationOutputProjection, Projection
checkConstraintProjection]}
where
checkConstraintSelect :: Select
checkConstraintSelect =
let subQueryAlias :: Text
subQueryAlias = Text
"check_sub_query"
checkEvaluationFieldName :: Text
checkEvaluationFieldName = Text
"check_evaluation"
sumAggregate :: Aggregate
sumAggregate =
Text -> [Expression] -> Aggregate
OpAggregate
Text
"SUM"
[ FieldName -> Expression
ColumnExpression
(FieldName -> Expression) -> FieldName -> Expression
forall a b. (a -> b) -> a -> b
$ FieldName
{ $sel:fieldNameEntity:FieldName :: Text
fieldNameEntity = Text
subQueryAlias,
$sel:fieldName:FieldName :: Text
fieldName = Text
checkEvaluationFieldName
}
]
checkSubQuery :: Select
checkSubQuery =
let zeroValue :: Expression
zeroValue = Value -> Expression
ValueExpression (Value -> Expression) -> Value -> Expression
forall a b. (a -> b) -> a -> b
$ Int -> Value
ODBC.IntValue Int
0
oneValue :: Expression
oneValue = Value -> Expression
ValueExpression (Value -> Expression) -> Value -> Expression
forall a b. (a -> b) -> a -> b
$ Int -> Value
ODBC.IntValue Int
1
caseExpression :: Expression
caseExpression = Expression -> Expression -> Expression -> Expression
ConditionalExpression Expression
checkBoolExp Expression
zeroValue Expression
oneValue
in Select
emptySelect
{ $sel:selectProjections:Select :: [Projection]
selectProjections = [Aliased Expression -> Projection
ExpressionProjection (Expression -> Text -> Aliased Expression
forall a. a -> Text -> Aliased a
Aliased Expression
caseExpression Text
checkEvaluationFieldName)],
$sel:selectFrom:Select :: Maybe From
selectFrom = From -> Maybe From
forall a. a -> Maybe a
Just (From -> Maybe From) -> From -> Maybe From
forall a b. (a -> b) -> a -> b
$ Text -> From
TSQL.FromIdentifier Text
alias
}
in Select
emptySelect
{ $sel:selectProjections:Select :: [Projection]
selectProjections = [Aliased Aggregate -> Projection
AggregateProjection (Aggregate -> Text -> Aliased Aggregate
forall a. a -> Text -> Aliased a
Aliased Aggregate
sumAggregate Text
"check")],
$sel:selectFrom:Select :: Maybe From
selectFrom = From -> Maybe From
forall a. a -> Maybe a
Just (From -> Maybe From) -> From -> Maybe From
forall a b. (a -> b) -> a -> b
$ Aliased Select -> From
TSQL.FromSelect (Select -> Text -> Aliased Select
forall a. a -> Text -> Aliased a
Aliased Select
checkSubQuery Text
subQueryAlias)
}