Simplified query builder by replacing GADT with a more boring data st…

…ructure

IHP/QueryBuilder.hs

@@ -57,7 +57,9 @@ import IHP.ModelSupport
 import qualified Data.ByteString.Builder as Builder
 import IHP.HtmlSupport.ToHtml
 import qualified Data.ByteString.Char8 as ByteString
+import qualified Data.ByteString.Lazy as LByteString
 import qualified Control.DeepSeq as DeepSeq
+import qualified Data.Text.Encoding as Text
 
 -- | 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.
@@ -97,65 +99,121 @@ data FilterOperator = EqOp | InOp | NotInOp | IsOp | SqlOp deriving (Show, Eq)
 
 
 {-# INLINE compileOperator #-}
-compileOperator _ EqOp = "="
-compileOperator _ InOp = "IN"
-compileOperator _ NotInOp = "NOT IN"
-compileOperator _ IsOp = "IS"
-compileOperator _ SqlOp = ""
-
-data QueryBuilder (table :: Symbol) where
-    NewQueryBuilder :: QueryBuilder table
-    DistinctQueryBuilder :: QueryBuilder table -> QueryBuilder table
-    DistinctOnQueryBuilder :: KnownSymbol field => !(Proxy field) -> !(QueryBuilder table) -> QueryBuilder table
-    FilterByQueryBuilder :: (KnownSymbol field) => !(Proxy field, FilterOperator, Action) -> !(QueryBuilder table) -> QueryBuilder table
-    OrderByQueryBuilder :: KnownSymbol field => !(Proxy field, OrderByDirection) -> !(QueryBuilder table) -> QueryBuilder table
-    LimitQueryBuilder :: Int -> !(QueryBuilder table) -> QueryBuilder table
-    OffsetQueryBuilder :: Int -> !(QueryBuilder table) -> QueryBuilder table
-    UnionQueryBuilder :: !(QueryBuilder table) -> !(QueryBuilder table) -> QueryBuilder table
-
-data Condition = VarCondition !ByteString !Action | OrCondition !Condition !Condition | AndCondition !Condition !Condition deriving (Show)
-
-deriving instance Show (QueryBuilder a)
+compileOperator EqOp = "="
+compileOperator InOp = "IN"
+compileOperator NotInOp = "NOT IN"
+compileOperator IsOp = "IS"
+compileOperator SqlOp = ""
+
+data OrderByClause =
+    OrderByClause
+    { orderByColumn :: !ByteString
+    , orderByDirection :: !OrderByDirection }
+    deriving (Show, Eq)
+
+data QueryBuilder (table :: Symbol) =
+    NewQueryBuilder
+    | DistinctQueryBuilder   { queryBuilder :: !(QueryBuilder table) }
+    | DistinctOnQueryBuilder { queryBuilder :: !(QueryBuilder table), distinctOnColumn :: !ByteString }
+    | FilterByQueryBuilder   { queryBuilder :: !(QueryBuilder table), queryFilter :: !(ByteString, FilterOperator, Action) }
+    | OrderByQueryBuilder    { queryBuilder :: !(QueryBuilder table), queryOrderByClause :: !OrderByClause }
+    | LimitQueryBuilder      { queryBuilder :: !(QueryBuilder table), queryLimit :: !Int }
+    | OffsetQueryBuilder     { queryBuilder :: !(QueryBuilder table), queryOffset :: !Int }
+    | UnionQueryBuilder      { firstQueryBuilder :: !(QueryBuilder table), secondQueryBuilder :: !(QueryBuilder table) }
+    deriving (Show, Eq)
+
+data Condition = VarCondition !ByteString !Action | OrCondition !Condition !Condition | AndCondition !Condition !Condition deriving (Show, Eq)
 
 -- | Display QueryBuilder's as their sql query inside HSX
 instance KnownSymbol table => ToHtml (QueryBuilder table) where
     toHtml queryBuilder = toHtml (toSQL queryBuilder)
 
--- | This hack is to allow Eq instances for models with hasMany relations
-instance Eq (IHP.QueryBuilder.QueryBuilder table) where a == b = True
-
 data OrderByDirection = Asc | Desc deriving (Eq, Show)
-data SQLQuery = SQLQuery {
-        selectFrom :: !ByteString,
-        distinctClause :: !(Maybe ByteString),
-        distinctOnClause :: !(Maybe ByteString),
-        whereCondition :: !(Maybe Condition),
-        orderByClause :: !([(ByteString, OrderByDirection)]),
-        limitClause :: !(Maybe ByteString),
-        offsetClause :: !(Maybe ByteString)
-    }
+data SQLQuery = SQLQuery
+    { selectFrom :: !ByteString
+    , distinctClause :: !(Maybe ByteString)
+    , distinctOnClause :: !(Maybe ByteString)
+    , whereCondition :: !(Maybe Condition)
+    , orderByClause :: ![OrderByClause]
+    , limitClause :: !(Maybe ByteString)
+    , offsetClause :: !(Maybe ByteString)
+    } deriving (Show, Eq)
+
+-- | Needed for the 'Eq QueryBuilder' instance
+deriving instance Eq Action
+
+-- | Need for the 'Eq QueryBuilder' instance
+--
+-- You likely wonder: Why do we need the 'Eq SQLQuery' instance if this causes so much trouble?
+-- This has to do with how has-many and belongs-to relations are models by the SchemaCompiler
+--
+-- E.g. given a table users and a table posts. Each Post belongs to a user. The schema compiler will
+-- add a field 'posts :: QueryBuilder "posts"' with the default value @query |> filterWhere (#userId, get #id self)@ to all users by default.
+-- 
+-- This is needed to support syntax like this:
+-- 
+-- > user
+-- >     |> get #posts
+-- >     |> fetch
+--
+instance Eq Builder.Builder where
+    a == b = (Builder.toLazyByteString a) == (Builder.toLazyByteString b)
+
+instance SetField "selectFrom" SQLQuery ByteString where setField value sqlQuery = sqlQuery { selectFrom = value }
+instance SetField "distinctClause" SQLQuery (Maybe ByteString) where setField value sqlQuery = sqlQuery { distinctClause = value }
+instance SetField "distinctOnClause" SQLQuery (Maybe ByteString) where setField value sqlQuery = sqlQuery { distinctOnClause = value }
+instance SetField "whereCondition" SQLQuery (Maybe Condition) where setField value sqlQuery = sqlQuery { whereCondition = value }
+instance SetField "orderByClause" SQLQuery [OrderByClause] where setField value sqlQuery = sqlQuery { orderByClause = value }
+instance SetField "limitClause" SQLQuery (Maybe ByteString) where setField value sqlQuery = sqlQuery { limitClause = value }
+instance SetField "offsetClause" SQLQuery (Maybe ByteString) where setField value sqlQuery = sqlQuery { offsetClause = value }
 
 {-# INLINE buildQuery #-}
 buildQuery :: forall table. (KnownSymbol table) => QueryBuilder table -> SQLQuery
-buildQuery !queryBuilder =
-    case queryBuilder of
-        NewQueryBuilder ->
-            let tableName = symbolToByteString @table
-            in SQLQuery { selectFrom = cs tableName, distinctClause = Nothing, distinctOnClause = Nothing, whereCondition = Nothing, orderByClause = [], limitClause = Nothing, offsetClause = Nothing }
-        DistinctQueryBuilder queryBuilder -> (buildQuery queryBuilder) { distinctClause = Just "DISTINCT" }
-        DistinctOnQueryBuilder fieldProxy queryBuilder -> (buildQuery queryBuilder) { distinctOnClause = Just ("DISTINCT ON (" <> (cs $ fieldNameToColumnName . cs $ symbolVal fieldProxy) <> ")") }
-        FilterByQueryBuilder (fieldProxy, operator, value) queryBuilder ->
+buildQuery NewQueryBuilder =
+    let tableName = symbolToByteString @table
+    in SQLQuery
+            { selectFrom = tableName
+            , distinctClause = Nothing
+            , distinctOnClause = Nothing
+            , whereCondition = Nothing
+            , orderByClause = []
+            , limitClause = Nothing
+            , offsetClause = Nothing
+            }
+buildQuery DistinctQueryBuilder { queryBuilder } = queryBuilder
+        |> buildQuery
+        |> setJust #distinctClause "DISTINCT"
+buildQuery DistinctOnQueryBuilder { queryBuilder, distinctOnColumn } = queryBuilder
+        |> buildQuery
+        |> setJust #distinctOnClause ("DISTINCT ON (" <> distinctOnColumn <> ")")
+buildQuery FilterByQueryBuilder { queryBuilder, queryFilter = (columnName, operator, value) } =
             let
-                query = buildQuery queryBuilder
-                condition = VarCondition ((cs $ fieldNameToColumnName . cs $ symbolVal fieldProxy) <> " " <> compileOperator fieldProxy operator <> " ?") value
+                condition = VarCondition (columnName <> " " <> compileOperator operator <> " ?") value
             in
-                query { whereCondition = Just $ case whereCondition query of Just c -> AndCondition c condition; Nothing -> condition }
-        OrderByQueryBuilder (fieldProxy, orderByDirection) queryBuilder ->
-            let query = buildQuery queryBuilder
-            in query { orderByClause = (orderByClause query) ++ [(cs $ fieldNameToColumnName . cs $ symbolVal fieldProxy, orderByDirection)] } -- although adding to the end of a list is bad form, these lists are very short
-        LimitQueryBuilder limit queryBuilder -> (buildQuery queryBuilder) { limitClause = Just ("LIMIT " <> cs (show limit)) }
-        OffsetQueryBuilder offset queryBuilder -> (buildQuery queryBuilder) { offsetClause = Just ("OFFSET " <> cs (show offset)) }
-        UnionQueryBuilder firstQueryBuilder secondQueryBuilder ->
+                queryBuilder
+                    |> buildQuery
+                    |> modify #whereCondition \case
+                            Just c -> Just (AndCondition c condition)
+                            Nothing -> Just condition
+buildQuery OrderByQueryBuilder { queryBuilder, queryOrderByClause } = queryBuilder
+        |> buildQuery
+        |> modify #orderByClause (\value -> value <> [queryOrderByClause] ) -- although adding to the end of a list is bad form, these lists are very short
+buildQuery LimitQueryBuilder { queryBuilder, queryLimit } =
+                queryBuilder
+                |> buildQuery
+                |> setJust #limitClause (
+                        (Builder.byteString "LIMIT " <> Builder.intDec queryLimit)
+                        |> Builder.toLazyByteString
+                        |> LByteString.toStrict
+                    )
+buildQuery OffsetQueryBuilder { queryBuilder, queryOffset } = queryBuilder
+        |> buildQuery
+        |> setJust #offsetClause (
+                (Builder.byteString "OFFSET " <> Builder.intDec queryOffset)
+                |> Builder.toLazyByteString
+                |> LByteString.toStrict
+            )
+buildQuery UnionQueryBuilder { firstQueryBuilder, secondQueryBuilder } =
             let
                 firstQuery = buildQuery firstQueryBuilder
                 secondQuery = buildQuery secondQueryBuilder
@@ -273,7 +331,14 @@ genericfetchIdsOneOrNothing !ids = query @model |> filterWhereIn (#id, ids) |> f
 genericFetchIdsOne :: forall model value table. (KnownSymbol table, PG.FromRow model, ?modelContext :: ModelContext, ToField value, EqOrIsOperator value, HasField "id" model value, model ~ GetModelByTableName table, GetTableName model ~ table) => [value] -> IO model
 genericFetchIdsOne !ids = query @model |> filterWhereIn (#id, ids) |> fetchOne
 
-toSQL :: forall table. (KnownSymbol table) => QueryBuilder table -> (ByteString, [Action])
+-- | Transforms a @query @@User |> ..@ expression into a SQL Query. Returns a tuple with the sql query template and it's placeholder values.
+--
+-- __Example:__ Get the sql query that is represented by a QueryBuilder
+--
+-- >>> let postsQuery = query @Post |> filterWhere (#public, True)
+-- >>> toSQL postsQuery
+-- ("SELECT posts.* FROM posts WHERE public = ?", [Plain "true"])
+toSQL :: (KnownSymbol table) => QueryBuilder table -> (ByteString, [Action])
 toSQL queryBuilder = toSQL' (buildQuery queryBuilder)
 {-# INLINE toSQL #-}
 
@@ -316,7 +381,7 @@ toSQL' sqlQuery@SQLQuery { selectFrom, distinctClause, distinctOnClause, orderBy
         orderByClause' :: Maybe ByteString
         orderByClause' = case orderByClause of
                 [] -> Nothing
-                xs -> Just ("ORDER BY " <> ByteString.intercalate "," ((map (\(column,direction) -> column <> (if direction == Desc then " DESC" else mempty)) xs)))
+                xs -> Just ("ORDER BY " <> ByteString.intercalate "," ((map (\OrderByClause { orderByColumn, orderByDirection } -> orderByColumn <> (if orderByDirection == Desc then " DESC" else mempty)) xs)))
 
 {-# INLINE toSQL' #-}
 
@@ -373,16 +438,22 @@ class FilterPrimaryKey table where
 --
 -- When your condition is too complex, use a raw sql query with 'IHP.ModelSupport.sqlQuery'.
 filterWhere :: forall name table model value. (KnownSymbol name, ToField value, HasField name model value, EqOrIsOperator value, model ~ GetModelByTableName table) => (Proxy name, value) -> QueryBuilder table -> QueryBuilder table
-filterWhere (name, value) = FilterByQueryBuilder (name, toEqOrIsOperator value, toField value)
+filterWhere (name, value) queryBuilder = FilterByQueryBuilder { queryBuilder, queryFilter = (columnName, toEqOrIsOperator value, toField value) }
+    where
+        columnName = Text.encodeUtf8 (fieldNameToColumnName (symbolToText @name))
 {-# INLINE filterWhere #-}
 
 filterWhereIn :: forall name table model value. (KnownSymbol name, ToField value, HasField name model value, model ~ GetModelByTableName table) => (Proxy name, [value]) -> QueryBuilder table -> QueryBuilder table
-filterWhereIn (name, value) = FilterByQueryBuilder (name, InOp, toField (In value))
+filterWhereIn (name, value) queryBuilder = FilterByQueryBuilder { queryBuilder, queryFilter = (columnName, InOp, toField (In value)) }
+    where
+        columnName = Text.encodeUtf8 (fieldNameToColumnName (symbolToText @name))
 {-# INLINE filterWhereIn #-}
 
 filterWhereNotIn :: forall name table model value. (KnownSymbol name, ToField value, HasField name model value, model ~ GetModelByTableName table) => (Proxy name, [value]) -> QueryBuilder table -> QueryBuilder table
-filterWhereNotIn (_, []) = id -- Handle empty case by ignoring query part: `WHERE x NOT IN ()`
-filterWhereNotIn (name, value) = FilterByQueryBuilder (name, NotInOp, toField (In value))
+filterWhereNotIn (_, []) queryBuilder = queryBuilder -- Handle empty case by ignoring query part: `WHERE x NOT IN ()`
+filterWhereNotIn (name, value) queryBuilder = FilterByQueryBuilder { queryBuilder, queryFilter = (columnName, NotInOp, toField (In value)) }
+    where
+        columnName = Text.encodeUtf8 (fieldNameToColumnName (symbolToText @name))
 {-# INLINE filterWhereNotIn #-}
 
 -- | Allows to add a custom raw sql where condition
@@ -394,13 +465,11 @@ filterWhereNotIn (name, value) = FilterByQueryBuilder (name, NotInOp, toField (I
 -- >     |> filterWhereSql (#startedAt, "< current_timestamp - interval '1 day'")
 -- >     |> fetch
 -- > -- SELECT * FROM projects WHERE started_at < current_timestamp - interval '1 day'
-{-# INLINE filterWhereSql #-}
 filterWhereSql :: forall name table model value. (KnownSymbol name, ToField value, HasField name model value, model ~ GetModelByTableName table) => (Proxy name, ByteString) -> QueryBuilder table -> QueryBuilder table
-filterWhereSql (name, sqlCondition) = FilterByQueryBuilder (name, SqlOp, Plain (Builder.byteString sqlCondition))
-
-data FilterWhereTag
-
-data OrderByTag
+filterWhereSql (name, sqlCondition) queryBuilder = FilterByQueryBuilder { queryBuilder, queryFilter = (columnName, SqlOp, Plain (Builder.byteString sqlCondition)) }
+    where
+        columnName = Text.encodeUtf8 (fieldNameToColumnName (symbolToText @name))
+{-# INLINE filterWhereSql #-}
 
 -- | Adds an @ORDER BY .. ASC@ to your query.
 --
@@ -413,8 +482,10 @@ data OrderByTag
 -- >     |> limit 10
 -- >     |> fetch
 -- > -- SELECT * FROM books LIMIT 10 ORDER BY created_at ASC
-orderByAsc :: (KnownSymbol name, HasField name model value, model ~ GetModelByTableName table) => Proxy name -> QueryBuilder table -> QueryBuilder table
-orderByAsc !name = OrderByQueryBuilder (name, Asc)
+orderByAsc :: forall name model table value. (KnownSymbol name, HasField name model value, model ~ GetModelByTableName table) => Proxy name -> QueryBuilder table -> QueryBuilder table
+orderByAsc !name queryBuilder = OrderByQueryBuilder { queryBuilder, queryOrderByClause = OrderByClause { orderByColumn = columnName, orderByDirection = Asc } }
+    where
+        columnName = Text.encodeUtf8 (fieldNameToColumnName (symbolToText @name))
 {-# INLINE orderByAsc #-}
 
 -- | Adds an @ORDER BY .. DESC@ to your query.
@@ -428,8 +499,10 @@ orderByAsc !name = OrderByQueryBuilder (name, Asc)
 -- >     |> limit 10
 -- >     |> fetch
 -- > -- SELECT * FROM projects LIMIT 10 ORDER BY created_at DESC
-orderByDesc :: (KnownSymbol name, HasField name model value, model ~ GetModelByTableName table) => Proxy name -> QueryBuilder table -> QueryBuilder table
-orderByDesc !name = OrderByQueryBuilder (name, Desc)
+orderByDesc :: forall name model table value. (KnownSymbol name, HasField name model value, model ~ GetModelByTableName table) => Proxy name -> QueryBuilder table -> QueryBuilder table
+orderByDesc !name queryBuilder = OrderByQueryBuilder { queryBuilder, queryOrderByClause = OrderByClause { orderByColumn = columnName, orderByDirection = Desc } }
+    where
+        columnName = Text.encodeUtf8 (fieldNameToColumnName (symbolToText @name))
 {-# INLINE orderByDesc #-}
 
 -- | Alias for 'orderByAsc'
@@ -447,7 +520,7 @@ orderBy !name = orderByAsc name
 -- >     |> fetch
 -- > -- SELECT * FROM posts LIMIT 10
 limit :: Int -> QueryBuilder model -> QueryBuilder model
-limit !limit = LimitQueryBuilder limit
+limit !queryLimit queryBuilder = LimitQueryBuilder { queryBuilder, queryLimit }
 {-# INLINE limit #-}
 
 -- | Adds an @OFFSET ..@ to your query. Most often used together with @LIMIT...@
@@ -461,7 +534,7 @@ limit !limit = LimitQueryBuilder limit
 -- >     |> fetch
 -- > -- SELECT * FROM posts LIMIT 10 OFFSET 10
 offset :: Int -> QueryBuilder model -> QueryBuilder model
-offset !offset = OffsetQueryBuilder offset
+offset !queryOffset queryBuilder = OffsetQueryBuilder { queryBuilder, queryOffset }
 {-# INLINE offset #-}
 
 {-# INLINE findBy #-}
@@ -486,7 +559,7 @@ findManyBy !field !value !queryBuilder = queryBuilder |> filterWhere (field, val
 -- > pages <- queryUnion userPages teamPages |> fetch
 -- > -- (SELECT * FROM pages WHERE owner_id = '..') UNION (SELECT * FROM pages WHERE team_id = '..')
 queryUnion :: QueryBuilder model -> QueryBuilder model -> QueryBuilder model
-queryUnion = UnionQueryBuilder
+queryUnion firstQueryBuilder secondQueryBuilder = UnionQueryBuilder { firstQueryBuilder, secondQueryBuilder }
 {-# INLINE queryUnion #-}
 
 
@@ -501,7 +574,7 @@ queryUnion = UnionQueryBuilder
 -- >     |> fetch
 -- > -- SELECT * FROM pages WHERE created_by = '..' OR public = True
 queryOr :: (qb ~ QueryBuilder model) => (qb -> qb) -> (qb -> qb) -> qb -> qb
-queryOr a b queryBuilder = a queryBuilder `UnionQueryBuilder` b queryBuilder
+queryOr firstQuery secondQuery queryBuilder = UnionQueryBuilder { firstQueryBuilder = firstQuery queryBuilder, secondQueryBuilder = secondQuery queryBuilder }
 {-# INLINE queryOr #-}
 
 instance (model ~ GetModelById (Id' table), GetTableName model ~ table, FilterPrimaryKey table) => Fetchable (Id' table) model where
@@ -558,6 +631,8 @@ distinct = DistinctQueryBuilder
 -- >     |> distinctOn #categoryId
 -- >     |> fetch
 -- > -- SELECT DISTINCT ON (category_id) * FROM books
-distinctOn :: (KnownSymbol name, HasField name model value, model ~ GetModelByTableName table) => Proxy name -> QueryBuilder table -> QueryBuilder table
-distinctOn !name = DistinctOnQueryBuilder name
+distinctOn :: forall name model value table. (KnownSymbol name, HasField name model value, model ~ GetModelByTableName table) => Proxy name -> QueryBuilder table -> QueryBuilder table
+distinctOn !name queryBuilder = DistinctOnQueryBuilder { distinctOnColumn = columnName, queryBuilder }
+    where
+        columnName = Text.encodeUtf8 (fieldNameToColumnName (symbolToText @name))
 {-# INLINE distinctOn #-}

Test/QueryBuilderSpec.hs

@@ -23,10 +23,6 @@ data Post = Post
 type instance GetTableName Post = "posts"
 type instance GetModelByTableName "posts" = Post
 
-deriving instance Eq ToField.Action
-instance Eq ByteString.Builder where
-    a == b = (ByteString.toLazyByteString a) == (ByteString.toLazyByteString b)
-
 tests = do
     describe "QueryBuilder" do
         describe "query" do