{-# LANGUAGE BangPatterns, TypeFamilies, DataKinds, PolyKinds, TypeApplications, ScopedTypeVariables, ConstraintKinds, TypeOperators, GADTs, UndecidableInstances, StandaloneDeriving, FunctionalDependencies, FlexibleContexts, InstanceSigs, AllowAmbiguousTypes, DeriveAnyClass #-}

{-|
Module: IHP.QueryBuilder.HasqlCompiler
Description: Compile QueryBuilder to Hasql Snippet
Copyright: (c) digitally induced GmbH, 2025

This module compiles QueryBuilder queries to Hasql's Snippet type for execution
with prepared statements.
-}
module IHP.QueryBuilder.HasqlCompiler
( toSnippet
, buildSnippet
, snippetToSQL
, compileOperator
) where

import IHP.Prelude
import qualified Hasql.DynamicStatements.Snippet as Snippet
import Hasql.DynamicStatements.Snippet (Snippet)
import IHP.QueryBuilder.Types
import IHP.QueryBuilder.Compiler (buildQuery)
import qualified Data.List as List

-- | Compile a QueryBuilder to a Hasql Snippet
toSnippet :: forall table queryBuilderProvider joinRegister. (KnownSymbol table, HasQueryBuilder queryBuilderProvider joinRegister) => queryBuilderProvider table -> Snippet
toSnippet :: forall {k} (table :: Symbol) (queryBuilderProvider :: Symbol -> *)
       (joinRegister :: k).
(KnownSymbol table,
 HasQueryBuilder queryBuilderProvider joinRegister) =>
queryBuilderProvider table -> Snippet
toSnippet queryBuilderProvider table
queryBuilderProvider = SQLQuery -> Snippet
buildSnippet (queryBuilderProvider table -> SQLQuery
forall {k} (table :: Symbol) (queryBuilderProvider :: Symbol -> *)
       (joinRegister :: k).
(KnownSymbol table,
 HasQueryBuilder queryBuilderProvider joinRegister) =>
queryBuilderProvider table -> SQLQuery
buildQuery queryBuilderProvider table
queryBuilderProvider)
{-# INLINE toSnippet #-}

-- | Build a Snippet from a compiled SQLQuery
buildSnippet :: SQLQuery -> Snippet
buildSnippet :: SQLQuery -> Snippet
buildSnippet sqlQuery :: SQLQuery
sqlQuery@SQLQuery { Maybe Text
queryIndex :: Maybe Text
queryIndex :: SQLQuery -> Maybe Text
queryIndex, Text
selectFrom :: Text
selectFrom :: SQLQuery -> Text
selectFrom, Bool
distinctClause :: Bool
distinctClause :: SQLQuery -> Bool
distinctClause, Maybe Text
distinctOnClause :: Maybe Text
distinctOnClause :: SQLQuery -> Maybe Text
distinctOnClause, [OrderByClause]
orderByClause :: [OrderByClause]
orderByClause :: SQLQuery -> [OrderByClause]
orderByClause, Maybe Int
limitClause :: Maybe Int
limitClause :: SQLQuery -> Maybe Int
limitClause, Maybe Int
offsetClause :: Maybe Int
offsetClause :: SQLQuery -> Maybe Int
offsetClause, [Text]
columns :: [Text]
columns :: SQLQuery -> [Text]
columns } =
    Text -> Snippet
Snippet.sql Text
"SELECT"
    Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Bool -> Snippet
distinctSnippet Bool
distinctClause
    Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Snippet
distinctOnSnippet Maybe Text
distinctOnClause
    Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
selectorsSnippet
    Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
" FROM"
    Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
selectFrom
    Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> [Join] -> Snippet
joinSnippet ([Join] -> [Join]
forall a. [a] -> [a]
reverse (SQLQuery -> [Join]
joins SQLQuery
sqlQuery))
    Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Maybe Condition -> Snippet
whereSnippet (SQLQuery -> Maybe Condition
whereCondition SQLQuery
sqlQuery)
    Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> [OrderByClause] -> Snippet
orderBySnippet [OrderByClause]
orderByClause
    Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Maybe Int -> Snippet
limitSnippet Maybe Int
limitClause
    Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Maybe Int -> Snippet
offsetSnippet Maybe Int
offsetClause
    where
        distinctSnippet :: Bool -> Snippet
        distinctSnippet :: Bool -> Snippet
distinctSnippet Bool
False = Snippet
forall a. Monoid a => a
mempty
        distinctSnippet Bool
True = Text -> Snippet
Snippet.sql Text
" DISTINCT"
        {-# INLINE distinctSnippet #-}

        distinctOnSnippet :: Maybe Text -> Snippet
        distinctOnSnippet :: Maybe Text -> Snippet
distinctOnSnippet Maybe Text
Nothing = Snippet
forall a. Monoid a => a
mempty
        distinctOnSnippet (Just Text
col) = Text -> Snippet
Snippet.sql Text
" DISTINCT ON (" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
col Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
")"
        {-# INLINE distinctOnSnippet #-}

        limitSnippet :: Maybe Int -> Snippet
        limitSnippet :: Maybe Int -> Snippet
limitSnippet Maybe Int
Nothing = Snippet
forall a. Monoid a => a
mempty
        limitSnippet (Just Int
n) = Text -> Snippet
Snippet.sql Text
" LIMIT " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Int32 -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: Int32)
        {-# INLINE limitSnippet #-}

        offsetSnippet :: Maybe Int -> Snippet
        offsetSnippet :: Maybe Int -> Snippet
offsetSnippet Maybe Int
Nothing = Snippet
forall a. Monoid a => a
mempty
        offsetSnippet (Just Int
n) = Text -> Snippet
Snippet.sql Text
" OFFSET " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Int32 -> Snippet
forall param. DefaultParamEncoder param => param -> Snippet
Snippet.param (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: Int32)
        {-# INLINE offsetSnippet #-}

        selectorsSnippet :: Snippet
        selectorsSnippet :: Snippet
selectorsSnippet =
            let indexParts :: [Snippet]
indexParts = case Maybe Text
queryIndex of
                    Just Text
idx -> [Text -> Snippet
Snippet.sql Text
idx]
                    Maybe Text
Nothing -> []
                columnParts :: [Snippet]
columnParts = (Text -> Snippet) -> [Text] -> [Snippet]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
column -> Text -> Snippet
Snippet.sql Text
selectFrom Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
"." Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
column) [Text]
columns
            in [Snippet] -> Snippet
forall a. Monoid a => [a] -> a
mconcat ([Snippet] -> Snippet) -> [Snippet] -> Snippet
forall a b. (a -> b) -> a -> b
$ Snippet -> [Snippet] -> [Snippet]
forall a. a -> [a] -> [a]
List.intersperse (Text -> Snippet
Snippet.sql Text
", ") ([Snippet]
indexParts [Snippet] -> [Snippet] -> [Snippet]
forall a. Semigroup a => a -> a -> a
<> [Snippet]
columnParts)

        joinSnippet :: [Join] -> Snippet
        joinSnippet :: [Join] -> Snippet
joinSnippet [] = Snippet
forall a. Monoid a => a
mempty
        joinSnippet (Join
j:[Join]
js) = Text -> Snippet
Snippet.sql Text
" INNER JOIN " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql (Join -> Text
table Join
j) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
" ON " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql (Join -> Text
tableJoinColumn Join
j) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
" = " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql (Join -> Text
table Join
j) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
"." Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql (Join -> Text
otherJoinColumn Join
j) Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> [Join] -> Snippet
joinSnippet [Join]
js
-- buildSnippet takes monomorphic SQLQuery — no specialization benefit from INLINE.
-- Removing INLINE prevents duplicating the snippet compilation logic at every call site.

-- | Convert a WHERE condition to a Snippet
whereSnippet :: Maybe Condition -> Snippet
whereSnippet :: Maybe Condition -> Snippet
whereSnippet Maybe Condition
Nothing = Snippet
forall a. Monoid a => a
mempty
whereSnippet (Just Condition
condition) = Text -> Snippet
Snippet.sql Text
" WHERE " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Condition -> Snippet
conditionToSnippet Condition
condition
{-# INLINE whereSnippet #-}

-- | Convert a Condition to a Snippet
conditionToSnippet :: Condition -> Snippet
conditionToSnippet :: Condition -> Snippet
conditionToSnippet (ColumnCondition Text
column FilterOperator
operator Snippet
value Maybe Text
applyLeft Maybe Text
applyRight) =
    let applyFn :: Maybe Text -> Snippet -> Snippet
applyFn Maybe Text
fn Snippet
snippet = case Maybe Text
fn of
            Just Text
f -> Text -> Snippet
Snippet.sql Text
f Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
"(" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
snippet Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
")"
            Maybe Text
Nothing -> Snippet
snippet
        colSnippet :: Snippet
colSnippet = Maybe Text -> Snippet -> Snippet
applyFn Maybe Text
applyLeft (Text -> Snippet
Snippet.sql Text
column)
        valSnippet :: Snippet
valSnippet = case FilterOperator
operator of
            FilterOperator
InOp -> Text -> Snippet
Snippet.sql Text
"(" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
value Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
")"
            FilterOperator
NotInOp -> Text -> Snippet
Snippet.sql Text
"(" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
value Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
")"
            FilterOperator
SqlOp -> Snippet
value
            FilterOperator
_ -> Maybe Text -> Snippet -> Snippet
applyFn Maybe Text
applyRight Snippet
value
        opText :: Text
opText = FilterOperator -> Text
compileOperator FilterOperator
operator
    in case FilterOperator
operator of
        FilterOperator
SqlOp -> Snippet
colSnippet Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
valSnippet
        FilterOperator
_ -> Snippet
colSnippet Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
opText Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
" " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Snippet
valSnippet
conditionToSnippet (OrCondition Condition
a Condition
b) =
    Text -> Snippet
Snippet.sql Text
"(" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Condition -> Snippet
conditionToSnippet Condition
a Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
") OR (" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Condition -> Snippet
conditionToSnippet Condition
b Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
")"
conditionToSnippet (AndCondition Condition
a Condition
b) =
    Text -> Snippet
Snippet.sql Text
"(" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Condition -> Snippet
conditionToSnippet Condition
a Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
") AND (" Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Condition -> Snippet
conditionToSnippet Condition
b Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> Text -> Snippet
Snippet.sql Text
")"
{-# INLINE conditionToSnippet #-}

-- | Compiles a 'FilterOperator' to its SQL representation
compileOperator :: FilterOperator -> Text
compileOperator :: FilterOperator -> Text
compileOperator FilterOperator
EqOp = Text
"="
compileOperator FilterOperator
NotEqOp = Text
"!="
compileOperator FilterOperator
InOp = Text
"= ANY"
compileOperator FilterOperator
NotInOp = Text
"<> ALL"
compileOperator FilterOperator
IsOp = Text
"IS"
compileOperator FilterOperator
IsNotOp = Text
"IS NOT"
compileOperator (LikeOp MatchSensitivity
CaseSensitive) = Text
"LIKE"
compileOperator (LikeOp MatchSensitivity
CaseInsensitive) = Text
"ILIKE"
compileOperator (NotLikeOp MatchSensitivity
CaseSensitive) = Text
"NOT LIKE"
compileOperator (NotLikeOp MatchSensitivity
CaseInsensitive) = Text
"NOT ILIKE"
compileOperator (MatchesOp MatchSensitivity
CaseSensitive) = Text
"~"
compileOperator (MatchesOp MatchSensitivity
CaseInsensitive) = Text
"~*"
compileOperator FilterOperator
GreaterThanOp = Text
">"
compileOperator FilterOperator
GreaterThanOrEqualToOp = Text
">="
compileOperator FilterOperator
LessThanOp = Text
"<"
compileOperator FilterOperator
LessThanOrEqualToOp = Text
"<="
compileOperator FilterOperator
SqlOp = Text
""
{-# INLINE compileOperator #-}

-- | Convert ORDER BY clause to Snippet
orderBySnippet :: [OrderByClause] -> Snippet
orderBySnippet :: [OrderByClause] -> Snippet
orderBySnippet [] = Snippet
forall a. Monoid a => a
mempty
orderBySnippet [OrderByClause]
clauses = Text -> Snippet
Snippet.sql Text
" ORDER BY " Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> [Snippet] -> Snippet
forall a. Monoid a => [a] -> a
mconcat (Snippet -> [Snippet] -> [Snippet]
forall a. a -> [a] -> [a]
List.intersperse (Text -> Snippet
Snippet.sql Text
",") ((OrderByClause -> Snippet) -> [OrderByClause] -> [Snippet]
forall a b. (a -> b) -> [a] -> [b]
map OrderByClause -> Snippet
orderByClauseToSnippet [OrderByClause]
clauses))
    where
        orderByClauseToSnippet :: OrderByClause -> Snippet
orderByClauseToSnippet OrderByClause { Text
orderByColumn :: Text
orderByColumn :: OrderByClause -> Text
orderByColumn, OrderByDirection
orderByDirection :: OrderByDirection
orderByDirection :: OrderByClause -> OrderByDirection
orderByDirection } =
            Text -> Snippet
Snippet.sql Text
orderByColumn Snippet -> Snippet -> Snippet
forall a. Semigroup a => a -> a -> a
<> (if OrderByDirection
orderByDirection OrderByDirection -> OrderByDirection -> Bool
forall a. Eq a => a -> a -> Bool
== OrderByDirection
Desc then Text -> Snippet
Snippet.sql Text
" DESC" else Snippet
forall a. Monoid a => a
mempty)
{-# INLINE orderBySnippet #-}

-- | Extract the SQL ByteString from a Snippet (for testing purposes)
--
-- This converts a Snippet to a Statement and extracts the SQL text.
-- Useful for verifying the hasql compilation path in tests.
snippetToSQL :: Snippet -> Text
snippetToSQL :: Snippet -> Text
snippetToSQL Snippet
snippet = Snippet -> Text
Snippet.toSql Snippet
snippet