Add more support for non-id primary keys

IHP/Fetch.hs

@@ -188,16 +188,16 @@ genericFetchIdOne :: forall table model. (Table model, KnownSymbol table, PG.Fro
 genericFetchIdOne !id = query @model |> filterWhereId id |> fetchOne
 
 {-# INLINE genericFetchIds #-}
-genericFetchIds :: forall table model value. (Table model, KnownSymbol table, PG.FromRow model, ?modelContext :: ModelContext, ToField value, EqOrIsOperator value, HasField "id" model value, model ~ GetModelByTableName table, GetTableName model ~ table) => [value] -> IO [model]
-genericFetchIds !ids = query @model |> filterWhereIn (#id, ids) |> fetch
+genericFetchIds :: forall table model. (Table model, KnownSymbol table, PG.FromRow model, ?modelContext :: ModelContext, model ~ GetModelByTableName table, GetTableName model ~ table) => [Id model] -> IO [model]
+genericFetchIds !ids = query @model |> filterWhereIdIn ids |> fetch
 
 {-# INLINE genericfetchIdsOneOrNothing #-}
-genericfetchIdsOneOrNothing :: forall model value table. (Table model, KnownSymbol table, PG.FromRow model, ?modelContext :: ModelContext, ToField value, EqOrIsOperator value, HasField "id" model value, model ~ GetModelByTableName table, GetTableName model ~ table) => [value] -> IO (Maybe model)
-genericfetchIdsOneOrNothing !ids = query @model |> filterWhereIn (#id, ids) |> fetchOneOrNothing
+genericfetchIdsOneOrNothing :: forall table model. (Table model, KnownSymbol table, PG.FromRow model, ?modelContext :: ModelContext, model ~ GetModelByTableName table, GetTableName model ~ table) => [Id model] -> IO (Maybe model)
+genericfetchIdsOneOrNothing !ids = query @model |> filterWhereIdIn ids |> fetchOneOrNothing
 
 {-# INLINE genericFetchIdsOne #-}
-genericFetchIdsOne :: forall model value table. (Table model, 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
+genericFetchIdsOne :: forall table model. (Table model, KnownSymbol table, PG.FromRow model, ?modelContext :: ModelContext, model ~ GetModelByTableName table, GetTableName model ~ table) => [Id model] -> IO model
+genericFetchIdsOne !ids = query @model |> filterWhereIdIn ids |> fetchOne
 
 {-# INLINE findBy #-}
 findBy !field !value !queryBuilder = queryBuilder |> filterWhere (field, value) |> fetchOne
@@ -231,7 +231,7 @@ instance (model ~ GetModelById (Id' table), GetTableName model ~ table, FilterPr
     fetchOne (Just a) = genericFetchIdOne a
     fetchOne Nothing = error "Fetchable (Maybe Id): Failed to fetch because given id is 'Nothing', 'Just id' was expected"
 
-instance (model ~ GetModelById (Id' table), value ~ Id' table, HasField "id" model value, ToField (PrimaryKey table), GetModelByTableName (GetTableName model) ~ model) => Fetchable [Id' table] model where
+instance (model ~ GetModelById (Id' table), GetModelByTableName table ~ model, GetTableName model ~ table) => Fetchable [Id' table] model where
     type FetchResult [Id' table] model = [model]
     {-# INLINE fetch #-}
     fetch = genericFetchIds

IHP/FetchRelated.hs

@@ -71,6 +71,7 @@ instance (
         , Show (PrimaryKey tableName)
         , HasField "id" relatedModel (Id' tableName)
         , relatedModel ~ GetModelByTableName (GetTableName relatedModel)
+        , GetTableName relatedModel ~ tableName
         , Table relatedModel
         ) => CollectionFetchRelated (Id' tableName) relatedModel where
     collectionFetchRelated :: forall model relatedField. (
@@ -84,7 +85,7 @@ instance (
             Table relatedModel
         ) => Proxy relatedField -> [model] -> IO [Include relatedField model]
     collectionFetchRelated relatedField model = do
-        relatedModels :: [relatedModel] <- query @relatedModel |> filterWhereIn (#id, map (getField @relatedField) model) |> fetch
+        relatedModels :: [relatedModel] <- query @relatedModel |> filterWhereIdIn (map (getField @relatedField) model) |> fetch
         let
             assignRelated :: model -> Include relatedField model
             assignRelated model =
@@ -121,6 +122,7 @@ instance (
         , ToField (PrimaryKey tableName)
         , HasField "id" relatedModel (Id' tableName)
         , relatedModel ~ GetModelByTableName (GetTableName relatedModel)
+        , GetTableName relatedModel ~ tableName
         , Table relatedModel
         ) => CollectionFetchRelatedOrNothing (Id' tableName) relatedModel where
     collectionFetchRelatedOrNothing :: forall model relatedField. (
@@ -133,7 +135,7 @@ instance (
             KnownSymbol relatedField
         ) => Proxy relatedField -> [model] -> IO [Include relatedField model]
     collectionFetchRelatedOrNothing relatedField model = do
-        relatedModels :: [relatedModel] <- query @relatedModel |> filterWhereIn (#id, mapMaybe (getField @relatedField) model) |> fetch
+        relatedModels :: [relatedModel] <- query @relatedModel |> filterWhereIdIn (mapMaybe (getField @relatedField) model) |> fetch
         let
             assignRelated :: model -> Include relatedField model
             assignRelated model =

IHP/IDE/SchemaDesigner/View/Columns/Edit.hs

@@ -1,6 +1,6 @@
 module IHP.IDE.SchemaDesigner.View.Columns.Edit where
 
-import IHP.ViewPrelude
+import IHP.ViewPrelude hiding (primaryKeyColumnNames)
 import IHP.IDE.SchemaDesigner.Types
 import qualified IHP.IDE.SchemaDesigner.Compiler as Compiler
 import IHP.IDE.ToolServer.Types

IHP/IDE/SchemaDesigner/View/Layout.hs

@@ -15,7 +15,7 @@ module IHP.IDE.SchemaDesigner.View.Layout
 , emptyColumnSelectorContainer
 ) where
 
-import IHP.ViewPrelude
+import IHP.ViewPrelude hiding (primaryKeyColumnNames)
 import IHP.IDE.SchemaDesigner.Types
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.ToolServer.Helper.View

IHP/ModelSupport.hs

@@ -566,21 +566,68 @@ class
     --
     columnNames :: [ByteString]
 
-    -- | Returns WHERE conditions to match an entity by it's primary key
+    -- | Returns the list of column names, that are contained in the primary key for a given model
     --
-    -- For tables with a simple primary key this returns a tuple with the id:
+    -- __Example:__
     --
-    -- >>> primaryKeyCondition project
-    -- [("id", "d619f3cf-f355-4614-8a4c-e9ea4f301e39")]
+    -- >>> primaryKeyColumnNames @User
+    -- ["id"]
     --
-    -- If the table has a composite primary key, this returns multiple elements:
+    -- >>> primaryKeyColumnNames @PostTagging
+    -- ["post_id", "tag_id"]
+    --
+    primaryKeyColumnNames :: [ByteString]
+
+    -- | Returns the parameters for a WHERE conditions to match an entity by it's primary key, given the entities id
     --
-    -- >>> primaryKeyCondition postTag
-    -- [("post_id", "0ace9270-568f-4188-b237-3789aa520588"), ("tag_id", "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c")]
+    -- For tables with a simple primary key this simply the id:
     --
-    primaryKeyCondition :: record -> [(Text, PG.Action)]
-    default primaryKeyCondition :: forall id. (HasField "id" record id, ToField id) => record -> [(Text, PG.Action)]
-    primaryKeyCondition record = [("id", toField record.id)]
+    -- >>> primaryKeyConditionForId project.id
+    -- ["d619f3cf-f355-4614-8a4c-e9ea4f301e39"]
+    --
+    -- If the table has a composite primary key, this returns multiple elements:
+    --
+    -- >>> primaryKeyConditionForId postTag.id
+    -- ["0ace9270-568f-4188-b237-3789aa520588", "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c"]
+    -- 
+    -- The order of the elements for a composite primary key must match the order of the columns returned by 'primaryKeyColumnNames'
+    primaryKeyConditionForId :: Id record -> [PG.Action]
+
+-- | Returns an ActionTuple, representing the parameters that can be passed to a prepared SQL statement
+-- >>> toField $ primaryKeyConditionActionTupleForId postTag.id
+-- Many [Plain "(", Plain "0ace9270-568f-4188-b237-3789aa520588", Plain "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c", Plain ")"]
+primaryKeyConditionActionTupleForId :: forall record. (Table record) => Id record -> ActionTuple
+primaryKeyConditionActionTupleForId = ActionTuple . primaryKeyConditionForId @record
+
+-- | Returns ByteString, that represents the part of an SQL where clause, that matches on a tuple consisting of all the primary keys
+-- For table with simple primary keys this simply returns the name of the primary key column, without wrapping in a tuple
+-- >>> primaryKeyColumnSelector @PostTag
+-- "(post_tags.post_id, post_tags.tag_id)"
+-- >>> primaryKeyColumnSelector @Post
+-- "post_tags.post_id"
+primaryKeyConditionColumnSelector :: forall record. (Table record) => ByteString
+primaryKeyConditionColumnSelector = 
+    let 
+        qualifyColumnName col = tableNameByteString @record <> "." <> col
+    in
+    case primaryKeyColumnNames @record of
+            [] -> error . cs $ "Impossible happened in primaryKeyConditionColumnSelector. No primary keys found for table " <> tableName @record <> ". At least one primary key is required."
+            [s] -> qualifyColumnName s
+            conds -> "(" <> intercalate ", " (map qualifyColumnName conds) <> ")"
+
+-- | Returns WHERE conditions to match an entity by it's primary key
+--
+-- For tables with a simple primary key this returns a tuple with the id:
+--
+-- >>> primaryKeyCondition project
+-- ["d619f3cf-f355-4614-8a4c-e9ea4f301e39"]
+--
+-- If the table has a composite primary key, this returns multiple elements:
+--
+-- >>> primaryKeyCondition postTag
+-- ["0ace9270-568f-4188-b237-3789aa520588", "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c"]
+primaryKeyCondition :: forall record. (HasField "id" record (Id record), Table record) => record -> [PG.Action]
+primaryKeyCondition r = primaryKeyConditionForId @record r.id
 
 logQuery :: (?modelContext :: ModelContext, PG.ToRow parameters) => Query -> parameters -> NominalDiffTime -> IO ()
 logQuery query parameters time = do
@@ -610,7 +657,8 @@ logQuery query parameters time = do
 -- DELETE FROM projects WHERE id = '..'
 --
 -- Use 'deleteRecords' if you want to delete multiple records.
-deleteRecord :: forall record table. (?modelContext :: ModelContext, Show (PrimaryKey table), Table record, HasField "id" record (Id' table), ToField (PrimaryKey table), GetModelByTableName table ~ record, Show (PrimaryKey table), ToField (PrimaryKey table)) => record -> IO ()
+--
+deleteRecord :: forall record table. (?modelContext :: ModelContext, Table record, Show (PrimaryKey table), HasField "id" record (Id record), GetTableName record ~ table, record ~ GetModelByTableName table) => record -> IO ()
 deleteRecord record =
     deleteRecordById @record record.id
 {-# INLINABLE deleteRecord #-}
@@ -621,20 +669,21 @@ deleteRecord record =
 -- >>> delete projectId
 -- DELETE FROM projects WHERE id = '..'
 --
-deleteRecordById :: forall record table. (?modelContext :: ModelContext, Table record, ToField (PrimaryKey table), Show (PrimaryKey table), record ~ GetModelByTableName table) => Id' table -> IO ()
+deleteRecordById :: forall record table. (?modelContext :: ModelContext, Table record, Show (PrimaryKey table), GetTableName record ~ table, record ~ GetModelByTableName table) => Id' table -> IO ()
 deleteRecordById id = do
-    let theQuery = "DELETE FROM " <> tableName @record <> " WHERE id = ?"
-    let theParameters = PG.Only id
-    sqlExec (PG.Query . cs $! theQuery) theParameters
-    pure ()
+  let theQuery = "DELETE FROM " <> tableNameByteString @record <> " WHERE " <> (primaryKeyConditionColumnSelector @record) <> " = ?"
+
+  let theParameters = PG.Only $ primaryKeyConditionActionTupleForId @record id
+  sqlExec (PG.Query $! theQuery) theParameters
+  pure ()
 {-# INLINABLE deleteRecordById #-}
 
 -- | Runs a @DELETE@ query for a list of records.
 --
 -- >>> let projects :: [Project] = ...
 -- >>> deleteRecords projects
 -- DELETE FROM projects WHERE id IN (..)
-deleteRecords :: forall record table. (?modelContext :: ModelContext, Show (PrimaryKey table), Table record, HasField "id" record (Id' table), ToField (PrimaryKey table), record ~ GetModelByTableName table) => [record] -> IO ()
+deleteRecords :: forall record table. (?modelContext :: ModelContext, Show (PrimaryKey table), Table record, HasField "id" record (Id' table), GetTableName record ~ table, record ~ GetModelByTableName table) => [record] -> IO ()
 deleteRecords records =
     deleteRecordByIds @record (ids records)
 {-# INLINABLE deleteRecords #-}
@@ -645,12 +694,15 @@ deleteRecords records =
 -- >>> delete projectIds
 -- DELETE FROM projects WHERE id IN ('..')
 --
-deleteRecordByIds :: forall record table. (?modelContext :: ModelContext, Show (PrimaryKey table), Table record, ToField (PrimaryKey table), record ~ GetModelByTableName table) => [Id' table] -> IO ()
-deleteRecordByIds ids = do
-    let theQuery = "DELETE FROM " <> tableName @record <> " WHERE id IN ?"
-    let theParameters = (PG.Only (PG.In ids))
-    sqlExec (PG.Query . cs $! theQuery) theParameters
-    pure ()
+deleteRecordByIds :: forall record table. (?modelContext :: ModelContext, Show (PrimaryKey table), Table record, GetTableName record ~ table, record ~ GetModelByTableName table) => [Id' table] -> IO ()
+deleteRecordByIds [] = do
+  pure () -- If there are no ids, we wouldn't even know the pkCols, so we just don't do anything, as nothing happens anyways
+deleteRecordByIds ids@(firstId : _) = do
+  let theQuery = "DELETE FROM " <> tableNameByteString @record <> " WHERE " <> (primaryKeyConditionColumnSelector @record) <> " IN ?"
+
+  let theParameters = PG.Only $ PG.In $ map (primaryKeyConditionActionTupleForId @record) ids
+  sqlExec (PG.Query $! theQuery) theParameters
+  pure ()
 {-# INLINABLE deleteRecordByIds #-}
 
 -- | Runs a @DELETE@ query to delete all rows in a table.
@@ -921,6 +973,16 @@ instance ToField value => ToField [value] where
 instance (FromField value, Typeable value) => FromField [value] where
     fromField field value = PG.fromPGArray <$> (fromField field value)
 
+-- | Wraps a list of actions to be used as a Tuple, useful e.g for matching composite keys
+-- >>> toField (ActionTuple [ PG.Escape "myId" ])
+-- Many [Plain "(",Escape "myId",Plain ")"]
+--
+--   Analogous to PGArray from postgres-simple
+newtype ActionTuple = ActionTuple [Action]
+
+instance ToField ActionTuple where
+  toField (ActionTuple actions) = PG.Many ([PG.Plain "("] <> intersperse (PG.Plain ",") actions <> [PG.Plain ")"])
+
 -- | Useful to manually mark a table read when doing a custom sql query inside AutoRefresh or 'withTableReadTracker'.
 --
 -- When using 'fetch' on a query builder, this function is automatically called. That's why you only need to call

IHP/QueryBuilder.hs

@@ -24,6 +24,7 @@ module IHP.QueryBuilder
 , filterWhereCaseInsensitive
 , filterWhereNot
 , filterWhereIn
+, filterWhereIdIn
 , filterWhereNotIn
 , filterWhereLike
 , filterWhereILike
@@ -61,6 +62,9 @@ module IHP.QueryBuilder
 , Condition (..)
 , Join (..)
 , OrderByDirection (..)
+, injectQueryBuilder
+, FilterOperator (..)
+, toEqOrIsOperator
 )
 where
 import IHP.Prelude
@@ -826,6 +830,21 @@ filterWhereCaseInsensitive (name, value) queryBuilderProvider = injectQueryBuild
         queryBuilder = getQueryBuilder queryBuilderProvider
 {-# INLINE filterWhereCaseInsensitive #-}
 
+
+filterWhereIdIn :: forall table model queryBuilderProvider (joinRegister :: *). (KnownSymbol table, Table model, model ~ GetModelByTableName table, HasQueryBuilder queryBuilderProvider joinRegister) => [Id model] -> queryBuilderProvider table -> queryBuilderProvider table
+filterWhereIdIn values queryBuilderProvider =
+    -- We don't need to treat null values differently here, because primary keys imply not-null
+    let
+        actionTuples = map (primaryKeyConditionActionTupleForId @model) values
+
+        queryBuilder = getQueryBuilder queryBuilderProvider
+
+        whereInQuery = FilterByQueryBuilder {queryBuilder, queryFilter = (primaryKeyConditionColumnSelector @model, InOp, toField (In actionTuples)), applyLeft = Nothing, applyRight = Nothing}
+     in
+        injectQueryBuilder whereInQuery
+{-# INLINE filterWhereIdIn #-}
+
+
 -- | Joins a table to an existing QueryBuilder (or something holding a QueryBuilder) on the specified columns. Example:
 -- >    query @Posts 
 -- > |> innerJoin @Users (#author, #id)