-- | MSSQL Plan
--
-- Planning T-SQL queries and subscription by translating IR to MSSQL-specific
-- SQL query types.
module Hasura.Backends.MSSQL.Plan
  ( PrepareState (..),
    planQuery,
    planSourceRelationship,
    planSubscription,
    prepareValueQuery,
    resultAlias,
    resultIdAlias,
    resultVarsAlias,
    rowAlias,
  )
where

-- TODO: Re-add the export list after cleaning up the module
-- ( planQuery
-- , planSubscription
-- ) where

import Control.Applicative (Const (Const))
import Data.Aeson qualified as J
import Data.ByteString.Lazy (toStrict)
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.HashSet qualified as Set
import Data.List.NonEmpty qualified as NE
import Data.Text qualified as T
import Data.Text.Extended
import Database.ODBC.SQLServer qualified as ODBC
import Hasura.Backends.MSSQL.FromIr
import Hasura.Backends.MSSQL.FromIr.Query (fromQueryRootField, fromSourceRelationship)
import Hasura.Backends.MSSQL.Types.Internal
import Hasura.Base.Error
import Hasura.GraphQL.Parser qualified as GraphQL
import Hasura.Prelude hiding (first)
import Hasura.RQL.IR
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column qualified as RQL
import Hasura.RQL.Types.Common qualified as RQL
import Hasura.SQL.Types
import Hasura.Session
import Language.GraphQL.Draft.Syntax qualified as G
import Network.HTTP.Types qualified as HTTP

--------------------------------------------------------------------------------
-- Top-level planner

planQuery ::
  (MonadError QErr m) =>
  SessionVariables ->
  QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL) ->
  m (QueryWithDDL Select)
planQuery :: forall (m :: * -> *).
MonadError QErr m =>
SessionVariables
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (QueryWithDDL Select)
planQuery SessionVariables
sessionVariables QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
queryDB = do
  QueryDB 'MSSQL Void Expression
rootField <- (UnpreparedValue 'MSSQL -> m Expression)
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (QueryDB 'MSSQL 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 'MSSQL Void a -> f (QueryDB 'MSSQL Void b)
traverse (SessionVariables -> UnpreparedValue 'MSSQL -> m Expression
forall (m :: * -> *).
MonadError QErr m =>
SessionVariables -> UnpreparedValue 'MSSQL -> m Expression
prepareValueQuery SessionVariables
sessionVariables) QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
queryDB
  FromIr Select -> m (QueryWithDDL Select)
forall (m :: * -> *).
MonadError QErr m =>
FromIr Select -> m (QueryWithDDL Select)
runIrWrappingRoot (FromIr Select -> m (QueryWithDDL Select))
-> FromIr Select -> m (QueryWithDDL Select)
forall a b. (a -> b) -> a -> b
$ QueryDB 'MSSQL Void Expression -> FromIr Select
fromQueryRootField QueryDB 'MSSQL Void Expression
rootField

-- | For more information, see the module/documentation of 'Hasura.GraphQL.Execute.RemoteJoin.Source'.
planSourceRelationship ::
  (MonadError QErr m) =>
  SessionVariables ->
  -- | List of json objects, each of which becomes a row of the table
  NE.NonEmpty J.Object ->
  -- | The above objects have this schema
  HashMap.HashMap RQL.FieldName (ColumnName, ScalarType) ->
  RQL.FieldName ->
  (RQL.FieldName, SourceRelationshipSelection 'MSSQL Void UnpreparedValue) ->
  m Select
planSourceRelationship :: forall (m :: * -> *).
MonadError QErr m =>
SessionVariables
-> NonEmpty Object
-> HashMap FieldName (ColumnName, ScalarType)
-> FieldName
-> (FieldName,
    SourceRelationshipSelection 'MSSQL Void UnpreparedValue)
-> m Select
planSourceRelationship
  SessionVariables
sessionVariables
  NonEmpty Object
lhs
  HashMap FieldName (ColumnName, ScalarType)
lhsSchema
  FieldName
argumentId
  (FieldName
relationshipName, SourceRelationshipSelection 'MSSQL Void UnpreparedValue
sourceRelationshipRaw) = do
    SourceRelationshipSelection 'MSSQL Void (Const Expression)
sourceRelationship <-
      (UnpreparedValue 'MSSQL -> m (Const Expression 'MSSQL))
-> SourceRelationshipSelection 'MSSQL Void UnpreparedValue
-> m (SourceRelationshipSelection 'MSSQL Void (Const Expression))
forall (f :: * -> *) (backend :: BackendType)
       (vf :: BackendType -> *) (vg :: BackendType -> *) r.
(Applicative f, Backend backend) =>
(vf backend -> f (vg backend))
-> SourceRelationshipSelection backend r vf
-> f (SourceRelationshipSelection backend r vg)
traverseSourceRelationshipSelection
        ((Expression -> Const Expression 'MSSQL)
-> m Expression -> m (Const Expression 'MSSQL)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expression -> Const Expression 'MSSQL
forall {k} a (b :: k). a -> Const a b
Const (m Expression -> m (Const Expression 'MSSQL))
-> (UnpreparedValue 'MSSQL -> m Expression)
-> UnpreparedValue 'MSSQL
-> m (Const Expression 'MSSQL)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionVariables -> UnpreparedValue 'MSSQL -> m Expression
forall (m :: * -> *).
MonadError QErr m =>
SessionVariables -> UnpreparedValue 'MSSQL -> m Expression
prepareValueQuery SessionVariables
sessionVariables)
        SourceRelationshipSelection 'MSSQL Void UnpreparedValue
sourceRelationshipRaw
    QueryWithDDL Select -> Select
forall a. QueryWithDDL a -> a
qwdQuery
      (QueryWithDDL Select -> Select)
-> m (QueryWithDDL Select) -> m Select
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromIr Select -> m (QueryWithDDL Select)
forall (m :: * -> *).
MonadError QErr m =>
FromIr Select -> m (QueryWithDDL Select)
runIrWrappingRoot
        ( NonEmpty Object
-> HashMap FieldName (ColumnName, ScalarType)
-> FieldName
-> (FieldName,
    SourceRelationshipSelection 'MSSQL Void (Const Expression))
-> FromIr Select
fromSourceRelationship
            NonEmpty Object
lhs
            HashMap FieldName (ColumnName, ScalarType)
lhsSchema
            FieldName
argumentId
            (FieldName
relationshipName, SourceRelationshipSelection 'MSSQL Void (Const Expression)
sourceRelationship)
        )

runIrWrappingRoot ::
  (MonadError QErr m) =>
  FromIr Select ->
  m (QueryWithDDL Select)
runIrWrappingRoot :: forall (m :: * -> *).
MonadError QErr m =>
FromIr Select -> m (QueryWithDDL Select)
runIrWrappingRoot FromIr Select
selectAction =
  FromIr Select -> Either QErr (QueryWithDDL Select)
forall (m :: * -> *).
MonadError QErr m =>
FromIr Select -> m (QueryWithDDL Select)
runFromIrUseCTEs FromIr Select
selectAction Either QErr (QueryWithDDL Select)
-> (QErr -> m (QueryWithDDL Select)) -> m (QueryWithDDL Select)
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` (QErr -> m (QueryWithDDL Select)
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (QErr -> m (QueryWithDDL Select))
-> (QErr -> QErr) -> QErr -> m (QueryWithDDL Select)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Code -> QErr -> QErr
overrideQErrStatus Status
HTTP.status400 Code
NotSupported)

-- | Prepare a value without any query planning; we just execute the
-- query with the values embedded.
prepareValueQuery ::
  (MonadError QErr m) =>
  SessionVariables ->
  UnpreparedValue 'MSSQL ->
  m Expression
prepareValueQuery :: forall (m :: * -> *).
MonadError QErr m =>
SessionVariables -> UnpreparedValue 'MSSQL -> m Expression
prepareValueQuery SessionVariables
sessionVariables =
  {- History note:
      This function used to be called 'planNoPlan', and was used for building sql
      expressions for queries. That evolved differently, but this function is now
      left as a *suggestion* for implementing support for mutations.
      -}
  \case
    UVLiteral SQLExpression 'MSSQL
x -> Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SQLExpression 'MSSQL
Expression
x
    UnpreparedValue 'MSSQL
UVSession -> Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ Value -> Expression
ValueExpression (Value -> Expression) -> Value -> Expression
forall a b. (a -> b) -> a -> b
$ ByteString -> Value
ODBC.ByteStringValue (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ SessionVariables -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode SessionVariables
sessionVariables
    UVParameter Provenance
_ RQL.ColumnValue {ScalarValue 'MSSQL
ColumnType 'MSSQL
cvType :: ColumnType 'MSSQL
cvValue :: ScalarValue 'MSSQL
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 (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ Value -> Expression
ValueExpression Value
ScalarValue 'MSSQL
cvValue
    UVSessionVar SessionVarType 'MSSQL
typ SessionVariable
sessionVariable -> do
      Text
value <-
        SessionVariable -> SessionVariables -> Maybe Text
getSessionVariableValue SessionVariable
sessionVariable SessionVariables
sessionVariables
          Maybe Text -> m Text -> m Text
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m Text
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound (Text
"missing session variable: " Text -> SessionVariable -> Text
forall t. ToTxt t => Text -> t -> Text
<>> SessionVariable
sessionVariable)
      -- See https://github.com/fpco/odbc/pull/34#issuecomment-812223147
      -- We first cast to nvarchar(max) because casting from ntext is not supported
      Expression -> ScalarType -> DataLength -> Expression
CastExpression (Expression -> ScalarType -> DataLength -> Expression
CastExpression (Value -> Expression
ValueExpression (Value -> Expression) -> Value -> Expression
forall a b. (a -> b) -> a -> b
$ Text -> Value
ODBC.TextValue Text
value) ScalarType
WvarcharType DataLength
DataLengthMax)
        (ScalarType -> DataLength -> Expression)
-> m ScalarType -> m (DataLength -> Expression)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case SessionVarType 'MSSQL
typ of
          CollectableTypeScalar ScalarType 'MSSQL
baseTy ->
            ScalarType -> m ScalarType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType 'MSSQL
ScalarType
baseTy
          CollectableTypeArray {} ->
            Code -> Text -> m ScalarType
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Array types are currently not supported in MS SQL Server"
        m (DataLength -> Expression) -> m DataLength -> m Expression
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DataLength -> m DataLength
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DataLength
DataLengthMax

planSubscription ::
  (MonadError QErr m) =>
  InsOrdHashMap.InsOrdHashMap G.Name (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)) ->
  SessionVariables ->
  m (Reselect, PrepareState)
planSubscription :: forall (m :: * -> *).
MonadError QErr m =>
InsOrdHashMap Name (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
-> SessionVariables -> m (Reselect, PrepareState)
planSubscription InsOrdHashMap Name (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
unpreparedMap SessionVariables
sessionVariables = do
  (InsOrdHashMap Name (QueryDB 'MSSQL Void Expression)
rootFieldMap, PrepareState
prepareState) <-
    StateT
  PrepareState
  m
  (InsOrdHashMap Name (QueryDB 'MSSQL Void Expression))
-> PrepareState
-> m (InsOrdHashMap Name (QueryDB 'MSSQL Void Expression),
      PrepareState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT
      ( (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
 -> StateT PrepareState m (QueryDB 'MSSQL Void Expression))
-> InsOrdHashMap
     Name (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
-> StateT
     PrepareState
     m
     (InsOrdHashMap Name (QueryDB 'MSSQL 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) -> InsOrdHashMap Name a -> f (InsOrdHashMap Name b)
traverse
          ((UnpreparedValue 'MSSQL -> StateT PrepareState m Expression)
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> StateT PrepareState m (QueryDB 'MSSQL 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 'MSSQL Void a -> f (QueryDB 'MSSQL Void b)
traverse (HashSet SessionVariable
-> UnpreparedValue 'MSSQL -> StateT PrepareState m Expression
forall (m :: * -> *).
(MonadState PrepareState m, MonadError QErr m) =>
HashSet SessionVariable -> UnpreparedValue 'MSSQL -> m Expression
prepareValueSubscription (SessionVariables -> HashSet SessionVariable
getSessionVariablesSet SessionVariables
sessionVariables)))
          InsOrdHashMap Name (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
unpreparedMap
      )
      PrepareState
emptyPrepareState
  let rootFields :: InsOrdHashMap G.Name (FromIr Select)
      rootFields :: InsOrdHashMap Name (FromIr Select)
rootFields = (QueryDB 'MSSQL Void Expression -> FromIr Select)
-> InsOrdHashMap Name (QueryDB 'MSSQL Void Expression)
-> InsOrdHashMap Name (FromIr Select)
forall a b.
(a -> b) -> InsOrdHashMap Name a -> InsOrdHashMap Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QueryDB 'MSSQL Void Expression -> FromIr Select
fromQueryRootField InsOrdHashMap Name (QueryDB 'MSSQL Void Expression)
rootFieldMap
  InsOrdHashMap Name Select
selectMap <- (QueryWithDDL Select -> Select)
-> InsOrdHashMap Name (QueryWithDDL Select)
-> InsOrdHashMap Name Select
forall a b.
(a -> b) -> InsOrdHashMap Name a -> InsOrdHashMap Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QueryWithDDL Select -> Select
forall a. QueryWithDDL a -> a
qwdQuery (InsOrdHashMap Name (QueryWithDDL Select)
 -> InsOrdHashMap Name Select)
-> m (InsOrdHashMap Name (QueryWithDDL Select))
-> m (InsOrdHashMap Name Select)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InsOrdHashMap Name (FromIr Select)
-> m (InsOrdHashMap Name (QueryWithDDL Select))
forall (t :: * -> *) (m :: * -> *).
(Traversable t, MonadError QErr m) =>
t (FromIr Select) -> m (t (QueryWithDDL Select))
runFromIrUseCTEsT InsOrdHashMap Name (FromIr Select)
rootFields
  (Reselect, PrepareState) -> m (Reselect, PrepareState)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InsOrdHashMap Name Select -> Reselect
collapseMap InsOrdHashMap Name Select
selectMap, PrepareState
prepareState)

-- Plan a query without prepare/exec.
-- planNoPlanMap ::
--      InsOrdHashMap.InsOrdHashMap G.Name (SubscriptionRootFieldMSSQL (UnpreparedValue 'MSSQL))
--   -> Either PrepareError Reselect
-- planNoPlanMap _unpreparedMap =
-- let rootFieldMap = runIdentity $
--       traverse (traverseQueryRootField (pure . prepareValueNoPlan)) unpreparedMap
-- selectMap <-
--   first
--     FromIrError
--     (runValidate (runFromIr (traverse fromRootField rootFieldMap)))
-- pure (collapseMap selectMap)

--------------------------------------------------------------------------------
-- Converting a root field into a T-SQL select statement

-- | Collapse a set of selects into a single select that projects
-- these as subselects.
collapseMap ::
  InsOrdHashMap.InsOrdHashMap G.Name Select ->
  Reselect
collapseMap :: InsOrdHashMap Name Select -> Reselect
collapseMap InsOrdHashMap Name Select
selects =
  Reselect
    { $sel:reselectFor:Reselect :: For
reselectFor =
        ForJson -> For
JsonFor ForJson {$sel:jsonCardinality:ForJson :: JsonCardinality
jsonCardinality = JsonCardinality
JsonSingleton, $sel:jsonRoot:ForJson :: Root
jsonRoot = Root
NoRoot},
      $sel:reselectWhere:Reselect :: Where
reselectWhere = [Expression] -> Where
Where [Expression]
forall a. Monoid a => a
mempty,
      $sel:reselectProjections:Reselect :: [Projection]
reselectProjections =
        ((Name, Select) -> Projection) -> [(Name, Select)] -> [Projection]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Select) -> Projection
projectSelect (InsOrdHashMap Name Select -> [(Name, Select)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList InsOrdHashMap Name Select
selects)
    }
  where
    projectSelect :: (G.Name, Select) -> Projection
    projectSelect :: (Name, Select) -> Projection
projectSelect (Name
name, Select
sel) =
      Aliased Expression -> Projection
ExpressionProjection
        ( Aliased
            { $sel:aliasedThing:Aliased :: Expression
aliasedThing = Select -> Expression
SelectExpression Select
sel,
              $sel:aliasedAlias:Aliased :: Text
aliasedAlias = Name -> Text
G.unName Name
name
            }
        )

--------------------------------------------------------------------------------
-- Session variables

-- globalSessionExpression :: Expression
-- globalSessionExpression =
--   ValueExpression (ODBC.TextValue "current_setting('hasura.user')::json")

--------------------------------------------------------------------------------
-- Resolving values

-- data PrepareError
--   = FromIrError (NonEmpty Error)

data PrepareState = PrepareState
  { PrepareState -> [ColumnValue 'MSSQL]
positionalArguments :: [RQL.ColumnValue 'MSSQL],
    PrepareState -> HashMap Name (ColumnValue 'MSSQL)
namedArguments :: HashMap G.Name (RQL.ColumnValue 'MSSQL),
    PrepareState -> HashSet SessionVariable
sessionVariables :: Set.HashSet SessionVariable
  }

emptyPrepareState :: PrepareState
emptyPrepareState :: PrepareState
emptyPrepareState =
  PrepareState
    { positionalArguments :: [ColumnValue 'MSSQL]
positionalArguments = [ColumnValue 'MSSQL]
forall a. Monoid a => a
mempty,
      namedArguments :: HashMap Name (ColumnValue 'MSSQL)
namedArguments = HashMap Name (ColumnValue 'MSSQL)
forall a. Monoid a => a
mempty,
      sessionVariables :: HashSet SessionVariable
sessionVariables = HashSet SessionVariable
forall a. Monoid a => a
mempty
    }

-- | Prepare a value for multiplexed queries.
prepareValueSubscription ::
  (MonadState PrepareState m, MonadError QErr m) =>
  Set.HashSet SessionVariable ->
  UnpreparedValue 'MSSQL ->
  m Expression
prepareValueSubscription :: forall (m :: * -> *).
(MonadState PrepareState m, MonadError QErr m) =>
HashSet SessionVariable -> UnpreparedValue 'MSSQL -> m Expression
prepareValueSubscription HashSet SessionVariable
globalVariables =
  \case
    UVLiteral SQLExpression 'MSSQL
x -> Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SQLExpression 'MSSQL
Expression
x
    UnpreparedValue 'MSSQL
UVSession -> do
      (PrepareState -> PrepareState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\PrepareState
s -> PrepareState
s {sessionVariables :: HashSet SessionVariable
sessionVariables = PrepareState -> HashSet SessionVariable
sessionVariables PrepareState
s HashSet SessionVariable
-> HashSet SessionVariable -> HashSet SessionVariable
forall a. Semigroup a => a -> a -> a
<> HashSet SessionVariable
globalVariables})
      Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ JsonPath -> Expression
resultVarExp (JsonPath
RootPath JsonPath -> Text -> JsonPath
`FieldPath` Text
"session")
    UVSessionVar SessionVarType 'MSSQL
_typ SessionVariable
text -> do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SessionVariable
text SessionVariable -> HashSet SessionVariable -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Set.member` HashSet SessionVariable
globalVariables)
        (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400
          Code
NotFound
          (Text
"missing session variable: " Text -> Text -> Text
forall t. ToTxt t => Text -> t -> Text
<>> SessionVariable -> Text
sessionVariableToText SessionVariable
text)
      (PrepareState -> PrepareState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\PrepareState
s -> PrepareState
s {sessionVariables :: HashSet SessionVariable
sessionVariables = SessionVariable
text SessionVariable
-> HashSet SessionVariable -> HashSet SessionVariable
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
`Set.insert` PrepareState -> HashSet SessionVariable
sessionVariables PrepareState
s})
      Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ JsonPath -> Expression
resultVarExp (Text -> JsonPath
sessionDot (Text -> JsonPath) -> Text -> JsonPath
forall a b. (a -> b) -> a -> b
$ SessionVariable -> Text
forall a. ToTxt a => a -> Text
toTxt SessionVariable
text)
    UVParameter (FromGraphQL VariableInfo
variableInfo) ColumnValue 'MSSQL
columnValue -> do
      let name :: Name
name = VariableInfo -> Name
forall a. HasName a => a -> Name
GraphQL.getName VariableInfo
variableInfo

      (PrepareState -> PrepareState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
        ( \PrepareState
s ->
            PrepareState
s
              { namedArguments :: HashMap Name (ColumnValue 'MSSQL)
namedArguments =
                  Name
-> ColumnValue 'MSSQL
-> HashMap Name (ColumnValue 'MSSQL)
-> HashMap Name (ColumnValue 'MSSQL)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
name ColumnValue 'MSSQL
columnValue (PrepareState -> HashMap Name (ColumnValue 'MSSQL)
namedArguments PrepareState
s)
              }
        )
      Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ JsonPath -> Expression
resultVarExp (Text -> JsonPath
queryDot (Text -> JsonPath) -> Text -> JsonPath
forall a b. (a -> b) -> a -> b
$ Name -> Text
G.unName Name
name)
    UVParameter Provenance
_ ColumnValue 'MSSQL
columnValue -> do
      Integer
currentIndex <- Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer)
-> ([ColumnValue 'MSSQL] -> Int) -> [ColumnValue 'MSSQL] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ColumnValue 'MSSQL] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ColumnValue 'MSSQL] -> Integer)
-> m [ColumnValue 'MSSQL] -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PrepareState -> [ColumnValue 'MSSQL]) -> m [ColumnValue 'MSSQL]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrepareState -> [ColumnValue 'MSSQL]
positionalArguments
      (PrepareState -> PrepareState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify'
        ( \PrepareState
s ->
            PrepareState
s
              { positionalArguments :: [ColumnValue 'MSSQL]
positionalArguments = PrepareState -> [ColumnValue 'MSSQL]
positionalArguments PrepareState
s [ColumnValue 'MSSQL]
-> [ColumnValue 'MSSQL] -> [ColumnValue 'MSSQL]
forall a. Semigroup a => a -> a -> a
<> [ColumnValue 'MSSQL
columnValue]
              }
        )
      Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JsonPath -> Expression
resultVarExp (Integer -> JsonPath
syntheticIx Integer
currentIndex))
  where
    resultVarExp :: JsonPath -> Expression
    resultVarExp :: JsonPath -> Expression
resultVarExp =
      Expression -> JsonPath -> Expression
JsonValueExpression
        (Expression -> JsonPath -> Expression)
-> Expression -> JsonPath -> Expression
forall a b. (a -> b) -> a -> b
$ FieldName -> Expression
ColumnExpression
        (FieldName -> Expression) -> FieldName -> Expression
forall a b. (a -> b) -> a -> b
$ FieldName
          { $sel:fieldNameEntity:FieldName :: Text
fieldNameEntity = Text
rowAlias,
            $sel:fieldName:FieldName :: Text
fieldName = Text
resultVarsAlias
          }

    queryDot :: Text -> JsonPath
    queryDot :: Text -> JsonPath
queryDot Text
name = JsonPath
RootPath JsonPath -> Text -> JsonPath
`FieldPath` Text
"query" JsonPath -> Text -> JsonPath
`FieldPath` Text
name

    syntheticIx :: Integer -> JsonPath
    syntheticIx :: Integer -> JsonPath
syntheticIx Integer
i = JsonPath
RootPath JsonPath -> Text -> JsonPath
`FieldPath` Text
"synthetic" JsonPath -> Integer -> JsonPath
`IndexPath` Integer
i

    sessionDot :: Text -> JsonPath
    sessionDot :: Text -> JsonPath
sessionDot Text
name = JsonPath
RootPath JsonPath -> Text -> JsonPath
`FieldPath` Text
"session" JsonPath -> Text -> JsonPath
`FieldPath` Text
name

resultIdAlias :: T.Text
resultIdAlias :: Text
resultIdAlias = Text
"result_id"

resultVarsAlias :: T.Text
resultVarsAlias :: Text
resultVarsAlias = Text
"result_vars"

resultAlias :: T.Text
resultAlias :: Text
resultAlias = Text
"result"

rowAlias :: T.Text
rowAlias :: Text
rowAlias = Text
"row"