{-|
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

data Renamer = Renamer
    { Renamer -> Text -> Text
fieldToColumn :: Text -> Text
    , Renamer -> Text -> Text
columnToField :: Text -> Text
    }

compileQuery :: DynamicSQLQuery -> (PG.Query, [PG.Action])
compileQuery :: DynamicSQLQuery -> (Query, [Action])
compileQuery = Renamer -> DynamicSQLQuery -> (Query, [Action])
compileQueryWithRenamer Renamer
camelCaseRenamer

compileQueryWithRenamer :: Renamer -> DynamicSQLQuery -> (PG.Query, [PG.Action])
compileQueryWithRenamer :: Renamer -> DynamicSQLQuery -> (Query, [Action])
compileQueryWithRenamer Renamer
renamer DynamicSQLQuery
query = DynamicSQLQuery -> (Query, [Action])
compileQueryMapped ((Text -> Text) -> DynamicSQLQuery -> DynamicSQLQuery
mapColumnNames Renamer
renamer.fieldToColumn DynamicSQLQuery
query)

-- | Default renamer used by DataSync.
--
-- Transforms JS inputs in @camelCase@ to snake_case for the database
-- and DB outputs in @snake_case@ back to @camelCase@
camelCaseRenamer :: Renamer
camelCaseRenamer :: Renamer
camelCaseRenamer =
    Renamer
    { fieldToColumn :: Text -> Text
fieldToColumn = Text -> Text
fieldNameToColumnName
    , columnToField :: Text -> Text
columnToField = Text -> Text
columnNameToFieldName
    }

-- | Renamer that does not modify the column names
unmodifiedRenamer :: Renamer
unmodifiedRenamer :: Renamer
unmodifiedRenamer =
    Renamer
    { fieldToColumn :: Text -> Text
fieldToColumn = Text -> Text
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    , columnToField :: Text -> Text
columnToField = Text -> Text
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    }

-- | When a Field is retrieved from the database, it's all in @snake_case@. This turns it into @camelCase@
renameField :: Renamer -> Field -> Field
renameField :: Renamer -> Field -> Field
renameField Renamer
renamer Field
field =
    Field
field { fieldName = renamer.columnToField field.fieldName }

compileQueryMapped :: DynamicSQLQuery -> (PG.Query, [PG.Action])
compileQueryMapped :: DynamicSQLQuery -> (Query, [Action])
compileQueryMapped 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
offset :: DynamicSQLQuery -> Maybe Int
limit :: DynamicSQLQuery -> Maybe Int
distinctOnColumn :: DynamicSQLQuery -> Maybe ByteString
orderByClause :: DynamicSQLQuery -> [OrderByClause]
whereCondition :: DynamicSQLQuery -> Maybe ConditionExpression
selectedColumns :: DynamicSQLQuery -> SelectedColumns
table :: DynamicSQLQuery -> 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 (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
orderByColumn :: OrderByClause -> ByteString
orderByColumn, OrderByDirection
orderByDirection :: OrderByDirection
orderByDirection :: 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 (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
tsvector :: OrderByClause -> Text
tsvector, Text
tsquery :: Text
tsquery :: 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
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
"", [])

-- | Used to transform column names from @camelCase@ to @snake_case@
mapColumnNames :: (Text -> Text) -> DynamicSQLQuery -> DynamicSQLQuery
mapColumnNames :: (Text -> Text) -> DynamicSQLQuery -> DynamicSQLQuery
mapColumnNames Text -> Text
rename DynamicSQLQuery
query =
    DynamicSQLQuery
query
    { selectedColumns = mapSelectedColumns query.selectedColumns
    , whereCondition = mapConditionExpression <$> query.whereCondition
    , orderByClause = map mapOrderByClause query.orderByClause
    , distinctOnColumn = (cs . rename . cs) <$> query.distinctOnColumn
    }
    where
        mapSelectedColumns :: SelectedColumns -> SelectedColumns
        mapSelectedColumns :: SelectedColumns -> SelectedColumns
mapSelectedColumns SelectedColumns
SelectAll = SelectedColumns
SelectAll
        mapSelectedColumns (SelectSpecific [Text]
columns) = [Text] -> SelectedColumns
SelectSpecific ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
rename [Text]
columns)

        mapConditionExpression :: ConditionExpression -> ConditionExpression
        mapConditionExpression :: ConditionExpression -> ConditionExpression
mapConditionExpression ColumnExpression { Text
field :: Text
field :: ConditionExpression -> Text
field } = ColumnExpression { field :: Text
field = Text -> Text
rename Text
field }
        mapConditionExpression InfixOperatorExpression { ConditionExpression
left :: ConditionExpression
left :: ConditionExpression -> ConditionExpression
left, ConditionOperator
op :: ConditionOperator
op :: ConditionExpression -> ConditionOperator
op, ConditionExpression
right :: ConditionExpression
right :: ConditionExpression -> ConditionExpression
right } = InfixOperatorExpression { left :: ConditionExpression
left = ConditionExpression -> ConditionExpression
mapConditionExpression ConditionExpression
left, ConditionOperator
op :: ConditionOperator
op :: ConditionOperator
op, right :: ConditionExpression
right = ConditionExpression -> ConditionExpression
mapConditionExpression ConditionExpression
right }
        mapConditionExpression ConditionExpression
otherwise = ConditionExpression
otherwise

        mapOrderByClause :: OrderByClause -> OrderByClause
        mapOrderByClause :: OrderByClause -> OrderByClause
mapOrderByClause OrderByClause { ByteString
orderByColumn :: OrderByClause -> ByteString
orderByColumn :: ByteString
orderByColumn, OrderByDirection
orderByDirection :: OrderByClause -> OrderByDirection
orderByDirection :: OrderByDirection
orderByDirection } = OrderByClause { orderByColumn :: ByteString
orderByColumn = Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Text
rename (ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
orderByColumn)), OrderByDirection
orderByDirection :: OrderByDirection
orderByDirection :: OrderByDirection
orderByDirection }
        mapOrderByClause OrderByClause
otherwise = OrderByClause
otherwise

compileOrderByClause :: OrderByClause -> Text
compileOrderByClause :: OrderByClause -> Text
compileOrderByClause OrderByClause {} = Text
"? ?"
compileOrderByClause OrderByTSRank { Text
tsvector :: OrderByClause -> Text
tsvector :: Text
tsvector, Text
tsquery :: 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
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]
values :: 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 { values :: [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 { functionCall :: ConditionExpression -> FunctionCall
functionCall = ToTSQuery { Text
text :: Text
text :: FunctionCall -> Text
text } }) = (Query
"to_tsquery('english', ?)", [Text -> Action
forall a. ToField a => a -> Action
PG.toField Text
text])
compileCondition (ListExpression { [DynamicValue]
values :: 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