{-# 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,
    fromTempTableDDL,
    fromSetIdentityInsert,
    fromDelete,
    fromUpdate,
    fromSelectIntoTempTable,
    fromInsertValuesIntoTempTable,
    dropTempTableQuery,
    fromRawUnescapedText,
    fromTableName,
    (<+>),
    Printer (..),
  )
where

import Data.Aeson (ToJSON (..))
import Data.HashMap.Strict qualified as HashMap
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.NativeQuery.Metadata (InterpolatedItem (..), InterpolatedQuery (..))
import Hasura.Prelude hiding (GT, LT)

--------------------------------------------------------------------------------

-- * Types

data Printer
  = SeqPrinter [Printer]
  | SepByPrinter Printer [Printer]
  | NewlinePrinter
  | QueryPrinter Query
  | IndentPrinter Int Printer
  deriving (Int -> Printer -> ShowS
[Printer] -> ShowS
Printer -> String
(Int -> Printer -> ShowS)
-> (Printer -> String) -> ([Printer] -> ShowS) -> Show Printer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Printer -> ShowS
showsPrec :: Int -> Printer -> ShowS
$cshow :: Printer -> String
show :: Printer -> String
$cshowList :: [Printer] -> ShowS
showList :: [Printer] -> ShowS
Show, Printer -> Printer -> Bool
(Printer -> Printer -> Bool)
-> (Printer -> Printer -> Bool) -> Eq Printer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Printer -> Printer -> Bool
== :: Printer -> Printer -> Bool
$c/= :: Printer -> Printer -> Bool
/= :: Printer -> Printer -> Bool
Eq)

instance IsString Printer where
  fromString :: String -> Printer
fromString = Query -> Printer
QueryPrinter (Query -> Printer) -> (String -> Query) -> String -> Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Query
forall a. IsString a => String -> a
fromString

(<+>) :: Printer -> Printer -> Printer
<+> :: Printer -> Printer -> Printer
(<+>) Printer
x Printer
y = [Printer] -> Printer
SeqPrinter [Printer
x, Printer
y]

(<+>?) :: Printer -> Maybe Printer -> Printer
<+>? :: Printer -> Maybe Printer -> Printer
(<+>?) Printer
x Maybe Printer
Nothing = Printer
x
(<+>?) Printer
x (Just Printer
y) = [Printer] -> Printer
SeqPrinter [Printer
x, Printer
y]

(?<+>) :: Maybe Printer -> Printer -> Printer
?<+> :: Maybe Printer -> Printer -> Printer
(?<+>) Maybe Printer
Nothing Printer
x = Printer
x
(?<+>) (Just Printer
x) Printer
y = [Printer] -> Printer
SeqPrinter [Printer
x, Printer
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 :: Expression -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Expression -> Text) -> Expression -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Text
forall a. ToTxt a => a -> Text
T.toTxt (Query -> Text) -> (Expression -> Query) -> Expression -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printer -> Query
toQueryFlat (Printer -> Query)
-> (Expression -> Printer) -> Expression -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression -> Printer
fromExpression

--------------------------------------------------------------------------------

-- * Printer generators

fromExpression :: Expression -> Printer
fromExpression :: Expression -> Printer
fromExpression =
  \case
    CastExpression Expression
e ScalarType
t DataLength
dataLength ->
      Printer
"CAST("
        Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
e
        Printer -> Printer -> Printer
<+> Printer
" AS "
        Printer -> Printer -> Printer
<+> String -> Printer
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ DataLength -> ScalarType -> Text
scalarTypeDBName DataLength
dataLength ScalarType
t)
        Printer -> Printer -> Printer
<+> Printer
")"
    JsonQueryExpression Expression
e -> Printer
"JSON_QUERY(" Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
e Printer -> Printer -> Printer
<+> Printer
")"
    JsonValueExpression Expression
e JsonPath
path ->
      Printer
"JSON_VALUE(" Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
e Printer -> Printer -> Printer
<+> JsonPath -> Printer
fromPath JsonPath
path Printer -> Printer -> Printer
<+> Printer
")"
    ValueExpression Value
value -> Query -> Printer
QueryPrinter (Query -> Printer) -> Query -> Printer
forall a b. (a -> b) -> a -> b
$ Value -> Query
forall a. ToSql a => a -> Query
toSql Value
value
    AndExpression [Expression]
xs ->
      case [Expression]
xs of
        [] -> Printer
truePrinter
        [Expression]
_ ->
          Printer -> [Printer] -> Printer
SepByPrinter
            (Printer
NewlinePrinter Printer -> Printer -> Printer
<+> Printer
"AND ")
            ((Expression -> Printer) -> [Expression] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Expression
x -> Printer
"(" Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
x Printer -> Printer -> Printer
<+> Printer
")") ([Expression] -> [Expression]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Expression]
xs))
    OrExpression [Expression]
xs ->
      case [Expression]
xs of
        [] -> Printer
falsePrinter
        [Expression]
_ ->
          Printer -> [Printer] -> Printer
SepByPrinter
            (Printer
NewlinePrinter Printer -> Printer -> Printer
<+> Printer
"OR ")
            ((Expression -> Printer) -> [Expression] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Expression
x -> Printer
"(" Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
x Printer -> Printer -> Printer
<+> Printer
")") ([Expression] -> [Expression]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Expression]
xs))
    NotExpression Expression
expression -> Printer
"NOT " Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
expression
    ExistsExpression Select
sel -> Printer
"EXISTS (" Printer -> Printer -> Printer
<+> Select -> Printer
fromSelect Select
sel Printer -> Printer -> Printer
<+> Printer
")"
    IsNullExpression Expression
expression ->
      Printer
"(" Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
expression Printer -> Printer -> Printer
<+> Printer
") IS NULL"
    IsNotNullExpression Expression
expression ->
      Printer
"(" Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
expression Printer -> Printer -> Printer
<+> Printer
") IS NOT NULL"
    ColumnExpression FieldName
fieldName -> FieldName -> Printer
fromFieldName FieldName
fieldName
    ToStringExpression Expression
e -> Printer
"CONCAT(" Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
e Printer -> Printer -> Printer
<+> Printer
", '')"
    SelectExpression Select
s -> Printer
"(" Printer -> Printer -> Printer
<+> Int -> Printer -> Printer
IndentPrinter Int
1 (Select -> Printer
fromSelect Select
s) Printer -> Printer -> Printer
<+> Printer
")"
    OpExpression Op
op Expression
x Expression
y ->
      Printer
"("
        Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
x
        Printer -> Printer -> Printer
<+> Printer
") "
        Printer -> Printer -> Printer
<+> Op -> Printer
fromOp Op
op
        Printer -> Printer -> Printer
<+> Printer
" ("
        Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
y
        Printer -> Printer -> Printer
<+> Printer
")"
    MethodApplicationExpression Expression
ex MethodApplicationExpression
methodAppExp -> Expression -> MethodApplicationExpression -> Printer
fromMethodApplicationExpression Expression
ex MethodApplicationExpression
methodAppExp
    FunctionApplicationExpression FunctionApplicationExpression
funAppExp -> FunctionApplicationExpression -> Printer
fromFunctionApplicationExpression FunctionApplicationExpression
funAppExp
    ListExpression [Expression]
xs -> Printer -> [Printer] -> Printer
SepByPrinter Printer
", " ([Printer] -> Printer) -> [Printer] -> Printer
forall a b. (a -> b) -> a -> b
$ Expression -> Printer
fromExpression (Expression -> Printer) -> [Expression] -> [Printer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expression]
xs
    STOpExpression SpatialOp
op Expression
e Expression
str ->
      Printer
"("
        Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
e
        Printer -> Printer -> Printer
<+> Printer
")."
        Printer -> Printer -> Printer
<+> String -> Printer
forall a. IsString a => String -> a
fromString (SpatialOp -> String
forall a. Show a => a -> String
show SpatialOp
op)
        Printer -> Printer -> Printer
<+> Printer
"("
        Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
str
        Printer -> Printer -> Printer
<+> Printer
") = 1"
    ConditionalExpression Expression
condition Expression
trueExpression Expression
falseExpression ->
      Printer
"(CASE WHEN("
        Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
condition
        Printer -> Printer -> Printer
<+> Printer
") THEN "
        Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
trueExpression
        Printer -> Printer -> Printer
<+> Printer
" ELSE "
        Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
falseExpression
        Printer -> Printer -> Printer
<+> Printer
" END)"
    Expression
DefaultExpression -> Printer
"DEFAULT"

fromMethodApplicationExpression :: Expression -> MethodApplicationExpression -> Printer
fromMethodApplicationExpression :: Expression -> MethodApplicationExpression -> Printer
fromMethodApplicationExpression Expression
ex MethodApplicationExpression
methodAppExp =
  case MethodApplicationExpression
methodAppExp of
    MethodApplicationExpression
MethExpSTAsText -> Text -> [Expression] -> Printer
fromApp Text
"STAsText" []
  where
    fromApp :: Text -> [Expression] -> Printer
    fromApp :: Text -> [Expression] -> Printer
fromApp Text
method [Expression]
args =
      Expression -> Printer
fromExpression Expression
ex
        Printer -> Printer -> Printer
<+> Printer
"."
        Printer -> Printer -> Printer
<+> String -> Printer
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
method)
        Printer -> Printer -> Printer
<+> Printer
"("
        Printer -> Printer -> Printer
<+> [Printer] -> Printer
SeqPrinter ((Expression -> Printer) -> [Expression] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map Expression -> Printer
fromExpression [Expression]
args)
        Printer -> Printer -> Printer
<+> Printer
")"

fromFunctionApplicationExpression :: FunctionApplicationExpression -> Printer
fromFunctionApplicationExpression :: FunctionApplicationExpression -> Printer
fromFunctionApplicationExpression FunctionApplicationExpression
funAppExp = case FunctionApplicationExpression
funAppExp of
  (FunExpISNULL Expression
x Expression
y) -> Text -> [Expression] -> Printer
fromApp Text
"ISNULL" [Expression
x, Expression
y]
  where
    fromApp :: Text -> [Expression] -> Printer
    fromApp :: Text -> [Expression] -> Printer
fromApp Text
function [Expression]
args =
      String -> Printer
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
function)
        Printer -> Printer -> Printer
<+> Printer
"("
        Printer -> Printer -> Printer
<+> Printer -> [Printer] -> Printer
SepByPrinter Printer
", " ((Expression -> Printer) -> [Expression] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map Expression -> Printer
fromExpression [Expression]
args)
        Printer -> Printer -> Printer
<+> Printer
")"

fromOp :: Op -> Printer
fromOp :: Op -> Printer
fromOp =
  \case
    Op
LT -> Printer
"<"
    Op
GT -> Printer
">"
    Op
GTE -> Printer
">="
    Op
LTE -> Printer
"<="
    Op
IN -> Printer
"IN"
    Op
NIN -> Printer
"NOT IN"
    Op
LIKE -> Printer
"LIKE"
    Op
NLIKE -> Printer
"NOT LIKE"
    Op
EQ' -> Printer
"="
    Op
NEQ' -> Printer
"!="

fromPath :: JsonPath -> Printer
fromPath :: JsonPath -> Printer
fromPath JsonPath
path =
  Printer
", " Printer -> Printer -> Printer
<+> JsonPath -> Printer
string JsonPath
path
  where
    string :: JsonPath -> Printer
string =
      Expression -> Printer
fromExpression
        (Expression -> Printer)
-> (JsonPath -> Expression) -> JsonPath -> Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Expression
ValueExpression
        (Value -> Expression)
-> (JsonPath -> Value) -> JsonPath -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
TextValue
        (Text -> Value) -> (JsonPath -> Text) -> JsonPath -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
L.toStrict
        (Text -> Text) -> (JsonPath -> Text) -> JsonPath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
L.toLazyText
        (Builder -> Text) -> (JsonPath -> Builder) -> JsonPath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonPath -> Builder
go
    go :: JsonPath -> Builder
go =
      \case
        JsonPath
RootPath -> Builder
"$"
        IndexPath JsonPath
r Integer
i -> JsonPath -> Builder
go JsonPath
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
L.fromString (Integer -> String
forall a. Show a => a -> String
show Integer
i) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]"
        FieldPath JsonPath
r Text
f -> JsonPath -> Builder
go JsonPath
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
L.fromText Text
f Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\""

fromFieldName :: FieldName -> Printer
fromFieldName :: FieldName -> Printer
fromFieldName (FieldName {Text
fieldName :: Text
fieldNameEntity :: Text
$sel:fieldName:FieldName :: FieldName -> Text
$sel:fieldNameEntity:FieldName :: FieldName -> Text
..}) =
  Text -> Printer
fromNameText Text
fieldNameEntity Printer -> Printer -> Printer
<+> Printer
"." Printer -> Printer -> Printer
<+> Text -> Printer
fromNameText Text
fieldName

fromInserted :: Inserted -> Printer
fromInserted :: Inserted -> Printer
fromInserted Inserted
Inserted = Printer
"INSERTED"

fromDeleted :: Deleted -> Printer
fromDeleted :: Deleted -> Printer
fromDeleted Deleted
Deleted = Printer
"DELETED"

fromOutputColumn :: Printer -> OutputColumn -> Printer
fromOutputColumn :: Printer -> OutputColumn -> Printer
fromOutputColumn Printer
prefix (OutputColumn ColumnName
columnName) =
  Printer
prefix Printer -> Printer -> Printer
<+> Printer
"." Printer -> Printer -> Printer
<+> Text -> Printer
fromNameText (ColumnName -> Text
columnNameText ColumnName
columnName)

fromOutput :: (t -> Printer) -> Output t -> Printer
fromOutput :: forall t. (t -> Printer) -> Output t -> Printer
fromOutput t -> Printer
typePrinter (Output t
ty [OutputColumn]
outputColumns) =
  Printer
"OUTPUT " Printer -> Printer -> Printer
<+> Printer -> [Printer] -> Printer
SepByPrinter Printer
", " ((OutputColumn -> Printer) -> [OutputColumn] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map (Printer -> OutputColumn -> Printer
fromOutputColumn (t -> Printer
typePrinter t
ty)) [OutputColumn]
outputColumns)

fromInsertOutput :: InsertOutput -> Printer
fromInsertOutput :: InsertOutput -> Printer
fromInsertOutput = (Inserted -> Printer) -> InsertOutput -> Printer
forall t. (t -> Printer) -> Output t -> Printer
fromOutput Inserted -> Printer
fromInserted

fromDeleteOutput :: DeleteOutput -> Printer
fromDeleteOutput :: DeleteOutput -> Printer
fromDeleteOutput = (Deleted -> Printer) -> DeleteOutput -> Printer
forall t. (t -> Printer) -> Output t -> Printer
fromOutput Deleted -> Printer
fromDeleted

fromUpdateOutput :: UpdateOutput -> Printer
fromUpdateOutput :: InsertOutput -> Printer
fromUpdateOutput = (Inserted -> Printer) -> InsertOutput -> Printer
forall t. (t -> Printer) -> Output t -> Printer
fromOutput Inserted -> Printer
fromInserted

fromValues :: Values -> Printer
fromValues :: Values -> Printer
fromValues (Values [Expression]
values) =
  Printer
"( " Printer -> Printer -> Printer
<+> Printer -> [Printer] -> Printer
SepByPrinter Printer
", " ((Expression -> Printer) -> [Expression] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map Expression -> Printer
fromExpression [Expression]
values) Printer -> Printer -> Printer
<+> Printer
" )"

fromValuesList :: [Values] -> Printer
fromValuesList :: [Values] -> Printer
fromValuesList [Values]
valuesList =
  Printer
"VALUES " Printer -> Printer -> Printer
<+> Printer -> [Printer] -> Printer
SepByPrinter Printer
", " ((Values -> Printer) -> [Values] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map Values -> Printer
fromValues [Values]
valuesList)

fromInsert :: Insert -> Printer
fromInsert :: Insert -> Printer
fromInsert Insert {[ColumnName]
[Values]
TableName
TempTable
InsertOutput
insertTable :: TableName
insertColumns :: [ColumnName]
insertOutput :: InsertOutput
insertTempTable :: TempTable
insertValues :: [Values]
$sel:insertTable:Insert :: Insert -> TableName
$sel:insertColumns:Insert :: Insert -> [ColumnName]
$sel:insertOutput:Insert :: Insert -> InsertOutput
$sel:insertTempTable:Insert :: Insert -> TempTable
$sel:insertValues:Insert :: Insert -> [Values]
..} =
  Printer -> [Printer] -> Printer
SepByPrinter
    Printer
NewlinePrinter
    ([Printer] -> Printer) -> [Printer] -> Printer
forall a b. (a -> b) -> a -> b
$ [Printer
"INSERT INTO " Printer -> Printer -> Printer
<+> TableName -> Printer
fromTableName TableName
insertTable]
    [Printer] -> [Printer] -> [Printer]
forall a. Semigroup a => a -> a -> a
<> [ Printer
"(" Printer -> Printer -> Printer
<+> Printer -> [Printer] -> Printer
SepByPrinter Printer
", " ((ColumnName -> Printer) -> [ColumnName] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Printer
fromNameText (Text -> Printer) -> (ColumnName -> Text) -> ColumnName -> Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnName -> Text
columnNameText) [ColumnName]
insertColumns) Printer -> Printer -> Printer
<+> Printer
")"
         | Bool -> Bool
not ([ColumnName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ColumnName]
insertColumns)
       ]
    [Printer] -> [Printer] -> [Printer]
forall a. Semigroup a => a -> a -> a
<> [ InsertOutput -> Printer
fromInsertOutput InsertOutput
insertOutput,
         Printer
"INTO " Printer -> Printer -> Printer
<+> TempTable -> Printer
fromTempTable TempTable
insertTempTable,
         if [ColumnName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ColumnName]
insertColumns
           then Printer
"VALUES " Printer -> Printer -> Printer
<+> Printer -> [Printer] -> Printer
SepByPrinter Printer
", " ((Values -> Printer) -> [Values] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map (Printer -> Values -> Printer
forall a b. a -> b -> a
const Printer
"(DEFAULT)") [Values]
insertValues)
           else [Values] -> Printer
fromValuesList [Values]
insertValues
       ]

fromSetValue :: SetValue -> Printer
fromSetValue :: SetValue -> Printer
fromSetValue = \case
  SetValue
SetON -> Printer
"ON"
  SetValue
SetOFF -> Printer
"OFF"

fromSetIdentityInsert :: SetIdentityInsert -> Printer
fromSetIdentityInsert :: SetIdentityInsert -> Printer
fromSetIdentityInsert SetIdentityInsert {SomeTableName
SetValue
setTable :: SomeTableName
setValue :: SetValue
$sel:setTable:SetIdentityInsert :: SetIdentityInsert -> SomeTableName
$sel:setValue:SetIdentityInsert :: SetIdentityInsert -> SetValue
..} =
  Printer -> [Printer] -> Printer
SepByPrinter
    Printer
" "
    [ Printer
"SET IDENTITY_INSERT",
      Printer
tableName,
      SetValue -> Printer
fromSetValue SetValue
setValue
    ]
  where
    tableName :: Printer
tableName =
      case SomeTableName
setTable of
        RegularTableName TableName
name -> TableName -> Printer
fromTableName TableName
name
        TemporaryTableName TempTableName
name -> TempTableName -> Printer
fromTempTableName TempTableName
name

-- | Generate a statement to insert values into temporary table.
fromInsertValuesIntoTempTable :: InsertValuesIntoTempTable -> Printer
fromInsertValuesIntoTempTable :: InsertValuesIntoTempTable -> Printer
fromInsertValuesIntoTempTable InsertValuesIntoTempTable {[ColumnName]
[Values]
TempTableName
ivittTempTableName :: TempTableName
ivittColumns :: [ColumnName]
ivittValues :: [Values]
$sel:ivittTempTableName:InsertValuesIntoTempTable :: InsertValuesIntoTempTable -> TempTableName
$sel:ivittColumns:InsertValuesIntoTempTable :: InsertValuesIntoTempTable -> [ColumnName]
$sel:ivittValues:InsertValuesIntoTempTable :: InsertValuesIntoTempTable -> [Values]
..} =
  Printer -> [Printer] -> Printer
SepByPrinter
    Printer
NewlinePrinter
    [ Printer
"INSERT INTO " Printer -> Printer -> Printer
<+> TempTableName -> Printer
fromTempTableName TempTableName
ivittTempTableName,
      Printer
"(" Printer -> Printer -> Printer
<+> Printer -> [Printer] -> Printer
SepByPrinter Printer
", " ((ColumnName -> Printer) -> [ColumnName] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Printer
fromNameText (Text -> Printer) -> (ColumnName -> Text) -> ColumnName -> Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnName -> Text
columnNameText) [ColumnName]
ivittColumns) Printer -> Printer -> Printer
<+> Printer
")",
      [Values] -> Printer
fromValuesList [Values]
ivittValues
    ]

-- | Alias for the source table in a MERGE statement. Used when pretty printing MERGE statments.
mergeSourceAlias :: Text
mergeSourceAlias :: Text
mergeSourceAlias = Text
"source"

-- | Alias for the target table in a MERGE statement. Used when pretty printing MERGE statments.
mergeTargetAlias :: Text
mergeTargetAlias :: Text
mergeTargetAlias = Text
"target"

-- | USING section of a MERGE statement. Used in 'fromMerge'.
fromMergeUsing :: MergeUsing -> Printer
fromMergeUsing :: MergeUsing -> Printer
fromMergeUsing MergeUsing {[ColumnName]
TempTableName
mergeUsingTempTable :: TempTableName
mergeUsingColumns :: [ColumnName]
$sel:mergeUsingTempTable:MergeUsing :: MergeUsing -> TempTableName
$sel:mergeUsingColumns:MergeUsing :: MergeUsing -> [ColumnName]
..} =
  Printer
"USING (" Printer -> Printer -> Printer
<+> Select -> Printer
fromSelect Select
selectSubQuery Printer -> Printer -> Printer
<+> Printer
") AS " Printer -> Printer -> Printer
<+> Text -> Printer
fromNameText Text
mergeSourceAlias
  where
    selectSubQuery :: Select
    selectSubQuery :: Select
selectSubQuery =
      let alias :: Text
alias = Text
"merge_temptable"
          columnNameToProjection :: ColumnName -> Projection
columnNameToProjection ColumnName {Text
$sel:columnNameText:ColumnName :: ColumnName -> Text
columnNameText :: Text
columnNameText} =
            -- merge_temptable.column_name AS column_name
            Aliased FieldName -> Projection
FieldNameProjection
              (Aliased FieldName -> Projection)
-> Aliased FieldName -> Projection
forall a b. (a -> b) -> a -> b
$ Aliased
                { $sel:aliasedThing:Aliased :: FieldName
aliasedThing = Text -> Text -> FieldName
FieldName Text
columnNameText Text
alias,
                  $sel:aliasedAlias:Aliased :: Text
aliasedAlias = Text
columnNameText
                }
       in Select
emptySelect
            { $sel:selectProjections:Select :: [Projection]
selectProjections = (ColumnName -> Projection) -> [ColumnName] -> [Projection]
forall a b. (a -> b) -> [a] -> [b]
map ColumnName -> Projection
columnNameToProjection [ColumnName]
mergeUsingColumns,
              $sel:selectFrom:Select :: Maybe From
selectFrom = From -> Maybe From
forall a. a -> Maybe a
Just (Aliased TempTableName -> From
FromTempTable (Aliased TempTableName -> From) -> Aliased TempTableName -> From
forall a b. (a -> b) -> a -> b
$ TempTableName -> Text -> Aliased TempTableName
forall a. a -> Text -> Aliased a
Aliased TempTableName
mergeUsingTempTable Text
alias) -- FROM temp_table AS merge_temptable
            }

-- | ON section of a MERGE statement. Used in 'fromMerge'.
fromMergeOn :: MergeOn -> Printer
fromMergeOn :: MergeOn -> Printer
fromMergeOn MergeOn {[ColumnName]
mergeOnColumns :: [ColumnName]
$sel:mergeOnColumns:MergeOn :: MergeOn -> [ColumnName]
..} =
  Printer
"ON (" Printer -> Printer -> Printer
<+> Printer
onExpression Printer -> Printer -> Printer
<+> Printer
")"
  where
    onExpression :: Printer
onExpression
      | [ColumnName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ColumnName]
mergeOnColumns =
          Printer
falsePrinter
      | Bool
otherwise =
          (Expression -> Printer
fromExpression (Expression -> Printer)
-> ([Expression] -> Expression) -> [Expression] -> Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expression] -> Expression
AndExpression) ((ColumnName -> Expression) -> [ColumnName] -> [Expression]
forall a b. (a -> b) -> [a] -> [b]
map ColumnName -> Expression
matchColumn [ColumnName]
mergeOnColumns)

    matchColumn :: ColumnName -> Expression
    matchColumn :: ColumnName -> Expression
matchColumn ColumnName {Text
$sel:columnNameText:ColumnName :: ColumnName -> Text
columnNameText :: Text
..} =
      let sourceColumn :: Expression
sourceColumn = FieldName -> Expression
ColumnExpression (FieldName -> Expression) -> FieldName -> Expression
forall a b. (a -> b) -> a -> b
$ Text -> Text -> FieldName
FieldName Text
columnNameText Text
mergeSourceAlias
          targetColumn :: Expression
targetColumn = FieldName -> Expression
ColumnExpression (FieldName -> Expression) -> FieldName -> Expression
forall a b. (a -> b) -> a -> b
$ Text -> Text -> FieldName
FieldName Text
columnNameText Text
mergeTargetAlias
       in Op -> Expression -> Expression -> Expression
OpExpression Op
EQ' Expression
sourceColumn Expression
targetColumn

-- | WHEN MATCHED section of a MERGE statement. Used in 'fromMerge'.
fromMergeWhenMatched :: MergeWhenMatched -> Printer
fromMergeWhenMatched :: MergeWhenMatched -> Printer
fromMergeWhenMatched (MergeWhenMatched [ColumnName]
updateColumns Expression
updateCondition HashMap ColumnName Expression
updatePreset) =
  if UpdateSet -> Bool
forall a. HashMap ColumnName a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null UpdateSet
updates
    then Printer
""
    else
      Printer
"WHEN MATCHED AND "
        Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
updateCondition
        Printer -> Printer -> Printer
<+> Printer
" THEN UPDATE "
        Printer -> Printer -> Printer
<+> UpdateSet -> Printer
fromUpdateSet UpdateSet
updates
  where
    updates :: UpdateSet
updates = UpdateSet
updateSet UpdateSet -> UpdateSet -> UpdateSet
forall a. Semigroup a => a -> a -> a
<> (Expression -> UpdateOperator Expression)
-> HashMap ColumnName Expression -> UpdateSet
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map Expression -> UpdateOperator Expression
forall v. v -> UpdateOperator v
UpdateSet HashMap ColumnName Expression
updatePreset

    updateSet :: UpdateSet
    updateSet :: UpdateSet
updateSet =
      [(ColumnName, UpdateOperator Expression)] -> UpdateSet
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
        ([(ColumnName, UpdateOperator Expression)] -> UpdateSet)
-> [(ColumnName, UpdateOperator Expression)] -> UpdateSet
forall a b. (a -> b) -> a -> b
$ (ColumnName -> (ColumnName, UpdateOperator Expression))
-> [ColumnName] -> [(ColumnName, UpdateOperator Expression)]
forall a b. (a -> b) -> [a] -> [b]
map
          ( \cn :: ColumnName
cn@ColumnName {Text
$sel:columnNameText:ColumnName :: ColumnName -> Text
columnNameText :: Text
..} ->
              ( ColumnName
cn,
                Expression -> UpdateOperator Expression
forall v. v -> UpdateOperator v
UpdateSet (Expression -> UpdateOperator Expression)
-> Expression -> UpdateOperator Expression
forall a b. (a -> b) -> a -> b
$ FieldName -> Expression
ColumnExpression (FieldName -> Expression) -> FieldName -> Expression
forall a b. (a -> b) -> a -> b
$ Text -> Text -> FieldName
FieldName Text
columnNameText Text
mergeSourceAlias
              )
          )
          [ColumnName]
updateColumns

-- | WHEN NOT MATCHED section of a MERGE statement. Used in 'fromMerge'.
fromMergeWhenNotMatched :: MergeWhenNotMatched -> Printer
fromMergeWhenNotMatched :: MergeWhenNotMatched -> Printer
fromMergeWhenNotMatched (MergeWhenNotMatched [ColumnName]
insertColumns) =
  Printer -> [Printer] -> Printer
SepByPrinter
    Printer
NewlinePrinter
    [ Printer
"WHEN NOT MATCHED THEN INSERT (" Printer -> Printer -> Printer
<+> Printer -> [Printer] -> Printer
SepByPrinter Printer
", " ((ColumnName -> Printer) -> [ColumnName] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map ColumnName -> Printer
fromColumnName [ColumnName]
insertColumns) Printer -> Printer -> Printer
<+> Printer
")",
      [Values] -> Printer
fromValuesList [[Expression] -> Values
Values [Expression]
columnsFromSource]
    ]
  where
    columnsFromSource :: [Expression]
columnsFromSource =
      [ColumnName]
insertColumns [ColumnName] -> (ColumnName -> Expression) -> [Expression]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ColumnName {Text
$sel:columnNameText:ColumnName :: ColumnName -> Text
columnNameText :: Text
..} -> FieldName -> Expression
ColumnExpression (FieldName -> Expression) -> FieldName -> Expression
forall a b. (a -> b) -> a -> b
$ Text -> Text -> FieldName
FieldName Text
columnNameText Text
mergeSourceAlias

-- | Generate a MERGE SQL statement
fromMerge :: Merge -> Printer
fromMerge :: Merge -> Printer
fromMerge Merge {TableName
TempTable
MergeWhenNotMatched
MergeWhenMatched
MergeOn
MergeUsing
InsertOutput
mergeTargetTable :: TableName
mergeUsing :: MergeUsing
mergeOn :: MergeOn
mergeWhenMatched :: MergeWhenMatched
mergeWhenNotMatched :: MergeWhenNotMatched
mergeInsertOutput :: InsertOutput
mergeOutputTempTable :: TempTable
$sel:mergeTargetTable:Merge :: Merge -> TableName
$sel:mergeUsing:Merge :: Merge -> MergeUsing
$sel:mergeOn:Merge :: Merge -> MergeOn
$sel:mergeWhenMatched:Merge :: Merge -> MergeWhenMatched
$sel:mergeWhenNotMatched:Merge :: Merge -> MergeWhenNotMatched
$sel:mergeInsertOutput:Merge :: Merge -> InsertOutput
$sel:mergeOutputTempTable:Merge :: Merge -> TempTable
..} =
  Printer -> [Printer] -> Printer
SepByPrinter
    Printer
NewlinePrinter
    [ Printer
"MERGE " Printer -> Printer -> Printer
<+> Aliased Printer -> Printer
fromAliased ((TableName -> Printer) -> Aliased TableName -> Aliased Printer
forall a b. (a -> b) -> Aliased a -> Aliased b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableName -> Printer
fromTableName Aliased TableName
mergeTableAsTarget),
      MergeUsing -> Printer
fromMergeUsing MergeUsing
mergeUsing,
      MergeOn -> Printer
fromMergeOn MergeOn
mergeOn,
      MergeWhenMatched -> Printer
fromMergeWhenMatched MergeWhenMatched
mergeWhenMatched,
      MergeWhenNotMatched -> Printer
fromMergeWhenNotMatched MergeWhenNotMatched
mergeWhenNotMatched,
      InsertOutput -> Printer
fromInsertOutput InsertOutput
mergeInsertOutput,
      Printer
"INTO " Printer -> Printer -> Printer
<+> TempTable -> Printer
fromTempTable TempTable
mergeOutputTempTable,
      Printer
";" -- Always, a Merge statement should end with a ";"
    ]
  where
    mergeTableAsTarget :: Aliased TableName
    mergeTableAsTarget :: Aliased TableName
mergeTableAsTarget = TableName -> Text -> Aliased TableName
forall a. a -> Text -> Aliased a
Aliased TableName
mergeTargetTable Text
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 -> Printer
fromDelete Delete {Aliased TableName
deleteTable :: Aliased TableName
$sel:deleteTable:Delete :: Delete -> Aliased TableName
deleteTable, DeleteOutput
deleteOutput :: DeleteOutput
$sel:deleteOutput:Delete :: Delete -> DeleteOutput
deleteOutput, TempTable
deleteTempTable :: TempTable
$sel:deleteTempTable:Delete :: Delete -> TempTable
deleteTempTable, Where
deleteWhere :: Where
$sel:deleteWhere:Delete :: Delete -> Where
deleteWhere} =
  Printer -> [Printer] -> Printer
SepByPrinter
    Printer
NewlinePrinter
    [ Printer
"DELETE " Printer -> Printer -> Printer
<+> Text -> Printer
fromNameText (Aliased TableName -> Text
forall a. Aliased a -> Text
aliasedAlias Aliased TableName
deleteTable),
      DeleteOutput -> Printer
fromDeleteOutput DeleteOutput
deleteOutput,
      Printer
"INTO " Printer -> Printer -> Printer
<+> TempTable -> Printer
fromTempTable TempTable
deleteTempTable,
      Printer
"FROM " Printer -> Printer -> Printer
<+> Aliased Printer -> Printer
fromAliased ((TableName -> Printer) -> Aliased TableName -> Aliased Printer
forall a b. (a -> b) -> Aliased a -> Aliased b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableName -> Printer
fromTableName Aliased TableName
deleteTable),
      Where -> Printer
fromWhere Where
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 -> Printer
fromUpdate Update {UpdateSet
Aliased TableName
Where
TempTable
InsertOutput
updateTable :: Aliased TableName
updateSet :: UpdateSet
updateOutput :: InsertOutput
updateTempTable :: TempTable
updateWhere :: Where
updateTable :: Update -> Aliased TableName
updateSet :: Update -> UpdateSet
updateOutput :: Update -> InsertOutput
updateTempTable :: Update -> TempTable
updateWhere :: Update -> Where
..} =
  Printer -> [Printer] -> Printer
SepByPrinter
    Printer
NewlinePrinter
    [ Printer
"UPDATE " Printer -> Printer -> Printer
<+> Text -> Printer
fromNameText (Aliased TableName -> Text
forall a. Aliased a -> Text
aliasedAlias Aliased TableName
updateTable),
      UpdateSet -> Printer
fromUpdateSet UpdateSet
updateSet,
      InsertOutput -> Printer
fromUpdateOutput InsertOutput
updateOutput,
      Printer
"INTO " Printer -> Printer -> Printer
<+> TempTable -> Printer
fromTempTable TempTable
updateTempTable,
      Printer
"FROM " Printer -> Printer -> Printer
<+> Aliased Printer -> Printer
fromAliased ((TableName -> Printer) -> Aliased TableName -> Aliased Printer
forall a b. (a -> b) -> Aliased a -> Aliased b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableName -> Printer
fromTableName Aliased TableName
updateTable),
      Where -> Printer
fromWhere Where
updateWhere
    ]

fromUpdateSet :: UpdateSet -> Printer
fromUpdateSet :: UpdateSet -> Printer
fromUpdateSet UpdateSet
setColumns =
  let updateColumnValue :: (ColumnName, UpdateOperator Expression) -> Printer
updateColumnValue (ColumnName
column, UpdateOperator Expression
updateOp) =
        ColumnName -> Printer
fromColumnName ColumnName
column Printer -> Printer -> Printer
<+> UpdateOperator Printer -> Printer
fromUpdateOperator (Expression -> Printer
fromExpression (Expression -> Printer)
-> UpdateOperator Expression -> UpdateOperator Printer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateOperator Expression
updateOp)
   in Printer
"SET " Printer -> Printer -> Printer
<+> Printer -> [Printer] -> Printer
SepByPrinter Printer
", " (((ColumnName, UpdateOperator Expression) -> Printer)
-> [(ColumnName, UpdateOperator Expression)] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map (ColumnName, UpdateOperator Expression) -> Printer
updateColumnValue (UpdateSet -> [(ColumnName, UpdateOperator Expression)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList UpdateSet
setColumns))
  where
    fromUpdateOperator :: UpdateOperator Printer -> Printer
    fromUpdateOperator :: UpdateOperator Printer -> Printer
fromUpdateOperator = \case
      UpdateSet Printer
p -> Printer
" = " Printer -> Printer -> Printer
<+> Printer
p
      UpdateInc Printer
p -> Printer
" += " Printer -> Printer -> Printer
<+> Printer
p

fromTempTableDDL :: TempTableDDL -> Printer
fromTempTableDDL :: TempTableDDL -> Printer
fromTempTableDDL = \case
  CreateTemp TempTableName
tempTableName [UnifiedColumn]
tempColumns ->
    Printer
"CREATE TABLE "
      Printer -> Printer -> Printer
<+> TempTableName -> Printer
fromTempTableName TempTableName
tempTableName
      Printer -> Printer -> Printer
<+> Printer
" ( "
      Printer -> Printer -> Printer
<+> Printer
columns
      Printer -> Printer -> Printer
<+> Printer
" ) "
    where
      columns :: Printer
columns =
        Printer -> [Printer] -> Printer
SepByPrinter
          (Printer
"," Printer -> Printer -> Printer
<+> Printer
NewlinePrinter)
          ((UnifiedColumn -> Printer) -> [UnifiedColumn] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map UnifiedColumn -> Printer
columnNameAndType [UnifiedColumn]
tempColumns)
      columnNameAndType :: UnifiedColumn -> Printer
columnNameAndType (UnifiedColumn ColumnName
name ScalarType
ty) =
        ColumnName -> Printer
fromColumnName ColumnName
name
          Printer -> Printer -> Printer
<+> Printer
" "
          Printer -> Printer -> Printer
<+> String -> Printer
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack (DataLength -> ScalarType -> Text
scalarTypeDBName DataLength
DataLengthMax ScalarType
ty))
          Printer -> Printer -> Printer
<+> Printer
" null"
  InsertTemp [Declare]
declares TempTableName
tempTableName InterpolatedQuery Expression
interpolatedQuery ->
    Printer -> [Printer] -> Printer
SepByPrinter
      Printer
NewlinePrinter
      ( (Declare -> Printer) -> [Declare] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map Declare -> Printer
fromDeclare [Declare]
declares
          [Printer] -> [Printer] -> [Printer]
forall a. Semigroup a => a -> a -> a
<> [ Printer
"INSERT INTO "
                 Printer -> Printer -> Printer
<+> TempTableName -> Printer
fromTempTableName TempTableName
tempTableName
                 Printer -> Printer -> Printer
<+> Printer
" "
                 Printer -> Printer -> Printer
<+> InterpolatedQuery Expression -> Printer
renderInterpolatedQuery InterpolatedQuery Expression
interpolatedQuery
             ]
      )
  DropTemp TempTableName
tempTableName ->
    Printer
"DROP TABLE "
      Printer -> Printer -> Printer
<+> TempTableName -> Printer
fromTempTableName TempTableName
tempTableName

fromDeclare :: Declare -> Printer
fromDeclare :: Declare -> Printer
fromDeclare (Declare Text
dName ScalarType
dType Expression
dValue) =
  Printer -> [Printer] -> Printer
SepByPrinter
    Printer
NewlinePrinter
    [ Printer
"DECLARE @" Printer -> Printer -> Printer
<+> Text -> Printer
fromRawUnescapedText Text
dName Printer -> Printer -> Printer
<+> Printer
" " Printer -> Printer -> Printer
<+> Text -> Printer
fromRawUnescapedText (DataLength -> ScalarType -> Text
scalarTypeDBName DataLength
DataLengthMax ScalarType
dType) Printer -> Printer -> Printer
<+> Printer
";",
      Printer
"SET @" Printer -> Printer -> Printer
<+> Text -> Printer
fromRawUnescapedText Text
dName Printer -> Printer -> Printer
<+> Printer
" = " Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
dValue Printer -> Printer -> Printer
<+> Printer
";"
    ]

-- | 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 -> Printer
fromSelectIntoTempTable SelectIntoTempTable {TempTableName
sittTempTableName :: TempTableName
$sel:sittTempTableName:SelectIntoTempTable :: SelectIntoTempTable -> TempTableName
sittTempTableName, [UnifiedColumn]
sittColumns :: [UnifiedColumn]
$sel:sittColumns:SelectIntoTempTable :: SelectIntoTempTable -> [UnifiedColumn]
sittColumns, TableName
sittFromTableName :: TableName
$sel:sittFromTableName:SelectIntoTempTable :: SelectIntoTempTable -> TableName
sittFromTableName, SITTConstraints
sittConstraints :: SITTConstraints
$sel:sittConstraints:SelectIntoTempTable :: SelectIntoTempTable -> SITTConstraints
sittConstraints} =
  Printer -> [Printer] -> Printer
SepByPrinter
    Printer
NewlinePrinter
    ([Printer] -> Printer) -> [Printer] -> Printer
forall a b. (a -> b) -> a -> b
$ [ Printer
"SELECT "
          Printer -> Printer -> Printer
<+> Printer
columns,
        Printer
"INTO " Printer -> Printer -> Printer
<+> TempTableName -> Printer
fromTempTableName TempTableName
sittTempTableName,
        Printer
"FROM " Printer -> Printer -> Printer
<+> TableName -> Printer
fromTableName TableName
sittFromTableName,
        Printer
"WHERE " Printer -> Printer -> Printer
<+> Printer
falsePrinter
      ]
    [Printer] -> [Printer] -> [Printer]
forall a. Semigroup a => a -> a -> a
<> case SITTConstraints
sittConstraints of
      SITTConstraints
RemoveConstraints ->
        [ Printer
"UNION ALL SELECT " Printer -> Printer -> Printer
<+> Printer
columns,
          Printer
"FROM " Printer -> Printer -> Printer
<+> TableName -> Printer
fromTableName TableName
sittFromTableName,
          Printer
"WHERE " Printer -> Printer -> Printer
<+> Printer
falsePrinter
        ]
      SITTConstraints
KeepConstraints ->
        []
  where
    -- column names separated by commas
    columns :: Printer
columns =
      Printer -> [Printer] -> Printer
SepByPrinter
        (Printer
"," Printer -> Printer -> Printer
<+> Printer
NewlinePrinter)
        ((UnifiedColumn -> Printer) -> [UnifiedColumn] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map UnifiedColumn -> Printer
columnNameFromUnifiedColumn [UnifiedColumn]
sittColumns)

    -- column name with potential modifications of types
    columnNameFromUnifiedColumn :: UnifiedColumn -> Printer
columnNameFromUnifiedColumn (UnifiedColumn ColumnName
columnName ScalarType
columnType) =
      case ScalarType
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.
        ScalarType
TimestampType -> Printer
"CAST(" Printer -> Printer -> Printer
<+> ColumnName -> Printer
fromColumnName ColumnName
columnName Printer -> Printer -> Printer
<+> Printer
" AS binary(8)) AS " Printer -> Printer -> Printer
<+> ColumnName -> Printer
fromColumnName ColumnName
columnName
        ScalarType
_ -> ColumnName -> Printer
fromColumnName ColumnName
columnName

-- | @TempTableName "deleted"@ becomes @\#deleted@
fromTempTableName :: TempTableName -> Printer
fromTempTableName :: TempTableName -> Printer
fromTempTableName (TempTableName Text
v) = Query -> Printer
QueryPrinter (String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> (Text -> String) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v)

fromTempTable :: TempTable -> Printer
fromTempTable :: TempTable -> Printer
fromTempTable (TempTable TempTableName
table [ColumnName]
columns) =
  TempTableName -> Printer
fromTempTableName TempTableName
table Printer -> Printer -> Printer
<+> Printer -> Printer
parens (Printer -> [Printer] -> Printer
SepByPrinter Printer
", " ((ColumnName -> Printer) -> [ColumnName] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map ColumnName -> Printer
fromColumnName [ColumnName]
columns))

-- | @TempTableName "temp_table" is converted to "DROP TABLE #temp_table"
dropTempTableQuery :: TempTableName -> Printer
dropTempTableQuery :: TempTableName -> Printer
dropTempTableQuery TempTableName
tempTableName =
  Query -> Printer
QueryPrinter Query
"DROP TABLE " Printer -> Printer -> Printer
<+> TempTableName -> Printer
fromTempTableName TempTableName
tempTableName

fromSelect :: Select -> Printer
fromSelect :: Select -> Printer
fromSelect Select {[Join]
[Projection]
Maybe (NonEmpty OrderBy)
Maybe From
Maybe Expression
Maybe With
Top
Where
For
$sel:selectProjections:Select :: Select -> [Projection]
$sel:selectFrom:Select :: Select -> Maybe From
selectWith :: Maybe With
selectTop :: Top
selectProjections :: [Projection]
selectFrom :: Maybe From
selectJoins :: [Join]
selectWhere :: Where
selectFor :: For
selectOrderBy :: Maybe (NonEmpty OrderBy)
selectOffset :: Maybe Expression
$sel:selectWith:Select :: Select -> Maybe With
$sel:selectTop:Select :: Select -> Top
$sel:selectJoins:Select :: Select -> [Join]
$sel:selectWhere:Select :: Select -> Where
$sel:selectFor:Select :: Select -> For
$sel:selectOrderBy:Select :: Select -> Maybe (NonEmpty OrderBy)
$sel:selectOffset:Select :: Select -> Maybe Expression
..} = (With -> Printer) -> Maybe With -> Maybe Printer
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap With -> Printer
fromWith Maybe With
selectWith Maybe Printer -> Printer -> Printer
?<+> Printer
result
  where
    allWheres :: Where
allWheres = Where
selectWhere Where -> Where -> Where
forall a. Semigroup a => a -> a -> a
<> [Where] -> Where
forall a. Monoid a => [a] -> a
mconcat (Join -> Where
joinWhere (Join -> Where) -> [Join] -> [Where]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Join]
selectJoins)
    result :: Printer
result =
      Printer -> [Printer] -> Printer
SepByPrinter
        Printer
NewlinePrinter
        ([Printer] -> Printer) -> [Printer] -> Printer
forall a b. (a -> b) -> a -> b
$ [ Printer
"SELECT "
              Printer -> Printer -> Printer
<+> Int -> Printer -> Printer
IndentPrinter
                Int
7
                ( Printer -> [Printer] -> Printer
SepByPrinter
                    (Printer
"," Printer -> Printer -> Printer
<+> Printer
NewlinePrinter)
                    ((Projection -> Printer) -> [Projection] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map Projection -> Printer
fromProjection ([Projection] -> [Projection]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Projection]
selectProjections))
                )
          ]
        [Printer] -> [Printer] -> [Printer]
forall a. Semigroup a => a -> a -> a
<> [Printer
"FROM " Printer -> Printer -> Printer
<+> Int -> Printer -> Printer
IndentPrinter Int
5 (From -> Printer
fromFrom From
f) | Just From
f <- [Maybe From
selectFrom]]
        [Printer] -> [Printer] -> [Printer]
forall a. Semigroup a => a -> a -> a
<> [ Printer -> [Printer] -> Printer
SepByPrinter
               Printer
NewlinePrinter
               ( (Join -> Printer) -> [Join] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map
                   ( \Join {Where
JoinAlias
JoinSource
$sel:joinWhere:Join :: Join -> Where
joinSource :: JoinSource
joinJoinAlias :: JoinAlias
joinWhere :: Where
$sel:joinSource:Join :: Join -> JoinSource
$sel:joinJoinAlias:Join :: Join -> JoinAlias
..} ->
                       [Printer] -> Printer
SeqPrinter
                         [ Printer
"OUTER APPLY (",
                           Int -> Printer -> Printer
IndentPrinter Int
13 (JoinSource -> Printer
fromJoinSource JoinSource
joinSource),
                           Printer
") ",
                           Printer
NewlinePrinter,
                           Printer
"AS ",
                           JoinAlias -> Printer
fromJoinAlias JoinAlias
joinJoinAlias
                         ]
                   )
                   [Join]
selectJoins
               ),
             Where -> Printer
fromWhere Where
allWheres,
             Top -> Maybe Expression -> Maybe (NonEmpty OrderBy) -> Printer
fromOrderBys Top
selectTop Maybe Expression
selectOffset Maybe (NonEmpty OrderBy)
selectOrderBy,
             For -> Printer
fromFor For
selectFor
           ]

fromWith :: With -> Printer
fromWith :: With -> Printer
fromWith (With NonEmpty (Aliased CTEBody)
withSelects) =
  Printer
"WITH " Printer -> Printer -> Printer
<+> Printer -> [Printer] -> Printer
SepByPrinter Printer
", " ((Aliased CTEBody -> Printer) -> [Aliased CTEBody] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map Aliased CTEBody -> Printer
fromAliasedSelect (NonEmpty (Aliased CTEBody) -> [Aliased CTEBody]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Aliased CTEBody)
withSelects)) Printer -> Printer -> Printer
<+> Printer
NewlinePrinter
  where
    fromAliasedSelect :: Aliased CTEBody -> Printer
fromAliasedSelect (Aliased {Text
CTEBody
$sel:aliasedThing:Aliased :: forall a. Aliased a -> a
$sel:aliasedAlias:Aliased :: forall a. Aliased a -> Text
aliasedThing :: CTEBody
aliasedAlias :: Text
..}) =
      Text -> Printer
fromNameText Text
aliasedAlias
        Printer -> Printer -> Printer
<+> Printer
" AS "
        Printer -> Printer -> Printer
<+> Printer
"( "
        Printer -> Printer -> Printer
<+> ( case CTEBody
aliasedThing of
                CTESelect Select
select ->
                  Select -> Printer
fromSelect Select
select
                CTEUnsafeRawSQL InterpolatedQuery Expression
nativeQuery ->
                  InterpolatedQuery Expression -> Printer
renderInterpolatedQuery InterpolatedQuery Expression
nativeQuery
            )
        Printer -> Printer -> Printer
<+> Printer
" )"

renderInterpolatedQuery :: InterpolatedQuery Expression -> Printer
renderInterpolatedQuery :: InterpolatedQuery Expression -> Printer
renderInterpolatedQuery = (Printer -> Printer -> Printer) -> Printer -> [Printer] -> Printer
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Printer -> Printer -> Printer
(<+>) Printer
"" ([Printer] -> Printer)
-> (InterpolatedQuery Expression -> [Printer])
-> InterpolatedQuery Expression
-> Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpolatedQuery Expression -> [Printer]
renderedParts
  where
    renderedParts :: InterpolatedQuery Expression -> [Printer]
    renderedParts :: InterpolatedQuery Expression -> [Printer]
renderedParts (InterpolatedQuery [InterpolatedItem Expression]
parts) =
      ( \case
          IIText Text
t -> Text -> Printer
fromRawUnescapedText Text
t
          IIVariable Expression
v -> Expression -> Printer
fromExpression Expression
v
      )
        (InterpolatedItem Expression -> Printer)
-> [InterpolatedItem Expression] -> [Printer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InterpolatedItem Expression]
parts

fromJoinSource :: JoinSource -> Printer
fromJoinSource :: JoinSource -> Printer
fromJoinSource =
  \case
    JoinSelect Select
sel -> Select -> Printer
fromSelect Select
sel
    JoinReselect Reselect
reselect -> Reselect -> Printer
fromReselect Reselect
reselect

fromReselect :: Reselect -> Printer
fromReselect :: Reselect -> Printer
fromReselect Reselect {[Projection]
Where
For
reselectProjections :: [Projection]
reselectFor :: For
reselectWhere :: Where
$sel:reselectProjections:Reselect :: Reselect -> [Projection]
$sel:reselectFor:Reselect :: Reselect -> For
$sel:reselectWhere:Reselect :: Reselect -> Where
..} = Printer
result
  where
    result :: Printer
result =
      Printer -> [Printer] -> Printer
SepByPrinter
        Printer
NewlinePrinter
        [ Printer
"SELECT "
            Printer -> Printer -> Printer
<+> Int -> Printer -> Printer
IndentPrinter
              Int
7
              ( Printer -> [Printer] -> Printer
SepByPrinter
                  (Printer
"," Printer -> Printer -> Printer
<+> Printer
NewlinePrinter)
                  ((Projection -> Printer) -> [Projection] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map Projection -> Printer
fromProjection ([Projection] -> [Projection]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Projection]
reselectProjections))
              ),
          Where -> Printer
fromWhere Where
reselectWhere,
          For -> Printer
fromFor For
reselectFor
        ]

fromOrderBys ::
  Top -> Maybe Expression -> Maybe (NonEmpty OrderBy) -> Printer
fromOrderBys :: Top -> Maybe Expression -> Maybe (NonEmpty OrderBy) -> Printer
fromOrderBys Top
NoTop Maybe Expression
Nothing Maybe (NonEmpty OrderBy)
Nothing = Printer
"" -- An ORDER BY is wasteful if not needed.
fromOrderBys Top
top Maybe Expression
moffset Maybe (NonEmpty OrderBy)
morderBys =
  [Printer] -> Printer
SeqPrinter
    [ Printer
"ORDER BY ",
      Int -> Printer -> Printer
IndentPrinter
        Int
9
        ( Printer -> [Printer] -> Printer
SepByPrinter
            Printer
NewlinePrinter
            [ case Maybe (NonEmpty OrderBy)
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.
                Maybe (NonEmpty OrderBy)
Nothing -> Printer
"(SELECT NULL) /* ORDER BY is required for OFFSET */"
                Just NonEmpty OrderBy
orderBys ->
                  Printer -> [Printer] -> Printer
SepByPrinter
                    (Printer
"," Printer -> Printer -> Printer
<+> Printer
NewlinePrinter)
                    ((OrderBy -> [Printer]) -> [OrderBy] -> [Printer]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OrderBy -> [Printer]
fromOrderBy (NonEmpty OrderBy -> [OrderBy]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty OrderBy
orderBys)),
              case (Top
top, Maybe Expression
moffset) of
                (Top
NoTop, Maybe Expression
Nothing) -> Printer
""
                (Top
NoTop, Just Expression
offset) ->
                  Printer
"OFFSET " Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
offset Printer -> Printer -> Printer
<+> Printer
" ROWS"
                (Top Int
n, Maybe Expression
Nothing) ->
                  Printer
"OFFSET 0 ROWS FETCH NEXT "
                    Printer -> Printer -> Printer
<+> Query -> Printer
QueryPrinter (Value -> Query
forall a. ToSql a => a -> Query
toSql (Int -> Value
IntValue Int
n))
                    Printer -> Printer -> Printer
<+> Printer
" ROWS ONLY"
                (Top Int
n, Just Expression
offset) ->
                  Printer
"OFFSET "
                    Printer -> Printer -> Printer
<+> Expression -> Printer
fromExpression Expression
offset
                    Printer -> Printer -> Printer
<+> Printer
" ROWS FETCH NEXT "
                    Printer -> Printer -> Printer
<+> Query -> Printer
QueryPrinter (Value -> Query
forall a. ToSql a => a -> Query
toSql (Int -> Value
IntValue Int
n))
                    Printer -> Printer -> Printer
<+> Printer
" ROWS ONLY"
            ]
        )
    ]

fromOrderBy :: OrderBy -> [Printer]
fromOrderBy :: OrderBy -> [Printer]
fromOrderBy OrderBy {Maybe ScalarType
FieldName
NullsOrder
Order
orderByFieldName :: FieldName
orderByOrder :: Order
orderByNullsOrder :: NullsOrder
orderByType :: Maybe ScalarType
$sel:orderByFieldName:OrderBy :: OrderBy -> FieldName
$sel:orderByOrder:OrderBy :: OrderBy -> Order
$sel:orderByNullsOrder:OrderBy :: OrderBy -> NullsOrder
$sel:orderByType:OrderBy :: OrderBy -> Maybe ScalarType
..} =
  [ FieldName -> NullsOrder -> Printer
fromNullsOrder FieldName
orderByFieldName NullsOrder
orderByNullsOrder,
    -- Above: This doesn't do anything when using text, ntext or image
    -- types. See below on CAST commentary.
    Printer -> Printer
wrapNullHandling (FieldName -> Printer
fromFieldName FieldName
orderByFieldName)
      Printer -> Printer -> Printer
<+> Printer
" "
      Printer -> Printer -> Printer
<+> Order -> Printer
fromOrder Order
orderByOrder
  ]
  where
    wrapNullHandling :: Printer -> Printer
wrapNullHandling Printer
inner =
      case Maybe ScalarType
orderByType of
        Just ScalarType
TextType -> Printer -> Printer
castTextish Printer
inner
        Just ScalarType
WtextType -> Printer -> Printer
castTextish Printer
inner
        -- Above: For some types, we have to do null handling manually
        -- ourselves:
        Maybe ScalarType
_ -> Printer
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 :: Printer -> Printer
castTextish Printer
inner = Printer
"CAST(" Printer -> Printer -> Printer
<+> Printer
inner Printer -> Printer -> Printer
<+> Printer
" AS VARCHAR(MAX))"

fromOrder :: Order -> Printer
fromOrder :: Order -> Printer
fromOrder =
  \case
    Order
AscOrder -> Printer
"ASC"
    Order
DescOrder -> Printer
"DESC"

fromNullsOrder :: FieldName -> NullsOrder -> Printer
fromNullsOrder :: FieldName -> NullsOrder -> Printer
fromNullsOrder FieldName
fieldName =
  \case
    NullsOrder
NullsAnyOrder -> Printer
""
    NullsOrder
NullsFirst -> Printer
"IIF(" Printer -> Printer -> Printer
<+> FieldName -> Printer
fromFieldName FieldName
fieldName Printer -> Printer -> Printer
<+> Printer
" IS NULL, 0, 1)"
    NullsOrder
NullsLast -> Printer
"IIF(" Printer -> Printer -> Printer
<+> FieldName -> Printer
fromFieldName FieldName
fieldName Printer -> Printer -> Printer
<+> Printer
" IS NULL, 1, 0)"

fromJoinAlias :: JoinAlias -> Printer
fromJoinAlias :: JoinAlias -> Printer
fromJoinAlias JoinAlias {Maybe Text
Text
joinAliasEntity :: Text
joinAliasField :: Maybe Text
$sel:joinAliasEntity:JoinAlias :: JoinAlias -> Text
$sel:joinAliasField:JoinAlias :: JoinAlias -> Maybe Text
..} =
  Text -> Printer
fromNameText Text
joinAliasEntity
    Printer -> Maybe Printer -> Printer
<+>? (Text -> Printer) -> Maybe Text -> Maybe Printer
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
name -> Printer
"(" Printer -> Printer -> Printer
<+> Text -> Printer
fromNameText Text
name Printer -> Printer -> Printer
<+> Printer
")") Maybe Text
joinAliasField

fromFor :: For -> Printer
fromFor :: For -> Printer
fromFor =
  \case
    For
NoFor -> Printer
""
    JsonFor ForJson {JsonCardinality
jsonCardinality :: JsonCardinality
$sel:jsonCardinality:ForJson :: ForJson -> JsonCardinality
jsonCardinality} ->
      Printer
"FOR JSON PATH, INCLUDE_NULL_VALUES"
        Printer -> Printer -> Printer
<+> case JsonCardinality
jsonCardinality of
          JsonCardinality
JsonArray -> Printer
""
          JsonCardinality
JsonSingleton -> Printer
", WITHOUT_ARRAY_WRAPPER"

fromProjection :: Projection -> Printer
fromProjection :: Projection -> Printer
fromProjection =
  \case
    ExpressionProjection Aliased Expression
aliasedExpression ->
      Aliased Printer -> Printer
fromAliased ((Expression -> Printer) -> Aliased Expression -> Aliased Printer
forall a b. (a -> b) -> Aliased a -> Aliased b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expression -> Printer
fromExpression Aliased Expression
aliasedExpression)
    FieldNameProjection Aliased FieldName
aliasedFieldName ->
      Aliased Printer -> Printer
fromAliased ((FieldName -> Printer) -> Aliased FieldName -> Aliased Printer
forall a b. (a -> b) -> Aliased a -> Aliased b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldName -> Printer
fromFieldName Aliased FieldName
aliasedFieldName)
    AggregateProjection Aliased Aggregate
aliasedAggregate ->
      Aliased Printer -> Printer
fromAliased ((Aggregate -> Printer) -> Aliased Aggregate -> Aliased Printer
forall a b. (a -> b) -> Aliased a -> Aliased b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Aggregate -> Printer
fromAggregate Aliased Aggregate
aliasedAggregate)
    Projection
StarProjection -> Printer
"*"

fromAggregate :: Aggregate -> Printer
fromAggregate :: Aggregate -> Printer
fromAggregate =
  \case
    CountAggregate Countable FieldName
countable -> Printer
"COUNT(" Printer -> Printer -> Printer
<+> Countable FieldName -> Printer
fromCountable Countable FieldName
countable Printer -> Printer -> Printer
<+> Printer
")"
    OpAggregate Text
op [Expression]
args ->
      Query -> Printer
QueryPrinter (Text -> Query
rawUnescapedText Text
op)
        Printer -> Printer -> Printer
<+> Printer
"("
        Printer -> Printer -> Printer
<+> Printer -> [Printer] -> Printer
SepByPrinter Printer
", " ((Expression -> Printer) -> [Expression] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map Expression -> Printer
fromExpression ([Expression] -> [Expression]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Expression]
args))
        Printer -> Printer -> Printer
<+> Printer
")"
    TextAggregate Text
text -> Expression -> Printer
fromExpression (Value -> Expression
ValueExpression (Text -> Value
TextValue Text
text))

fromCountable :: Countable FieldName -> Printer
fromCountable :: Countable FieldName -> Printer
fromCountable =
  \case
    Countable FieldName
StarCountable -> Printer
"*"
    NonNullFieldCountable FieldName
field -> FieldName -> Printer
fromFieldName FieldName
field
    DistinctCountable FieldName
field -> Printer
"DISTINCT " Printer -> Printer -> Printer
<+> FieldName -> Printer
fromFieldName FieldName
field

fromWhere :: Where -> Printer
fromWhere :: Where -> Printer
fromWhere =
  \case
    Where [Expression]
expressions
      | Just Expression
whereExp <- Expression -> Maybe Expression
collapseWhere ([Expression] -> Expression
AndExpression [Expression]
expressions) ->
          Printer
"WHERE " Printer -> Printer -> Printer
<+> Int -> Printer -> Printer
IndentPrinter Int
6 (Expression -> Printer
fromExpression Expression
whereExp)
      | Bool
otherwise -> Printer
""

-- | 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 :: Expression -> Maybe Expression
collapseWhere = Expression -> Maybe Expression
go
  where
    go :: Expression -> Maybe Expression
go =
      \case
        ValueExpression (BoolValue Bool
True) -> Maybe Expression
forall a. Maybe a
Nothing
        AndExpression [Expression]
xs ->
          case (Expression -> Maybe Expression) -> [Expression] -> [Expression]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe Expression -> Maybe Expression
go [Expression]
xs of
            [] -> Maybe Expression
forall a. Maybe a
Nothing
            [Expression]
ys -> Expression -> Maybe Expression
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expression] -> Expression
AndExpression [Expression]
ys)
        Expression
e -> Expression -> Maybe Expression
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression
e

fromFrom :: From -> Printer
fromFrom :: From -> Printer
fromFrom =
  \case
    FromQualifiedTable Aliased TableName
aliasedQualifiedTableName ->
      Aliased Printer -> Printer
fromAliased ((TableName -> Printer) -> Aliased TableName -> Aliased Printer
forall a b. (a -> b) -> Aliased a -> Aliased b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableName -> Printer
fromTableName Aliased TableName
aliasedQualifiedTableName)
    FromOpenJson Aliased OpenJson
openJson -> Aliased Printer -> Printer
fromAliased ((OpenJson -> Printer) -> Aliased OpenJson -> Aliased Printer
forall a b. (a -> b) -> Aliased a -> Aliased b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OpenJson -> Printer
fromOpenJson Aliased OpenJson
openJson)
    FromSelect Aliased Select
select -> Aliased Printer -> Printer
fromAliased ((Select -> Printer) -> Aliased Select -> Aliased Printer
forall a b. (a -> b) -> Aliased a -> Aliased b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Printer -> Printer
parens (Printer -> Printer) -> (Select -> Printer) -> Select -> Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Select -> Printer
fromSelect) Aliased Select
select)
    FromIdentifier Text
identifier -> Text -> Printer
fromNameText Text
identifier
    FromTempTable Aliased TempTableName
aliasedTempTable -> Aliased Printer -> Printer
fromAliased ((TempTableName -> Printer)
-> Aliased TempTableName -> Aliased Printer
forall a b. (a -> b) -> Aliased a -> Aliased b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TempTableName -> Printer
fromTempTableName Aliased TempTableName
aliasedTempTable)

fromOpenJson :: OpenJson -> Printer
fromOpenJson :: OpenJson -> Printer
fromOpenJson OpenJson {Expression
openJsonExpression :: Expression
$sel:openJsonExpression:OpenJson :: OpenJson -> Expression
openJsonExpression, Maybe (NonEmpty JsonFieldSpec)
openJsonWith :: Maybe (NonEmpty JsonFieldSpec)
$sel:openJsonWith:OpenJson :: OpenJson -> Maybe (NonEmpty JsonFieldSpec)
openJsonWith} =
  Printer -> [Printer] -> Printer
SepByPrinter
    Printer
NewlinePrinter
    [ Printer
"OPENJSON("
        Printer -> Printer -> Printer
<+> Int -> Printer -> Printer
IndentPrinter Int
9 (Expression -> Printer
fromExpression Expression
openJsonExpression)
        Printer -> Printer -> Printer
<+> Printer
")",
      case Maybe (NonEmpty JsonFieldSpec)
openJsonWith of
        Maybe (NonEmpty JsonFieldSpec)
Nothing -> Printer
""
        Just NonEmpty JsonFieldSpec
openJsonWith' ->
          Printer
"WITH ("
            Printer -> Printer -> Printer
<+> Int -> Printer -> Printer
IndentPrinter
              Int
5
              ( Printer -> [Printer] -> Printer
SepByPrinter
                  (Printer
"," Printer -> Printer -> Printer
<+> Printer
NewlinePrinter)
                  (JsonFieldSpec -> Printer
fromJsonFieldSpec (JsonFieldSpec -> Printer) -> [JsonFieldSpec] -> [Printer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty JsonFieldSpec -> [JsonFieldSpec]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty JsonFieldSpec
openJsonWith')
              )
            Printer -> Printer -> Printer
<+> Printer
")"
    ]

fromJsonFieldSpec :: JsonFieldSpec -> Printer
fromJsonFieldSpec :: JsonFieldSpec -> Printer
fromJsonFieldSpec =
  \case
    StringField Text
name Maybe JsonPath
mPath -> Text -> Printer
fromNameText Text
name Printer -> Printer -> Printer
<+> Printer
" NVARCHAR(MAX)" Printer -> Printer -> Printer
<+> Maybe JsonPath -> Printer
quote Maybe JsonPath
mPath
    JsonField Text
name Maybe JsonPath
mPath -> JsonFieldSpec -> Printer
fromJsonFieldSpec (Text -> Maybe JsonPath -> JsonFieldSpec
StringField Text
name Maybe JsonPath
mPath) Printer -> Printer -> Printer
<+> Printer
" AS JSON"
    ScalarField ScalarType
fieldType DataLength
fieldLength Text
name Maybe JsonPath
mPath ->
      Text -> Printer
fromNameText Text
name
        Printer -> Printer -> Printer
<+> Printer
" "
        Printer -> Printer -> Printer
<+> String -> Printer
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ DataLength -> ScalarType -> Text
scalarTypeDBName DataLength
fieldLength ScalarType
fieldType)
        Printer -> Printer -> Printer
<+> Maybe JsonPath -> Printer
quote Maybe JsonPath
mPath
  where
    quote :: Maybe JsonPath -> Printer
quote Maybe JsonPath
mPath = Printer -> (JsonPath -> Printer) -> Maybe JsonPath -> Printer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Printer
"" ((\Printer
p -> Printer
" '" Printer -> Printer -> Printer
<+> Printer
p Printer -> Printer -> Printer
<+> Printer
"'") (Printer -> Printer)
-> (JsonPath -> Printer) -> JsonPath -> Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonPath -> Printer
go) Maybe JsonPath
mPath
    go :: JsonPath -> Printer
go = \case
      JsonPath
RootPath -> Printer
"$"
      IndexPath JsonPath
r Integer
i -> JsonPath -> Printer
go JsonPath
r Printer -> Printer -> Printer
<+> Printer
"[" Printer -> Printer -> Printer
<+> String -> Printer
forall a. IsString a => String -> a
fromString (Integer -> String
forall a. Show a => a -> String
show Integer
i) Printer -> Printer -> Printer
<+> Printer
"]"
      FieldPath JsonPath
r Text
f -> JsonPath -> Printer
go JsonPath
r Printer -> Printer -> Printer
<+> Printer
".\"" Printer -> Printer -> Printer
<+> String -> Printer
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
f) Printer -> Printer -> Printer
<+> Printer
"\""

fromTableName :: TableName -> Printer
fromTableName :: TableName -> Printer
fromTableName (TableName Text
tableName (SchemaName Text
tableSchema)) =
  Text -> Printer
fromNameText Text
tableSchema Printer -> Printer -> Printer
<+> Printer
"." Printer -> Printer -> Printer
<+> Text -> Printer
fromNameText Text
tableName

fromAliased :: Aliased Printer -> Printer
fromAliased :: Aliased Printer -> Printer
fromAliased Aliased {Text
Printer
$sel:aliasedThing:Aliased :: forall a. Aliased a -> a
$sel:aliasedAlias:Aliased :: forall a. Aliased a -> Text
aliasedThing :: Printer
aliasedAlias :: Text
..} =
  Printer
aliasedThing
    Printer -> Printer -> Printer
<+> ((Printer
" AS " Printer -> Printer -> Printer
<+>) (Printer -> Printer) -> (Text -> Printer) -> Text -> Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Printer
fromNameText) Text
aliasedAlias

fromColumnName :: ColumnName -> Printer
fromColumnName :: ColumnName -> Printer
fromColumnName (ColumnName Text
colname) = Text -> Printer
quoteIdentifier Text
colname

fromNameText :: Text -> Printer
fromNameText :: Text -> Printer
fromNameText = Text -> Printer
quoteIdentifier

fromRawUnescapedText :: Text -> Printer
fromRawUnescapedText :: Text -> Printer
fromRawUnescapedText Text
t = Query -> Printer
QueryPrinter (Text -> Query
rawUnescapedText Text
t)

-- | In Sql Server identifiers can be quoted using square brackets or double
-- quotes, "Delimited Identifiers" in T-SQL parlance, which gives full freedom
-- in what can syntactically constitute a name of a thing.
--
-- The delimiting characters may themselves appear in a delimited identifier,
-- in which case they are quoted by duplication of the terminal delimiter. This
-- is the only character escaping that happens within a delimited identifier.
--
-- (TODO: That fact does not seem to be documented anywhere I could find, but
-- seems to be folklore. I verified it myself at any rate)
--
-- Reference: https://learn.microsoft.com/en-us/sql/relational-databases/databases/database-identifiers?view=sql-server-ver16
quoteIdentifier :: Text -> Printer
quoteIdentifier :: Text -> Printer
quoteIdentifier Text
ident = Query -> Printer
QueryPrinter (Text -> Query
rawUnescapedText (Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
duplicateBrackets Text
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"))
  where
    duplicateBrackets :: Text -> Text
    duplicateBrackets :: Text -> Text
duplicateBrackets = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"]" Text
"]]"

truePrinter :: Printer
truePrinter :: Printer
truePrinter = Printer
"(1=1)"

falsePrinter :: Printer
falsePrinter :: Printer
falsePrinter = Printer
"(1<>1)"

parens :: Printer -> Printer
parens :: Printer -> Printer
parens Printer
p = Printer
"(" Printer -> Printer -> Printer
<+> Int -> Printer -> Printer
IndentPrinter Int
1 Printer
p Printer -> Printer -> Printer
<+> Printer
")"

--------------------------------------------------------------------------------

-- * Basic printing API

-- | Pretty-prints a 'Printer' as one line, converting 'NewlinePrinter' to space.
toQueryFlat :: Printer -> Query
toQueryFlat :: Printer -> Query
toQueryFlat = Int -> Printer -> Query
go Int
0
  where
    go :: Int -> Printer -> Query
go Int
level =
      \case
        QueryPrinter Query
q -> Query
q
        SeqPrinter [Printer]
xs -> [Query] -> Query
forall a. Monoid a => [a] -> a
mconcat ((Query -> Bool) -> [Query] -> [Query]
forall a. (a -> Bool) -> [a] -> [a]
filter Query -> Bool
notEmpty ((Printer -> Query) -> [Printer] -> [Query]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Printer -> Query
go Int
level) [Printer]
xs))
        SepByPrinter Printer
x [Printer]
xs ->
          [Query] -> Query
forall a. Monoid a => [a] -> a
mconcat
            (Query -> [Query] -> [Query]
forall a. a -> [a] -> [a]
intersperse (Int -> Printer -> Query
go Int
level Printer
x) ((Query -> Bool) -> [Query] -> [Query]
forall a. (a -> Bool) -> [a] -> [a]
filter Query -> Bool
notEmpty ((Printer -> Query) -> [Printer] -> [Query]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Printer -> Query
go Int
level) [Printer]
xs)))
        Printer
NewlinePrinter -> Query
" "
        IndentPrinter Int
n Printer
p -> Int -> Printer -> Query
go (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Printer
p
    notEmpty :: Query -> Bool
notEmpty = (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
forall a. Monoid a => a
mempty) (Text -> Bool) -> (Query -> Text) -> Query -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Text
renderQuery

-- | Pretty-prints a 'Printer' as multiple lines as defined by the printer.
toQueryPretty :: Printer -> Query
toQueryPretty :: Printer -> Query
toQueryPretty = Int -> Printer -> Query
go Int
0
  where
    go :: Int -> Printer -> Query
go Int
level =
      \case
        QueryPrinter Query
q -> Query
q
        SeqPrinter [Printer]
xs -> [Query] -> Query
forall a. Monoid a => [a] -> a
mconcat ((Query -> Bool) -> [Query] -> [Query]
forall a. (a -> Bool) -> [a] -> [a]
filter Query -> Bool
notEmpty ((Printer -> Query) -> [Printer] -> [Query]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Printer -> Query
go Int
level) [Printer]
xs))
        SepByPrinter Printer
x [Printer]
xs ->
          [Query] -> Query
forall a. Monoid a => [a] -> a
mconcat
            (Query -> [Query] -> [Query]
forall a. a -> [a] -> [a]
intersperse (Int -> Printer -> Query
go Int
level Printer
x) ((Query -> Bool) -> [Query] -> [Query]
forall a. (a -> Bool) -> [a] -> [a]
filter Query -> Bool
notEmpty ((Printer -> Query) -> [Printer] -> [Query]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Printer -> Query
go Int
level) [Printer]
xs)))
        Printer
NewlinePrinter -> Query
"\n" Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Int -> Query
indentation Int
level
        IndentPrinter Int
n Printer
p -> Int -> Printer -> Query
go (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Printer
p
    indentation :: Int -> Query
indentation Int
n = Text -> Query
rawUnescapedText (Int -> Text -> Text
T.replicate Int
n Text
" ")
    notEmpty :: Query -> Bool
notEmpty = (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
forall a. Monoid a => a
mempty) (Text -> Bool) -> (Query -> Text) -> Query -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Text
renderQuery