2021-07-08 23:49:10 +03:00
{- # LANGUAGE ViewPatterns # -}
2021-09-20 13:26:21 +03:00
2021-09-24 01:56:37 +03:00
-- | Translate from the DML to the TSql dialect.
--
-- We use 'StateT' (newtype 'FromIr') as the base monad for all operations, since
-- state is used to mangle names such that the scope of identifiers in the IR is
-- preserved in the resulting TSQL.
--
-- For the MSSQL backend, a supported subset of the constructs that make
-- up its TSQL dialect are represented in the form of data-types in the
-- Hasura.Backends.MSSQL.Types module. In this module, we translate from RQL to
-- those TSQL types. And in 'ToQuery' we render/serialize/print the TSQL types to
-- query-strings that are suitable to be executed on the actual MSSQL database.
--
-- In places where a series of transations are scoped under a context, we use
-- 'ReaderT'. For example, such translations as pertaining to a table with an
-- alias, will require the alias for their translation operations, like qualified
-- equality checks under where clauses, etc., perhaps below multiple layers of
-- nested function calls.
2021-02-23 20:37:27 +03:00
module Hasura.Backends.MSSQL.FromIr
2021-09-24 01:56:37 +03:00
( fromSelectRows ,
mkSQLSelect ,
fromRootField ,
fromSelectAggregate ,
fromGBoolExp ,
Error ( .. ) ,
runFromIr ,
FromIr ,
jsonFieldName ,
2021-10-01 15:52:19 +03:00
fromInsert ,
2021-12-31 13:56:06 +03:00
toMerge ,
2021-09-24 01:56:37 +03:00
fromDelete ,
2021-12-15 16:55:41 +03:00
fromUpdate ,
2021-11-19 20:05:01 +03:00
toSelectIntoTempTable ,
2021-12-31 13:56:06 +03:00
toInsertValuesIntoTempTable ,
2021-09-24 01:56:37 +03:00
)
where
import Control.Monad.Validate
import Data.HashMap.Strict qualified as HM
import Data.Map.Strict ( Map )
import Data.Map.Strict qualified as M
import Data.Proxy
import Data.Text qualified as T
import Database.ODBC.SQLServer qualified as ODBC
import Hasura.Backends.MSSQL.Instances.Types ( )
2021-12-31 13:56:06 +03:00
import Hasura.Backends.MSSQL.Types.Insert as TSQL ( BackendInsert ( .. ) , IfMatched ( .. ) )
2021-12-15 20:07:21 +03:00
import Hasura.Backends.MSSQL.Types.Internal as TSQL
import Hasura.Backends.MSSQL.Types.Update as TSQL ( BackendUpdate ( .. ) , Update ( .. ) )
2021-09-24 01:56:37 +03:00
import Hasura.Prelude
import Hasura.RQL.IR qualified as IR
import Hasura.RQL.Types.Column qualified as IR
import Hasura.RQL.Types.Common qualified as IR
2021-12-01 07:53:34 +03:00
import Hasura.RQL.Types.Relationships.Local qualified as IR
2021-09-24 01:56:37 +03:00
import Hasura.SQL.Backend
2021-11-19 20:05:01 +03:00
import Language.GraphQL.Draft.Syntax ( unName )
2021-02-23 20:37:27 +03:00
--------------------------------------------------------------------------------
-- Types
-- | Most of these errors should be checked for legitimacy.
data Error
= UnsupportedOpExpG ( IR . OpExpG 'MSSQL Expression )
| FunctionNotSupported
2021-04-28 14:05:33 +03:00
| NodesUnsupportedForNow
2021-06-11 06:26:50 +03:00
| ConnectionsNotSupported
2021-02-23 20:37:27 +03:00
deriving ( Show , Eq )
-- | The base monad used throughout this module for all conversion
-- functions.
--
-- It's a Validate, so it'll continue going when it encounters errors
-- to accumulate as many as possible.
--
-- It also contains a mapping from entity prefixes to counters. So if
-- my prefix is "table" then there'll be a counter that lets me
-- generate table1, table2, etc. Same for any other prefix needed
-- (e.g. names for joins).
--
-- A ReaderT is used around this in most of the module too, for
-- setting the current entity that a given field name refers to. See
2022-01-19 11:37:50 +03:00
-- @fromColumn@.
2021-02-23 20:37:27 +03:00
newtype FromIr a = FromIr
{ unFromIr :: StateT ( Map Text Int ) ( Validate ( NonEmpty Error ) ) a
2021-09-24 01:56:37 +03:00
}
deriving ( Functor , Applicative , Monad , MonadValidate ( NonEmpty Error ) )
2021-02-23 20:37:27 +03:00
data StringifyNumbers
= StringifyNumbers
| LeaveNumbersAlone
deriving ( Eq )
--------------------------------------------------------------------------------
-- Runners
runFromIr :: FromIr a -> Validate ( NonEmpty Error ) a
runFromIr fromIr = evalStateT ( unFromIr fromIr ) mempty
--------------------------------------------------------------------------------
-- Similar rendition of old API
2021-09-24 01:56:37 +03:00
mkSQLSelect ::
IR . JsonAggSelect ->
2021-12-07 16:12:02 +03:00
IR . AnnSelectG 'MSSQL Void ( IR . AnnFieldG 'MSSQL Void ) Expression ->
2021-09-24 01:56:37 +03:00
FromIr TSQL . Select
2021-02-23 20:37:27 +03:00
mkSQLSelect jsonAggSelect annSimpleSel =
case jsonAggSelect of
IR . JASMultipleRows -> fromSelectRows annSimpleSel
2021-06-08 06:50:24 +03:00
IR . JASSingleObject ->
fromSelectRows annSimpleSel <&> \ sel ->
sel
2021-02-23 20:37:27 +03:00
{ selectFor =
JsonFor
2021-09-24 01:56:37 +03:00
ForJson { jsonCardinality = JsonSingleton , jsonRoot = NoRoot } ,
selectTop = Top 1
2021-02-23 20:37:27 +03:00
}
-- | Convert from the IR database query into a select.
2021-12-07 16:12:02 +03:00
fromRootField :: IR . QueryDB 'MSSQL Void Expression -> FromIr Select
2021-02-23 20:37:27 +03:00
fromRootField =
\ case
2021-09-24 01:56:37 +03:00
( IR . QDBSingleRow s ) -> mkSQLSelect IR . JASSingleObject s
2021-06-11 06:26:50 +03:00
( IR . QDBMultipleRows s ) -> mkSQLSelect IR . JASMultipleRows s
2021-09-24 01:56:37 +03:00
( IR . QDBAggregation s ) -> fromSelectAggregate Nothing s
2021-02-23 20:37:27 +03:00
--------------------------------------------------------------------------------
-- Top-level exported functions
2021-09-20 13:26:21 +03:00
-- | Top/root-level 'Select'. All descendent/sub-translations are collected to produce a root TSQL.Select.
2021-12-07 16:12:02 +03:00
fromSelectRows :: IR . AnnSelectG 'MSSQL Void ( IR . AnnFieldG 'MSSQL Void ) Expression -> FromIr TSQL . Select
2021-02-23 20:37:27 +03:00
fromSelectRows annSelectG = do
selectFrom <-
case from of
IR . FromTable qualifiedObject -> fromQualifiedTable qualifiedObject
2021-12-13 19:48:10 +03:00
IR . FromIdentifier identifier -> pure $ FromIdentifier $ IR . unFIIdentifier identifier
2021-09-24 01:56:37 +03:00
IR . FromFunction { } -> refute $ pure FunctionNotSupported
Args
{ argsOrderBy ,
argsWhere ,
argsJoins ,
argsTop ,
argsDistinct = Proxy ,
argsOffset ,
argsExistingJoins
} <-
runReaderT ( fromSelectArgsG args ) ( fromAlias selectFrom )
2021-02-23 20:37:27 +03:00
fieldSources <-
runReaderT
( traverse ( fromAnnFieldsG argsExistingJoins stringifyNumbers ) fields )
( fromAlias selectFrom )
filterExpression <-
2021-09-20 13:26:21 +03:00
runReaderT ( fromGBoolExp permFilter ) ( fromAlias selectFrom )
2021-12-02 17:21:42 +03:00
let selectProjections = map fieldSourceProjections fieldSources
2021-10-01 15:52:19 +03:00
pure $
emptySelect
2021-09-24 01:56:37 +03:00
{ selectOrderBy = argsOrderBy ,
selectTop = permissionBasedTop <> argsTop ,
selectProjections ,
selectFrom = Just selectFrom ,
selectJoins = argsJoins <> mapMaybe fieldSourceJoin fieldSources ,
selectWhere = argsWhere <> Where [ filterExpression ] ,
selectFor =
JsonFor ForJson { jsonCardinality = JsonArray , jsonRoot = NoRoot } ,
selectOffset = argsOffset
2021-02-23 20:37:27 +03:00
}
where
2021-09-24 01:56:37 +03:00
IR . AnnSelectG
{ _asnFields = fields ,
_asnFrom = from ,
_asnPerm = perm ,
_asnArgs = args ,
_asnStrfyNum = num
} = annSelectG
2021-02-23 20:37:27 +03:00
IR . TablePerm { _tpLimit = mPermLimit , _tpFilter = permFilter } = perm
permissionBasedTop =
[Preview] Inherited roles for postgres read queries
fixes #3868
docker image - `hasura/graphql-engine:inherited-roles-preview-48b73a2de`
Note:
To be able to use the inherited roles feature, the graphql-engine should be started with the env variable `HASURA_GRAPHQL_EXPERIMENTAL_FEATURES` set to `inherited_roles`.
Introduction
------------
This PR implements the idea of multiple roles as presented in this [paper](https://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/FGALanguageICDE07.pdf). The multiple roles feature in this PR can be used via inherited roles. An inherited role is a role which can be created by combining multiple singular roles. For example, if there are two roles `author` and `editor` configured in the graphql-engine, then we can create a inherited role with the name of `combined_author_editor` role which will combine the select permissions of the `author` and `editor` roles and then make GraphQL queries using the `combined_author_editor`.
How are select permissions of different roles are combined?
------------------------------------------------------------
A select permission includes 5 things:
1. Columns accessible to the role
2. Row selection filter
3. Limit
4. Allow aggregation
5. Scalar computed fields accessible to the role
Suppose there are two roles, `role1` gives access to the `address` column with row filter `P1` and `role2` gives access to both the `address` and the `phone` column with row filter `P2` and we create a new role `combined_roles` which combines `role1` and `role2`.
Let's say the following GraphQL query is queried with the `combined_roles` role.
```graphql
query {
employees {
address
phone
}
}
```
This will translate to the following SQL query:
```sql
select
(case when (P1 or P2) then address else null end) as address,
(case when P2 then phone else null end) as phone
from employee
where (P1 or P2)
```
The other parameters of the select permission will be combined in the following manner:
1. Limit - Minimum of the limits will be the limit of the inherited role
2. Allow aggregations - If any of the role allows aggregation, then the inherited role will allow aggregation
3. Scalar computed fields - same as table column fields, as in the above example
APIs for inherited roles:
----------------------
1. `add_inherited_role`
`add_inherited_role` is the [metadata API](https://hasura.io/docs/1.0/graphql/core/api-reference/index.html#schema-metadata-api) to create a new inherited role. It accepts two arguments
`role_name`: the name of the inherited role to be added (String)
`role_set`: list of roles that need to be combined (Array of Strings)
Example:
```json
{
"type": "add_inherited_role",
"args": {
"role_name":"combined_user",
"role_set":[
"user",
"user1"
]
}
}
```
After adding the inherited role, the inherited role can be used like single roles like earlier
Note:
An inherited role can only be created with non-inherited/singular roles.
2. `drop_inherited_role`
The `drop_inherited_role` API accepts the name of the inherited role and drops it from the metadata. It accepts a single argument:
`role_name`: name of the inherited role to be dropped
Example:
```json
{
"type": "drop_inherited_role",
"args": {
"role_name":"combined_user"
}
}
```
Metadata
---------
The derived roles metadata will be included under the `experimental_features` key while exporting the metadata.
```json
{
"experimental_features": {
"derived_roles": [
{
"role_name": "manager_is_employee_too",
"role_set": [
"employee",
"manager"
]
}
]
}
}
```
Scope
------
Only postgres queries and subscriptions are supported in this PR.
Important points:
-----------------
1. All columns exposed to an inherited role will be marked as `nullable`, this is done so that cell value nullification can be done.
TODOs
-------
- [ ] Tests
- [ ] Test a GraphQL query running with a inherited role without enabling inherited roles in experimental features
- [] Tests for aggregate queries, limit, computed fields, functions, subscriptions (?)
- [ ] Introspection test with a inherited role (nullability changes in a inherited role)
- [ ] Docs
- [ ] Changelog
Co-authored-by: Vamshi Surabhi <6562944+0x777@users.noreply.github.com>
GitOrigin-RevId: 3b8ee1e11f5ceca80fe294f8c074d42fbccfec63
2021-03-08 14:14:13 +03:00
maybe NoTop Top mPermLimit
2021-02-23 20:37:27 +03:00
stringifyNumbers =
if num
then StringifyNumbers
else LeaveNumbersAlone
2021-12-02 17:21:42 +03:00
mkNodesSelect :: Args -> Where -> Expression -> Top -> From -> [ ( Int , ( IR . FieldName , [ FieldSource ] ) ) ] -> [ ( Int , Projection ) ]
2021-09-24 01:56:37 +03:00
mkNodesSelect Args { .. } foreignKeyConditions filterExpression permissionBasedTop selectFrom nodes =
[ ( index ,
2021-12-02 17:21:42 +03:00
ExpressionProjection $
Aliased
{ aliasedThing =
SelectExpression $
emptySelect
{ selectProjections = map fieldSourceProjections fieldSources ,
selectTop = permissionBasedTop <> argsTop ,
selectFrom = pure selectFrom ,
selectJoins = argsJoins <> mapMaybe fieldSourceJoin fieldSources ,
selectWhere = argsWhere <> Where [ filterExpression ] <> foreignKeyConditions ,
selectFor =
JsonFor ForJson { jsonCardinality = JsonArray , jsonRoot = NoRoot } ,
selectOrderBy = argsOrderBy ,
selectOffset = argsOffset
} ,
aliasedAlias = IR . getFieldNameTxt fieldName
}
2021-07-08 23:49:10 +03:00
)
2021-12-02 17:21:42 +03:00
| ( index , ( fieldName , fieldSources ) ) <- nodes
2021-09-24 01:56:37 +03:00
]
2021-07-08 23:49:10 +03:00
--
-- The idea here is that LIMIT/OFFSET and aggregates don't mix
-- well. Therefore we have a nested query:
--
-- select sum(*), .. FROM (select * from x offset o limit l) p
--
-- That's why @projections@ appears on the outer, and is a
-- @StarProjection@ for the inner. But the joins, conditions, top,
-- offset are on the inner.
--
2021-12-02 17:21:42 +03:00
mkAggregateSelect :: Args -> Where -> Expression -> From -> [ ( Int , ( IR . FieldName , [ Projection ] ) ) ] -> [ ( Int , Projection ) ]
mkAggregateSelect Args { .. } foreignKeyConditions filterExpression selectFrom aggregates =
2021-09-24 01:56:37 +03:00
[ ( index ,
2021-12-02 17:21:42 +03:00
ExpressionProjection $
Aliased
{ aliasedThing =
JsonQueryExpression $
SelectExpression $
emptySelect
{ selectProjections = projections ,
selectTop = NoTop ,
selectFrom =
pure $
FromSelect
Aliased
{ aliasedAlias = aggSubselectName ,
aliasedThing =
emptySelect
{ selectProjections = pure StarProjection ,
selectTop = argsTop ,
selectFrom = pure selectFrom ,
selectJoins = argsJoins ,
selectWhere = argsWhere <> Where [ filterExpression ] <> foreignKeyConditions ,
selectFor = NoFor ,
selectOrderBy = mempty ,
selectOffset = argsOffset
}
2021-09-24 01:56:37 +03:00
} ,
2021-12-02 17:21:42 +03:00
selectJoins = mempty ,
selectWhere = mempty ,
selectFor =
JsonFor
ForJson
{ jsonCardinality = JsonSingleton ,
jsonRoot = NoRoot
} ,
selectOrderBy = mempty ,
selectOffset = Nothing
} ,
aliasedAlias = IR . getFieldNameTxt fieldName
}
2021-09-24 01:56:37 +03:00
)
| ( index , ( fieldName , projections ) ) <- aggregates
2021-07-08 23:49:10 +03:00
]
2021-09-24 01:56:37 +03:00
fromSelectAggregate ::
Maybe ( EntityAlias , HashMap ColumnName ColumnName ) ->
2021-12-07 16:12:02 +03:00
IR . AnnSelectG 'MSSQL Void ( IR . TableAggregateFieldG 'MSSQL Void ) Expression ->
2021-09-24 01:56:37 +03:00
FromIr TSQL . Select
2021-07-08 23:49:10 +03:00
fromSelectAggregate
mparentRelationship
IR . AnnSelectG
2021-09-24 01:56:37 +03:00
{ _asnFields = ( zip [ 0 .. ] -> fields ) ,
_asnFrom = from ,
_asnPerm = IR . TablePerm { _tpLimit = ( maybe NoTop Top -> permissionBasedTop ) , _tpFilter = permFilter } ,
_asnArgs = args ,
_asnStrfyNum = ( bool LeaveNumbersAlone StringifyNumbers -> stringifyNumbers )
} =
do
selectFrom <- case from of
IR . FromTable qualifiedObject -> fromQualifiedTable qualifiedObject
2021-12-13 19:48:10 +03:00
IR . FromIdentifier identifier -> pure $ FromIdentifier $ IR . unFIIdentifier identifier
2021-09-24 01:56:37 +03:00
IR . FromFunction { } -> refute $ pure FunctionNotSupported
-- Below: When we're actually a RHS of a query (of CROSS APPLY),
-- then we'll have a LHS table that we're joining on. So we get the
-- conditions expressions from the field mappings. The LHS table is
-- the entityAlias, and the RHS table is selectFrom.
mforeignKeyConditions <- fmap ( Where . fromMaybe [] ) $
for mparentRelationship $
\ ( entityAlias , mapping ) ->
runReaderT ( fromMapping selectFrom mapping ) entityAlias
filterExpression <- runReaderT ( fromGBoolExp permFilter ) ( fromAlias selectFrom )
args' @ Args { argsExistingJoins } <-
runReaderT ( fromSelectArgsG args ) ( fromAlias selectFrom )
-- Although aggregates, exps and nodes could be handled in one list,
-- we need to separately treat the subselect expressions
2021-12-02 17:21:42 +03:00
expss :: [ ( Int , Projection ) ] <- flip runReaderT ( fromAlias selectFrom ) $ sequence $ mapMaybe fromTableExpFieldG fields
nodes :: [ ( Int , ( IR . FieldName , [ FieldSource ] ) ) ] <-
2021-09-24 01:56:37 +03:00
flip runReaderT ( fromAlias selectFrom ) $ sequence $ mapMaybe ( fromTableNodesFieldG argsExistingJoins stringifyNumbers ) fields
let aggregates :: [ ( Int , ( IR . FieldName , [ Projection ] ) ) ] = mapMaybe fromTableAggFieldG fields
pure
2021-10-01 15:52:19 +03:00
emptySelect
2021-09-24 01:56:37 +03:00
{ selectProjections =
2021-12-02 17:21:42 +03:00
map snd $
2021-09-24 01:56:37 +03:00
sortBy ( comparing fst ) $
expss
<> mkNodesSelect args' mforeignKeyConditions filterExpression permissionBasedTop selectFrom nodes
2021-12-02 17:21:42 +03:00
<> mkAggregateSelect args' mforeignKeyConditions filterExpression selectFrom aggregates ,
2021-09-24 01:56:37 +03:00
selectTop = NoTop ,
selectFrom =
pure $
FromOpenJson $
Aliased
{ aliasedThing =
OpenJson
{ openJsonExpression = ValueExpression $ ODBC . TextValue " [0] " ,
openJsonWith = Nothing
} ,
aliasedAlias = existsFieldName
} ,
selectJoins = mempty , -- JOINs and WHEREs are only relevant in subselects
selectWhere = mempty ,
selectFor = JsonFor ForJson { jsonCardinality = JsonSingleton , jsonRoot = NoRoot } ,
selectOrderBy = Nothing ,
selectOffset = Nothing
2021-07-08 23:49:10 +03:00
}
2021-02-23 20:37:27 +03:00
--------------------------------------------------------------------------------
-- GraphQL Args
data Args = Args
2021-09-24 01:56:37 +03:00
{ argsWhere :: Where ,
argsOrderBy :: Maybe ( NonEmpty OrderBy ) ,
argsJoins :: [ Join ] ,
argsTop :: Top ,
argsOffset :: Maybe Expression ,
argsDistinct :: Proxy ( Maybe ( NonEmpty FieldName ) ) ,
argsExistingJoins :: Map TableName EntityAlias
}
deriving ( Show )
2021-02-23 20:37:27 +03:00
data UnfurledJoin = UnfurledJoin
2021-09-24 01:56:37 +03:00
{ unfurledJoin :: Join ,
-- | Recorded if we joined onto an object relation.
unfurledObjectTableAlias :: Maybe ( TableName , EntityAlias )
}
deriving ( Show )
2021-02-23 20:37:27 +03:00
fromSelectArgsG :: IR . SelectArgsG 'MSSQL Expression -> ReaderT EntityAlias FromIr Args
fromSelectArgsG selectArgsG = do
2021-06-10 19:13:20 +03:00
let argsOffset = ValueExpression . ODBC . IntValue . fromIntegral <$> moffset
2021-02-23 20:37:27 +03:00
argsWhere <-
2021-09-20 13:26:21 +03:00
maybe ( pure mempty ) ( fmap ( Where . pure ) . fromGBoolExp ) mannBoolExp
2021-06-10 19:13:20 +03:00
argsTop <-
maybe ( pure mempty ) ( pure . Top ) mlimit
2021-02-23 20:37:27 +03:00
-- Not supported presently, per Vamshi:
--
-- > It is hardly used and we don't have to go to great lengths to support it.
--
-- But placeholdering the code so that when it's ready to be used,
-- you can just drop the Proxy wrapper.
2021-06-15 18:53:20 +03:00
let argsDistinct = Proxy
2021-02-23 20:37:27 +03:00
( argsOrderBy , joins ) <-
2021-07-27 19:27:28 +03:00
runWriterT ( traverse fromAnnotatedOrderByItemG ( maybe [] toList orders ) )
2021-02-23 20:37:27 +03:00
-- Any object-relation joins that we generated, we record their
-- generated names into a mapping.
let argsExistingJoins =
M . fromList ( mapMaybe unfurledObjectTableAlias ( toList joins ) )
pure
Args
2021-09-24 01:56:37 +03:00
{ argsJoins = toList ( fmap unfurledJoin joins ) ,
argsOrderBy = nonEmpty argsOrderBy ,
..
2021-02-23 20:37:27 +03:00
}
where
2021-09-24 01:56:37 +03:00
IR . SelectArgs
{ _saWhere = mannBoolExp ,
_saLimit = mlimit ,
_saOffset = moffset ,
_saOrderBy = orders
} = selectArgsG
2021-02-23 20:37:27 +03:00
-- | Produce a valid ORDER BY construct, telling about any joins
-- needed on the side.
2021-09-24 01:56:37 +03:00
fromAnnotatedOrderByItemG ::
IR . AnnotatedOrderByItemG 'MSSQL Expression ->
WriterT ( Seq UnfurledJoin ) ( ReaderT EntityAlias FromIr ) OrderBy
2021-07-27 19:27:28 +03:00
fromAnnotatedOrderByItemG IR . OrderByItemG { obiType , obiColumn = obiColumn , obiNulls } = do
( orderByFieldName , orderByType ) <- unfurlAnnotatedOrderByElement obiColumn
2021-02-23 20:37:27 +03:00
let orderByNullsOrder = fromMaybe NullsAnyOrder obiNulls
2021-09-24 01:56:37 +03:00
orderByOrder = fromMaybe AscOrder obiType
2021-02-23 20:37:27 +03:00
pure OrderBy { .. }
-- | Unfurl the nested set of object relations (tell'd in the writer)
-- that are terminated by field name (IR.AOCColumn and
-- IR.AOCArrayAggregation).
2021-09-24 01:56:37 +03:00
unfurlAnnotatedOrderByElement ::
IR . AnnotatedOrderByElement 'MSSQL Expression ->
WriterT ( Seq UnfurledJoin ) ( ReaderT EntityAlias FromIr ) ( FieldName , Maybe TSQL . ScalarType )
2021-07-27 19:27:28 +03:00
unfurlAnnotatedOrderByElement =
2021-02-23 20:37:27 +03:00
\ case
2022-01-19 11:37:50 +03:00
IR . AOCColumn columnInfo -> do
fieldName <- lift ( fromColumnInfo columnInfo )
2021-05-21 15:27:44 +03:00
pure
2021-09-24 01:56:37 +03:00
( fieldName ,
2022-01-19 11:37:50 +03:00
case IR . ciType columnInfo of
2021-05-21 15:27:44 +03:00
IR . ColumnScalar t -> Just t
-- Above: It is of interest to us whether the type is
-- text/ntext/image. See ToQuery for more explanation.
2021-09-24 01:56:37 +03:00
_ -> Nothing
)
2021-05-21 15:27:44 +03:00
IR . AOCObjectRelation IR . RelInfo { riMapping = mapping , riRTable = table } annBoolExp annOrderByElementG -> do
selectFrom <- lift ( lift ( fromQualifiedTable table ) )
2021-02-23 20:37:27 +03:00
joinAliasEntity <-
2021-09-20 13:26:21 +03:00
lift ( lift ( generateAlias ( ForOrderAlias ( tableNameText table ) ) ) )
2021-02-23 20:37:27 +03:00
foreignKeyConditions <- lift ( fromMapping selectFrom mapping )
-- TODO: Because these object relations are re-used by regular
-- object mapping queries, this WHERE may be unnecessarily
-- restrictive. But I actually don't know from where such an
-- expression arises in the source GraphQL syntax.
--
-- Worst case scenario, we could put the WHERE in the key of the
-- Map in 'argsExistingJoins'. That would guarantee only equal
-- selects are re-used.
whereExpression <-
2021-09-20 13:26:21 +03:00
lift ( local ( const ( fromAlias selectFrom ) ) ( fromGBoolExp annBoolExp ) )
2021-02-23 20:37:27 +03:00
tell
2021-09-24 01:56:37 +03:00
( pure
UnfurledJoin
{ unfurledJoin =
Join
{ joinSource =
JoinSelect
2021-10-01 15:52:19 +03:00
emptySelect
2021-09-24 01:56:37 +03:00
{ selectTop = NoTop ,
selectProjections = [ StarProjection ] ,
selectFrom = Just selectFrom ,
selectJoins = [] ,
selectWhere =
Where ( foreignKeyConditions <> [ whereExpression ] ) ,
selectFor = NoFor ,
selectOrderBy = Nothing ,
selectOffset = Nothing
} ,
joinJoinAlias =
JoinAlias { joinAliasEntity , joinAliasField = Nothing }
} ,
unfurledObjectTableAlias = Just ( table , EntityAlias joinAliasEntity )
}
)
2021-02-23 20:37:27 +03:00
local
( const ( EntityAlias joinAliasEntity ) )
2021-07-27 19:27:28 +03:00
( unfurlAnnotatedOrderByElement annOrderByElementG )
2021-05-18 16:06:42 +03:00
IR . AOCArrayAggregation IR . RelInfo { riMapping = mapping , riRTable = tableName } annBoolExp annAggregateOrderBy -> do
selectFrom <- lift ( lift ( fromQualifiedTable tableName ) )
2021-02-23 20:37:27 +03:00
let alias = aggFieldName
joinAliasEntity <-
2021-09-20 13:26:21 +03:00
lift ( lift ( generateAlias ( ForOrderAlias ( tableNameText tableName ) ) ) )
2021-02-23 20:37:27 +03:00
foreignKeyConditions <- lift ( fromMapping selectFrom mapping )
whereExpression <-
2021-09-20 13:26:21 +03:00
lift ( local ( const ( fromAlias selectFrom ) ) ( fromGBoolExp annBoolExp ) )
2021-02-23 20:37:27 +03:00
aggregate <-
lift
2021-09-24 01:56:37 +03:00
( local
( const ( fromAlias selectFrom ) )
( case annAggregateOrderBy of
IR . AAOCount -> pure ( CountAggregate StarCountable )
2022-01-19 11:37:50 +03:00
IR . AAOOp text columnInfo -> do
fieldName <- fromColumnInfo columnInfo
2021-09-24 01:56:37 +03:00
pure ( OpAggregate text ( pure ( ColumnExpression fieldName ) ) )
)
)
2021-02-23 20:37:27 +03:00
tell
2021-09-24 01:56:37 +03:00
( pure
( UnfurledJoin
{ unfurledJoin =
Join
{ joinSource =
JoinSelect
2021-10-01 15:52:19 +03:00
emptySelect
2021-09-24 01:56:37 +03:00
{ selectTop = NoTop ,
selectProjections =
[ AggregateProjection
Aliased
{ aliasedThing = aggregate ,
aliasedAlias = alias
}
] ,
selectFrom = Just selectFrom ,
selectJoins = [] ,
selectWhere =
Where
( foreignKeyConditions <> [ whereExpression ] ) ,
selectFor = NoFor ,
selectOrderBy = Nothing ,
selectOffset = Nothing
} ,
joinJoinAlias =
JoinAlias { joinAliasEntity , joinAliasField = Nothing }
} ,
unfurledObjectTableAlias = Nothing
}
)
)
2021-05-21 15:27:44 +03:00
pure
2021-09-24 01:56:37 +03:00
( FieldName { fieldNameEntity = joinAliasEntity , fieldName = alias } ,
Nothing
)
2021-02-23 20:37:27 +03:00
--------------------------------------------------------------------------------
-- Conversion functions
2021-07-08 23:49:10 +03:00
tableNameText :: TableName -> Text
2021-02-23 20:37:27 +03:00
tableNameText ( TableName { tableName } ) = tableName
-- | This is really the start where you query the base table,
-- everything else is joins attached to it.
fromQualifiedTable :: TableName -> FromIr From
2021-09-24 01:56:37 +03:00
fromQualifiedTable schemadTableName @ ( TableName { tableName } ) = do
2021-09-20 13:26:21 +03:00
alias <- generateAlias ( TableTemplate tableName )
2021-02-23 20:37:27 +03:00
pure
2021-09-24 01:56:37 +03:00
( FromQualifiedTable
( Aliased
{ aliasedThing = schemadTableName ,
aliasedAlias = alias
}
)
)
2021-02-23 20:37:27 +03:00
fromTableName :: TableName -> FromIr EntityAlias
2021-09-24 01:56:37 +03:00
fromTableName TableName { tableName } = do
2021-09-20 13:26:21 +03:00
alias <- generateAlias ( TableTemplate tableName )
2021-02-23 20:37:27 +03:00
pure ( EntityAlias alias )
2021-09-20 13:26:21 +03:00
-- | Translate an 'AnnBoolExpFld' within an 'EntityAlias' context referring to the table the `AnnBoolExpFld` field belongs to.
--
-- This is mutually recursive with 'fromGBoolExp', mirroring the mutually recursive structure between 'AnnBoolExpFld' and 'AnnBoolExp b a' (alias of 'GBoolExp b (AnnBoolExpFld b a)').
2021-09-24 01:56:37 +03:00
fromAnnBoolExpFld ::
IR . AnnBoolExpFld 'MSSQL Expression ->
ReaderT EntityAlias FromIr Expression
2021-02-23 20:37:27 +03:00
fromAnnBoolExpFld =
\ case
2022-01-19 11:37:50 +03:00
IR . AVColumn columnInfo opExpGs -> do
expression <- fromColumnInfoForBoolExp columnInfo
2021-02-23 20:37:27 +03:00
expressions <- traverse ( lift . fromOpExpG expression ) opExpGs
pure ( AndExpression expressions )
2021-07-07 14:58:37 +03:00
IR . AVRelationship IR . RelInfo { riMapping = mapping , riRTable = table } annBoolExp -> do
2021-02-23 20:37:27 +03:00
selectFrom <- lift ( fromQualifiedTable table )
foreignKeyConditions <- fromMapping selectFrom mapping
whereExpression <-
2021-09-20 13:26:21 +03:00
local ( const ( fromAlias selectFrom ) ) ( fromGBoolExp annBoolExp )
2021-02-23 20:37:27 +03:00
pure
2021-09-24 01:56:37 +03:00
( ExistsExpression
2021-10-01 15:52:19 +03:00
emptySelect
2021-09-24 01:56:37 +03:00
{ selectOrderBy = Nothing ,
selectProjections =
[ ExpressionProjection
( Aliased
{ aliasedThing = trueExpression ,
aliasedAlias = existsFieldName
}
)
] ,
selectFrom = Just selectFrom ,
selectJoins = mempty ,
selectWhere = Where ( foreignKeyConditions <> [ whereExpression ] ) ,
selectTop = NoTop ,
selectFor = NoFor ,
selectOffset = Nothing
}
)
2021-02-23 20:37:27 +03:00
2021-05-21 15:27:44 +03:00
-- | For boolean operators, various comparison operators used need
-- special handling to ensure that SQL Server won't outright reject
-- the comparison. See also 'shouldCastToVarcharMax'.
fromColumnInfoForBoolExp :: IR . ColumnInfo 'MSSQL -> ReaderT EntityAlias FromIr Expression
2022-01-19 11:37:50 +03:00
fromColumnInfoForBoolExp IR . ColumnInfo { ciColumn = column , ciType } = do
fieldName <- columnNameToFieldName column <$> ask
if shouldCastToVarcharMax ciType -- See function commentary.
2022-01-05 14:09:45 +03:00
then pure ( CastExpression ( ColumnExpression fieldName ) WvarcharType DataLengthMax )
2021-09-24 01:56:37 +03:00
else pure ( ColumnExpression fieldName )
2021-05-21 15:27:44 +03:00
-- | There's a problem of comparing text fields with =, <, etc. that
-- SQL Server completely refuses to do so. So one way to workaround
-- this restriction is to automatically cast such text fields to
-- varchar(max).
shouldCastToVarcharMax :: IR . ColumnType 'MSSQL -> Bool
shouldCastToVarcharMax typ =
typ == IR . ColumnScalar TextType || typ == IR . ColumnScalar WtextType
2022-01-19 11:37:50 +03:00
fromColumnInfo :: IR . ColumnInfo 'MSSQL -> ReaderT EntityAlias FromIr FieldName
fromColumnInfo IR . ColumnInfo { ciColumn = column } =
columnNameToFieldName column <$> ask
2021-09-24 01:56:37 +03:00
2021-02-23 20:37:27 +03:00
-- entityAlias <- ask
-- pure
2022-01-19 11:37:50 +03:00
-- (columnNameToFieldName column entityAlias
2021-02-23 20:37:27 +03:00
-- FieldName
2022-01-19 11:37:50 +03:00
-- {fieldName = columnName column, fieldNameEntity = entityAliasText})
2021-02-23 20:37:27 +03:00
--------------------------------------------------------------------------------
-- Sources of projected fields
--
-- Because in the IR, a field projected can be a foreign object, we
-- have to both generate a projection AND on the side generate a join.
--
-- So a @FieldSource@ couples the idea of the projected thing and the
-- source of it (via 'Aliased').
data FieldSource
= ExpressionFieldSource ( Aliased Expression )
| JoinFieldSource ( Aliased Join )
deriving ( Eq , Show )
2021-07-08 23:49:10 +03:00
-- | Get FieldSource from a TAFExp type table aggregate field
fromTableExpFieldG :: -- TODO: Convert function to be similar to Nodes function
2021-12-07 16:12:02 +03:00
( Int , ( IR . FieldName , IR . TableAggregateFieldG 'MSSQL Void Expression ) ) ->
2021-12-02 17:21:42 +03:00
Maybe ( ReaderT EntityAlias FromIr ( Int , Projection ) )
2021-07-08 23:49:10 +03:00
fromTableExpFieldG = \ case
2021-09-24 01:56:37 +03:00
( index , ( IR . FieldName name , IR . TAFExp text ) ) ->
Just $
pure $
( index ,
fieldSourceProjections $
ExpressionFieldSource
Aliased
{ aliasedThing = TSQL . ValueExpression ( ODBC . TextValue text ) ,
aliasedAlias = name
}
)
2021-07-08 23:49:10 +03:00
_ -> Nothing
fromTableAggFieldG ::
2021-12-07 16:12:02 +03:00
( Int , ( IR . FieldName , IR . TableAggregateFieldG 'MSSQL Void Expression ) ) ->
2021-09-03 02:00:23 +03:00
Maybe ( Int , ( IR . FieldName , [ Projection ] ) )
2021-07-08 23:49:10 +03:00
fromTableAggFieldG = \ case
2021-09-24 01:56:37 +03:00
( index , ( fieldName , IR . TAFAgg ( aggregateFields :: [ ( IR . FieldName , IR . AggregateField 'MSSQL ) ] ) ) ) ->
Just $
let aggregates =
aggregateFields <&> \ ( fieldName' , aggregateField ) ->
fromAggregateField ( IR . getFieldNameTxt fieldName' ) aggregateField
in ( index , ( fieldName , aggregates ) )
2021-07-08 23:49:10 +03:00
_ -> Nothing
fromTableNodesFieldG ::
Map TableName EntityAlias ->
StringifyNumbers ->
2021-12-07 16:12:02 +03:00
( Int , ( IR . FieldName , IR . TableAggregateFieldG 'MSSQL Void Expression ) ) ->
2021-12-02 17:21:42 +03:00
Maybe ( ReaderT EntityAlias FromIr ( Int , ( IR . FieldName , [ FieldSource ] ) ) )
2021-07-08 23:49:10 +03:00
fromTableNodesFieldG argsExistingJoins stringifyNumbers = \ case
2021-12-07 16:12:02 +03:00
( index , ( fieldName , IR . TAFNodes () ( annFieldsG :: [ ( IR . FieldName , IR . AnnFieldG 'MSSQL Void Expression ) ] ) ) ) -> Just do
2021-07-08 23:49:10 +03:00
fieldSources' <- fromAnnFieldsG argsExistingJoins stringifyNumbers ` traverse ` annFieldsG
2021-12-02 17:21:42 +03:00
pure ( index , ( fieldName , fieldSources' ) )
2021-07-08 23:49:10 +03:00
_ -> Nothing
2021-09-03 02:00:23 +03:00
fromAggregateField :: Text -> IR . AggregateField 'MSSQL -> Projection
fromAggregateField alias aggregateField =
2021-02-23 20:37:27 +03:00
case aggregateField of
2021-09-24 01:56:37 +03:00
IR . AFExp text -> AggregateProjection $ Aliased ( TextAggregate text ) alias
2021-09-03 02:00:23 +03:00
IR . AFCount countType -> AggregateProjection . flip Aliased alias . CountAggregate $ case countType of
2021-09-24 01:56:37 +03:00
StarCountable -> StarCountable
2022-01-18 17:53:44 +03:00
NonNullFieldCountable name -> NonNullFieldCountable $ columnFieldAggEntity name
DistinctCountable name -> DistinctCountable $ columnFieldAggEntity name
2021-09-03 02:00:23 +03:00
IR . AFOp IR . AggregateOp { _aoOp = op , _aoFields = fields } ->
2021-09-24 01:56:37 +03:00
let projections :: [ Projection ] =
2022-01-19 11:37:50 +03:00
fields <&> \ ( fieldName , columnField ) ->
case columnField of
IR . CFCol column _columnType ->
let fname = columnFieldAggEntity column
2021-09-24 01:56:37 +03:00
in AggregateProjection $ Aliased ( OpAggregate op [ ColumnExpression fname ] ) ( IR . getFieldNameTxt fieldName )
IR . CFExp text ->
ExpressionProjection $ Aliased ( ValueExpression ( ODBC . TextValue text ) ) ( IR . getFieldNameTxt fieldName )
in ExpressionProjection $
flip Aliased alias $
JsonQueryExpression $
SelectExpression $
emptySelect
{ selectProjections = projections ,
selectFor = JsonFor $ ForJson JsonSingleton NoRoot
}
2021-09-03 02:00:23 +03:00
where
columnFieldAggEntity col = columnNameToFieldName col $ EntityAlias aggSubselectName
2021-07-30 12:02:38 +03:00
2021-02-23 20:37:27 +03:00
-- | The main sources of fields, either constants, fields or via joins.
fromAnnFieldsG ::
2021-09-24 01:56:37 +03:00
Map TableName EntityAlias ->
StringifyNumbers ->
2021-12-07 16:12:02 +03:00
( IR . FieldName , IR . AnnFieldG 'MSSQL Void Expression ) ->
2021-09-24 01:56:37 +03:00
ReaderT EntityAlias FromIr FieldSource
2021-02-23 20:37:27 +03:00
fromAnnFieldsG existingJoins stringifyNumbers ( IR . FieldName name , field ) =
case field of
IR . AFColumn annColumnField -> do
expression <- fromAnnColumnField stringifyNumbers annColumnField
pure
2021-09-24 01:56:37 +03:00
( ExpressionFieldSource
Aliased { aliasedThing = expression , aliasedAlias = name }
)
2021-02-23 20:37:27 +03:00
IR . AFExpression text ->
pure
2021-09-24 01:56:37 +03:00
( ExpressionFieldSource
Aliased
{ aliasedThing = TSQL . ValueExpression ( ODBC . TextValue text ) ,
aliasedAlias = name
}
)
2021-02-23 20:37:27 +03:00
IR . AFObjectRelation objectRelationSelectG ->
fmap
2021-09-24 01:56:37 +03:00
( \ aliasedThing ->
JoinFieldSource ( Aliased { aliasedThing , aliasedAlias = name } )
)
2021-02-23 20:37:27 +03:00
( fromObjectRelationSelectG existingJoins objectRelationSelectG )
IR . AFArrayRelation arraySelectG ->
fmap
2021-09-24 01:56:37 +03:00
( \ aliasedThing ->
JoinFieldSource ( Aliased { aliasedThing , aliasedAlias = name } )
)
2021-02-23 20:37:27 +03:00
( fromArraySelectG arraySelectG )
-- | Here is where we project a field as a column expression. If
-- number stringification is on, then we wrap it in a
-- 'ToStringExpression' so that it's casted when being projected.
2021-09-24 01:56:37 +03:00
fromAnnColumnField ::
StringifyNumbers ->
IR . AnnColumnField 'MSSQL Expression ->
ReaderT EntityAlias FromIr Expression
2021-02-23 20:37:27 +03:00
fromAnnColumnField _stringifyNumbers annColumnField = do
2022-01-19 11:37:50 +03:00
fieldName <- fromColumn column
2021-02-24 15:52:21 +03:00
-- TODO: Handle stringifying large numbers
2022-01-19 11:37:50 +03:00
{- (IR.isScalarColumnWhere isBigNum typ && stringifyNumbers == StringifyNumbers) -}
2021-02-24 15:52:21 +03:00
-- for geometry and geography values, the automatic json encoding on sql
-- server would fail. So we need to convert it to a format the json encoding
-- handles. Ideally we want this representation to be GeoJSON but sql server
-- doesn't have any functions to convert to GeoJSON format. So we return it in
-- WKT format
if typ == ( IR . ColumnScalar GeometryType ) || typ == ( IR . ColumnScalar GeographyType )
2022-01-05 14:09:45 +03:00
then pure $ MethodApplicationExpression ( ColumnExpression fieldName ) MethExpSTAsText
2021-09-24 01:56:37 +03:00
else case caseBoolExpMaybe of
Nothing -> pure ( ColumnExpression fieldName )
Just ex -> do
ex' <- fromGBoolExp ( coerce ex )
2021-10-01 15:52:19 +03:00
let nullValue = ValueExpression ODBC . NullValue
pure ( ConditionalExpression ex' ( ColumnExpression fieldName ) nullValue )
2021-02-23 20:37:27 +03:00
where
2021-09-24 01:56:37 +03:00
IR . AnnColumnField
2022-01-19 11:37:50 +03:00
{ _acfColumn = column ,
2021-09-24 01:56:37 +03:00
_acfType = typ ,
_acfAsText = _asText :: Bool ,
_acfOp = _ :: Maybe ( IR . ColumnOp 'MSSQL ) , -- TODO: What's this?
_acfCaseBoolExpression = caseBoolExpMaybe
} = annColumnField
2021-02-23 20:37:27 +03:00
-- | This is where a field name "foo" is resolved to a fully qualified
-- field name [table].[foo]. The table name comes from EntityAlias in
-- the ReaderT.
2022-01-19 11:37:50 +03:00
fromColumn :: ColumnName -> ReaderT EntityAlias FromIr FieldName
fromColumn column = columnNameToFieldName column <$> ask
2021-09-24 01:56:37 +03:00
2021-02-23 20:37:27 +03:00
-- entityAlias <- ask
2022-01-19 11:37:50 +03:00
-- pure (columnNameToFieldName column entityAlias -- FieldName {fieldName = columnName column, fieldNameEntity = entityAliasText}
2021-02-23 20:37:27 +03:00
-- )
2021-12-02 17:21:42 +03:00
fieldSourceProjections :: FieldSource -> Projection
2021-02-23 20:37:27 +03:00
fieldSourceProjections =
\ case
ExpressionFieldSource aliasedExpression ->
2021-12-02 17:21:42 +03:00
ExpressionProjection aliasedExpression
2021-02-23 20:37:27 +03:00
JoinFieldSource aliasedJoin ->
2021-12-02 17:21:42 +03:00
ExpressionProjection
( aliasedJoin
{ aliasedThing =
-- Basically a cast, to ensure that SQL Server won't
-- double-encode the JSON but will "pass it through"
-- untouched.
JsonQueryExpression
( ColumnExpression
( joinAliasToField
( joinJoinAlias ( aliasedThing aliasedJoin ) )
2021-09-24 01:56:37 +03:00
)
2021-12-02 17:21:42 +03:00
)
}
2021-09-24 01:56:37 +03:00
)
2021-02-23 20:37:27 +03:00
joinAliasToField :: JoinAlias -> FieldName
joinAliasToField JoinAlias { .. } =
FieldName
2021-09-24 01:56:37 +03:00
{ fieldNameEntity = joinAliasEntity ,
fieldName = fromMaybe ( error " TODO: Eliminate this case. joinAliasToField " ) joinAliasField
2021-02-23 20:37:27 +03:00
}
fieldSourceJoin :: FieldSource -> Maybe Join
fieldSourceJoin =
\ case
JoinFieldSource aliasedJoin -> pure ( aliasedThing aliasedJoin )
2021-09-24 01:56:37 +03:00
ExpressionFieldSource { } -> Nothing
2021-02-23 20:37:27 +03:00
--------------------------------------------------------------------------------
-- Joins
fromObjectRelationSelectG ::
2022-01-19 11:37:50 +03:00
Map TableName EntityAlias ->
2021-12-07 16:12:02 +03:00
IR . ObjectRelationSelectG 'MSSQL Void Expression ->
2021-09-24 01:56:37 +03:00
ReaderT EntityAlias FromIr Join
2021-02-23 20:37:27 +03:00
fromObjectRelationSelectG existingJoins annRelationSelectG = do
eitherAliasOrFrom <- lift ( lookupTableFrom existingJoins tableFrom )
let entityAlias :: EntityAlias = either id fromAlias eitherAliasOrFrom
fieldSources <-
local
( const entityAlias )
( traverse ( fromAnnFieldsG mempty LeaveNumbersAlone ) fields )
2021-12-02 17:21:42 +03:00
let selectProjections = map fieldSourceProjections fieldSources
2021-02-23 20:37:27 +03:00
joinJoinAlias <-
2021-09-24 01:56:37 +03:00
do
fieldName <- lift ( fromRelName aarRelationshipName )
alias <- lift ( generateAlias ( ObjectRelationTemplate fieldName ) )
pure
JoinAlias
{ joinAliasEntity = alias ,
joinAliasField = pure jsonFieldName
}
2021-02-23 20:37:27 +03:00
let selectFor =
JsonFor ForJson { jsonCardinality = JsonSingleton , jsonRoot = NoRoot }
2021-09-20 13:26:21 +03:00
filterExpression <- local ( const entityAlias ) ( fromGBoolExp tableFilter )
2021-02-23 20:37:27 +03:00
case eitherAliasOrFrom of
Right selectFrom -> do
foreignKeyConditions <- fromMapping selectFrom mapping
pure
Join
2021-09-24 01:56:37 +03:00
{ joinJoinAlias ,
joinSource =
2021-02-23 20:37:27 +03:00
JoinSelect
2021-10-01 15:52:19 +03:00
emptySelect
2021-09-24 01:56:37 +03:00
{ selectOrderBy = Nothing ,
selectTop = NoTop ,
selectProjections ,
selectFrom = Just selectFrom ,
selectJoins = mapMaybe fieldSourceJoin fieldSources ,
selectWhere =
Where ( foreignKeyConditions <> [ filterExpression ] ) ,
selectFor ,
selectOffset = Nothing
2021-02-23 20:37:27 +03:00
}
}
Left _entityAlias ->
pure
Join
2021-09-24 01:56:37 +03:00
{ joinJoinAlias ,
joinSource =
2021-02-23 20:37:27 +03:00
JoinReselect
Reselect
2021-09-24 01:56:37 +03:00
{ reselectProjections = selectProjections ,
reselectFor = selectFor ,
reselectWhere = Where [ filterExpression ]
2021-02-23 20:37:27 +03:00
}
}
where
2021-09-24 01:56:37 +03:00
IR . AnnObjectSelectG
2021-12-07 16:12:02 +03:00
{ _aosFields = fields :: IR . AnnFieldsG 'MSSQL Void Expression ,
2022-01-19 11:37:50 +03:00
_aosTableFrom = tableFrom :: TableName ,
2021-09-24 01:56:37 +03:00
_aosTableFilter = tableFilter :: IR . AnnBoolExp 'MSSQL Expression
} = annObjectSelectG
IR . AnnRelationSelectG
{ aarRelationshipName ,
2022-01-19 11:37:50 +03:00
aarColumnMapping = mapping :: HashMap ColumnName ColumnName ,
2021-12-07 16:12:02 +03:00
aarAnnSelect = annObjectSelectG :: IR . AnnObjectSelectG 'MSSQL Void Expression
2021-09-24 01:56:37 +03:00
} = annRelationSelectG
2021-02-23 20:37:27 +03:00
lookupTableFrom ::
2022-01-19 11:37:50 +03:00
Map TableName EntityAlias ->
TableName ->
2021-09-24 01:56:37 +03:00
FromIr ( Either EntityAlias From )
2021-02-23 20:37:27 +03:00
lookupTableFrom existingJoins tableFrom = do
case M . lookup tableFrom existingJoins of
Just entityAlias -> pure ( Left entityAlias )
2021-09-24 01:56:37 +03:00
Nothing -> fmap Right ( fromQualifiedTable tableFrom )
2021-02-23 20:37:27 +03:00
2021-12-07 16:12:02 +03:00
fromArraySelectG :: IR . ArraySelectG 'MSSQL Void Expression -> ReaderT EntityAlias FromIr Join
2021-02-23 20:37:27 +03:00
fromArraySelectG =
\ case
IR . ASSimple arrayRelationSelectG ->
fromArrayRelationSelectG arrayRelationSelectG
IR . ASAggregate arrayAggregateSelectG ->
fromArrayAggregateSelectG arrayAggregateSelectG
2021-09-24 01:56:37 +03:00
fromArrayAggregateSelectG ::
2021-12-07 16:12:02 +03:00
IR . AnnRelationSelectG 'MSSQL ( IR . AnnAggregateSelectG 'MSSQL Void Expression ) ->
2021-09-24 01:56:37 +03:00
ReaderT EntityAlias FromIr Join
2021-02-23 20:37:27 +03:00
fromArrayAggregateSelectG annRelationSelectG = do
fieldName <- lift ( fromRelName aarRelationshipName )
2021-07-08 23:49:10 +03:00
joinSelect <- do
lhsEntityAlias <- ask
-- With this, the foreign key relations are injected automatically
-- at the right place by fromSelectAggregate.
lift ( fromSelectAggregate ( pure ( lhsEntityAlias , mapping ) ) annSelectG )
2021-09-20 13:26:21 +03:00
alias <- lift ( generateAlias ( ArrayAggregateTemplate fieldName ) )
2021-02-23 20:37:27 +03:00
pure
Join
{ joinJoinAlias =
JoinAlias
2021-09-24 01:56:37 +03:00
{ joinAliasEntity = alias ,
joinAliasField = pure jsonFieldName
} ,
joinSource = JoinSelect joinSelect
2021-02-23 20:37:27 +03:00
}
where
2021-09-24 01:56:37 +03:00
IR . AnnRelationSelectG
{ aarRelationshipName ,
aarColumnMapping = mapping :: HashMap ColumnName ColumnName ,
aarAnnSelect = annSelectG
} = annRelationSelectG
2021-02-23 20:37:27 +03:00
2021-12-07 16:12:02 +03:00
fromArrayRelationSelectG :: IR . ArrayRelationSelectG 'MSSQL Void Expression -> ReaderT EntityAlias FromIr Join
2021-02-23 20:37:27 +03:00
fromArrayRelationSelectG annRelationSelectG = do
fieldName <- lift ( fromRelName aarRelationshipName )
2021-06-08 06:50:24 +03:00
sel <- lift ( fromSelectRows annSelectG )
2021-02-23 20:37:27 +03:00
joinSelect <-
2021-09-24 01:56:37 +03:00
do
foreignKeyConditions <- selectFromMapping sel mapping
pure
sel { selectWhere = Where foreignKeyConditions <> selectWhere sel }
2021-09-20 13:26:21 +03:00
alias <- lift ( generateAlias ( ArrayRelationTemplate fieldName ) )
2021-02-23 20:37:27 +03:00
pure
Join
{ joinJoinAlias =
JoinAlias
2021-09-24 01:56:37 +03:00
{ joinAliasEntity = alias ,
joinAliasField = pure jsonFieldName
} ,
joinSource = JoinSelect joinSelect
2021-02-23 20:37:27 +03:00
}
where
2021-09-24 01:56:37 +03:00
IR . AnnRelationSelectG
{ aarRelationshipName ,
2022-01-19 11:37:50 +03:00
aarColumnMapping = mapping :: HashMap ColumnName ColumnName ,
2021-09-24 01:56:37 +03:00
aarAnnSelect = annSelectG
} = annRelationSelectG
2021-02-23 20:37:27 +03:00
fromRelName :: IR . RelName -> FromIr Text
fromRelName relName =
pure ( IR . relNameToTxt relName )
-- | The context given by the reader is of the previous/parent
-- "remote" table. The WHERE that we're generating goes in the child,
-- "local" query. The @From@ passed in as argument is the local table.
--
-- We should hope to see e.g. "post.category = category.id" for a
-- local table of post and a remote table of category.
--
2022-01-19 11:37:50 +03:00
-- The left/right columns in @HashMap ColumnName ColumnName@ corresponds
2021-02-23 20:37:27 +03:00
-- to the left/right of @select ... join ...@. Therefore left=remote,
-- right=local in this context.
fromMapping ::
2021-09-24 01:56:37 +03:00
From ->
2022-01-19 11:37:50 +03:00
HashMap ColumnName ColumnName ->
2021-09-24 01:56:37 +03:00
ReaderT EntityAlias FromIr [ Expression ]
2021-02-23 20:37:27 +03:00
fromMapping localFrom =
traverse
2022-01-19 11:37:50 +03:00
( \ ( remoteColumn , localColumn ) -> do
localFieldName <- local ( const ( fromAlias localFrom ) ) ( fromColumn localColumn )
remoteFieldName <- fromColumn remoteColumn
2021-09-24 01:56:37 +03:00
pure
( OpExpression
TSQL . EQ'
( ColumnExpression localFieldName )
( ColumnExpression remoteFieldName )
)
)
. HM . toList
selectFromMapping ::
Select ->
HashMap ColumnName ColumnName ->
ReaderT EntityAlias FromIr [ Expression ]
selectFromMapping Select { selectFrom = Nothing } = const ( pure [] )
2021-06-08 06:50:24 +03:00
selectFromMapping Select { selectFrom = Just from } = fromMapping from
2021-02-23 20:37:27 +03:00
--------------------------------------------------------------------------------
-- Basic SQL expression types
fromOpExpG :: Expression -> IR . OpExpG 'MSSQL Expression -> FromIr Expression
fromOpExpG expression op =
case op of
2021-09-24 01:56:37 +03:00
IR . ANISNULL -> pure $ TSQL . IsNullExpression expression
IR . ANISNOTNULL -> pure $ TSQL . IsNotNullExpression expression
IR . AEQ False val -> pure $ nullableBoolEquality expression val
IR . AEQ True val -> pure $ OpExpression TSQL . EQ' expression val
IR . ANE False val -> pure $ nullableBoolInequality expression val
IR . ANE True val -> pure $ OpExpression TSQL . NEQ' expression val
IR . AGT val -> pure $ OpExpression TSQL . GT expression val
IR . ALT val -> pure $ OpExpression TSQL . LT expression val
IR . AGTE val -> pure $ OpExpression TSQL . GTE expression val
IR . ALTE val -> pure $ OpExpression TSQL . LTE expression val
IR . AIN val -> pure $ OpExpression TSQL . IN expression val
IR . ANIN val -> pure $ OpExpression TSQL . NIN expression val
IR . ALIKE val -> pure $ OpExpression TSQL . LIKE expression val
IR . ANLIKE val -> pure $ OpExpression TSQL . NLIKE expression val
2021-03-25 20:50:08 +03:00
IR . ABackendSpecific o -> case o of
2021-09-24 01:56:37 +03:00
ASTContains val -> pure $ TSQL . STOpExpression TSQL . STContains expression val
ASTCrosses val -> pure $ TSQL . STOpExpression TSQL . STCrosses expression val
ASTEquals val -> pure $ TSQL . STOpExpression TSQL . STEquals expression val
2021-03-25 20:50:08 +03:00
ASTIntersects val -> pure $ TSQL . STOpExpression TSQL . STIntersects expression val
2021-09-24 01:56:37 +03:00
ASTOverlaps val -> pure $ TSQL . STOpExpression TSQL . STOverlaps expression val
ASTTouches val -> pure $ TSQL . STOpExpression TSQL . STTouches expression val
ASTWithin val -> pure $ TSQL . STOpExpression TSQL . STWithin expression val
2021-03-25 20:50:08 +03:00
-- As of March 2021, only geometry/geography casts are supported
2021-09-24 01:56:37 +03:00
IR . ACast _casts -> refute ( pure ( UnsupportedOpExpG op ) ) -- mkCastsExp casts
2021-03-25 20:50:08 +03:00
-- We do not yet support column names in permissions
2021-09-24 01:56:37 +03:00
IR . CEQ _rhsCol -> refute ( pure ( UnsupportedOpExpG op ) ) -- S.BECompare S.SEQ lhs $ mkQCol rhsCol
IR . CNE _rhsCol -> refute ( pure ( UnsupportedOpExpG op ) ) -- S.BECompare S.SNE lhs $ mkQCol rhsCol
IR . CGT _rhsCol -> refute ( pure ( UnsupportedOpExpG op ) ) -- S.BECompare S.SGT lhs $ mkQCol rhsCol
IR . CLT _rhsCol -> refute ( pure ( UnsupportedOpExpG op ) ) -- S.BECompare S.SLT lhs $ mkQCol rhsCol
IR . CGTE _rhsCol -> refute ( pure ( UnsupportedOpExpG op ) ) -- S.BECompare S.SGTE lhs $ mkQCol rhsCol
IR . CLTE _rhsCol -> refute ( pure ( UnsupportedOpExpG op ) ) -- S.BECompare S.SLTE lhs $ mkQCol rhsCol
2021-02-23 20:37:27 +03:00
nullableBoolEquality :: Expression -> Expression -> Expression
nullableBoolEquality x y =
OrExpression
2021-09-24 01:56:37 +03:00
[ OpExpression TSQL . EQ' x y ,
AndExpression [ IsNullExpression x , IsNullExpression y ]
2021-02-23 20:37:27 +03:00
]
nullableBoolInequality :: Expression -> Expression -> Expression
nullableBoolInequality x y =
OrExpression
2021-09-24 01:56:37 +03:00
[ OpExpression TSQL . NEQ' x y ,
AndExpression [ IsNotNullExpression x , IsNullExpression y ]
2021-02-23 20:37:27 +03:00
]
2021-09-20 13:26:21 +03:00
-- | Translate a 'GBoolExp' of a 'AnnBoolExpFld', within an 'EntityAlias' context.
--
-- It is mutually recursive with 'fromAnnBoolExpFld' and 'fromGExists'.
fromGBoolExp ::
2021-09-24 01:56:37 +03:00
IR . GBoolExp 'MSSQL ( IR . AnnBoolExpFld 'MSSQL Expression ) ->
ReaderT EntityAlias FromIr Expression
2021-02-23 20:37:27 +03:00
fromGBoolExp =
\ case
IR . BoolAnd expressions ->
fmap AndExpression ( traverse fromGBoolExp expressions )
IR . BoolOr expressions ->
fmap OrExpression ( traverse fromGBoolExp expressions )
2021-09-20 13:26:21 +03:00
IR . BoolNot expression ->
fmap NotExpression ( fromGBoolExp expression )
IR . BoolExists gExists ->
fromGExists gExists
IR . BoolFld expression ->
fromAnnBoolExpFld expression
where
fromGExists :: IR . GExists 'MSSQL ( IR . AnnBoolExpFld 'MSSQL Expression ) -> ReaderT EntityAlias FromIr Expression
fromGExists IR . GExists { _geTable , _geWhere } = do
selectFrom <- lift ( fromQualifiedTable _geTable )
whereExpression <-
local ( const ( fromAlias selectFrom ) ) ( fromGBoolExp _geWhere )
2021-09-24 01:56:37 +03:00
pure $
ExistsExpression $
2021-10-01 15:52:19 +03:00
emptySelect
2021-09-24 01:56:37 +03:00
{ selectOrderBy = Nothing ,
selectProjections =
[ ExpressionProjection
( Aliased
{ aliasedThing = trueExpression ,
aliasedAlias = existsFieldName
}
)
] ,
selectFrom = Just selectFrom ,
selectJoins = mempty ,
selectWhere = Where [ whereExpression ] ,
selectTop = NoTop ,
selectFor = NoFor ,
selectOffset = Nothing
}
2021-02-23 20:37:27 +03:00
2021-10-01 15:52:19 +03:00
--------------------------------------------------------------------------------
-- Insert
2021-12-07 16:12:02 +03:00
fromInsert :: IR . AnnInsert 'MSSQL Void Expression -> Insert
2021-10-01 15:52:19 +03:00
fromInsert IR . AnnInsert { .. } =
let IR . AnnIns { .. } = _aiData
2021-12-31 13:56:06 +03:00
insertRows = normalizeInsertRows ( _biIdentityColumns _aiBackendInsert ) _aiTableCols $ map ( IR . getInsertColumns ) _aiInsObj
2021-10-01 15:52:19 +03:00
insertColumnNames = maybe [] ( map fst ) $ listToMaybe insertRows
insertValues = map ( Values . map snd ) insertRows
2022-01-19 11:37:50 +03:00
allColumnNames = map ( ColumnName . unName . IR . ciName ) _aiTableCols
2021-12-22 14:04:33 +03:00
insertOutput = Output Inserted $ map OutputColumn allColumnNames
tempTable = TempTable tempTableNameInserted allColumnNames
in Insert _aiTableName insertColumnNames insertOutput tempTable insertValues
2021-10-01 15:52:19 +03:00
-- | Normalize a row by adding missing columns with 'DEFAULT' value and sort by column name to make sure
-- all rows are consistent in column values and order.
--
-- Example: A table "author" is defined as
--
-- CREATE TABLE author ([id] INTEGER NOT NULL PRIMARY KEY, name TEXT NOT NULL, age INTEGER)
--
-- Consider the following mutation;
--
-- mutation {
-- insert_author(
-- objects: [{id: 1, name: "Foo", age: 21}, {id: 2, name: "Bar"}]
-- ){
-- affected_rows
-- }
-- }
--
-- We consider 'DEFAULT' value for "age" column which is missing in second insert row. The INSERT statement look like
--
-- INSERT INTO author (id, name, age) OUTPUT INSERTED.id VALUES (1, 'Foo', 21), (2, 'Bar', DEFAULT)
2021-12-31 13:56:06 +03:00
normalizeInsertRows ::
[ ColumnName ] ->
[ IR . ColumnInfo 'MSSQL ] ->
[ [ ( Column 'MSSQL , Expression ) ] ] ->
[ [ ( Column 'MSSQL , Expression ) ] ]
normalizeInsertRows identityColumnNames tableColumns insertRows =
2022-01-19 11:37:50 +03:00
let isIdentityColumn column = IR . ciColumn column ` elem ` identityColumnNames
2021-10-01 15:52:19 +03:00
allColumnsWithDefaultValue =
-- DEFAULT or NULL are not allowed as explicit identity values.
2022-01-19 11:37:50 +03:00
map ( ( , DefaultExpression ) . IR . ciColumn ) $ filter ( not . isIdentityColumn ) tableColumns
2021-10-01 15:52:19 +03:00
addMissingColumns insertRow =
HM . toList $ HM . fromList insertRow ` HM . union ` HM . fromList allColumnsWithDefaultValue
sortByColumn = sortBy ( \ l r -> compare ( fst l ) ( fst r ) )
in map ( sortByColumn . addMissingColumns ) insertRows
2021-12-31 13:56:06 +03:00
-- | Construct a MERGE statement from AnnInsert information.
-- A MERGE statement is responsible for actually inserting and/or updating
-- the data in the table.
toMerge ::
TableName ->
[ IR . AnnotatedInsertRow 'MSSQL Expression ] ->
[ ColumnName ] ->
[ IR . ColumnInfo 'MSSQL ] ->
IfMatched Expression ->
FromIr Merge
toMerge tableName insertRows identityColumnNames tableColumns IfMatched { .. } = do
let normalizedInsertRows =
normalizeInsertRows identityColumnNames tableColumns $
map ( IR . getInsertColumns ) insertRows
insertColumnNames = maybe [] ( map fst ) $ listToMaybe normalizedInsertRows
2022-01-19 11:37:50 +03:00
allColumnNames = map ( ColumnName . unName . IR . ciName ) tableColumns
2021-12-31 13:56:06 +03:00
matchConditions <-
flip runReaderT ( EntityAlias " target " ) $ -- the table is aliased as "target" in MERGE sql
fromGBoolExp _imConditions
pure $
Merge
{ mergeTargetTable = tableName ,
mergeUsing = MergeUsing tempTableNameValues allColumnNames ,
mergeOn = MergeOn _imMatchColumns ,
mergeWhenMatched = MergeWhenMatched _imUpdateColumns matchConditions _imColumnPresets ,
mergeWhenNotMatched = MergeWhenNotMatched insertColumnNames ,
mergeInsertOutput = Output Inserted $ map OutputColumn allColumnNames ,
mergeOutputTempTable = TempTable tempTableNameInserted allColumnNames
}
-- | As part of an INSERT/UPSERT process, insert VALUES into a temporary table.
-- The content of the temporary table will later be inserted into the original table
-- using a MERGE statement.
--
-- We insert the values into a temporary table first in order to replace the missing
-- fields with @DEFAULT@ in @normalizeInsertRows@, and we can't do that in a
-- MERGE statement directly.
toInsertValuesIntoTempTable :: TempTableName -> IR . AnnInsert 'MSSQL Void Expression -> InsertValuesIntoTempTable
toInsertValuesIntoTempTable tempTable IR . AnnInsert { .. } =
let IR . AnnIns { .. } = _aiData
insertRows = normalizeInsertRows ( _biIdentityColumns _aiBackendInsert ) _aiTableCols $ map IR . getInsertColumns _aiInsObj
insertColumnNames = maybe [] ( map fst ) $ listToMaybe insertRows
insertValues = map ( Values . map snd ) insertRows
in InsertValuesIntoTempTable
{ ivittTempTableName = tempTable ,
ivittColumns = insertColumnNames ,
ivittValues = insertValues
}
2021-02-23 20:37:27 +03:00
--------------------------------------------------------------------------------
-- Delete
2021-11-19 20:05:01 +03:00
-- | Convert IR AST representing delete into MSSQL AST representing a delete statement
2021-02-23 20:37:27 +03:00
fromDelete :: IR . AnnDel 'MSSQL -> FromIr Delete
2021-11-19 20:05:01 +03:00
fromDelete ( IR . AnnDel tableName ( permFilter , whereClause ) _ allColumns ) = do
2021-02-23 20:37:27 +03:00
tableAlias <- fromTableName tableName
runReaderT
2021-09-24 01:56:37 +03:00
( do
permissionsFilter <- fromGBoolExp permFilter
2021-09-20 13:26:21 +03:00
whereExpression <- fromGBoolExp whereClause
2022-01-19 11:37:50 +03:00
let columnNames = map ( ColumnName . unName . IR . ciName ) allColumns
2021-02-23 20:37:27 +03:00
pure
Delete
{ deleteTable =
Aliased
2021-09-24 01:56:37 +03:00
{ aliasedAlias = entityAliasText tableAlias ,
aliasedThing = tableName
} ,
2021-11-22 12:11:32 +03:00
deleteOutput = Output Deleted ( map OutputColumn columnNames ) ,
deleteTempTable = TempTable tempTableNameDeleted columnNames ,
2021-09-24 01:56:37 +03:00
deleteWhere = Where [ permissionsFilter , whereExpression ]
}
2021-12-15 16:55:41 +03:00
)
tableAlias
-- | Convert IR AST representing update into MSSQL AST representing an update statement
fromUpdate :: IR . AnnotatedUpdate 'MSSQL -> FromIr Update
fromUpdate ( IR . AnnotatedUpdateG tableName ( permFilter , whereClause ) _ backendUpdate _ allColumns ) = do
tableAlias <- fromTableName tableName
runReaderT
( do
permissionsFilter <- fromGBoolExp permFilter
whereExpression <- fromGBoolExp whereClause
2022-01-19 11:37:50 +03:00
let columnNames = map ( ColumnName . unName . IR . ciName ) allColumns
2021-12-15 16:55:41 +03:00
pure
Update
{ updateTable =
Aliased
{ aliasedAlias = entityAliasText tableAlias ,
aliasedThing = tableName
} ,
updateSet = updateOperations backendUpdate ,
updateOutput = Output Inserted ( map OutputColumn columnNames ) ,
updateTempTable = TempTable tempTableNameUpdated columnNames ,
updateWhere = Where [ permissionsFilter , whereExpression ]
}
2021-09-24 01:56:37 +03:00
)
2021-02-23 20:37:27 +03:00
tableAlias
2021-11-22 12:11:32 +03:00
-- | Create a temporary table with the same schema as the given table.
2021-12-31 13:56:06 +03:00
toSelectIntoTempTable :: TempTableName -> TableName -> [ IR . ColumnInfo 'MSSQL ] -> SITTConstraints -> SelectIntoTempTable
toSelectIntoTempTable tempTableName fromTable allColumns withConstraints = do
2021-11-19 20:05:01 +03:00
SelectIntoTempTable
{ sittTempTableName = tempTableName ,
sittColumns = map columnInfoToUnifiedColumn allColumns ,
2021-12-31 13:56:06 +03:00
sittFromTableName = fromTable ,
sittConstraints = withConstraints
2021-11-19 20:05:01 +03:00
}
-- | Extracts the type and column name of a ColumnInfo
columnInfoToUnifiedColumn :: IR . ColumnInfo 'MSSQL -> UnifiedColumn
columnInfoToUnifiedColumn colInfo =
2022-01-19 11:37:50 +03:00
case IR . ciType colInfo of
2021-11-19 20:05:01 +03:00
IR . ColumnScalar t ->
UnifiedColumn
2022-01-19 11:37:50 +03:00
{ name = unName $ IR . ciName colInfo ,
2021-11-19 20:05:01 +03:00
type' = t
}
-- Enum values are represented as text value so they will always be of type text
IR . ColumnEnumReference { } ->
UnifiedColumn
2022-01-19 11:37:50 +03:00
{ name = unName $ IR . ciName colInfo ,
2021-11-19 20:05:01 +03:00
type' = TextType
}
2021-02-23 20:37:27 +03:00
--------------------------------------------------------------------------------
-- Misc combinators
trueExpression :: Expression
trueExpression = ValueExpression ( ODBC . BoolValue True )
--------------------------------------------------------------------------------
-- Constants
jsonFieldName :: Text
jsonFieldName = " json "
aggFieldName :: Text
aggFieldName = " agg "
2021-07-08 23:49:10 +03:00
aggSubselectName :: Text
aggSubselectName = " agg_sub "
2021-02-23 20:37:27 +03:00
existsFieldName :: Text
existsFieldName = " exists_placeholder "
--------------------------------------------------------------------------------
-- Name generation
data NameTemplate
= ArrayRelationTemplate Text
| ArrayAggregateTemplate Text
| ObjectRelationTemplate Text
| TableTemplate Text
| ForOrderAlias Text
2021-09-20 13:26:21 +03:00
-- | Generate an alias for a given entity to remove ambiguity and naming
-- conflicts between scopes at the TSQL level. Keeps track of the increments for
-- the alias index in the 'StateT'
generateAlias :: NameTemplate -> FromIr Text
generateAlias template = do
2021-02-23 20:37:27 +03:00
FromIr ( modify' ( M . insertWith ( + ) prefix start ) )
i <- FromIr get
pure ( prefix <> tshow ( fromMaybe start ( M . lookup prefix i ) ) )
where
start = 1
prefix = T . take 20 rendered
rendered =
case template of
2021-09-24 01:56:37 +03:00
ArrayRelationTemplate sample -> " ar_ " <> sample
2021-02-23 20:37:27 +03:00
ArrayAggregateTemplate sample -> " aa_ " <> sample
ObjectRelationTemplate sample -> " or_ " <> sample
2021-09-24 01:56:37 +03:00
TableTemplate sample -> " t_ " <> sample
ForOrderAlias sample -> " order_ " <> sample
2021-02-23 20:37:27 +03:00
fromAlias :: From -> EntityAlias
fromAlias ( FromQualifiedTable Aliased { aliasedAlias } ) = EntityAlias aliasedAlias
2021-09-24 01:56:37 +03:00
fromAlias ( FromOpenJson Aliased { aliasedAlias } ) = EntityAlias aliasedAlias
fromAlias ( FromSelect Aliased { aliasedAlias } ) = EntityAlias aliasedAlias
2021-10-01 15:52:19 +03:00
fromAlias ( FromIdentifier identifier ) = EntityAlias identifier
2021-11-19 20:05:01 +03:00
fromAlias ( FromTempTable Aliased { aliasedAlias } ) = EntityAlias aliasedAlias
2021-02-23 20:37:27 +03:00
columnNameToFieldName :: ColumnName -> EntityAlias -> FieldName
columnNameToFieldName ( ColumnName fieldName ) EntityAlias { entityAliasText = fieldNameEntity } =
FieldName { fieldName , fieldNameEntity }