{-|
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.ToField as PG
import qualified Database.PostgreSQL.Simple.Types 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
table :: Text
selectedColumns :: SelectedColumns
whereCondition :: Maybe ConditionExpression
orderByClause :: [OrderByClause]
distinctOnColumn :: Maybe ByteString
limit :: Maybe Int
offset :: Maybe Int
$sel:table:DynamicSQLQuery :: DynamicSQLQuery -> Text
$sel:selectedColumns:DynamicSQLQuery :: DynamicSQLQuery -> SelectedColumns
$sel:whereCondition:DynamicSQLQuery :: DynamicSQLQuery -> Maybe ConditionExpression
$sel:orderByClause:DynamicSQLQuery :: DynamicSQLQuery -> [OrderByClause]
$sel:distinctOnColumn:DynamicSQLQuery :: DynamicSQLQuery -> Maybe ByteString
$sel:limit:DynamicSQLQuery :: DynamicSQLQuery -> Maybe Int
$sel:offset:DynamicSQLQuery :: DynamicSQLQuery -> Maybe Int
.. } = (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
orderByColumn :: ByteString
$sel:orderByColumn:OrderByClause :: OrderByClause -> ByteString
orderByColumn, OrderByDirection
orderByDirection :: OrderByDirection
$sel:orderByDirection:OrderByClause :: OrderByClause -> 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
tsvector :: Text
$sel:tsvector:OrderByClause :: OrderByClause -> Text
tsvector, Text
tsquery :: Text
$sel:tsquery:OrderByClause :: OrderByClause -> 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
$sel:tsvector:OrderByClause :: OrderByClause -> Text
tsvector :: Text
tsvector, Text
$sel:tsquery:OrderByClause :: OrderByClause -> Text
tsquery :: 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 (InfixOperatorExpression ConditionExpression
a ConditionOperator
OpEqual (LiteralExpression DynamicValue
Null)) = ConditionExpression -> (Query, [Action])
compileCondition (ConditionExpression
-> ConditionOperator -> ConditionExpression -> ConditionExpression
InfixOperatorExpression ConditionExpression
a ConditionOperator
OpIs (DynamicValue -> ConditionExpression
LiteralExpression DynamicValue
Null)) -- Turn 'a = NULL' into 'a IS NULL'
compileCondition (InfixOperatorExpression ConditionExpression
a ConditionOperator
OpNotEqual (LiteralExpression DynamicValue
Null)) = ConditionExpression -> (Query, [Action])
compileCondition (ConditionExpression
-> ConditionOperator -> ConditionExpression -> ConditionExpression
InfixOperatorExpression ConditionExpression
a ConditionOperator
OpIsNot (DynamicValue -> ConditionExpression
LiteralExpression DynamicValue
Null)) -- Turn 'a <> NULL' into 'a IS NOT NULL'
compileCondition (InfixOperatorExpression ConditionExpression
a ConditionOperator
OpIn (ListExpression { [DynamicValue]
values :: [DynamicValue]
$sel:values:ColumnExpression :: ConditionExpression -> [DynamicValue]
values })) | (DynamicValue
Null DynamicValue -> [DynamicValue] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`List.elem` [DynamicValue]
values) =
    -- Turn 'a IN (NULL)' into 'a IS NULL'
    case (DynamicValue -> Bool)
-> [DynamicValue] -> ([DynamicValue], [DynamicValue])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (DynamicValue -> DynamicValue -> Bool
forall a. Eq a => a -> a -> Bool
(/=) DynamicValue
Null) [DynamicValue]
values of
        ([], [DynamicValue]
nullValues) -> ConditionExpression -> (Query, [Action])
compileCondition (ConditionExpression
-> ConditionOperator -> ConditionExpression -> ConditionExpression
InfixOperatorExpression ConditionExpression
a ConditionOperator
OpIs (DynamicValue -> ConditionExpression
LiteralExpression DynamicValue
Null))
        ([DynamicValue]
nonNullValues, [DynamicValue]
nullValues) -> ConditionExpression -> (Query, [Action])
compileCondition (ConditionExpression
-> ConditionOperator -> ConditionExpression -> ConditionExpression
InfixOperatorExpression (ConditionExpression
-> ConditionOperator -> ConditionExpression -> ConditionExpression
InfixOperatorExpression ConditionExpression
a ConditionOperator
OpIn (ListExpression { $sel:values:ColumnExpression :: [DynamicValue]
values = [DynamicValue]
nonNullValues })) ConditionOperator
OpOr (ConditionExpression
-> ConditionOperator -> ConditionExpression -> ConditionExpression
InfixOperatorExpression ConditionExpression
a ConditionOperator
OpIs (DynamicValue -> ConditionExpression
LiteralExpression DynamicValue
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
                LiteralExpression DynamicValue
Null -> 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
text :: Text
$sel:text:ToTSQuery :: FunctionCall -> 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 (ArrayValue [DynamicValue]
values) = PGArray DynamicValue -> Action
forall a. ToField a => a -> Action
PG.toField ([DynamicValue] -> PGArray DynamicValue
forall a. [a] -> PGArray a
PG.PGArray [DynamicValue]
values)
    toField DynamicValue
Null = Null -> Action
forall a. ToField a => a -> Action
PG.toField Null
PG.Null