{-|
Module: IHP.DataSync.DynamicQueryCompiler
Description: Compiles a DynamicQuery to SQL
Copyright: (c) digitally induced GmbH, 2021
-}
module IHP.DataSync.DynamicQueryCompiler where

import IHP.Prelude
import IHP.DataSync.DynamicQuery
import qualified IHP.QueryBuilder as QueryBuilder
import qualified Database.PostgreSQL.Simple as PG
import qualified Database.PostgreSQL.Simple.FromField as PG
import qualified Database.PostgreSQL.Simple.FromRow as PG
import qualified Database.PostgreSQL.Simple.ToField as PG
import qualified Database.PostgreSQL.Simple.Types as PG
import qualified Database.PostgreSQL.Simple.Notification as PG
import qualified Data.List as List

compileQuery :: DynamicSQLQuery -> (PG.Query, [PG.Action])
compileQuery :: DynamicSQLQuery -> (Query, [Action])
compileQuery DynamicSQLQuery { [OrderByClause]
Maybe Int
Maybe ByteString
Maybe ConditionExpression
Text
SelectedColumns
$sel:offset:DynamicSQLQuery :: DynamicSQLQuery -> Maybe Int
$sel:limit:DynamicSQLQuery :: DynamicSQLQuery -> Maybe Int
$sel:distinctOnColumn:DynamicSQLQuery :: DynamicSQLQuery -> Maybe ByteString
$sel:orderByClause:DynamicSQLQuery :: DynamicSQLQuery -> [OrderByClause]
$sel:whereCondition:DynamicSQLQuery :: DynamicSQLQuery -> Maybe ConditionExpression
$sel:selectedColumns:DynamicSQLQuery :: DynamicSQLQuery -> SelectedColumns
$sel:table:DynamicSQLQuery :: DynamicSQLQuery -> Text
offset :: Maybe Int
limit :: Maybe Int
distinctOnColumn :: Maybe ByteString
orderByClause :: [OrderByClause]
whereCondition :: Maybe ConditionExpression
selectedColumns :: SelectedColumns
table :: Text
.. } = (Query
sql, [Action]
args)
    where
        sql :: Query
sql = Query
"SELECT" Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
distinctOnSql Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
"? FROM ?" Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
whereSql Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
orderBySql Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
limitSql Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
offsetSql
        args :: [Action]
args = [Action]
distinctOnArgs
                [Action] -> [Action] -> [Action]
forall a. Semigroup a => a -> a -> a
<> [Maybe Action] -> [Action]
forall a. [Maybe a] -> [a]
catMaybes
                    [ Action -> Maybe Action
forall a. a -> Maybe a
Just (SelectedColumns -> Action
compileSelectedColumns SelectedColumns
selectedColumns)
                    , Action -> Maybe Action
forall a. a -> Maybe a
Just (Identifier -> Action
forall a. ToField a => a -> Action
PG.toField (Text -> Identifier
PG.Identifier Text
table))
                    ]
                [Action] -> [Action] -> [Action]
forall a. Semigroup a => a -> a -> a
<> [Action]
whereArgs
                [Action] -> [Action] -> [Action]
forall a. Semigroup a => a -> a -> a
<> [Action]
orderByArgs
                [Action] -> [Action] -> [Action]
forall a. Semigroup a => a -> a -> a
<> [Action]
limitArgs
                [Action] -> [Action] -> [Action]
forall a. Semigroup a => a -> a -> a
<> [Action]
offsetArgs

        (Query
distinctOnSql, [Action]
distinctOnArgs) = case Maybe ByteString
distinctOnColumn of
            Just ByteString
column -> (Query
" DISTINCT ON (?) ", [Identifier -> Action
forall a. ToField a => a -> Action
PG.toField (Identifier -> Action) -> Identifier -> Action
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
PG.Identifier (Text -> Text
fieldNameToColumnName (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
column)])
            Maybe ByteString
Nothing     -> (Query
" ", [])

        (Query
orderBySql, [Action]
orderByArgs) = case [OrderByClause]
orderByClause of
                [] -> (Query
"", [])
                [OrderByClause]
orderByClauses ->
                    ( ByteString -> Query
PG.Query (ByteString -> Query) -> ByteString -> Query
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
" ORDER BY " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> [Text] -> Text
intercalate Text
", " ((OrderByClause -> Text) -> [OrderByClause] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map OrderByClause -> Text
compileOrderByClause [OrderByClause]
orderByClauses))
                    , [OrderByClause]
orderByClauses
                        [OrderByClause] -> ([OrderByClause] -> [[Action]]) -> [[Action]]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (OrderByClause -> [Action]) -> [OrderByClause] -> [[Action]]
forall a b. (a -> b) -> [a] -> [b]
map (\case
                            OrderByClause { ByteString
$sel:orderByColumn:OrderByClause :: OrderByClause -> ByteString
orderByColumn :: ByteString
orderByColumn, OrderByDirection
$sel:orderByDirection:OrderByClause :: OrderByClause -> OrderByDirection
orderByDirection :: OrderByDirection
orderByDirection } ->
                                    [ Identifier -> Action
forall a. ToField a => a -> Action
PG.toField (Identifier -> Action) -> Identifier -> Action
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
PG.Identifier (Text -> Text
fieldNameToColumnName (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
orderByColumn)
                                    , Action -> Action
forall a. ToField a => a -> Action
PG.toField (Action -> Action) -> Action -> Action
forall a b. (a -> b) -> a -> b
$ if OrderByDirection
orderByDirection OrderByDirection -> OrderByDirection -> Bool
forall a. Eq a => a -> a -> Bool
== OrderByDirection
QueryBuilder.Desc
                                        then Builder -> Action
PG.Plain Builder
"DESC"
                                        else Builder -> Action
PG.Plain Builder
""
                                    ]
                            OrderByTSRank { Text
$sel:tsvector:OrderByClause :: OrderByClause -> Text
tsvector :: Text
tsvector, Text
$sel:tsquery:OrderByClause :: OrderByClause -> Text
tsquery :: Text
tsquery } ->
                                    [ Identifier -> Action
forall a. ToField a => a -> Action
PG.toField (Identifier -> Action) -> Identifier -> Action
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
PG.Identifier (Text -> Text
fieldNameToColumnName Text
tsvector)
                                    , Text -> Action
forall a. ToField a => a -> Action
PG.toField Text
tsquery
                                    ]
                        )
                        [[Action]] -> ([[Action]] -> [Action]) -> [Action]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> [[Action]] -> [Action]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    )

        (Query
whereSql, [Action]
whereArgs) = case ConditionExpression -> (Query, [Action])
compileCondition (ConditionExpression -> (Query, [Action]))
-> Maybe ConditionExpression -> Maybe (Query, [Action])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ConditionExpression
whereCondition of
            Just (Query
sql, [Action]
args) -> (Query
" WHERE " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
sql, [Action]
args)
            Maybe (Query, [Action])
Nothing -> (Query
"", [])

        (Query
limitSql, [Action]
limitArgs) = case Maybe Int
limit of
                Just Int
limit -> (Query
" LIMIT ?", [Int -> Action
forall a. ToField a => a -> Action
PG.toField Int
limit])
                Maybe Int
Nothing -> (Query
"", [])

        (Query
offsetSql, [Action]
offsetArgs) = case Maybe Int
offset of
                Just Int
offset -> (Query
" OFFSET ?", [Int -> Action
forall a. ToField a => a -> Action
PG.toField Int
offset])
                Maybe Int
Nothing -> (Query
"", [])

compileOrderByClause :: OrderByClause -> Text
compileOrderByClause :: OrderByClause -> Text
compileOrderByClause OrderByClause {} = Text
"? ?"
compileOrderByClause OrderByTSRank { Text
tsvector :: Text
$sel:tsvector:OrderByClause :: OrderByClause -> Text
tsvector, Text
tsquery :: Text
$sel:tsquery:OrderByClause :: OrderByClause -> Text
tsquery } = Text
"ts_rank(?, to_tsquery('english', ?))"

compileSelectedColumns :: SelectedColumns -> PG.Action
compileSelectedColumns :: SelectedColumns -> Action
compileSelectedColumns SelectedColumns
SelectAll = Builder -> Action
PG.Plain Builder
"*"
compileSelectedColumns (SelectSpecific [Text]
fields) = [Action] -> Action
PG.Many [Action]
args
    where
        args :: [PG.Action]
        args :: [Action]
args = [Action] -> [[Action]] -> [Action]
forall a. [a] -> [[a]] -> [a]
List.intercalate ([Builder -> Action
PG.Plain Builder
", "]) [[Action]]
fieldActions
        fieldActions :: [[PG.Action]]
        fieldActions :: [[Action]]
fieldActions = ((Text -> [Action]) -> [Text] -> [[Action]]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
field -> [ Identifier -> Action
forall a. ToField a => a -> Action
PG.toField (Text -> Identifier
PG.Identifier Text
field) ]) [Text]
fields)

-- TODO: validate query against schema

compileCondition :: ConditionExpression -> (PG.Query, [PG.Action])
compileCondition :: ConditionExpression -> (Query, [Action])
compileCondition (ColumnExpression Text
column) = (Query
"?", [Identifier -> Action
forall a. ToField a => a -> Action
PG.toField (Identifier -> Action) -> Identifier -> Action
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
PG.Identifier (Text -> Text
fieldNameToColumnName Text
column)])
compileCondition ConditionExpression
NullExpression = (Query
"NULL", [])
compileCondition (InfixOperatorExpression ConditionExpression
a ConditionOperator
OpEqual ConditionExpression
NullExpression) = ConditionExpression -> (Query, [Action])
compileCondition (ConditionExpression
-> ConditionOperator -> ConditionExpression -> ConditionExpression
InfixOperatorExpression ConditionExpression
a ConditionOperator
OpIs ConditionExpression
NullExpression) -- Turn 'a = NULL' into 'a IS NULL'
compileCondition (InfixOperatorExpression ConditionExpression
a ConditionOperator
OpNotEqual ConditionExpression
NullExpression) = ConditionExpression -> (Query, [Action])
compileCondition (ConditionExpression
-> ConditionOperator -> ConditionExpression -> ConditionExpression
InfixOperatorExpression ConditionExpression
a ConditionOperator
OpIsNot ConditionExpression
NullExpression) -- Turn 'a <> NULL' into 'a IS NOT NULL'
compileCondition (InfixOperatorExpression ConditionExpression
a ConditionOperator
operator ConditionExpression
b) = (Query
"(" Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
queryA Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
") " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> ConditionOperator -> Query
compileOperator ConditionOperator
operator Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
rightOperand, [Action]
paramsA [Action] -> [Action] -> [Action]
forall a. Semigroup a => a -> a -> a
<> [Action]
paramsB)
    where
        (Query
queryA, [Action]
paramsA) = ConditionExpression -> (Query, [Action])
compileCondition ConditionExpression
a
        (Query
queryB, [Action]
paramsB) = ConditionExpression -> (Query, [Action])
compileCondition ConditionExpression
b

        rightOperand :: Query
rightOperand = if Bool
rightParentheses
                then Query
"(" Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<>  Query
queryB Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
")"
                else Query
queryB

        rightParentheses :: Bool
        rightParentheses :: Bool
rightParentheses =
            case ConditionExpression
b of
                ConditionExpression
NullExpression -> Bool
False
                ListExpression {} -> Bool
False -- The () are inserted already via @PG.In@
                ConditionExpression
_ -> Bool
True
compileCondition (LiteralExpression DynamicValue
literal) = (Query
"?", [DynamicValue -> Action
forall a. ToField a => a -> Action
PG.toField DynamicValue
literal])
compileCondition (CallExpression { $sel:functionCall:ColumnExpression :: ConditionExpression -> FunctionCall
functionCall = ToTSQuery { Text
$sel:text:ToTSQuery :: FunctionCall -> Text
text :: Text
text } }) = (Query
"to_tsquery('english', ?)", [Text -> Action
forall a. ToField a => a -> Action
PG.toField Text
text])
compileCondition (ListExpression { [DynamicValue]
$sel:values:ColumnExpression :: ConditionExpression -> [DynamicValue]
values :: [DynamicValue]
values }) = (Query
"?", [In [DynamicValue] -> Action
forall a. ToField a => a -> Action
PG.toField ([DynamicValue] -> In [DynamicValue]
forall a. a -> In a
PG.In [DynamicValue]
values)])

compileOperator :: ConditionOperator -> PG.Query
compileOperator :: ConditionOperator -> Query
compileOperator ConditionOperator
OpEqual = Query
"="
compileOperator ConditionOperator
OpGreaterThan = Query
">"
compileOperator ConditionOperator
OpLessThan = Query
"<"
compileOperator ConditionOperator
OpGreaterThanOrEqual = Query
">="
compileOperator ConditionOperator
OpLessThanOrEqual = Query
"<="
compileOperator ConditionOperator
OpNotEqual = Query
"<>"
compileOperator ConditionOperator
OpAnd = Query
"AND"
compileOperator ConditionOperator
OpOr = Query
"OR"
compileOperator ConditionOperator
OpIs = Query
"IS"
compileOperator ConditionOperator
OpIsNot = Query
"IS NOT"
compileOperator ConditionOperator
OpTSMatch = Query
"@@"
compileOperator ConditionOperator
OpIn = Query
"IN"

instance PG.ToField DynamicValue where
    toField :: DynamicValue -> Action
toField (IntValue Int
int) = Int -> Action
forall a. ToField a => a -> Action
PG.toField Int
int
    toField (DoubleValue Double
double) = Double -> Action
forall a. ToField a => a -> Action
PG.toField Double
double
    toField (TextValue Text
text) = Text -> Action
forall a. ToField a => a -> Action
PG.toField Text
text
    toField (BoolValue Bool
bool) = Bool -> Action
forall a. ToField a => a -> Action
PG.toField Bool
bool
    toField (UUIDValue UUID
uuid) = UUID -> Action
forall a. ToField a => a -> Action
PG.toField UUID
uuid
    toField (DateTimeValue UTCTime
utcTime) = UTCTime -> Action
forall a. ToField a => a -> Action
PG.toField UTCTime
utcTime
    toField (PointValue Point
point) = Point -> Action
forall a. ToField a => a -> Action
PG.toField Point
point
    toField DynamicValue
Null = Null -> Action
forall a. ToField a => a -> Action
PG.toField Null
PG.Null