{-# LANGUAGE BangPatterns, TypeFamilies, DataKinds, PolyKinds, TypeApplications, ScopedTypeVariables, ConstraintKinds, TypeOperators, GADTs, UndecidableInstances, StandaloneDeriving, FunctionalDependencies, FlexibleContexts, InstanceSigs, AllowAmbiguousTypes, DeriveAnyClass #-}
{-|
Module: IHP.QueryBuilder.Compiler
Description: SQL compilation for QueryBuilder
Copyright: (c) digitally induced GmbH, 2020

This module provides functions to compile a QueryBuilder into SQL.
-}
module IHP.QueryBuilder.Compiler
( query
, buildQuery
, negateFilterOperator
, compileSQLQuery
, qualifiedColumnName
) where

import IHP.Prelude
import IHP.ModelSupport
import IHP.QueryBuilder.Types


-- | Returns the "NOT" version of an operator
--
-- >>> negateFilterOperator EqOp
-- NotEqOp
--
negateFilterOperator :: FilterOperator -> FilterOperator
negateFilterOperator :: FilterOperator -> FilterOperator
negateFilterOperator FilterOperator
EqOp = FilterOperator
NotEqOp
negateFilterOperator FilterOperator
NotEqOp = FilterOperator
EqOp
negateFilterOperator FilterOperator
InOp = FilterOperator
NotInOp
negateFilterOperator FilterOperator
NotInOp = FilterOperator
InOp
negateFilterOperator FilterOperator
IsOp = FilterOperator
IsNotOp
negateFilterOperator FilterOperator
IsNotOp = FilterOperator
IsOp
negateFilterOperator (LikeOp MatchSensitivity
matchSensitivity) = (MatchSensitivity -> FilterOperator
NotLikeOp MatchSensitivity
matchSensitivity)
negateFilterOperator (NotLikeOp MatchSensitivity
matchSensitivity) = (MatchSensitivity -> FilterOperator
LikeOp MatchSensitivity
matchSensitivity)
negateFilterOperator (MatchesOp MatchSensitivity
matchSensitivity) = Text -> FilterOperator
forall a. Text -> a
error Text
"not supported"
negateFilterOperator FilterOperator
GreaterThanOp = FilterOperator
LessThanOrEqualToOp
negateFilterOperator FilterOperator
GreaterThanOrEqualToOp = FilterOperator
LessThanOp
negateFilterOperator FilterOperator
LessThanOp = FilterOperator
GreaterThanOrEqualToOp
negateFilterOperator FilterOperator
LessThanOrEqualToOp = FilterOperator
GreaterThanOp
negateFilterOperator FilterOperator
SqlOp = FilterOperator
SqlOp

-- | Represent's a @SELECT * FROM ..@ query. It's the starting point to build a query.
-- Used together with the other functions to compose a sql query.
--
-- Example: Fetching all users
--
-- > allUsers <- query @User |> fetch
-- > -- Runs a 'SELECT * FROM users' query
--
-- You can use it together with 'filterWhere':
--
-- > activeUsers :: [User] <-
-- >    query @User
-- >     |> filterWhere (#active, True)
-- >     |> fetch
query :: forall model table. (table ~ GetTableName model, Table model) => DefaultScope table => QueryBuilder table
query :: forall model (table :: Symbol).
(table ~ GetTableName model, Table model, DefaultScope table) =>
QueryBuilder table
query = (forall (table :: Symbol).
DefaultScope table =>
QueryBuilder table -> QueryBuilder table
defaultScope @table) NewQueryBuilder { selectFrom :: Text
selectFrom = forall record. Table record => Text
tableName @model, columns :: [Text]
columns = forall record. Table record => [Text]
columnNames @model }
{-# INLINE query #-}

{-# INLINE buildQuery #-}
buildQuery :: forall table queryBuilderProvider joinRegister. (KnownSymbol table, HasQueryBuilder queryBuilderProvider joinRegister) => queryBuilderProvider table -> SQLQuery
buildQuery :: forall {k} (table :: Symbol) (queryBuilderProvider :: Symbol -> *)
       (joinRegister :: k).
(KnownSymbol table,
 HasQueryBuilder queryBuilderProvider joinRegister) =>
queryBuilderProvider table -> SQLQuery
buildQuery queryBuilderProvider table
queryBuilderProvider = Maybe Text -> QueryBuilder table -> SQLQuery
forall (table :: Symbol).
Maybe Text -> QueryBuilder table -> SQLQuery
compileSQLQuery (queryBuilderProvider table -> Maybe Text
forall {k} (queryBuilderProvider :: Symbol -> *)
       (joinRegister :: k) (table :: Symbol).
HasQueryBuilder queryBuilderProvider joinRegister =>
queryBuilderProvider table -> Maybe Text
forall (table :: Symbol). queryBuilderProvider table -> Maybe Text
getQueryIndex queryBuilderProvider table
queryBuilderProvider) (queryBuilderProvider table -> QueryBuilder table
forall {k} (queryBuilderProvider :: Symbol -> *)
       (joinRegister :: k) (table :: Symbol).
HasQueryBuilder queryBuilderProvider joinRegister =>
queryBuilderProvider table -> QueryBuilder table
forall (table :: Symbol).
queryBuilderProvider table -> QueryBuilder table
getQueryBuilder queryBuilderProvider table
queryBuilderProvider)

-- | Traverse a 'QueryBuilder' tree and produce an 'SQLQuery'.
--
-- Defined at the top level so the recursive case analysis is shared across
-- all inlined call sites of 'buildQuery'. The tiny 'buildQuery' wrapper
-- stays INLINE to resolve the 'HasQueryBuilder' dictionary, then hands off
-- to this shared worker.
compileSQLQuery :: Maybe Text -> QueryBuilder table -> SQLQuery
compileSQLQuery :: forall (table :: Symbol).
Maybe Text -> QueryBuilder table -> SQLQuery
compileSQLQuery Maybe Text
qIndex NewQueryBuilder { Text
selectFrom :: forall (table :: Symbol). QueryBuilder table -> Text
selectFrom :: Text
selectFrom, [Text]
columns :: forall (table :: Symbol). QueryBuilder table -> [Text]
columns :: [Text]
columns } =
    SQLQuery
        {     queryIndex :: Maybe Text
queryIndex = Maybe Text
qIndex
            , selectFrom :: Text
selectFrom = Text
selectFrom
            , distinctClause :: Bool
distinctClause = Bool
False
            , distinctOnClause :: Maybe Text
distinctOnClause = Maybe Text
forall a. Maybe a
Nothing
            , whereCondition :: Maybe Condition
whereCondition = Maybe Condition
forall a. Maybe a
Nothing
            , joins :: [Join]
joins = []
            , orderByClause :: [OrderByClause]
orderByClause = []
            , limitClause :: Maybe Int
limitClause = Maybe Int
forall a. Maybe a
Nothing
            , offsetClause :: Maybe Int
offsetClause = Maybe Int
forall a. Maybe a
Nothing
            , [Text]
columns :: [Text]
columns :: [Text]
columns
            }
compileSQLQuery Maybe Text
qIndex (DistinctQueryBuilder { QueryBuilder table
queryBuilder :: QueryBuilder table
queryBuilder :: forall (table :: Symbol). QueryBuilder table -> QueryBuilder table
queryBuilder }) = QueryBuilder table
queryBuilder
        QueryBuilder table -> (QueryBuilder table -> SQLQuery) -> SQLQuery
forall a b. a -> (a -> b) -> b
|> Maybe Text -> QueryBuilder table -> SQLQuery
forall (table :: Symbol).
Maybe Text -> QueryBuilder table -> SQLQuery
compileSQLQuery Maybe Text
qIndex
        SQLQuery -> (SQLQuery -> SQLQuery) -> SQLQuery
forall a b. a -> (a -> b) -> b
|> Proxy "distinctClause" -> Bool -> SQLQuery -> SQLQuery
forall model (name :: Symbol) value.
(KnownSymbol name, SetField name model value) =>
Proxy name -> value -> model -> model
set Proxy "distinctClause"
#distinctClause Bool
True
compileSQLQuery Maybe Text
qIndex (DistinctOnQueryBuilder { QueryBuilder table
queryBuilder :: forall (table :: Symbol). QueryBuilder table -> QueryBuilder table
queryBuilder :: QueryBuilder table
queryBuilder, Text
distinctOnColumn :: Text
distinctOnColumn :: forall (table :: Symbol). QueryBuilder table -> Text
distinctOnColumn }) = QueryBuilder table
queryBuilder
        QueryBuilder table -> (QueryBuilder table -> SQLQuery) -> SQLQuery
forall a b. a -> (a -> b) -> b
|> Maybe Text -> QueryBuilder table -> SQLQuery
forall (table :: Symbol).
Maybe Text -> QueryBuilder table -> SQLQuery
compileSQLQuery Maybe Text
qIndex
        SQLQuery -> (SQLQuery -> SQLQuery) -> SQLQuery
forall a b. a -> (a -> b) -> b
|> Proxy "distinctOnClause" -> Text -> SQLQuery -> SQLQuery
forall model (name :: Symbol) value.
(KnownSymbol name, SetField name model (Maybe value)) =>
Proxy name -> value -> model -> model
setJust Proxy "distinctOnClause"
#distinctOnClause Text
distinctOnColumn
compileSQLQuery Maybe Text
qIndex (FilterByQueryBuilder { QueryBuilder table
queryBuilder :: forall (table :: Symbol). QueryBuilder table -> QueryBuilder table
queryBuilder :: QueryBuilder table
queryBuilder, queryFilter :: forall (table :: Symbol).
QueryBuilder table -> (Text, FilterOperator, Snippet)
queryFilter = (Text
columnName, FilterOperator
operator, Snippet
snippet), Maybe Text
applyLeft :: Maybe Text
applyLeft :: forall (table :: Symbol). QueryBuilder table -> Maybe Text
applyLeft, Maybe Text
applyRight :: Maybe Text
applyRight :: forall (table :: Symbol). QueryBuilder table -> Maybe Text
applyRight }) =
            let condition :: Condition
condition = Text
-> FilterOperator
-> Snippet
-> Maybe Text
-> Maybe Text
-> Condition
ColumnCondition Text
columnName FilterOperator
operator Snippet
snippet Maybe Text
applyLeft Maybe Text
applyRight
            in
                QueryBuilder table
queryBuilder
                    QueryBuilder table -> (QueryBuilder table -> SQLQuery) -> SQLQuery
forall a b. a -> (a -> b) -> b
|> Maybe Text -> QueryBuilder table -> SQLQuery
forall (table :: Symbol).
Maybe Text -> QueryBuilder table -> SQLQuery
compileSQLQuery Maybe Text
qIndex
                    SQLQuery -> (SQLQuery -> SQLQuery) -> SQLQuery
forall a b. a -> (a -> b) -> b
|> Proxy "whereCondition"
-> (Maybe Condition -> Maybe Condition) -> SQLQuery -> SQLQuery
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value,
 SetField name model value) =>
Proxy name -> (value -> value) -> model -> model
modify Proxy "whereCondition"
#whereCondition \case
                            Just Condition
c -> Condition -> Maybe Condition
forall a. a -> Maybe a
Just (Condition -> Condition -> Condition
AndCondition Condition
c Condition
condition)
                            Maybe Condition
Nothing -> Condition -> Maybe Condition
forall a. a -> Maybe a
Just Condition
condition
compileSQLQuery Maybe Text
qIndex (OrderByQueryBuilder { QueryBuilder table
queryBuilder :: forall (table :: Symbol). QueryBuilder table -> QueryBuilder table
queryBuilder :: QueryBuilder table
queryBuilder, OrderByClause
queryOrderByClause :: OrderByClause
queryOrderByClause :: forall (table :: Symbol). QueryBuilder table -> OrderByClause
queryOrderByClause }) = QueryBuilder table
queryBuilder
        QueryBuilder table -> (QueryBuilder table -> SQLQuery) -> SQLQuery
forall a b. a -> (a -> b) -> b
|> Maybe Text -> QueryBuilder table -> SQLQuery
forall (table :: Symbol).
Maybe Text -> QueryBuilder table -> SQLQuery
compileSQLQuery Maybe Text
qIndex
        SQLQuery -> (SQLQuery -> SQLQuery) -> SQLQuery
forall a b. a -> (a -> b) -> b
|> Proxy "orderByClause"
-> ([OrderByClause] -> [OrderByClause]) -> SQLQuery -> SQLQuery
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value,
 SetField name model value) =>
Proxy name -> (value -> value) -> model -> model
modify Proxy "orderByClause"
#orderByClause (\[OrderByClause]
value -> [OrderByClause]
value [OrderByClause] -> [OrderByClause] -> [OrderByClause]
forall a. Semigroup a => a -> a -> a
<> [OrderByClause
queryOrderByClause] ) -- although adding to the end of a list is bad form, these lists are very short
compileSQLQuery Maybe Text
qIndex (LimitQueryBuilder { QueryBuilder table
queryBuilder :: forall (table :: Symbol). QueryBuilder table -> QueryBuilder table
queryBuilder :: QueryBuilder table
queryBuilder, Int
queryLimit :: Int
queryLimit :: forall (table :: Symbol). QueryBuilder table -> Int
queryLimit }) =
                QueryBuilder table
queryBuilder
                QueryBuilder table -> (QueryBuilder table -> SQLQuery) -> SQLQuery
forall a b. a -> (a -> b) -> b
|> Maybe Text -> QueryBuilder table -> SQLQuery
forall (table :: Symbol).
Maybe Text -> QueryBuilder table -> SQLQuery
compileSQLQuery Maybe Text
qIndex
                SQLQuery -> (SQLQuery -> SQLQuery) -> SQLQuery
forall a b. a -> (a -> b) -> b
|> Proxy "limitClause" -> Int -> SQLQuery -> SQLQuery
forall model (name :: Symbol) value.
(KnownSymbol name, SetField name model (Maybe value)) =>
Proxy name -> value -> model -> model
setJust Proxy "limitClause"
#limitClause Int
queryLimit
compileSQLQuery Maybe Text
qIndex (OffsetQueryBuilder { QueryBuilder table
queryBuilder :: forall (table :: Symbol). QueryBuilder table -> QueryBuilder table
queryBuilder :: QueryBuilder table
queryBuilder, Int
queryOffset :: Int
queryOffset :: forall (table :: Symbol). QueryBuilder table -> Int
queryOffset }) = QueryBuilder table
queryBuilder
        QueryBuilder table -> (QueryBuilder table -> SQLQuery) -> SQLQuery
forall a b. a -> (a -> b) -> b
|> Maybe Text -> QueryBuilder table -> SQLQuery
forall (table :: Symbol).
Maybe Text -> QueryBuilder table -> SQLQuery
compileSQLQuery Maybe Text
qIndex
        SQLQuery -> (SQLQuery -> SQLQuery) -> SQLQuery
forall a b. a -> (a -> b) -> b
|> Proxy "offsetClause" -> Int -> SQLQuery -> SQLQuery
forall model (name :: Symbol) value.
(KnownSymbol name, SetField name model (Maybe value)) =>
Proxy name -> value -> model -> model
setJust Proxy "offsetClause"
#offsetClause Int
queryOffset
compileSQLQuery Maybe Text
qIndex (UnionQueryBuilder { QueryBuilder table
firstQueryBuilder :: QueryBuilder table
firstQueryBuilder :: forall (table :: Symbol). QueryBuilder table -> QueryBuilder table
firstQueryBuilder, QueryBuilder table
secondQueryBuilder :: QueryBuilder table
secondQueryBuilder :: forall (table :: Symbol). QueryBuilder table -> QueryBuilder table
secondQueryBuilder }) =
            let
                firstQuery :: SQLQuery
firstQuery = Maybe Text -> QueryBuilder table -> SQLQuery
forall (table :: Symbol).
Maybe Text -> QueryBuilder table -> SQLQuery
compileSQLQuery Maybe Text
qIndex QueryBuilder table
firstQueryBuilder
                secondQuery :: SQLQuery
secondQuery = Maybe Text -> QueryBuilder table -> SQLQuery
forall (table :: Symbol).
Maybe Text -> QueryBuilder table -> SQLQuery
compileSQLQuery Maybe Text
qIndex QueryBuilder table
secondQueryBuilder
                isSimpleQuery :: SQLQuery -> Bool
isSimpleQuery SQLQuery
q = [OrderByClause] -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null (SQLQuery -> [OrderByClause]
orderByClause SQLQuery
q) Bool -> Bool -> Bool
&& Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (SQLQuery -> Maybe Int
limitClause SQLQuery
q) Bool -> Bool -> Bool
&& Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (SQLQuery -> Maybe Int
offsetClause SQLQuery
q) Bool -> Bool -> Bool
&& [Join] -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null (SQLQuery -> [Join]
joins SQLQuery
q)
                isSimpleUnion :: Bool
isSimpleUnion = SQLQuery -> Bool
isSimpleQuery SQLQuery
firstQuery Bool -> Bool -> Bool
&& SQLQuery -> Bool
isSimpleQuery SQLQuery
secondQuery
                unionWhere :: Maybe Condition
unionWhere =
                    case (SQLQuery -> Maybe Condition
whereCondition SQLQuery
firstQuery, SQLQuery -> Maybe Condition
whereCondition SQLQuery
secondQuery) of
                        (Maybe Condition
Nothing, Maybe Condition
wc) -> Maybe Condition
wc
                        (Maybe Condition
wc, Maybe Condition
Nothing) -> Maybe Condition
wc
                        (Just Condition
firstWhere, Just Condition
secondWhere) -> Condition -> Maybe Condition
forall a. a -> Maybe a
Just (Condition -> Maybe Condition) -> Condition -> Maybe Condition
forall a b. (a -> b) -> a -> b
$ Condition -> Condition -> Condition
OrCondition Condition
firstWhere Condition
secondWhere
            in
                if Bool
isSimpleUnion then
                    SQLQuery
firstQuery { whereCondition = unionWhere }
                else
                    Text -> SQLQuery
forall a. Text -> a
error Text
"buildQuery: Union of complex queries not supported yet"
compileSQLQuery Maybe Text
qIndex (JoinQueryBuilder { QueryBuilder table
queryBuilder :: forall (table :: Symbol). QueryBuilder table -> QueryBuilder table
queryBuilder :: QueryBuilder table
queryBuilder, Join
joinData :: Join
joinData :: forall (table :: Symbol). QueryBuilder table -> Join
joinData }) =
    let
        firstQuery :: SQLQuery
firstQuery = Maybe Text -> QueryBuilder table -> SQLQuery
forall (table :: Symbol).
Maybe Text -> QueryBuilder table -> SQLQuery
compileSQLQuery Maybe Text
qIndex QueryBuilder table
queryBuilder
     in SQLQuery
firstQuery { joins = joinData:joins firstQuery }

-- | Build a qualified column name like @tablename.column_name@ from a table name
-- and a camelCase field name. The field name is converted to snake_case via
-- 'fieldNameToColumnName'.
--
-- This is intentionally NOINLINE: the call sites in filterWhere, orderBy, etc.
-- are always lifted to CAFs (evaluated once at program start), so inlining
-- only duplicates the Text.Inflections parsing logic and Text concatenation
-- without any runtime benefit.
qualifiedColumnName :: Text -> Text -> Text
qualifiedColumnName :: Text -> Text -> Text
qualifiedColumnName Text
tableName Text
fieldName = Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
fieldNameToColumnName Text
fieldName
{-# NOINLINE qualifiedColumnName #-}