-- | 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 HM
import Data.HashMap.Strict.InsOrd qualified as OMap
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.Column qualified as RQL
import Hasura.RQL.Types.Common qualified as RQL
import Hasura.SQL.Backend
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 Select
planQuery :: SessionVariables
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL) -> m 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)
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 Select
forall (m :: * -> *).
MonadError QErr m =>
FromIr Select -> m Select
runIrWrappingRoot (FromIr Select -> m Select) -> FromIr Select -> m 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
  HM.HashMap RQL.FieldName (ColumnName, ScalarType) ->
  RQL.FieldName ->
  (RQL.FieldName, SourceRelationshipSelection 'MSSQL Void UnpreparedValue) ->
  m Select
planSourceRelationship :: 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 (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
    FromIr Select -> m Select
forall (m :: * -> *).
MonadError QErr m =>
FromIr Select -> m Select
runIrWrappingRoot (FromIr Select -> m Select) -> FromIr Select -> m Select
forall a b. (a -> b) -> a -> b
$
      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 Select
runIrWrappingRoot :: FromIr Select -> m Select
runIrWrappingRoot FromIr Select
selectAction =
  FromIr Select -> Either QErr Select
forall (m :: * -> *) a. MonadError QErr m => FromIr a -> m a
runFromIr FromIr Select
selectAction Either QErr Select -> (QErr -> m Select) -> m Select
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` (QErr -> m Select
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (QErr -> m Select) -> (QErr -> QErr) -> QErr -> m 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 :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure SQLExpression 'MSSQL
Expression
x
    UnpreparedValue 'MSSQL
UVSession -> Expression -> m Expression
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 Maybe VariableInfo
_ RQL.ColumnValue {ScalarValue 'MSSQL
ColumnType 'MSSQL
cvValue :: forall (b :: BackendType). ColumnValue b -> ScalarValue b
cvType :: forall (b :: BackendType). ColumnValue b -> ColumnType b
cvValue :: ScalarValue 'MSSQL
cvType :: ColumnType 'MSSQL
..} -> Expression -> m Expression
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
      SessionVariableValue
value <-
        SessionVariable -> SessionVariables -> Maybe SessionVariableValue
getSessionVariableValue SessionVariable
sessionVariable SessionVariables
sessionVariables
          Maybe SessionVariableValue
-> m SessionVariableValue -> m SessionVariableValue
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> SessionVariableValue -> m SessionVariableValue
forall (m :: * -> *) a.
QErrM m =>
Code -> SessionVariableValue -> m a
throw400 Code
NotFound (SessionVariableValue
"missing session variable: " SessionVariableValue -> SessionVariable -> SessionVariableValue
forall t.
ToTxt t =>
SessionVariableValue -> t -> SessionVariableValue
<>> 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
$ SessionVariableValue -> Value
ODBC.TextValue SessionVariableValue
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 (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType 'MSSQL
ScalarType
baseTy
          CollectableTypeArray {} ->
            Code -> SessionVariableValue -> m ScalarType
forall (m :: * -> *) a.
QErrM m =>
Code -> SessionVariableValue -> m a
throw400 Code
NotSupported SessionVariableValue
"Array types are currently not supported in MS SQL Server"
        m (DataLength -> Expression) -> m DataLength -> m Expression
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DataLength -> m DataLength
forall (f :: * -> *) a. Applicative f => a -> f a
pure DataLength
DataLengthMax

planSubscription ::
  MonadError QErr m =>
  OMap.InsOrdHashMap G.Name (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)) ->
  SessionVariables ->
  m (Reselect, PrepareState)
planSubscription :: 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)
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)
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
  InsOrdHashMap Name Select
selectMap <- FromIr (InsOrdHashMap Name Select) -> m (InsOrdHashMap Name Select)
forall (m :: * -> *) a. MonadError QErr m => FromIr a -> m a
runFromIr ((QueryDB 'MSSQL Void Expression -> FromIr Select)
-> InsOrdHashMap Name (QueryDB 'MSSQL Void Expression)
-> FromIr (InsOrdHashMap Name Select)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse QueryDB 'MSSQL Void Expression -> FromIr Select
fromQueryRootField InsOrdHashMap Name (QueryDB 'MSSQL Void Expression)
rootFieldMap)
  (Reselect, PrepareState) -> m (Reselect, PrepareState)
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 ::
--      OMap.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 ::
  OMap.InsOrdHashMap G.Name Select ->
  Reselect
collapseMap :: InsOrdHashMap Name Select -> Reselect
collapseMap InsOrdHashMap Name Select
selects =
  Reselect :: [Projection] -> For -> Where -> Reselect
Reselect
    { $sel:reselectFor:Reselect :: For
reselectFor =
        ForJson -> For
JsonFor ForJson :: JsonCardinality -> Root -> ForJson
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)]
OMap.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 :: forall a. a -> SessionVariableValue -> Aliased a
Aliased
            { $sel:aliasedThing:Aliased :: Expression
aliasedThing = Select -> Expression
SelectExpression Select
sel,
              $sel:aliasedAlias:Aliased :: SessionVariableValue
aliasedAlias = Name -> SessionVariableValue
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 :: [ColumnValue 'MSSQL]
-> HashMap Name (ColumnValue 'MSSQL)
-> HashSet SessionVariable
-> PrepareState
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 :: HashSet SessionVariable -> UnpreparedValue 'MSSQL -> m Expression
prepareValueSubscription HashSet SessionVariable
globalVariables =
  \case
    UVLiteral SQLExpression 'MSSQL
x -> Expression -> m Expression
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 (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 -> SessionVariableValue -> JsonPath
`FieldPath` SessionVariableValue
"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 -> SessionVariableValue -> m ()
forall (m :: * -> *) a.
QErrM m =>
Code -> SessionVariableValue -> m a
throw400
          Code
NotFound
          (SessionVariableValue
"missing session variable: " SessionVariableValue
-> SessionVariableValue -> SessionVariableValue
forall t.
ToTxt t =>
SessionVariableValue -> t -> SessionVariableValue
<>> SessionVariable -> SessionVariableValue
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 (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ JsonPath -> Expression
resultVarExp (SessionVariableValue -> JsonPath
sessionDot (SessionVariableValue -> JsonPath)
-> SessionVariableValue -> JsonPath
forall a b. (a -> b) -> a -> b
$ SessionVariable -> SessionVariableValue
forall a. ToTxt a => a -> SessionVariableValue
toTxt SessionVariable
text)
    UVParameter Maybe VariableInfo
mVariableInfo ColumnValue 'MSSQL
columnValue ->
      case (VariableInfo -> Name) -> Maybe VariableInfo -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VariableInfo -> Name
forall a. HasName a => a -> Name
GraphQL.getName Maybe VariableInfo
mVariableInfo of
        Maybe Name
Nothing -> 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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure (JsonPath -> Expression
resultVarExp (Integer -> JsonPath
syntheticIx Integer
currentIndex))
        Just Name
name -> do
          (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
HM.insert Name
name ColumnValue 'MSSQL
columnValue (PrepareState -> HashMap Name (ColumnValue 'MSSQL)
namedArguments PrepareState
s)
                  }
            )
          Expression -> m Expression
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 (SessionVariableValue -> JsonPath
queryDot (SessionVariableValue -> JsonPath)
-> SessionVariableValue -> JsonPath
forall a b. (a -> b) -> a -> b
$ Name -> SessionVariableValue
G.unName Name
name)
  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 :: SessionVariableValue -> SessionVariableValue -> FieldName
FieldName
            { $sel:fieldNameEntity:FieldName :: SessionVariableValue
fieldNameEntity = SessionVariableValue
rowAlias,
              $sel:fieldName:FieldName :: SessionVariableValue
fieldName = SessionVariableValue
resultVarsAlias
            }

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

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

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

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

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

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

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