Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add more support for non-id primary keys #1925

Merged
merged 25 commits into from
Mar 27, 2024
Merged
Show file tree
Hide file tree
Changes from 8 commits
Commits
Show all changes
25 commits
Select commit Hold shift + click to select a range
3e96871
add several unit for arbitrary pks
MonaMayrhofer Mar 2, 2024
19d4203
Fix SchemaCompiler to support non-id-pks
MonaMayrhofer Mar 2, 2024
db356aa
Change primaryKeyCondition to primaryKeyCondition'
MonaMayrhofer Mar 3, 2024
ad97647
Implement deleteRecord via primaryKeyCondition'
MonaMayrhofer Mar 3, 2024
1f5a140
Rename primaryKeyCondition'
MonaMayrhofer Mar 3, 2024
3ae76cb
reimplement deleteRecordByIds
MonaMayrhofer Mar 3, 2024
1e1624d
Add crude implementation for filterWhereIdIn
MonaMayrhofer Mar 5, 2024
ac49555
Fix empty values for filterWhereIdIn
MonaMayrhofer Mar 5, 2024
6643e07
Fix imports in SchemaDesigner
MonaMayrhofer Mar 5, 2024
873e2e7
Fix FetchRelated to respect id column name
MonaMayrhofer Mar 7, 2024
5157e43
Remove bogus default impl of pkConditionForId
MonaMayrhofer Mar 16, 2024
9007164
Create unit tests for nullable pks
MonaMayrhofer Mar 16, 2024
167089f
Fix SchemaCompiler for nullable pks
MonaMayrhofer Mar 16, 2024
c954ef6
Revert "Create unit tests for nullable pks"
MonaMayrhofer Mar 18, 2024
3d2aa44
Revert "Fix SchemaCompiler for nullable pks"
MonaMayrhofer Mar 18, 2024
dbdd70d
Fix small oversights
MonaMayrhofer Mar 18, 2024
30a18d0
Update Comment
MonaMayrhofer Mar 18, 2024
335b9e0
Merge branch 'digitallyinduced:master' into support_non_id_pks
MonaMayrhofer Mar 18, 2024
0bb5b45
Add unit test to prevent regressions
MonaMayrhofer Mar 26, 2024
a42f24a
Merge branch 'digitallyinduced:master' into support_non_id_pks
MonaMayrhofer Mar 26, 2024
dc62630
Abstract primaryKeyCondition
MonaMayrhofer Mar 26, 2024
cf5e530
Remove redundant info of primaryKeyConditionForId
MonaMayrhofer Mar 26, 2024
3da73f7
Remove ActionTuple
MonaMayrhofer Mar 26, 2024
84b309b
Simplify deleteRecordByIds
MonaMayrhofer Mar 26, 2024
27f6714
Small cleanups
MonaMayrhofer Mar 26, 2024
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 7 additions & 7 deletions IHP/Fetch.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion IHP/IDE/SchemaDesigner/View/Layout.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
89 changes: 71 additions & 18 deletions IHP/ModelSupport.hs
Original file line number Diff line number Diff line change
Expand Up @@ -566,21 +566,46 @@ 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
--
-- __Example:__
--
-- >>> primaryKeyColumnNames @User
-- ["id"]
--
-- >>> primaryKeyColumnNames @PostTagging
-- ["post_id", "tag_id"]
--
primaryKeyColumnNames :: [ByteString]

-- | Returns WHERE conditions to match an entity by it's primary key, given the entities id
--
-- For tables with a simple primary key this returns a tuple with the id:
--
-- >>> primaryKeyCondition project
-- >>> primaryKeyConditionForId project.id
-- [("id", "d619f3cf-f355-4614-8a4c-e9ea4f301e39")]
--
-- If the table has a composite primary key, this returns multiple elements:
--
-- >>> primaryKeyCondition postTag
-- >>> primaryKeyConditionForId postTag.id
-- [("post_id", "0ace9270-568f-4188-b237-3789aa520588"), ("tag_id", "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c")]
--
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 :: Id record -> [(Text, PG.Action)]
MonaMayrhofer marked this conversation as resolved.
Show resolved Hide resolved
default primaryKeyConditionForId :: (ToField (Id record)) => Id record -> [(Text, PG.Action)]
primaryKeyConditionForId id = [("id", toField id)]
MonaMayrhofer marked this conversation as resolved.
Show resolved Hide resolved

-- | 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
-- [("id", "d619f3cf-f355-4614-8a4c-e9ea4f301e39")]
--
-- If the table has a composite primary key, this returns multiple elements:
--
-- >>> primaryKeyCondition postTag
-- [("post_id", "0ace9270-568f-4188-b237-3789aa520588"), ("tag_id", "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c")]
primaryKeyCondition :: forall record. (HasField "id" record (Id record), Table record) => record -> [(Text, PG.Action)]
primaryKeyCondition r = primaryKeyConditionForId @record r.id
mpscholten marked this conversation as resolved.
Show resolved Hide resolved

logQuery :: (?modelContext :: ModelContext, PG.ToRow parameters) => Query -> parameters -> NominalDiffTime -> IO ()
logQuery query parameters time = do
Expand Down Expand Up @@ -610,7 +635,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 #-}
Expand All @@ -621,10 +647,19 @@ 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
let (pkCols, paramPattern, theParameters) = case primaryKeyConditionForId @record id of
[] -> error . cs $ "Impossible happened in deleteRecordById. No primary keys found for table " <> tableName @record <> ". At least one primary key is required."
[(colName, param)] -> (colName, "?", [param])
ps ->
( "(" <> intercalate "," (map fst ps) <> ")",
"(" <> intercalate "," (map (const "?") ps) <> ")",
map snd ps
)

let theQuery = "DELETE FROM " <> tableName @record <> " WHERE " <> pkCols <> " = " <> paramPattern

sqlExec (PG.Query . cs $! theQuery) theParameters
pure ()
{-# INLINABLE deleteRecordById #-}
Expand All @@ -634,7 +669,7 @@ deleteRecordById id = do
-- >>> 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 #-}
Expand All @@ -645,12 +680,20 @@ 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
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This comment is outdated, we can know the pkCols now that we have primaryKeyConditionColumnSelector. I'll bring this up to date again

deleteRecordByIds ids@(firstId : _) = do
let pkCols = case primaryKeyConditionForId @record firstId of
[] -> error . cs $ "Impossible happened in deleteRecordById. No primary keys found for table " <> (tableName @record) <> ". At least one primary key is required."
[(colName, _)] -> colName
ps -> "(" <> intercalate "," (map fst ps) <> ")"

let theQuery = "DELETE FROM " <> tableName @record <> " WHERE " <> pkCols <> " IN ?"

let theParameters = PG.Only $ PG.In $ map (ActionTuple . map snd . primaryKeyConditionForId @record) ids
sqlExec (PG.Query . cs $! theQuery) theParameters
MonaMayrhofer marked this conversation as resolved.
Show resolved Hide resolved
pure ()
{-# INLINABLE deleteRecordByIds #-}

-- | Runs a @DELETE@ query to delete all rows in a table.
Expand Down Expand Up @@ -921,6 +964,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 ")"])

MonaMayrhofer marked this conversation as resolved.
Show resolved Hide resolved
-- | 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
Expand Down
30 changes: 30 additions & 0 deletions IHP/QueryBuilder.hs
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,7 @@ module IHP.QueryBuilder
, filterWhereCaseInsensitive
, filterWhereNot
, filterWhereIn
, filterWhereIdIn
, filterWhereNotIn
, filterWhereLike
, filterWhereILike
Expand Down Expand Up @@ -61,6 +62,9 @@ module IHP.QueryBuilder
, Condition (..)
, Join (..)
, OrderByDirection (..)
, injectQueryBuilder
, FilterOperator (..)
, toEqOrIsOperator
)
where
import IHP.Prelude
Expand Down Expand Up @@ -826,6 +830,32 @@ 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 =
-- TODO Null values are ignored here for now, because they need special treatment as in sql they must be compared using "IS NULL"...
-- We would a) need to know somehow which values are null (which is not possible with primaryKeyConditionForId returning opaque Actions)
-- and b) then decompose the values into something like: (col_a IS NULL AND (col_b, col_c) IN ?) OR (col_b IS NULL AND (col_a, col_c) IN ?)
MonaMayrhofer marked this conversation as resolved.
Show resolved Hide resolved
let
qualifyColumnName col = tableNameByteString @model <> "." <> col

pkConds = map (primaryKeyConditionForId @model) values

actionTuples = map (ActionTuple . map snd) pkConds
MonaMayrhofer marked this conversation as resolved.
Show resolved Hide resolved

columnNames = case primaryKeyColumnNames @model of
[] -> error . cs $ "Impossible happened in deleteRecordById. No primary keys found for table " <> tableName @model <> ". At least one primary key is required."
[s] -> cs $ qualifyColumnName s
conds -> cs $ "(" <> ByteString.intercalate ", " (map qualifyColumnName conds) <> ")"

queryBuilder = getQueryBuilder queryBuilderProvider

whereInQuery = FilterByQueryBuilder {queryBuilder, queryFilter = (columnNames, 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)
Expand Down
33 changes: 25 additions & 8 deletions IHP/SchemaCompiler.hs
Original file line number Diff line number Diff line change
Expand Up @@ -581,11 +581,21 @@ compileUpdate table@(CreateTable { name, columns }) =
columnNames = writableColumns
|> map (.name)
|> intercalate ", "

primaryKeyPattern = case primaryKeyColumns table of
[] -> error $ "Impossible happened in compileUpdate. No primary keys found for table " <> cs name <> ". At least one primary key is required."
[col] -> col.name
cols -> "(" <> commaSep (map (\col -> col.name) cols) <> ")"

primaryKeyParameters = case primaryKeyColumns table of
[] -> error $ "Impossible happened in compileUpdate. No primary keys found for table " <> cs name <> ". At least one primary key is required."
[col] -> "?"
cols -> "(" <> commaSep (map (const "?") (primaryKeyColumns table)) <> ")"
in
"instance CanUpdate " <> modelName <> " where\n"
<> indent ("updateRecord model = do\n"
<> indent (
"List.head <$> sqlQuery \"UPDATE " <> name <> " SET " <> updates <> " WHERE id = ? RETURNING " <> columnNames <> "\" (" <> bindings <> ")\n"
"List.head <$> sqlQuery \"UPDATE " <> name <> " SET " <> updates <> " WHERE " <> primaryKeyPattern <> " = "<> primaryKeyParameters <> " RETURNING " <> columnNames <> "\" (" <> bindings <> ")\n"
)
)

Expand All @@ -607,19 +617,25 @@ instance FromRow #{modelName} where

compileField (fieldName, _)
| isColumn fieldName = fieldName
| isManyToManyField fieldName = let (Just ref) = find (\(n, _) -> columnNameToFieldName n == fieldName) referencing in compileSetQueryBuilder ref
| isOneToManyField fieldName = let (Just ref) = find (\(n, _) -> columnNameToFieldName n == fieldName) referencing in compileSetQueryBuilder ref
| fieldName == "meta" = "def { originalDatabaseRecord = Just (Data.Dynamic.toDyn theRecord) }"
| otherwise = "def"

isPrimaryKey name = name `elem` primaryKeyColumnNames table.primaryKeyConstraint
isColumn name = name `elem` columnNames
isManyToManyField fieldName = fieldName `elem` (referencing |> map (columnNameToFieldName . fst))
isOneToManyField fieldName = fieldName `elem` (referencing |> map (columnNameToFieldName . fst))

compileSetQueryBuilder (refTableName, refFieldName) = "(QueryBuilder.filterWhere (#" <> columnNameToFieldName refFieldName <> ", " <> primaryKeyField <> ") (QueryBuilder.query @" <> tableNameToModelName refTableName <> "))"
where
-- | When the referenced column is nullable, we have to wrap the @Id@ in @Just@
primaryKeyField :: Text
primaryKeyField = if refColumn.notNull then "id" else "Just id"
primaryKeyField = if refColumn.notNull then actualPrimaryKeyField else "Just " <> actualPrimaryKeyField
actualPrimaryKeyField :: Text
actualPrimaryKeyField = case primaryKeyColumns table of
[] -> error $ "Impossible happened in compilePrimaryKeyInstance. No primary keys found for table " <> cs name <> ". At least one primary key is required."
[pk] -> columnNameToFieldName pk.name
pks -> error $ "No support yet for composite foreign keys. Tables cannot have foreign keys to table '" <> cs name <> "' which has more than one column as its primary key."


(Just refTable) = let (Schema statements) = ?schema in
statements
Expand Down Expand Up @@ -754,8 +770,9 @@ instance #{instanceHead} where
tableName = \"#{name}\"
tableNameByteString = Data.Text.Encoding.encodeUtf8 \"#{name}\"
columnNames = #{columnNames}
primaryKeyCondition #{pattern} = #{condition}
{-# INLINABLE primaryKeyCondition #-}
primaryKeyColumnNames = #{primaryKeyColumnNames}
primaryKeyConditionForId (#{pattern}) = #{condition}
{-# INLINABLE primaryKeyConditionForId #-}
|]
where
instanceHead :: Text
Expand All @@ -772,13 +789,13 @@ instance #{instanceHead} where
|> \inner -> "(" <> inner <> ")"

primaryKeyColumnNames :: [Text]
primaryKeyColumnNames = (primaryKeyColumns table) |> map (.name)
primaryKeyColumnNames = primaryKeyColumns table |> map (.name)

primaryKeyFieldNames :: [Text]
primaryKeyFieldNames = primaryKeyColumnNames |> map columnNameToFieldName

pattern :: Text
pattern = tableNameToModelName name <> " { " <> intercalate ", " primaryKeyFieldNames <> " }"
pattern = "Id (" <> intercalate ", " primaryKeyFieldNames <> ")"

condition :: Text
condition = primaryKeyColumns table
Expand Down
Loading
Loading