mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-22 23:11:41 +03:00
342391f39d
This upgrades the version of Ormolu required by the HGE repository to v0.5.0.1, and reformats all code accordingly. Ormolu v0.5 reformats code that uses infix operators. This is mostly useful, adding newlines and indentation to make it clear which operators are applied first, but in some cases, it's unpleasant. To make this easier on the eyes, I had to do the following: * Add a few fixity declarations (search for `infix`) * Add parentheses to make precedence clear, allowing Ormolu to keep everything on one line * Rename `relevantEq` to `(==~)` in #6651 and set it to `infix 4` * Add a few _.ormolu_ files (thanks to @hallettj for helping me get started), mostly for Autodocodec operators that don't have explicit fixity declarations In general, I think these changes are quite reasonable. They mostly affect indentation. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6675 GitOrigin-RevId: cd47d87f1d089fb0bc9dcbbe7798dbceedcd7d83
825 lines
27 KiB
Haskell
825 lines
27 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
-- | MSSQL ToQuery
|
|
--
|
|
-- Convert the simple T-SQL AST to an SQL query, ready to be passed to the odbc
|
|
-- package's query/exec functions.
|
|
--
|
|
-- We define a custom prettyprinter with the type 'Printer'.
|
|
--
|
|
-- If you'd like to trace and see what a 'Printer' looks like as SQL, you can use something like:
|
|
-- > ltraceM "sql" (ODBC.renderQuery (toQueryPretty myPrinter))
|
|
module Hasura.Backends.MSSQL.ToQuery
|
|
( fromSelect,
|
|
fromReselect,
|
|
toQueryFlat,
|
|
toQueryPretty,
|
|
fromInsert,
|
|
fromMerge,
|
|
fromSetIdentityInsert,
|
|
fromDelete,
|
|
fromUpdate,
|
|
fromSelectIntoTempTable,
|
|
fromInsertValuesIntoTempTable,
|
|
dropTempTableQuery,
|
|
fromRawUnescapedText,
|
|
fromTableName,
|
|
(<+>),
|
|
Printer (..),
|
|
)
|
|
where
|
|
|
|
import Data.Aeson (ToJSON (..))
|
|
import Data.HashMap.Strict qualified as HM
|
|
import Data.List (intersperse)
|
|
import Data.String
|
|
import Data.Text qualified as T
|
|
import Data.Text.Extended qualified as T
|
|
import Data.Text.Lazy qualified as L
|
|
import Data.Text.Lazy.Builder qualified as L
|
|
import Database.ODBC.SQLServer
|
|
import Hasura.Backends.MSSQL.Types
|
|
import Hasura.Prelude hiding (GT, LT)
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- * Types
|
|
|
|
data Printer
|
|
= SeqPrinter [Printer]
|
|
| SepByPrinter Printer [Printer]
|
|
| NewlinePrinter
|
|
| QueryPrinter Query
|
|
| IndentPrinter Int Printer
|
|
deriving (Show, Eq)
|
|
|
|
instance IsString Printer where
|
|
fromString = QueryPrinter . fromString
|
|
|
|
(<+>) :: Printer -> Printer -> Printer
|
|
(<+>) x y = SeqPrinter [x, y]
|
|
|
|
(<+>?) :: Printer -> Maybe Printer -> Printer
|
|
(<+>?) x Nothing = x
|
|
(<+>?) x (Just y) = SeqPrinter [x, y]
|
|
|
|
(?<+>) :: Maybe Printer -> Printer -> Printer
|
|
(?<+>) Nothing x = x
|
|
(?<+>) (Just x) y = SeqPrinter [x, y]
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- * Instances
|
|
|
|
-- This is a debug instance, only here because it avoids a circular
|
|
-- dependency between this module and Types/Instances.
|
|
instance ToJSON Expression where
|
|
toJSON = toJSON . T.toTxt . toQueryFlat . fromExpression
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- * Printer generators
|
|
|
|
fromExpression :: Expression -> Printer
|
|
fromExpression =
|
|
\case
|
|
CastExpression e t dataLength ->
|
|
"CAST("
|
|
<+> fromExpression e
|
|
<+> " AS "
|
|
<+> fromString (T.unpack $ scalarTypeDBName dataLength t)
|
|
<+> ")"
|
|
JsonQueryExpression e -> "JSON_QUERY(" <+> fromExpression e <+> ")"
|
|
JsonValueExpression e path ->
|
|
"JSON_VALUE(" <+> fromExpression e <+> fromPath path <+> ")"
|
|
ValueExpression value -> QueryPrinter $ toSql value
|
|
AndExpression xs ->
|
|
case xs of
|
|
[] -> truePrinter
|
|
_ ->
|
|
SepByPrinter
|
|
(NewlinePrinter <+> "AND ")
|
|
(fmap (\x -> "(" <+> fromExpression x <+> ")") (toList xs))
|
|
OrExpression xs ->
|
|
case xs of
|
|
[] -> falsePrinter
|
|
_ ->
|
|
SepByPrinter
|
|
(NewlinePrinter <+> "OR ")
|
|
(fmap (\x -> "(" <+> fromExpression x <+> ")") (toList xs))
|
|
NotExpression expression -> "NOT " <+> fromExpression expression
|
|
ExistsExpression sel -> "EXISTS (" <+> fromSelect sel <+> ")"
|
|
IsNullExpression expression ->
|
|
"(" <+> fromExpression expression <+> ") IS NULL"
|
|
IsNotNullExpression expression ->
|
|
"(" <+> fromExpression expression <+> ") IS NOT NULL"
|
|
ColumnExpression fieldName -> fromFieldName fieldName
|
|
ToStringExpression e -> "CONCAT(" <+> fromExpression e <+> ", '')"
|
|
SelectExpression s -> "(" <+> IndentPrinter 1 (fromSelect s) <+> ")"
|
|
OpExpression op x y ->
|
|
"("
|
|
<+> fromExpression x
|
|
<+> ") "
|
|
<+> fromOp op
|
|
<+> " ("
|
|
<+> fromExpression y
|
|
<+> ")"
|
|
MethodApplicationExpression ex methodAppExp -> fromMethodApplicationExpression ex methodAppExp
|
|
FunctionApplicationExpression funAppExp -> fromFunctionApplicationExpression funAppExp
|
|
ListExpression xs -> SepByPrinter ", " $ fromExpression <$> xs
|
|
STOpExpression op e str ->
|
|
"("
|
|
<+> fromExpression e
|
|
<+> ")."
|
|
<+> fromString (show op)
|
|
<+> "("
|
|
<+> fromExpression str
|
|
<+> ") = 1"
|
|
ConditionalExpression condition trueExpression falseExpression ->
|
|
"(CASE WHEN("
|
|
<+> fromExpression condition
|
|
<+> ") THEN "
|
|
<+> fromExpression trueExpression
|
|
<+> " ELSE "
|
|
<+> fromExpression falseExpression
|
|
<+> " END)"
|
|
DefaultExpression -> "DEFAULT"
|
|
|
|
fromMethodApplicationExpression :: Expression -> MethodApplicationExpression -> Printer
|
|
fromMethodApplicationExpression ex methodAppExp =
|
|
case methodAppExp of
|
|
MethExpSTAsText -> fromApp "STAsText" []
|
|
where
|
|
fromApp :: Text -> [Expression] -> Printer
|
|
fromApp method args =
|
|
fromExpression ex
|
|
<+> "."
|
|
<+> fromString (T.unpack method)
|
|
<+> "("
|
|
<+> SeqPrinter (map fromExpression args)
|
|
<+> ")"
|
|
|
|
fromFunctionApplicationExpression :: FunctionApplicationExpression -> Printer
|
|
fromFunctionApplicationExpression funAppExp = case funAppExp of
|
|
(FunExpISNULL x y) -> fromApp "ISNULL" [x, y]
|
|
where
|
|
fromApp :: Text -> [Expression] -> Printer
|
|
fromApp function args =
|
|
fromString (T.unpack function)
|
|
<+> "("
|
|
<+> SepByPrinter ", " (map fromExpression args)
|
|
<+> ")"
|
|
|
|
fromOp :: Op -> Printer
|
|
fromOp =
|
|
\case
|
|
LT -> "<"
|
|
GT -> ">"
|
|
GTE -> ">="
|
|
LTE -> "<="
|
|
IN -> "IN"
|
|
NIN -> "NOT IN"
|
|
LIKE -> "LIKE"
|
|
NLIKE -> "NOT LIKE"
|
|
EQ' -> "="
|
|
NEQ' -> "!="
|
|
|
|
fromPath :: JsonPath -> Printer
|
|
fromPath path =
|
|
", " <+> string path
|
|
where
|
|
string =
|
|
fromExpression
|
|
. ValueExpression
|
|
. TextValue
|
|
. L.toStrict
|
|
. L.toLazyText
|
|
. go
|
|
go =
|
|
\case
|
|
RootPath -> "$"
|
|
IndexPath r i -> go r <> "[" <> L.fromString (show i) <> "]"
|
|
FieldPath r f -> go r <> ".\"" <> L.fromText f <> "\""
|
|
|
|
fromFieldName :: FieldName -> Printer
|
|
fromFieldName (FieldName {..}) =
|
|
fromNameText fieldNameEntity <+> "." <+> fromNameText fieldName
|
|
|
|
fromInserted :: Inserted -> Printer
|
|
fromInserted Inserted = "INSERTED"
|
|
|
|
fromDeleted :: Deleted -> Printer
|
|
fromDeleted Deleted = "DELETED"
|
|
|
|
fromOutputColumn :: Printer -> OutputColumn -> Printer
|
|
fromOutputColumn prefix (OutputColumn columnName) =
|
|
prefix <+> "." <+> fromNameText (columnNameText columnName)
|
|
|
|
fromOutput :: (t -> Printer) -> Output t -> Printer
|
|
fromOutput typePrinter (Output ty outputColumns) =
|
|
"OUTPUT " <+> SepByPrinter ", " (map (fromOutputColumn (typePrinter ty)) outputColumns)
|
|
|
|
fromInsertOutput :: InsertOutput -> Printer
|
|
fromInsertOutput = fromOutput fromInserted
|
|
|
|
fromDeleteOutput :: DeleteOutput -> Printer
|
|
fromDeleteOutput = fromOutput fromDeleted
|
|
|
|
fromUpdateOutput :: UpdateOutput -> Printer
|
|
fromUpdateOutput = fromOutput fromInserted
|
|
|
|
fromValues :: Values -> Printer
|
|
fromValues (Values values) =
|
|
"( " <+> SepByPrinter ", " (map fromExpression values) <+> " )"
|
|
|
|
fromValuesList :: [Values] -> Printer
|
|
fromValuesList valuesList =
|
|
"VALUES " <+> SepByPrinter ", " (map fromValues valuesList)
|
|
|
|
fromInsert :: Insert -> Printer
|
|
fromInsert Insert {..} =
|
|
SepByPrinter
|
|
NewlinePrinter
|
|
$ ["INSERT INTO " <+> fromTableName insertTable]
|
|
<> [ "(" <+> SepByPrinter ", " (map (fromNameText . columnNameText) insertColumns) <+> ")"
|
|
| not (null insertColumns)
|
|
]
|
|
<> [ fromInsertOutput insertOutput,
|
|
"INTO " <+> fromTempTable insertTempTable,
|
|
if null insertColumns
|
|
then "VALUES " <+> SepByPrinter ", " (map (const "(DEFAULT)") insertValues)
|
|
else fromValuesList insertValues
|
|
]
|
|
|
|
fromSetValue :: SetValue -> Printer
|
|
fromSetValue = \case
|
|
SetON -> "ON"
|
|
SetOFF -> "OFF"
|
|
|
|
fromSetIdentityInsert :: SetIdentityInsert -> Printer
|
|
fromSetIdentityInsert SetIdentityInsert {..} =
|
|
SepByPrinter
|
|
" "
|
|
[ "SET IDENTITY_INSERT",
|
|
tableName,
|
|
fromSetValue setValue
|
|
]
|
|
where
|
|
tableName =
|
|
case setTable of
|
|
RegularTableName name -> fromTableName name
|
|
TemporaryTableName name -> fromTempTableName name
|
|
|
|
-- | Generate a statement to insert values into temporary table.
|
|
fromInsertValuesIntoTempTable :: InsertValuesIntoTempTable -> Printer
|
|
fromInsertValuesIntoTempTable InsertValuesIntoTempTable {..} =
|
|
SepByPrinter
|
|
NewlinePrinter
|
|
[ "INSERT INTO " <+> fromTempTableName ivittTempTableName,
|
|
"(" <+> SepByPrinter ", " (map (fromNameText . columnNameText) ivittColumns) <+> ")",
|
|
fromValuesList ivittValues
|
|
]
|
|
|
|
-- | Alias for the source table in a MERGE statement. Used when pretty printing MERGE statments.
|
|
mergeSourceAlias :: Text
|
|
mergeSourceAlias = "source"
|
|
|
|
-- | Alias for the target table in a MERGE statement. Used when pretty printing MERGE statments.
|
|
mergeTargetAlias :: Text
|
|
mergeTargetAlias = "target"
|
|
|
|
-- | USING section of a MERGE statement. Used in 'fromMerge'.
|
|
fromMergeUsing :: MergeUsing -> Printer
|
|
fromMergeUsing MergeUsing {..} =
|
|
"USING (" <+> fromSelect selectSubQuery <+> ") AS " <+> fromNameText mergeSourceAlias
|
|
where
|
|
selectSubQuery :: Select
|
|
selectSubQuery =
|
|
let alias = "merge_temptable"
|
|
columnNameToProjection ColumnName {columnNameText} =
|
|
-- merge_temptable.column_name AS column_name
|
|
FieldNameProjection $
|
|
Aliased
|
|
{ aliasedThing = FieldName columnNameText alias,
|
|
aliasedAlias = columnNameText
|
|
}
|
|
in emptySelect
|
|
{ selectProjections = map columnNameToProjection mergeUsingColumns,
|
|
selectFrom = Just (FromTempTable $ Aliased mergeUsingTempTable alias) -- FROM temp_table AS merge_temptable
|
|
}
|
|
|
|
-- | ON section of a MERGE statement. Used in 'fromMerge'.
|
|
fromMergeOn :: MergeOn -> Printer
|
|
fromMergeOn MergeOn {..} =
|
|
"ON (" <+> onExpression <+> ")"
|
|
where
|
|
onExpression
|
|
| null mergeOnColumns =
|
|
falsePrinter
|
|
| otherwise =
|
|
(fromExpression . AndExpression) (map matchColumn mergeOnColumns)
|
|
|
|
matchColumn :: ColumnName -> Expression
|
|
matchColumn ColumnName {..} =
|
|
let sourceColumn = ColumnExpression $ FieldName columnNameText mergeSourceAlias
|
|
targetColumn = ColumnExpression $ FieldName columnNameText mergeTargetAlias
|
|
in OpExpression EQ' sourceColumn targetColumn
|
|
|
|
-- | WHEN MATCHED section of a MERGE statement. Used in 'fromMerge'.
|
|
fromMergeWhenMatched :: MergeWhenMatched -> Printer
|
|
fromMergeWhenMatched (MergeWhenMatched updateColumns updateCondition updatePreset) =
|
|
if null updates
|
|
then ""
|
|
else
|
|
"WHEN MATCHED AND "
|
|
<+> fromExpression updateCondition
|
|
<+> " THEN UPDATE "
|
|
<+> fromUpdateSet updates
|
|
where
|
|
updates = updateSet <> HM.map UpdateSet updatePreset
|
|
|
|
updateSet :: UpdateSet
|
|
updateSet =
|
|
HM.fromList $
|
|
map
|
|
( \cn@ColumnName {..} ->
|
|
( cn,
|
|
UpdateSet $ ColumnExpression $ FieldName columnNameText mergeSourceAlias
|
|
)
|
|
)
|
|
updateColumns
|
|
|
|
-- | WHEN NOT MATCHED section of a MERGE statement. Used in 'fromMerge'.
|
|
fromMergeWhenNotMatched :: MergeWhenNotMatched -> Printer
|
|
fromMergeWhenNotMatched (MergeWhenNotMatched insertColumns) =
|
|
SepByPrinter
|
|
NewlinePrinter
|
|
[ "WHEN NOT MATCHED THEN INSERT (" <+> SepByPrinter ", " (map fromColumnName insertColumns) <+> ")",
|
|
fromValuesList [Values columnsFromSource]
|
|
]
|
|
where
|
|
columnsFromSource =
|
|
insertColumns <&> \ColumnName {..} -> ColumnExpression $ FieldName columnNameText mergeSourceAlias
|
|
|
|
-- | Generate a MERGE SQL statement
|
|
fromMerge :: Merge -> Printer
|
|
fromMerge Merge {..} =
|
|
SepByPrinter
|
|
NewlinePrinter
|
|
[ "MERGE " <+> fromAliased (fmap fromTableName mergeTableAsTarget),
|
|
fromMergeUsing mergeUsing,
|
|
fromMergeOn mergeOn,
|
|
fromMergeWhenMatched mergeWhenMatched,
|
|
fromMergeWhenNotMatched mergeWhenNotMatched,
|
|
fromInsertOutput mergeInsertOutput,
|
|
"INTO " <+> fromTempTable mergeOutputTempTable,
|
|
";" -- Always, a Merge statement should end with a ";"
|
|
]
|
|
where
|
|
mergeTableAsTarget :: Aliased TableName
|
|
mergeTableAsTarget = Aliased mergeTargetTable mergeTargetAlias
|
|
|
|
-- | Generate a delete statement
|
|
--
|
|
-- > Delete
|
|
-- > (Aliased (TableName "table" "schema") "alias")
|
|
-- > [ColumnName "id", ColumnName "name"]
|
|
-- > (Where [OpExpression EQ' (ValueExpression (IntValue 1)) (ValueExpression (IntValue 1))])
|
|
--
|
|
-- Becomes:
|
|
--
|
|
-- > DELETE [alias] OUTPUT DELETED.[id], DELETED.[name] INTO #deleted([id], [name]) FROM [schema].[table] AS [alias] WHERE ((1) = (1))
|
|
fromDelete :: Delete -> Printer
|
|
fromDelete Delete {deleteTable, deleteOutput, deleteTempTable, deleteWhere} =
|
|
SepByPrinter
|
|
NewlinePrinter
|
|
[ "DELETE " <+> fromNameText (aliasedAlias deleteTable),
|
|
fromDeleteOutput deleteOutput,
|
|
"INTO " <+> fromTempTable deleteTempTable,
|
|
"FROM " <+> fromAliased (fmap fromTableName deleteTable),
|
|
fromWhere deleteWhere
|
|
]
|
|
|
|
-- | Generate an update statement
|
|
--
|
|
-- > Update
|
|
-- > (Aliased (TableName "table" "schema") "alias")
|
|
-- > (fromList [(ColumnName "name", ValueExpression (TextValue "updated_name"))])
|
|
-- > (Output Inserted)
|
|
-- > (TempTable (TempTableName "updated") [ColumnName "id", ColumnName "name"])
|
|
-- > (Where [OpExpression EQ' (ColumnName "id") (ValueExpression (IntValue 1))])
|
|
--
|
|
-- Becomes:
|
|
--
|
|
-- > UPDATE [alias] SET [alias].[name] = 'updated_name' OUTPUT INSERTED.[id], INSERTED.[name] INTO
|
|
-- > #updated([id], [name]) FROM [schema].[table] AS [alias] WHERE (id = 1)
|
|
fromUpdate :: Update -> Printer
|
|
fromUpdate Update {..} =
|
|
SepByPrinter
|
|
NewlinePrinter
|
|
[ "UPDATE " <+> fromNameText (aliasedAlias updateTable),
|
|
fromUpdateSet updateSet,
|
|
fromUpdateOutput updateOutput,
|
|
"INTO " <+> fromTempTable updateTempTable,
|
|
"FROM " <+> fromAliased (fmap fromTableName updateTable),
|
|
fromWhere updateWhere
|
|
]
|
|
|
|
fromUpdateSet :: UpdateSet -> Printer
|
|
fromUpdateSet setColumns =
|
|
let updateColumnValue (column, updateOp) =
|
|
fromColumnName column <+> fromUpdateOperator (fromExpression <$> updateOp)
|
|
in "SET " <+> SepByPrinter ", " (map updateColumnValue (HM.toList setColumns))
|
|
where
|
|
fromUpdateOperator :: UpdateOperator Printer -> Printer
|
|
fromUpdateOperator = \case
|
|
UpdateSet p -> " = " <+> p
|
|
UpdateInc p -> " += " <+> p
|
|
|
|
-- | Converts `SelectIntoTempTable`.
|
|
--
|
|
-- > SelectIntoTempTable (TempTableName "deleted") [UnifiedColumn "id" IntegerType, UnifiedColumn "name" TextType] (TableName "table" "schema")
|
|
--
|
|
-- Becomes:
|
|
--
|
|
-- > SELECT [id], [name] INTO #deleted([id], [name]) FROM [schema].[table] WHERE (1<>1) UNION ALL SELECT [id], [name] FROM [schema].[table];
|
|
--
|
|
-- We add the `UNION ALL` part to avoid copying identity constraints, and we cast columns with types such as `timestamp`
|
|
-- which are non-insertable to a different type.
|
|
fromSelectIntoTempTable :: SelectIntoTempTable -> Printer
|
|
fromSelectIntoTempTable SelectIntoTempTable {sittTempTableName, sittColumns, sittFromTableName, sittConstraints} =
|
|
SepByPrinter
|
|
NewlinePrinter
|
|
$ [ "SELECT "
|
|
<+> columns,
|
|
"INTO " <+> fromTempTableName sittTempTableName,
|
|
"FROM " <+> fromTableName sittFromTableName,
|
|
"WHERE " <+> falsePrinter
|
|
]
|
|
<> case sittConstraints of
|
|
RemoveConstraints ->
|
|
[ "UNION ALL SELECT " <+> columns,
|
|
"FROM " <+> fromTableName sittFromTableName,
|
|
"WHERE " <+> falsePrinter
|
|
]
|
|
KeepConstraints ->
|
|
[]
|
|
where
|
|
-- column names separated by commas
|
|
columns =
|
|
SepByPrinter
|
|
("," <+> NewlinePrinter)
|
|
(map columnNameFromUnifiedColumn sittColumns)
|
|
|
|
-- column name with potential modifications of types
|
|
columnNameFromUnifiedColumn (UnifiedColumn columnName columnType) =
|
|
case columnType of
|
|
-- The "timestamp" is type synonym for "rowversion" and it is just an incrementing number and does not preserve a date or a time.
|
|
-- So, the "timestamp" type is neither insertable nor explicitly updatable. Its values are unique binary numbers within a database.
|
|
-- We're using "binary" type instead so that we can copy a timestamp row value safely into the temporary table.
|
|
-- See https://docs.microsoft.com/en-us/sql/t-sql/data-types/rowversion-transact-sql for more details.
|
|
TimestampType -> "CAST(" <+> fromColumnName columnName <+> " AS binary(8)) AS " <+> fromColumnName columnName
|
|
_ -> fromColumnName columnName
|
|
|
|
-- | @TempTableName "deleted"@ becomes @\#deleted@
|
|
fromTempTableName :: TempTableName -> Printer
|
|
fromTempTableName (TempTableName v) = QueryPrinter (fromString . T.unpack $ "#" <> v)
|
|
|
|
fromTempTable :: TempTable -> Printer
|
|
fromTempTable (TempTable table columns) =
|
|
fromTempTableName table <+> parens (SepByPrinter ", " (map fromColumnName columns))
|
|
|
|
-- | @TempTableName "temp_table" is converted to "DROP TABLE #temp_table"
|
|
dropTempTableQuery :: TempTableName -> Printer
|
|
dropTempTableQuery tempTableName =
|
|
QueryPrinter "DROP TABLE " <+> fromTempTableName tempTableName
|
|
|
|
fromSelect :: Select -> Printer
|
|
fromSelect Select {..} = fmap fromWith selectWith ?<+> result
|
|
where
|
|
result =
|
|
SepByPrinter
|
|
NewlinePrinter
|
|
$ [ "SELECT "
|
|
<+> IndentPrinter
|
|
7
|
|
( SepByPrinter
|
|
("," <+> NewlinePrinter)
|
|
(map fromProjection (toList selectProjections))
|
|
)
|
|
]
|
|
<> ["FROM " <+> IndentPrinter 5 (fromFrom f) | Just f <- [selectFrom]]
|
|
<> [ SepByPrinter
|
|
NewlinePrinter
|
|
( map
|
|
( \Join {..} ->
|
|
SeqPrinter
|
|
[ "OUTER APPLY (",
|
|
IndentPrinter 13 (fromJoinSource joinSource),
|
|
") ",
|
|
NewlinePrinter,
|
|
"AS ",
|
|
fromJoinAlias joinJoinAlias
|
|
]
|
|
)
|
|
selectJoins
|
|
),
|
|
fromWhere selectWhere,
|
|
fromOrderBys selectTop selectOffset selectOrderBy,
|
|
fromFor selectFor
|
|
]
|
|
|
|
fromWith :: With -> Printer
|
|
fromWith (With withSelects) =
|
|
"WITH " <+> SepByPrinter ", " (map fromAliasedSelect (toList withSelects)) <+> NewlinePrinter
|
|
where
|
|
fromAliasedSelect Aliased {..} =
|
|
fromNameText aliasedAlias <+> " AS " <+> "( " <+> fromSelect aliasedThing <+> " )"
|
|
|
|
fromJoinSource :: JoinSource -> Printer
|
|
fromJoinSource =
|
|
\case
|
|
JoinSelect sel -> fromSelect sel
|
|
JoinReselect reselect -> fromReselect reselect
|
|
|
|
fromReselect :: Reselect -> Printer
|
|
fromReselect Reselect {..} = result
|
|
where
|
|
result =
|
|
SepByPrinter
|
|
NewlinePrinter
|
|
[ "SELECT "
|
|
<+> IndentPrinter
|
|
7
|
|
( SepByPrinter
|
|
("," <+> NewlinePrinter)
|
|
(map fromProjection (toList reselectProjections))
|
|
),
|
|
fromWhere reselectWhere,
|
|
fromFor reselectFor
|
|
]
|
|
|
|
fromOrderBys ::
|
|
Top -> Maybe Expression -> Maybe (NonEmpty OrderBy) -> Printer
|
|
fromOrderBys NoTop Nothing Nothing = "" -- An ORDER BY is wasteful if not needed.
|
|
fromOrderBys top moffset morderBys =
|
|
SeqPrinter
|
|
[ "ORDER BY ",
|
|
IndentPrinter
|
|
9
|
|
( SepByPrinter
|
|
NewlinePrinter
|
|
[ case morderBys of
|
|
-- If you ORDER BY 1, a text field will signal an
|
|
-- error. What we want instead is to just order by
|
|
-- nothing, but also satisfy the syntactic
|
|
-- requirements. Thus ORDER BY (SELECT NULL).
|
|
--
|
|
-- This won't create consistent orderings, but that's
|
|
-- why you should specify an order_by in your GraphQL
|
|
-- query anyway, to define the ordering.
|
|
Nothing -> "(SELECT NULL) /* ORDER BY is required for OFFSET */"
|
|
Just orderBys ->
|
|
SepByPrinter
|
|
("," <+> NewlinePrinter)
|
|
(concatMap fromOrderBy (toList orderBys)),
|
|
case (top, moffset) of
|
|
(NoTop, Nothing) -> ""
|
|
(NoTop, Just offset) ->
|
|
"OFFSET " <+> fromExpression offset <+> " ROWS"
|
|
(Top n, Nothing) ->
|
|
"OFFSET 0 ROWS FETCH NEXT "
|
|
<+> QueryPrinter (toSql (IntValue n))
|
|
<+> " ROWS ONLY"
|
|
(Top n, Just offset) ->
|
|
"OFFSET "
|
|
<+> fromExpression offset
|
|
<+> " ROWS FETCH NEXT "
|
|
<+> QueryPrinter (toSql (IntValue n))
|
|
<+> " ROWS ONLY"
|
|
]
|
|
)
|
|
]
|
|
|
|
fromOrderBy :: OrderBy -> [Printer]
|
|
fromOrderBy OrderBy {..} =
|
|
[ fromNullsOrder orderByFieldName orderByNullsOrder,
|
|
-- Above: This doesn't do anything when using text, ntext or image
|
|
-- types. See below on CAST commentary.
|
|
wrapNullHandling (fromFieldName orderByFieldName)
|
|
<+> " "
|
|
<+> fromOrder orderByOrder
|
|
]
|
|
where
|
|
wrapNullHandling inner =
|
|
case orderByType of
|
|
Just TextType -> castTextish inner
|
|
Just WtextType -> castTextish inner
|
|
-- Above: For some types, we have to do null handling manually
|
|
-- ourselves:
|
|
_ -> inner
|
|
-- Direct quote from SQL Server error response:
|
|
--
|
|
-- > The text, ntext, and image data types cannot be compared or
|
|
-- > sorted, except when using IS NULL or LIKE operator.
|
|
--
|
|
-- So we cast it to a varchar, maximum length.
|
|
castTextish inner = "CAST(" <+> inner <+> " AS VARCHAR(MAX))"
|
|
|
|
fromOrder :: Order -> Printer
|
|
fromOrder =
|
|
\case
|
|
AscOrder -> "ASC"
|
|
DescOrder -> "DESC"
|
|
|
|
fromNullsOrder :: FieldName -> NullsOrder -> Printer
|
|
fromNullsOrder fieldName =
|
|
\case
|
|
NullsAnyOrder -> ""
|
|
NullsFirst -> "IIF(" <+> fromFieldName fieldName <+> " IS NULL, 0, 1)"
|
|
NullsLast -> "IIF(" <+> fromFieldName fieldName <+> " IS NULL, 1, 0)"
|
|
|
|
fromJoinAlias :: JoinAlias -> Printer
|
|
fromJoinAlias JoinAlias {..} =
|
|
fromNameText joinAliasEntity
|
|
<+>? fmap (\name -> "(" <+> fromNameText name <+> ")") joinAliasField
|
|
|
|
fromFor :: For -> Printer
|
|
fromFor =
|
|
\case
|
|
NoFor -> ""
|
|
JsonFor ForJson {jsonCardinality} ->
|
|
"FOR JSON PATH, INCLUDE_NULL_VALUES"
|
|
<+> case jsonCardinality of
|
|
JsonArray -> ""
|
|
JsonSingleton -> ", WITHOUT_ARRAY_WRAPPER"
|
|
|
|
fromProjection :: Projection -> Printer
|
|
fromProjection =
|
|
\case
|
|
ExpressionProjection aliasedExpression ->
|
|
fromAliased (fmap fromExpression aliasedExpression)
|
|
FieldNameProjection aliasedFieldName ->
|
|
fromAliased (fmap fromFieldName aliasedFieldName)
|
|
AggregateProjection aliasedAggregate ->
|
|
fromAliased (fmap fromAggregate aliasedAggregate)
|
|
StarProjection -> "*"
|
|
|
|
fromAggregate :: Aggregate -> Printer
|
|
fromAggregate =
|
|
\case
|
|
CountAggregate countable -> "COUNT(" <+> fromCountable countable <+> ")"
|
|
OpAggregate op args ->
|
|
QueryPrinter (rawUnescapedText op)
|
|
<+> "("
|
|
<+> SepByPrinter ", " (map fromExpression (toList args))
|
|
<+> ")"
|
|
TextAggregate text -> fromExpression (ValueExpression (TextValue text))
|
|
|
|
fromCountable :: Countable FieldName -> Printer
|
|
fromCountable =
|
|
\case
|
|
StarCountable -> "*"
|
|
NonNullFieldCountable field -> fromFieldName field
|
|
DistinctCountable field -> "DISTINCT " <+> fromFieldName field
|
|
|
|
fromWhere :: Where -> Printer
|
|
fromWhere =
|
|
\case
|
|
Where expressions
|
|
| Just whereExp <- collapseWhere (AndExpression expressions) ->
|
|
"WHERE " <+> IndentPrinter 6 (fromExpression whereExp)
|
|
| otherwise -> ""
|
|
|
|
-- | Drop useless examples like this from the output:
|
|
--
|
|
-- WHERE (((1<>1))
|
|
-- AND ((1=1)))
|
|
-- AND ((1=1))
|
|
--
|
|
-- And
|
|
--
|
|
-- WHERE ((1<>1))
|
|
--
|
|
-- They're redundant, but make the output less readable.
|
|
collapseWhere :: Expression -> Maybe Expression
|
|
collapseWhere = go
|
|
where
|
|
go =
|
|
\case
|
|
ValueExpression (BoolValue True) -> Nothing
|
|
AndExpression xs ->
|
|
case mapMaybe go xs of
|
|
[] -> Nothing
|
|
ys -> pure (AndExpression ys)
|
|
e -> pure e
|
|
|
|
fromFrom :: From -> Printer
|
|
fromFrom =
|
|
\case
|
|
FromQualifiedTable aliasedQualifiedTableName ->
|
|
fromAliased (fmap fromTableName aliasedQualifiedTableName)
|
|
FromOpenJson openJson -> fromAliased (fmap fromOpenJson openJson)
|
|
FromSelect select -> fromAliased (fmap (parens . fromSelect) select)
|
|
FromIdentifier identifier -> fromNameText identifier
|
|
FromTempTable aliasedTempTable -> fromAliased (fmap fromTempTableName aliasedTempTable)
|
|
|
|
fromOpenJson :: OpenJson -> Printer
|
|
fromOpenJson OpenJson {openJsonExpression, openJsonWith} =
|
|
SepByPrinter
|
|
NewlinePrinter
|
|
[ "OPENJSON("
|
|
<+> IndentPrinter 9 (fromExpression openJsonExpression)
|
|
<+> ")",
|
|
case openJsonWith of
|
|
Nothing -> ""
|
|
Just openJsonWith' ->
|
|
"WITH ("
|
|
<+> IndentPrinter
|
|
5
|
|
( SepByPrinter
|
|
("," <+> NewlinePrinter)
|
|
(fromJsonFieldSpec <$> toList openJsonWith')
|
|
)
|
|
<+> ")"
|
|
]
|
|
|
|
fromJsonFieldSpec :: JsonFieldSpec -> Printer
|
|
fromJsonFieldSpec =
|
|
\case
|
|
StringField name mPath -> fromNameText name <+> " NVARCHAR(MAX)" <+> quote mPath
|
|
JsonField name mPath -> fromJsonFieldSpec (StringField name mPath) <+> " AS JSON"
|
|
ScalarField fieldType fieldLength name mPath ->
|
|
fromNameText name
|
|
<+> " "
|
|
<+> fromString (T.unpack $ scalarTypeDBName fieldLength fieldType)
|
|
<+> quote mPath
|
|
where
|
|
quote mPath = maybe "" ((\p -> " '" <+> p <+> "'") . go) mPath
|
|
go = \case
|
|
RootPath -> "$"
|
|
IndexPath r i -> go r <+> "[" <+> fromString (show i) <+> "]"
|
|
FieldPath r f -> go r <+> ".\"" <+> fromString (T.unpack f) <+> "\""
|
|
|
|
fromTableName :: TableName -> Printer
|
|
fromTableName (TableName tableName (SchemaName tableSchema)) =
|
|
fromNameText tableSchema <+> "." <+> fromNameText tableName
|
|
|
|
fromAliased :: Aliased Printer -> Printer
|
|
fromAliased Aliased {..} =
|
|
aliasedThing
|
|
<+> ((" AS " <+>) . fromNameText) aliasedAlias
|
|
|
|
fromColumnName :: ColumnName -> Printer
|
|
fromColumnName (ColumnName colname) = fromNameText colname
|
|
|
|
fromNameText :: Text -> Printer
|
|
fromNameText t = QueryPrinter (rawUnescapedText ("[" <> t <> "]"))
|
|
|
|
fromRawUnescapedText :: Text -> Printer
|
|
fromRawUnescapedText t = QueryPrinter (rawUnescapedText t)
|
|
|
|
truePrinter :: Printer
|
|
truePrinter = "(1=1)"
|
|
|
|
falsePrinter :: Printer
|
|
falsePrinter = "(1<>1)"
|
|
|
|
parens :: Printer -> Printer
|
|
parens p = "(" <+> IndentPrinter 1 p <+> ")"
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- * Basic printing API
|
|
|
|
-- | Pretty-prints a 'Printer' as one line, converting 'NewlinePrinter' to space.
|
|
toQueryFlat :: Printer -> Query
|
|
toQueryFlat = go 0
|
|
where
|
|
go level =
|
|
\case
|
|
QueryPrinter q -> q
|
|
SeqPrinter xs -> mconcat (filter notEmpty (map (go level) xs))
|
|
SepByPrinter x xs ->
|
|
mconcat
|
|
(intersperse (go level x) (filter notEmpty (map (go level) xs)))
|
|
NewlinePrinter -> " "
|
|
IndentPrinter n p -> go (level + n) p
|
|
notEmpty = (/= mempty) . renderQuery
|
|
|
|
-- | Pretty-prints a 'Printer' as multiple lines as defined by the printer.
|
|
toQueryPretty :: Printer -> Query
|
|
toQueryPretty = go 0
|
|
where
|
|
go level =
|
|
\case
|
|
QueryPrinter q -> q
|
|
SeqPrinter xs -> mconcat (filter notEmpty (map (go level) xs))
|
|
SepByPrinter x xs ->
|
|
mconcat
|
|
(intersperse (go level x) (filter notEmpty (map (go level) xs)))
|
|
NewlinePrinter -> "\n" <> indentation level
|
|
IndentPrinter n p -> go (level + n) p
|
|
indentation n = rawUnescapedText (T.replicate n " ")
|
|
notEmpty = (/= mempty) . renderQuery
|