From 3e968717bdebb680565d923ec046c48e1c273243 Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Sat, 2 Mar 2024 12:06:46 +0100 Subject: [PATCH 01/23] add several unit for arbitrary pks --- Test/SchemaCompilerSpec.hs | 146 +++++++++++++++++++++++++++++-------- 1 file changed, 114 insertions(+), 32 deletions(-) diff --git a/Test/SchemaCompilerSpec.hs b/Test/SchemaCompilerSpec.hs index e90af02e0..fbfeec93c 100644 --- a/Test/SchemaCompilerSpec.hs +++ b/Test/SchemaCompilerSpec.hs @@ -442,6 +442,120 @@ tests = do builder |> QueryBuilder.filterWhere (#id, id) {-# INLINE filterWhereId #-} |] + describe "compileStatementPreview for table with arbitrarily named primary key" do + let statements = parseSqlStatements [trimming| + CREATE TABLE things ( + thing_arbitrary_ident UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL + ); + CREATE TABLE others ( + other_arbitrary_ident UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, + thing_ref UUID NOT NULL + ); + ALTER TABLE others ADD CONSTRAINT other_thing_refs FOREIGN KEY (thing_ref) REFERENCES things (thing_arbitrary_ident) ON DELETE NO ACTION; + |] + let + isTargetTable :: Statement -> Bool + isTargetTable (StatementCreateTable CreateTable { name }) = name == "things" + isTargetTable otherwise = False + let (Just statement) = find isTargetTable statements + let compileOutput = compileStatementPreview statements statement |> Text.strip + + it "should compile CanCreate instance with sqlQuery" $ \statement -> do + getInstanceDecl "CanCreate" compileOutput `shouldBe` [trimming| + instance CanCreate Thing where + create :: (?modelContext :: ModelContext) => Thing -> IO Thing + create model = do + List.head <$> sqlQuery "INSERT INTO things (thing_arbitrary_ident) VALUES (?) RETURNING thing_arbitrary_ident" (Only (fieldWithDefault #thingArbitraryIdent model)) + createMany [] = pure [] + createMany models = do + sqlQuery (Query $ "INSERT INTO things (thing_arbitrary_ident) VALUES " <> (ByteString.intercalate ", " (List.map (\_ -> "(?)") models)) <> " RETURNING thing_arbitrary_ident") (List.concat $ List.map (\model -> [toField (fieldWithDefault #thingArbitraryIdent model)]) models) + |] + it "should compile CanUpdate instance with sqlQuery" $ \statement -> do + getInstanceDecl "CanUpdate" compileOutput `shouldBe` [trimming| + instance CanUpdate Thing where + updateRecord model = do + List.head <$> sqlQuery "UPDATE things SET thing_arbitrary_ident = ? WHERE thing_arbitrary_ident = ? RETURNING thing_arbitrary_ident" ((fieldWithUpdate #thingArbitraryIdent model, model.thingArbitraryIdent)) + |] + it "should compile FromRow instance" $ \statement -> do + getInstanceDecl "FromRow" compileOutput `shouldBe` [trimming| + instance FromRow Thing where + fromRow = do + thingArbitraryIdent <- field + let theRecord = Thing thingArbitraryIdent (QueryBuilder.filterWhere (#thingRef, thingArbitraryIdent) (QueryBuilder.query @Other)) def { originalDatabaseRecord = Just (Data.Dynamic.toDyn theRecord) } + pure theRecord + |] + it "should compile QueryBuilder.FilterPrimaryKey instance" $ \statement -> do + getInstanceDecl "QueryBuilder.FilterPrimaryKey" compileOutput `shouldBe` [trimming| + instance QueryBuilder.FilterPrimaryKey "things" where + filterWhereId thingArbitraryIdent builder = + builder |> QueryBuilder.filterWhere (#thingArbitraryIdent, thingArbitraryIdent) + {-# INLINE filterWhereId #-} + |] + describe "compileStatementPreview for table with composite primary key" do + let statements = parseSqlStatements [trimming| + CREATE TABLE bits ( + bit_arbitrary_ident UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL + ); + CREATE TABLE parts ( + part_arbitrary_ident UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL + ); + CREATE TABLE bit_part_refs ( + bit_ref UUID NOT NULL, + part_ref UUID NOT NULL, + PRIMARY KEY(bit_ref, part_ref) + ); + ALTER TABLE bit_part_refs ADD CONSTRAINT bit_part_bit_refs FOREIGN KEY (bit_ref) REFERENCES bits (bit_arbitrary_ident) ON DELETE NO ACTION; + ALTER TABLE bit_part_refs ADD CONSTRAINT bit_part_part_refs FOREIGN KEY (part_ref) REFERENCES parts (part_arbitrary_ident) ON DELETE NO ACTION; + |] + let + isNamedTable :: Text -> Statement -> Bool + isNamedTable targetName (StatementCreateTable CreateTable { name }) = name == targetName + isNamedTable _ _ = False + let (Just statement) = find (isNamedTable "bit_part_refs") statements + let compileOutput = compileStatementPreview statements statement |> Text.strip + + it "should compile CanCreate instance with sqlQuery" $ \statement -> do + getInstanceDecl "CanCreate" compileOutput `shouldBe` [trimming| + instance CanCreate BitPartRef where + create :: (?modelContext :: ModelContext) => BitPartRef -> IO BitPartRef + create model = do + List.head <$> sqlQuery "INSERT INTO bit_part_refs (bit_ref, part_ref) VALUES (?, ?) RETURNING bit_ref, part_ref" ((model.bitRef, model.partRef)) + createMany [] = pure [] + createMany models = do + sqlQuery (Query $ "INSERT INTO bit_part_refs (bit_ref, part_ref) VALUES " <> (ByteString.intercalate ", " (List.map (\_ -> "(?, ?)") models)) <> " RETURNING bit_ref, part_ref") (List.concat $ List.map (\model -> [toField (model.bitRef), toField (model.partRef)]) models) + |] + it "should compile CanUpdate instance with sqlQuery" $ \statement -> do + getInstanceDecl "CanUpdate" compileOutput `shouldBe` [trimming| + instance CanUpdate BitPartRef where + updateRecord model = do + List.head <$> sqlQuery "UPDATE bit_part_refs SET bit_ref = ?, part_ref = ? WHERE (bit_ref, part_ref) = (?, ?) RETURNING bit_ref, part_ref" ((fieldWithUpdate #bitRef model, fieldWithUpdate #partRef model, model.bitRef, model.partRef)) + |] + it "should compile FromRow instance" $ \statement -> do + getInstanceDecl "FromRow" compileOutput `shouldBe` [trimming| + instance FromRow BitPartRef where + fromRow = do + bitRef <- field + partRef <- field + let theRecord = BitPartRef bitRef partRef def { originalDatabaseRecord = Just (Data.Dynamic.toDyn theRecord) } + pure theRecord + |] + it "should compile FromRow instance of table that references part of a composite key" $ \statement -> do + let (Just statement) = find (isNamedTable "parts") statements + let compileOutput = compileStatementPreview statements statement |> Text.strip + getInstanceDecl "FromRow" compileOutput `shouldBe` [trimming| + instance FromRow Part where + fromRow = do + partArbitraryIdent <- field + let theRecord = Part partArbitraryIdent (QueryBuilder.filterWhere (#partRef, partArbitraryIdent) (QueryBuilder.query @BitPartRef)) def { originalDatabaseRecord = Just (Data.Dynamic.toDyn theRecord) } + pure theRecord + |] + it "should compile QueryBuilder.FilterPrimaryKey instance" $ \statement -> do + getInstanceDecl "QueryBuilder.FilterPrimaryKey" compileOutput `shouldBe` [trimming| + instance QueryBuilder.FilterPrimaryKey "bit_part_refs" where + filterWhereId (Id (bitRef, partRef)) builder = + builder |> QueryBuilder.filterWhere (#bitRef, bitRef) |> QueryBuilder.filterWhere (#partRef, partRef) + {-# INLINE filterWhereId #-} + |] describe "compileFilterPrimaryKeyInstance" do it "should compile FilterPrimaryKey instance when primary key is called id" do let statement = StatementCreateTable $ CreateTable { @@ -459,38 +573,6 @@ tests = do builder |> QueryBuilder.filterWhere (#id, id) {-# INLINE filterWhereId #-} |] - it "should compile FilterPrimaryKey instance when primary key is called thing_id" do - let statement = StatementCreateTable $ CreateTable { - name = "things", - columns = [ Column "thing_id" PUUID Nothing False False Nothing ], - primaryKeyConstraint = PrimaryKeyConstraint ["thing_id"], - constraints = [], - unlogged = False - } - let compileOutput = compileStatementPreview [statement] statement |> Text.strip - - getInstanceDecl "QueryBuilder.FilterPrimaryKey" compileOutput `shouldBe` [trimming| - instance QueryBuilder.FilterPrimaryKey "things" where - filterWhereId thingId builder = - builder |> QueryBuilder.filterWhere (#thingId, thingId) - {-# INLINE filterWhereId #-} - |] - it "should compile FilterPrimaryKey instance when primary key is composite of thing_id other_id" do - let statement = StatementCreateTable $ CreateTable { - name = "thing_other_rels", - columns = [ Column "thing_id" PUUID Nothing False False Nothing, Column "other_id" PUUID Nothing False False Nothing], - primaryKeyConstraint = PrimaryKeyConstraint ["thing_id", "other_id"], - constraints = [], - unlogged = False - } - let compileOutput = compileStatementPreview [statement] statement |> Text.strip - - getInstanceDecl "QueryBuilder.FilterPrimaryKey" compileOutput `shouldBe` [trimming| - instance QueryBuilder.FilterPrimaryKey "thing_other_rels" where - filterWhereId (Id (thingId, otherId)) builder = - builder |> QueryBuilder.filterWhere (#thingId, thingId) |> QueryBuilder.filterWhere (#otherId, otherId) - {-# INLINE filterWhereId #-} - |] getInstanceDecl :: Text -> Text -> Text getInstanceDecl instanceName full = From 19d420302237a1a6e0382cd881dc2810ece1ce63 Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Sat, 2 Mar 2024 16:27:32 +0100 Subject: [PATCH 02/23] Fix SchemaCompiler to support non-id-pks --- IHP/SchemaCompiler.hs | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/IHP/SchemaCompiler.hs b/IHP/SchemaCompiler.hs index 12df92462..280f98dab 100644 --- a/IHP/SchemaCompiler.hs +++ b/IHP/SchemaCompiler.hs @@ -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" ) ) @@ -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 From db356aabc410269183af8f94e23dfb099e5d7cea Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Sun, 3 Mar 2024 14:28:16 +0100 Subject: [PATCH 03/23] Change primaryKeyCondition to primaryKeyCondition' Replace primaryKeyCondition with a version that takes the id instead of the whole record --- IHP/ModelSupport.hs | 27 ++++++++++++++++++++------- IHP/SchemaCompiler.hs | 6 +++--- Test/QueryBuilderSpec.hs | 6 +++++- Test/SchemaCompilerSpec.hs | 34 ++++++++++++++++++++++++++-------- 4 files changed, 54 insertions(+), 19 deletions(-) diff --git a/IHP/ModelSupport.hs b/IHP/ModelSupport.hs index 0c08a301a..7d2de98be 100644 --- a/IHP/ModelSupport.hs +++ b/IHP/ModelSupport.hs @@ -566,21 +566,34 @@ class -- columnNames :: [ByteString] - -- | Returns WHERE conditions to match an entity by it's primary key + -- | 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 + -- >>> primaryKeyCondition' project.id -- [("id", "d619f3cf-f355-4614-8a4c-e9ea4f301e39")] -- -- If the table has a composite primary key, this returns multiple elements: -- - -- >>> primaryKeyCondition postTag + -- >>> primaryKeyCondition' 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)] + primaryKeyCondition' :: Id record -> [(Text, PG.Action)] + default primaryKeyCondition' :: (ToField (Id record)) => Id record -> [(Text, PG.Action)] + primaryKeyCondition' id = [("id", toField id)] + +-- | 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 id. (HasField "id" record id, id ~ Id' (GetTableName record), Table record) => record -> [(Text, PG.Action)] +primaryKeyCondition r = primaryKeyCondition' @record r.id logQuery :: (?modelContext :: ModelContext, PG.ToRow parameters) => Query -> parameters -> NominalDiffTime -> IO () logQuery query parameters time = do diff --git a/IHP/SchemaCompiler.hs b/IHP/SchemaCompiler.hs index 280f98dab..c5e570241 100644 --- a/IHP/SchemaCompiler.hs +++ b/IHP/SchemaCompiler.hs @@ -770,8 +770,8 @@ instance #{instanceHead} where tableName = \"#{name}\" tableNameByteString = Data.Text.Encoding.encodeUtf8 \"#{name}\" columnNames = #{columnNames} - primaryKeyCondition #{pattern} = #{condition} - {-# INLINABLE primaryKeyCondition #-} + primaryKeyCondition' (#{pattern}) = #{condition} + {-# INLINABLE primaryKeyCondition' #-} |] where instanceHead :: Text @@ -794,7 +794,7 @@ instance #{instanceHead} where primaryKeyFieldNames = primaryKeyColumnNames |> map columnNameToFieldName pattern :: Text - pattern = tableNameToModelName name <> " { " <> intercalate ", " primaryKeyFieldNames <> " }" + pattern = "Id (" <> intercalate ", " primaryKeyFieldNames <> ")" condition :: Text condition = primaryKeyColumns table diff --git a/Test/QueryBuilderSpec.hs b/Test/QueryBuilderSpec.hs index 6ac2bb019..2fcf1dba6 100644 --- a/Test/QueryBuilderSpec.hs +++ b/Test/QueryBuilderSpec.hs @@ -24,6 +24,7 @@ data Post = Post type instance GetTableName Post = "posts" type instance GetModelByTableName "posts" = Post +type instance PrimaryKey "posts" = UUID instance Table Post where columnNames = ["id", "title", "external_url", "created_at", "public", "created_by", "category_id"] @@ -35,6 +36,7 @@ data Tag = Tag type instance GetTableName Tag = "tags" type instance GetModelByTableName "tags" = Tag +type instance PrimaryKey "tags" = UUID instance Table Tag where columnNames = ["id", "tag_text"] @@ -48,6 +50,7 @@ data Tagging = Tagging type instance GetTableName Tagging = "taggings" type instance GetModelByTableName "taggings" = Tagging +type instance PrimaryKey "taggings" = UUID instance Table Tagging where columnNames = ["id", "post_id", "tag_id"] @@ -59,6 +62,7 @@ data User = User type instance GetTableName User = "users" type instance GetModelByTableName "users" = User +type instance PrimaryKey "users" = UUID instance Table User where columnNames = ["id", "name"] @@ -74,7 +78,7 @@ type instance GetModelByTableName "favorite_title" = FavoriteTitle instance Table FavoriteTitle where columnNames = ["title", "likes"] - primaryKeyCondition _ = [] + primaryKeyCondition' _ = [] tests = do describe "QueryBuilder" do diff --git a/Test/SchemaCompilerSpec.hs b/Test/SchemaCompilerSpec.hs index fbfeec93c..d7c162c55 100644 --- a/Test/SchemaCompilerSpec.hs +++ b/Test/SchemaCompilerSpec.hs @@ -189,8 +189,8 @@ tests = do tableName = "users" tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ids","electricity_unit_price"] - primaryKeyCondition User { id } = [("id", toField id)] - {-# INLINABLE primaryKeyCondition #-} + primaryKeyCondition' (Id (id)) = [("id", toField id)] + {-# INLINABLE primaryKeyCondition' #-} instance InputValue User where inputValue = IHP.ModelSupport.recordToInputValue @@ -258,8 +258,8 @@ tests = do tableName = "users" tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ids","electricity_unit_price"] - primaryKeyCondition User { id } = [("id", toField id)] - {-# INLINABLE primaryKeyCondition #-} + primaryKeyCondition' (Id (id)) = [("id", toField id)] + {-# INLINABLE primaryKeyCondition' #-} instance InputValue User where inputValue = IHP.ModelSupport.recordToInputValue @@ -327,8 +327,8 @@ tests = do tableName = "users" tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ts"] - primaryKeyCondition User { id } = [("id", toField id)] - {-# INLINABLE primaryKeyCondition #-} + primaryKeyCondition' (Id (id)) = [("id", toField id)] + {-# INLINABLE primaryKeyCondition' #-} instance InputValue User where inputValue = IHP.ModelSupport.recordToInputValue @@ -404,8 +404,8 @@ tests = do tableName = "landing_pages" tableNameByteString = Data.Text.Encoding.encodeUtf8 "landing_pages" columnNames = ["id"] - primaryKeyCondition LandingPage { id } = [("id", toField id)] - {-# INLINABLE primaryKeyCondition #-} + primaryKeyCondition' (Id (id)) = [("id", toField id)] + {-# INLINABLE primaryKeyCondition' #-} instance InputValue LandingPage where inputValue = IHP.ModelSupport.recordToInputValue @@ -484,6 +484,15 @@ tests = do let theRecord = Thing thingArbitraryIdent (QueryBuilder.filterWhere (#thingRef, thingArbitraryIdent) (QueryBuilder.query @Other)) def { originalDatabaseRecord = Just (Data.Dynamic.toDyn theRecord) } pure theRecord |] + it "should compile Table instance" $ \statement -> do + getInstanceDecl "() => Table" compileOutput `shouldBe` [trimming| + instance () => Table (Thing' others) where + tableName = "things" + tableNameByteString = Data.Text.Encoding.encodeUtf8 "things" + columnNames = ["thing_arbitrary_ident"] + primaryKeyCondition' (Id (thingArbitraryIdent)) = [("thing_arbitrary_ident", toField thingArbitraryIdent)] + {-# INLINABLE primaryKeyCondition' #-} + |] it "should compile QueryBuilder.FilterPrimaryKey instance" $ \statement -> do getInstanceDecl "QueryBuilder.FilterPrimaryKey" compileOutput `shouldBe` [trimming| instance QueryBuilder.FilterPrimaryKey "things" where @@ -539,6 +548,15 @@ tests = do let theRecord = BitPartRef bitRef partRef def { originalDatabaseRecord = Just (Data.Dynamic.toDyn theRecord) } pure theRecord |] + it "should compile Table instance" $ \statement -> do + getInstanceDecl "(ToField bitRef, ToField partRef) => Table" compileOutput `shouldBe` [trimming| + instance (ToField bitRef, ToField partRef) => Table (BitPartRef' bitRef partRef) where + tableName = "bit_part_refs" + tableNameByteString = Data.Text.Encoding.encodeUtf8 "bit_part_refs" + columnNames = ["bit_ref","part_ref"] + primaryKeyCondition' (Id (bitRef, partRef)) = [("bit_ref", toField bitRef), ("part_ref", toField partRef)] + {-# INLINABLE primaryKeyCondition' #-} + |] it "should compile FromRow instance of table that references part of a composite key" $ \statement -> do let (Just statement) = find (isNamedTable "parts") statements let compileOutput = compileStatementPreview statements statement |> Text.strip From ad97647469df3734d05c36c07bc500b4f8921329 Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Sun, 3 Mar 2024 14:29:24 +0100 Subject: [PATCH 04/23] Implement deleteRecord via primaryKeyCondition' This way it supports tables with arbitrary primary keys --- IHP/ModelSupport.hs | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/IHP/ModelSupport.hs b/IHP/ModelSupport.hs index 7d2de98be..d7c965327 100644 --- a/IHP/ModelSupport.hs +++ b/IHP/ModelSupport.hs @@ -592,7 +592,7 @@ class -- -- >>> primaryKeyCondition postTag -- [("post_id", "0ace9270-568f-4188-b237-3789aa520588"), ("tag_id", "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c")] -primaryKeyCondition :: forall record id. (HasField "id" record id, id ~ Id' (GetTableName record), Table record) => record -> [(Text, PG.Action)] +primaryKeyCondition :: forall record. (HasField "id" record (Id record), Table record) => record -> [(Text, PG.Action)] primaryKeyCondition r = primaryKeyCondition' @record r.id logQuery :: (?modelContext :: ModelContext, PG.ToRow parameters) => Query -> parameters -> NominalDiffTime -> IO () @@ -623,7 +623,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 #-} @@ -634,10 +635,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 primaryKeyCondition' @record id of + [] -> error "Impossible" + [(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 #-} From 1f5a140bbca443f6d8f3e8286dc7c672e495063b Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Sun, 3 Mar 2024 15:32:50 +0100 Subject: [PATCH 05/23] Rename primaryKeyCondition' --- IHP/ModelSupport.hs | 14 +++++++------- IHP/SchemaCompiler.hs | 4 ++-- Test/QueryBuilderSpec.hs | 2 +- Test/SchemaCompilerSpec.hs | 24 ++++++++++++------------ 4 files changed, 22 insertions(+), 22 deletions(-) diff --git a/IHP/ModelSupport.hs b/IHP/ModelSupport.hs index d7c965327..bade52987 100644 --- a/IHP/ModelSupport.hs +++ b/IHP/ModelSupport.hs @@ -570,16 +570,16 @@ class -- -- For tables with a simple primary key this returns a tuple with the id: -- - -- >>> primaryKeyCondition' project.id + -- >>> primaryKeyConditionForId project.id -- [("id", "d619f3cf-f355-4614-8a4c-e9ea4f301e39")] -- -- If the table has a composite primary key, this returns multiple elements: -- - -- >>> primaryKeyCondition' postTag.id + -- >>> primaryKeyConditionForId postTag.id -- [("post_id", "0ace9270-568f-4188-b237-3789aa520588"), ("tag_id", "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c")] - primaryKeyCondition' :: Id record -> [(Text, PG.Action)] - default primaryKeyCondition' :: (ToField (Id record)) => Id record -> [(Text, PG.Action)] - primaryKeyCondition' id = [("id", toField id)] + primaryKeyConditionForId :: Id record -> [(Text, PG.Action)] + default primaryKeyConditionForId :: (ToField (Id record)) => Id record -> [(Text, PG.Action)] + primaryKeyConditionForId id = [("id", toField id)] -- | Returns WHERE conditions to match an entity by it's primary key -- @@ -593,7 +593,7 @@ class -- >>> 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 = primaryKeyCondition' @record r.id +primaryKeyCondition r = primaryKeyConditionForId @record r.id logQuery :: (?modelContext :: ModelContext, PG.ToRow parameters) => Query -> parameters -> NominalDiffTime -> IO () logQuery query parameters time = do @@ -637,7 +637,7 @@ deleteRecord record = -- deleteRecordById :: forall record table. (?modelContext :: ModelContext, Table record, Show (PrimaryKey table), GetTableName record ~ table, record ~ GetModelByTableName table) => Id' table -> IO () deleteRecordById id = do - let (pkCols, paramPattern, theParameters) = case primaryKeyCondition' @record id of + let (pkCols, paramPattern, theParameters) = case primaryKeyConditionForId @record id of [] -> error "Impossible" [(colName, param)] -> (colName, "?", [param]) ps -> diff --git a/IHP/SchemaCompiler.hs b/IHP/SchemaCompiler.hs index c5e570241..0a1f47f84 100644 --- a/IHP/SchemaCompiler.hs +++ b/IHP/SchemaCompiler.hs @@ -770,8 +770,8 @@ instance #{instanceHead} where tableName = \"#{name}\" tableNameByteString = Data.Text.Encoding.encodeUtf8 \"#{name}\" columnNames = #{columnNames} - primaryKeyCondition' (#{pattern}) = #{condition} - {-# INLINABLE primaryKeyCondition' #-} + primaryKeyConditionForId (#{pattern}) = #{condition} + {-# INLINABLE primaryKeyConditionForId #-} |] where instanceHead :: Text diff --git a/Test/QueryBuilderSpec.hs b/Test/QueryBuilderSpec.hs index 2fcf1dba6..882b94498 100644 --- a/Test/QueryBuilderSpec.hs +++ b/Test/QueryBuilderSpec.hs @@ -78,7 +78,7 @@ type instance GetModelByTableName "favorite_title" = FavoriteTitle instance Table FavoriteTitle where columnNames = ["title", "likes"] - primaryKeyCondition' _ = [] + primaryKeyConditionForId _ = [] tests = do describe "QueryBuilder" do diff --git a/Test/SchemaCompilerSpec.hs b/Test/SchemaCompilerSpec.hs index d7c162c55..27e9110c1 100644 --- a/Test/SchemaCompilerSpec.hs +++ b/Test/SchemaCompilerSpec.hs @@ -189,8 +189,8 @@ tests = do tableName = "users" tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ids","electricity_unit_price"] - primaryKeyCondition' (Id (id)) = [("id", toField id)] - {-# INLINABLE primaryKeyCondition' #-} + primaryKeyConditionForId (Id (id)) = [("id", toField id)] + {-# INLINABLE primaryKeyConditionForId #-} instance InputValue User where inputValue = IHP.ModelSupport.recordToInputValue @@ -258,8 +258,8 @@ tests = do tableName = "users" tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ids","electricity_unit_price"] - primaryKeyCondition' (Id (id)) = [("id", toField id)] - {-# INLINABLE primaryKeyCondition' #-} + primaryKeyConditionForId (Id (id)) = [("id", toField id)] + {-# INLINABLE primaryKeyConditionForId #-} instance InputValue User where inputValue = IHP.ModelSupport.recordToInputValue @@ -327,8 +327,8 @@ tests = do tableName = "users" tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ts"] - primaryKeyCondition' (Id (id)) = [("id", toField id)] - {-# INLINABLE primaryKeyCondition' #-} + primaryKeyConditionForId (Id (id)) = [("id", toField id)] + {-# INLINABLE primaryKeyConditionForId #-} instance InputValue User where inputValue = IHP.ModelSupport.recordToInputValue @@ -404,8 +404,8 @@ tests = do tableName = "landing_pages" tableNameByteString = Data.Text.Encoding.encodeUtf8 "landing_pages" columnNames = ["id"] - primaryKeyCondition' (Id (id)) = [("id", toField id)] - {-# INLINABLE primaryKeyCondition' #-} + primaryKeyConditionForId (Id (id)) = [("id", toField id)] + {-# INLINABLE primaryKeyConditionForId #-} instance InputValue LandingPage where inputValue = IHP.ModelSupport.recordToInputValue @@ -490,8 +490,8 @@ tests = do tableName = "things" tableNameByteString = Data.Text.Encoding.encodeUtf8 "things" columnNames = ["thing_arbitrary_ident"] - primaryKeyCondition' (Id (thingArbitraryIdent)) = [("thing_arbitrary_ident", toField thingArbitraryIdent)] - {-# INLINABLE primaryKeyCondition' #-} + primaryKeyConditionForId (Id (thingArbitraryIdent)) = [("thing_arbitrary_ident", toField thingArbitraryIdent)] + {-# INLINABLE primaryKeyConditionForId #-} |] it "should compile QueryBuilder.FilterPrimaryKey instance" $ \statement -> do getInstanceDecl "QueryBuilder.FilterPrimaryKey" compileOutput `shouldBe` [trimming| @@ -554,8 +554,8 @@ tests = do tableName = "bit_part_refs" tableNameByteString = Data.Text.Encoding.encodeUtf8 "bit_part_refs" columnNames = ["bit_ref","part_ref"] - primaryKeyCondition' (Id (bitRef, partRef)) = [("bit_ref", toField bitRef), ("part_ref", toField partRef)] - {-# INLINABLE primaryKeyCondition' #-} + primaryKeyConditionForId (Id (bitRef, partRef)) = [("bit_ref", toField bitRef), ("part_ref", toField partRef)] + {-# INLINABLE primaryKeyConditionForId #-} |] it "should compile FromRow instance of table that references part of a composite key" $ \statement -> do let (Just statement) = find (isNamedTable "parts") statements From 3ae76cbf2fe4a620401cd99d5ed9d3a2fc1614b9 Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Sun, 3 Mar 2024 16:43:41 +0100 Subject: [PATCH 06/23] reimplement deleteRecordByIds --- IHP/ModelSupport.hs | 34 ++++++++++++++++++++++++++-------- 1 file changed, 26 insertions(+), 8 deletions(-) diff --git a/IHP/ModelSupport.hs b/IHP/ModelSupport.hs index bade52987..766371da4 100644 --- a/IHP/ModelSupport.hs +++ b/IHP/ModelSupport.hs @@ -638,7 +638,7 @@ deleteRecord record = deleteRecordById :: forall record table. (?modelContext :: ModelContext, Table record, Show (PrimaryKey table), GetTableName record ~ table, record ~ GetModelByTableName table) => Id' table -> IO () deleteRecordById id = do let (pkCols, paramPattern, theParameters) = case primaryKeyConditionForId @record id of - [] -> error "Impossible" + [] -> 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) <> ")", @@ -657,7 +657,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 #-} @@ -668,12 +668,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 +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 + pure () {-# INLINABLE deleteRecordByIds #-} -- | Runs a @DELETE@ query to delete all rows in a table. @@ -944,6 +952,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 From 1e1624d614183be8fc2647a9163b0bd91bfed5dd Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Tue, 5 Mar 2024 09:10:09 +0100 Subject: [PATCH 07/23] Add crude implementation for filterWhereIdIn --- IHP/Fetch.hs | 14 +++++------ IHP/QueryBuilder.hs | 32 +++++++++++++++++++++++++ Test/QueryBuilderSpec.hs | 50 +++++++++++++++++++++++++++++++++++++++- 3 files changed, 88 insertions(+), 8 deletions(-) diff --git a/IHP/Fetch.hs b/IHP/Fetch.hs index 3d5c47d63..bb8191fa2 100644 --- a/IHP/Fetch.hs +++ b/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 diff --git a/IHP/QueryBuilder.hs b/IHP/QueryBuilder.hs index cd4082b3a..af836910d 100644 --- a/IHP/QueryBuilder.hs +++ b/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,34 @@ 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 ?) + let + qualifyColumnName col = tableName @model <> "." <> col + + pkConds = map (primaryKeyConditionForId @model) values + + actionTuples = map (ActionTuple . map snd) pkConds + + columnNames = case head pkConds of + Nothing -> error "filterWhereIdIn doesn't yet support empty id lists" -- TODO We need a way to figure out what the primary key fields are when no ids are given + Just firstPkCond -> case firstPkCond 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 $ fst s + conds -> cs $ "(" <> intercalate ", " (map (qualifyColumnName . fst) 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) diff --git a/Test/QueryBuilderSpec.hs b/Test/QueryBuilderSpec.hs index 882b94498..7e8564c11 100644 --- a/Test/QueryBuilderSpec.hs +++ b/Test/QueryBuilderSpec.hs @@ -9,7 +9,7 @@ import IHP.Prelude import IHP.QueryBuilder import IHP.ModelSupport import qualified Database.PostgreSQL.Simple.ToField as ToField -import Database.PostgreSQL.Simple.ToField (Action (..)) +import Database.PostgreSQL.Simple.ToField (Action (..), ToField (toField)) import qualified Data.ByteString.Builder as ByteString data Post = Post @@ -54,6 +54,21 @@ type instance PrimaryKey "taggings" = UUID instance Table Tagging where columnNames = ["id", "post_id", "tag_id"] + +data CompositeTagging = CompositeTagging + { postId :: UUID + , tagId :: UUID + } + + +type instance GetTableName CompositeTagging = "composite_taggings" +type instance GetModelByTableName "composite_taggings" = CompositeTagging +type instance PrimaryKey "composite_taggings" = (Id' "posts", Id' "tags") + +instance Table CompositeTagging where + columnNames = ["post_id", "tag_id"] + primaryKeyConditionForId (Id (postId, tagId)) = [("post_id", toField postId), ("tag_id", toField tagId)] + data User = User { id :: UUID, @@ -145,6 +160,39 @@ tests = do (toSQL theQuery) `shouldBe` ("SELECT posts.id, posts.title, posts.external_url, posts.created_at, posts.public, posts.created_by, posts.category_id FROM posts WHERE posts.category_id IS ?", [Plain "null"]) + describe "filterWhereIdIn" do + it "should produce a SQL with a WHERE condition" do + let theValues :: [Id Post] = ["b80e37a8-41d4-4731-b050-a716879ef1d1", "629b7ee0-3675-4b02-ba3e-cdbd7b513553"] + let theQuery = query @Post + |> filterWhereIdIn theValues + + (toSQL theQuery) `shouldBe` ("SELECT posts.id, posts.title, posts.external_url, posts.created_at, posts.public, posts.created_by, posts.category_id FROM posts WHERE posts.id IN ?", [Many [Plain "(", Many [ Plain "(", Plain "'b80e37a8-41d4-4731-b050-a716879ef1d1'", Plain ")" ], Plain ",", Many [ Plain "(", Plain "'629b7ee0-3675-4b02-ba3e-cdbd7b513553'", Plain ")" ], Plain ")"]]) + + describe "with empty values" do + it "should produce a SQL with a WHERE condition" do + let theValues :: [Id Post] = [] + let theQuery = query @Post + |> filterWhereIdIn theValues + + (toSQL theQuery) `shouldBe` ("SELECT posts.id, posts.title, posts.external_url, posts.created_at, posts.public, posts.created_by, posts.category_id FROM posts WHERE posts.id IN ?", [Many [Plain "(", Plain ")"]]) + + describe "with composite keys" do + it "should produce a SQL with a WHERE condition" do + let theValues :: [Id CompositeTagging] = [Id ("b80e37a8-41d4-4731-b050-a716879ef1d1", "629b7ee0-3675-4b02-ba3e-cdbd7b513553"), Id ("8e2ef0ef-f680-4fcf-837d-7e3171385621", "95096f81-8ca6-407f-a263-cbc33546a828")] + let theQuery = query @CompositeTagging + |> filterWhereIdIn theValues + + (toSQL theQuery) `shouldBe` ("SELECT composite_taggings.post_id, composite_taggings.tag_id FROM composite_taggings WHERE (composite_taggings.post_id, composite_taggings.tag_id) IN ?", [Many [Plain "(", Many [ Plain "(", Plain "'b80e37a8-41d4-4731-b050-a716879ef1d1'", Plain ",", Plain "'629b7ee0-3675-4b02-ba3e-cdbd7b513553'", Plain ")" ], Plain ",", Many [ Plain "(", Plain "'8e2ef0ef-f680-4fcf-837d-7e3171385621'", Plain ",", Plain "'95096f81-8ca6-407f-a263-cbc33546a828'", Plain ")"], Plain ")"]]) + + describe "with empty values" do + it "should produce a SQL with a WHERE condition" do + let theValues :: [Id CompositeTagging] = [] + let theQuery = query @CompositeTagging + |> filterWhereIdIn theValues + + (toSQL theQuery) `shouldBe` ("SELECT composite_taggings.post_id, composite_taggings.tag_id FROM composite_taggings WHERE (composite_taggings.post_id, composite_taggings.tag_id) IN ?", [Many [Plain "(", Plain ")"]]) + + describe "filterWhereInJoinedTable" do it "should produce a SQL with a WHERE condition" do let theValues :: [Text] = ["first", "second"] From ac495556e9f9827f6fccc6ca16ed49bc517e2a27 Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Tue, 5 Mar 2024 09:36:21 +0100 Subject: [PATCH 08/23] Fix empty values for filterWhereIdIn --- IHP/IDE/SchemaDesigner/View/Layout.hs | 2 +- IHP/ModelSupport.hs | 12 +++++++++++ IHP/QueryBuilder.hs | 10 ++++----- IHP/SchemaCompiler.hs | 3 ++- Test/QueryBuilderSpec.hs | 31 +++++++++++++++++++++++++-- Test/SchemaCompilerSpec.hs | 6 ++++++ 6 files changed, 54 insertions(+), 10 deletions(-) diff --git a/IHP/IDE/SchemaDesigner/View/Layout.hs b/IHP/IDE/SchemaDesigner/View/Layout.hs index c19f89215..2105f17cc 100644 --- a/IHP/IDE/SchemaDesigner/View/Layout.hs +++ b/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 diff --git a/IHP/ModelSupport.hs b/IHP/ModelSupport.hs index 766371da4..bcd9fc31b 100644 --- a/IHP/ModelSupport.hs +++ b/IHP/ModelSupport.hs @@ -566,6 +566,18 @@ class -- columnNames :: [ByteString] + -- | 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: diff --git a/IHP/QueryBuilder.hs b/IHP/QueryBuilder.hs index af836910d..d2f6edacf 100644 --- a/IHP/QueryBuilder.hs +++ b/IHP/QueryBuilder.hs @@ -837,18 +837,16 @@ filterWhereIdIn values queryBuilderProvider = -- 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 ?) let - qualifyColumnName col = tableName @model <> "." <> col + qualifyColumnName col = tableNameByteString @model <> "." <> col pkConds = map (primaryKeyConditionForId @model) values actionTuples = map (ActionTuple . map snd) pkConds - columnNames = case head pkConds of - Nothing -> error "filterWhereIdIn doesn't yet support empty id lists" -- TODO We need a way to figure out what the primary key fields are when no ids are given - Just firstPkCond -> case firstPkCond of + 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 $ fst s - conds -> cs $ "(" <> intercalate ", " (map (qualifyColumnName . fst) conds) <> ")" + [s] -> cs $ qualifyColumnName s + conds -> cs $ "(" <> ByteString.intercalate ", " (map qualifyColumnName conds) <> ")" queryBuilder = getQueryBuilder queryBuilderProvider diff --git a/IHP/SchemaCompiler.hs b/IHP/SchemaCompiler.hs index 0a1f47f84..07de5ca69 100644 --- a/IHP/SchemaCompiler.hs +++ b/IHP/SchemaCompiler.hs @@ -770,6 +770,7 @@ instance #{instanceHead} where tableName = \"#{name}\" tableNameByteString = Data.Text.Encoding.encodeUtf8 \"#{name}\" columnNames = #{columnNames} + primaryKeyColumnNames = #{primaryKeyColumnNames} primaryKeyConditionForId (#{pattern}) = #{condition} {-# INLINABLE primaryKeyConditionForId #-} |] @@ -788,7 +789,7 @@ instance #{instanceHead} where |> \inner -> "(" <> inner <> ")" primaryKeyColumnNames :: [Text] - primaryKeyColumnNames = (primaryKeyColumns table) |> map (.name) + primaryKeyColumnNames = primaryKeyColumns table |> map (.name) primaryKeyFieldNames :: [Text] primaryKeyFieldNames = primaryKeyColumnNames |> map columnNameToFieldName diff --git a/Test/QueryBuilderSpec.hs b/Test/QueryBuilderSpec.hs index 7e8564c11..53557b10f 100644 --- a/Test/QueryBuilderSpec.hs +++ b/Test/QueryBuilderSpec.hs @@ -26,8 +26,23 @@ type instance GetTableName Post = "posts" type instance GetModelByTableName "posts" = Post type instance PrimaryKey "posts" = UUID + +data WeirdPkTag = WeirdPkTag + { tagIden :: UUID + , tagText :: Text + } + +type instance GetTableName WeirdPkTag = "weird_tags" +type instance GetModelByTableName "weird_tags" = WeirdPkTag +type instance PrimaryKey "weird_tags" = UUID + +instance Table WeirdPkTag where + columnNames = ["tag_iden", "tag_text"] + primaryKeyColumnNames = ["tag_iden"] + instance Table Post where columnNames = ["id", "title", "external_url", "created_at", "public", "created_by", "category_id"] + primaryKeyColumnNames = ["id"] data Tag = Tag { id :: UUID @@ -40,6 +55,7 @@ type instance PrimaryKey "tags" = UUID instance Table Tag where columnNames = ["id", "tag_text"] + primaryKeyColumnNames = ["id"] data Tagging = Tagging { id :: UUID @@ -54,6 +70,7 @@ type instance PrimaryKey "taggings" = UUID instance Table Tagging where columnNames = ["id", "post_id", "tag_id"] + primaryKeyColumnNames = ["id"] data CompositeTagging = CompositeTagging { postId :: UUID @@ -67,6 +84,7 @@ type instance PrimaryKey "composite_taggings" = (Id' "posts", Id' "tags") instance Table CompositeTagging where columnNames = ["post_id", "tag_id"] + primaryKeyColumnNames = ["post_id", "tag_id"] primaryKeyConditionForId (Id (postId, tagId)) = [("post_id", toField postId), ("tag_id", toField tagId)] @@ -81,6 +99,7 @@ type instance PrimaryKey "users" = UUID instance Table User where columnNames = ["id", "name"] + primaryKeyColumnNames = ["id"] data FavoriteTitle = FavoriteTitle { @@ -94,6 +113,7 @@ type instance GetModelByTableName "favorite_title" = FavoriteTitle instance Table FavoriteTitle where columnNames = ["title", "likes"] primaryKeyConditionForId _ = [] + primaryKeyColumnNames = [] tests = do describe "QueryBuilder" do @@ -174,8 +194,15 @@ tests = do let theQuery = query @Post |> filterWhereIdIn theValues - (toSQL theQuery) `shouldBe` ("SELECT posts.id, posts.title, posts.external_url, posts.created_at, posts.public, posts.created_by, posts.category_id FROM posts WHERE posts.id IN ?", [Many [Plain "(", Plain ")"]]) + (toSQL theQuery) `shouldBe` ("SELECT posts.id, posts.title, posts.external_url, posts.created_at, posts.public, posts.created_by, posts.category_id FROM posts WHERE posts.id IN ?", [Plain "(null)"]) + + describe "with weird primary key name" do + it "should produce a SQL with a WHERE condition" do + let theValues :: [Id WeirdPkTag] = ["b80e37a8-41d4-4731-b050-a716879ef1d1", "629b7ee0-3675-4b02-ba3e-cdbd7b513553"] + let theQuery = query @WeirdPkTag + |> filterWhereIdIn theValues + (toSQL theQuery) `shouldBe` ("SELECT weird_tags.tag_iden, weird_tags.tag_text FROM weird_tags WHERE weird_tags.tag_iden IN ?", [Many [Plain "(", Many [ Plain "(", Plain "'b80e37a8-41d4-4731-b050-a716879ef1d1'", Plain ")" ], Plain ",", Many [ Plain "(", Plain "'629b7ee0-3675-4b02-ba3e-cdbd7b513553'", Plain ")" ], Plain ")"]]) describe "with composite keys" do it "should produce a SQL with a WHERE condition" do let theValues :: [Id CompositeTagging] = [Id ("b80e37a8-41d4-4731-b050-a716879ef1d1", "629b7ee0-3675-4b02-ba3e-cdbd7b513553"), Id ("8e2ef0ef-f680-4fcf-837d-7e3171385621", "95096f81-8ca6-407f-a263-cbc33546a828")] @@ -190,7 +217,7 @@ tests = do let theQuery = query @CompositeTagging |> filterWhereIdIn theValues - (toSQL theQuery) `shouldBe` ("SELECT composite_taggings.post_id, composite_taggings.tag_id FROM composite_taggings WHERE (composite_taggings.post_id, composite_taggings.tag_id) IN ?", [Many [Plain "(", Plain ")"]]) + (toSQL theQuery) `shouldBe` ("SELECT composite_taggings.post_id, composite_taggings.tag_id FROM composite_taggings WHERE (composite_taggings.post_id, composite_taggings.tag_id) IN ?", [Plain "(null)"]) describe "filterWhereInJoinedTable" do diff --git a/Test/SchemaCompilerSpec.hs b/Test/SchemaCompilerSpec.hs index 27e9110c1..54f1c704d 100644 --- a/Test/SchemaCompilerSpec.hs +++ b/Test/SchemaCompilerSpec.hs @@ -189,6 +189,7 @@ tests = do tableName = "users" tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ids","electricity_unit_price"] + primaryKeyColumnNames = ["id"] primaryKeyConditionForId (Id (id)) = [("id", toField id)] {-# INLINABLE primaryKeyConditionForId #-} @@ -258,6 +259,7 @@ tests = do tableName = "users" tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ids","electricity_unit_price"] + primaryKeyColumnNames = ["id"] primaryKeyConditionForId (Id (id)) = [("id", toField id)] {-# INLINABLE primaryKeyConditionForId #-} @@ -327,6 +329,7 @@ tests = do tableName = "users" tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ts"] + primaryKeyColumnNames = ["id"] primaryKeyConditionForId (Id (id)) = [("id", toField id)] {-# INLINABLE primaryKeyConditionForId #-} @@ -404,6 +407,7 @@ tests = do tableName = "landing_pages" tableNameByteString = Data.Text.Encoding.encodeUtf8 "landing_pages" columnNames = ["id"] + primaryKeyColumnNames = ["id"] primaryKeyConditionForId (Id (id)) = [("id", toField id)] {-# INLINABLE primaryKeyConditionForId #-} @@ -490,6 +494,7 @@ tests = do tableName = "things" tableNameByteString = Data.Text.Encoding.encodeUtf8 "things" columnNames = ["thing_arbitrary_ident"] + primaryKeyColumnNames = ["thing_arbitrary_ident"] primaryKeyConditionForId (Id (thingArbitraryIdent)) = [("thing_arbitrary_ident", toField thingArbitraryIdent)] {-# INLINABLE primaryKeyConditionForId #-} |] @@ -554,6 +559,7 @@ tests = do tableName = "bit_part_refs" tableNameByteString = Data.Text.Encoding.encodeUtf8 "bit_part_refs" columnNames = ["bit_ref","part_ref"] + primaryKeyColumnNames = ["bit_ref","part_ref"] primaryKeyConditionForId (Id (bitRef, partRef)) = [("bit_ref", toField bitRef), ("part_ref", toField partRef)] {-# INLINABLE primaryKeyConditionForId #-} |] From 6643e0715fdf6891652e87b69ad88b7bc54beb6b Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Tue, 5 Mar 2024 09:52:32 +0100 Subject: [PATCH 09/23] Fix imports in SchemaDesigner --- IHP/IDE/SchemaDesigner/View/Columns/Edit.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/IHP/IDE/SchemaDesigner/View/Columns/Edit.hs b/IHP/IDE/SchemaDesigner/View/Columns/Edit.hs index f639f17e7..4efc3dfae 100644 --- a/IHP/IDE/SchemaDesigner/View/Columns/Edit.hs +++ b/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 From 873e2e7ca41aaf953583a477afcd35e7aea1ba7e Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Thu, 7 Mar 2024 18:50:47 +0100 Subject: [PATCH 10/23] Fix FetchRelated to respect id column name --- IHP/FetchRelated.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/IHP/FetchRelated.hs b/IHP/FetchRelated.hs index 2768c378a..6296c0657 100644 --- a/IHP/FetchRelated.hs +++ b/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 = From 5157e43abda1016ffb8a80bffe6db26ed06b0437 Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Sat, 16 Mar 2024 09:43:29 +0100 Subject: [PATCH 11/23] Remove bogus default impl of pkConditionForId --- IHP/ModelSupport.hs | 2 -- Test/QueryBuilderSpec.hs | 3 +++ 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/IHP/ModelSupport.hs b/IHP/ModelSupport.hs index bcd9fc31b..79313489a 100644 --- a/IHP/ModelSupport.hs +++ b/IHP/ModelSupport.hs @@ -590,8 +590,6 @@ class -- >>> primaryKeyConditionForId postTag.id -- [("post_id", "0ace9270-568f-4188-b237-3789aa520588"), ("tag_id", "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c")] primaryKeyConditionForId :: Id record -> [(Text, PG.Action)] - default primaryKeyConditionForId :: (ToField (Id record)) => Id record -> [(Text, PG.Action)] - primaryKeyConditionForId id = [("id", toField id)] -- | Returns WHERE conditions to match an entity by it's primary key -- diff --git a/Test/QueryBuilderSpec.hs b/Test/QueryBuilderSpec.hs index 53557b10f..a54a3f4dd 100644 --- a/Test/QueryBuilderSpec.hs +++ b/Test/QueryBuilderSpec.hs @@ -39,10 +39,12 @@ type instance PrimaryKey "weird_tags" = UUID instance Table WeirdPkTag where columnNames = ["tag_iden", "tag_text"] primaryKeyColumnNames = ["tag_iden"] + primaryKeyConditionForId (Id id) = [("tag_iden", toField id)] instance Table Post where columnNames = ["id", "title", "external_url", "created_at", "public", "created_by", "category_id"] primaryKeyColumnNames = ["id"] + primaryKeyConditionForId (Id id) = [("id", toField id)] data Tag = Tag { id :: UUID @@ -56,6 +58,7 @@ type instance PrimaryKey "tags" = UUID instance Table Tag where columnNames = ["id", "tag_text"] primaryKeyColumnNames = ["id"] + primaryKeyConditionForId (Id id) = [("id", toField id)] data Tagging = Tagging { id :: UUID From 90071648e3fea2d58915e782a1a7da34aeef3d97 Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Sat, 16 Mar 2024 11:17:16 +0100 Subject: [PATCH 12/23] Create unit tests for nullable pks --- Test/QueryBuilderSpec.hs | 98 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 98 insertions(+) diff --git a/Test/QueryBuilderSpec.hs b/Test/QueryBuilderSpec.hs index a54a3f4dd..f19b4850c 100644 --- a/Test/QueryBuilderSpec.hs +++ b/Test/QueryBuilderSpec.hs @@ -40,6 +40,37 @@ instance Table WeirdPkTag where columnNames = ["tag_iden", "tag_text"] primaryKeyColumnNames = ["tag_iden"] primaryKeyConditionForId (Id id) = [("tag_iden", toField id)] + + +data WeirdNullablePkTag = WeirdNullablePkTag + { tagIden :: Maybe UUID + , tagText :: Text + } + +type instance GetTableName WeirdNullablePkTag = "weird_nullable_tags" +type instance GetModelByTableName "weird_nullable_tags" = WeirdNullablePkTag +type instance PrimaryKey "weird_nullable_tags" = Maybe UUID + +instance Table WeirdNullablePkTag where + columnNames = ["tag_iden", "tag_text"] + primaryKeyColumnNames = ["tag_iden"] + primaryKeyConditionForId (Id id) = [("tag_iden", toField id)] + + +data WeirdNullableTagging = WeirdNullableTagging + { tagIden :: Maybe UUID + , parentTagIden :: Maybe UUID + } + +type instance GetTableName WeirdNullableTagging = "weird_nullable_tagging" +type instance GetModelByTableName "weird_nullable_tagging" = WeirdNullableTagging +type instance PrimaryKey "weird_nullable_tagging" = (Id' "weird_nullable_tags", Id' "weird_nullable_tags") + +instance Table WeirdNullableTagging where + columnNames = ["tag_iden", "parent_tag_iden"] + primaryKeyColumnNames = ["tag_iden", "parent_tag_iden"] + primaryKeyConditionForId (Id (tagIden, parentTagIden)) = [("tag_iden", toField tagIden), ("parent_tag_iden", toField parentTagIden)] + instance Table Post where columnNames = ["id", "title", "external_url", "created_at", "public", "created_by", "category_id"] @@ -74,6 +105,8 @@ type instance PrimaryKey "taggings" = UUID instance Table Tagging where columnNames = ["id", "post_id", "tag_id"] primaryKeyColumnNames = ["id"] + primaryKeyConditionForId (Id id) = [("id", toField id)] + data CompositeTagging = CompositeTagging { postId :: UUID @@ -103,6 +136,7 @@ type instance PrimaryKey "users" = UUID instance Table User where columnNames = ["id", "name"] primaryKeyColumnNames = ["id"] + primaryKeyConditionForId (Id id) = [("id", toField id)] data FavoriteTitle = FavoriteTitle { @@ -221,7 +255,71 @@ tests = do |> filterWhereIdIn theValues (toSQL theQuery) `shouldBe` ("SELECT composite_taggings.post_id, composite_taggings.tag_id FROM composite_taggings WHERE (composite_taggings.post_id, composite_taggings.tag_id) IN ?", [Plain "(null)"]) + describe "with nullable primary key" do + it "should produce a SQL with a WHERE IS OR IN condition" do + let theValues :: [Id WeirdNullablePkTag] = [Id (Just "b80e37a8-41d4-4731-b050-a716879ef1d1"), Id Nothing] + let theQuery = query @WeirdNullablePkTag + |> filterWhereIdIn theValues + + (toSQL theQuery) `shouldBe` ("SELECT weird_nullable_tags.tag_iden, weird_nullable_tags.tag_text FROM weird_nullable_tags WHERE weird_nullable_tags.tag_iden IN ?", [Many [Plain "(", Many [ Plain "(", Plain "'b80e37a8-41d4-4731-b050-a716879ef1d1'", Plain ")" ], Plain ",", Many [ Plain "(", Plain "null", Plain ")" ], Plain ")"]]) + + describe "with nullable composite primary key" do + it "should produce a SQL with a WHERE IN condition if given two non-null ids" do + let theValues :: [Id WeirdNullableTagging] = [ + Id (Id $ Just "b80e37a8-41d4-4731-b050-a716879ef1d1", Id $ Just "df38c8e0-ca9b-41d0-9091-785ad19d3782"), + Id (Id $ Just "8e5ecb74-a86b-428f-a647-683c3ee842a1", Id $ Just "7b183d12-0254-48b7-a759-68ceb80ff219") + ] + let theQuery = query @WeirdNullableTagging + |> filterWhereIdIn theValues + + (toSQL theQuery) `shouldBe` ("SELECT weird_nullable_tagging.tag_iden, weird_nullable_tagging.parent_tag_iden FROM weird_nullable_tagging WHERE (weird_nullable_tagging.tag_iden, weird_nullable_tagging.parent_tag_iden) IN ?", + [Many [Plain "(", Many [ Plain "(", Plain "'b80e37a8-41d4-4731-b050-a716879ef1d1'", Plain ",", Plain "'df38c8e0-ca9b-41d0-9091-785ad19d3782'", Plain ")" ], Plain ",", + Many [ Plain "(", Plain "'8e5ecb74-a86b-428f-a647-683c3ee842a1'", Plain ",", Plain "'7b183d12-0254-48b7-a759-68ceb80ff219'", Plain ")" ], Plain ")" + ]]) + it "should produce a SQL with a WHERE IS AND IN condition if given one null id exclusively" do + let theValues :: [Id WeirdNullableTagging] = [ + Id (Id $ Nothing, Id $ Just "df38c8e0-ca9b-41d0-9091-785ad19d3782"), + Id (Id $ Nothing, Id $ Just "7b183d12-0254-48b7-a759-68ceb80ff219") + ] + let theQuery = query @WeirdNullableTagging + |> filterWhereIdIn theValues + + (toSQL theQuery) `shouldBe` ("SELECT weird_nullable_tagging.tag_iden, weird_nullable_tagging.parent_tag_iden FROM weird_nullable_tagging WHERE (weird_nullable_tagging.tag_iden IS NULL AND weird_nullable_tagging.parent_tag_iden IN ?)", + [Many [Plain "(", Many [ Plain "(", Plain "'df38c8e0-ca9b-41d0-9091-785ad19d3782'", Plain ")" ], Plain ",", + Many [ Plain "(", Plain "'7b183d12-0254-48b7-a759-68ceb80ff219'", Plain ")" ], Plain ")" + ] + ]) + it "should produce a SQL with a WHERE (IS AND IN) OR IN condition if given one null id among others" do + let theValues :: [Id WeirdNullableTagging] = [ + Id (Id $ Nothing, Id $ Just "df38c8e0-ca9b-41d0-9091-785ad19d3782"), + Id (Id $ Nothing, Id $ Just "7b183d12-0254-48b7-a759-68ceb80ff219"), + Id (Id $ Just "c6c80b50-f8b4-4b61-bb2d-8a20c171ae3e", Id $ Just "1a4713d4-b28f-470c-902d-3ed542800526") + ] + let theQuery = query @WeirdNullableTagging + |> filterWhereIdIn theValues + + (toSQL theQuery) `shouldBe` ("SELECT weird_nullable_tagging.tag_iden, weird_nullable_tagging.parent_tag_iden FROM weird_nullable_tagging WHERE (weird_nullable_tagging.tag_iden IS NULL AND weird_nullable_tagging.parent_tag_iden IN ?) OR ((weird_nullable_tagging.tag_iden, weird_nullable_tagging.parent_tag_iden) IN ?)", + [ Many [Plain "(", Many [ Plain "(", Plain "'df38c8e0-ca9b-41d0-9091-785ad19d3782'", Plain ")" ], Plain ",", + Many [ Plain "(", Plain "'7b183d12-0254-48b7-a759-68ceb80ff219'", Plain ")" ], Plain ")" + ] + ,Many [Plain "(", Many [ Plain "(", Plain "'c6c80b50-f8b4-4b61-bb2d-8a20c171ae3e'", Plain ",", Plain "'1a4713d4-b28f-470c-902d-3ed542800526'", Plain ")" ]] + ]) + it "should produce a SQL with a WHERE (IS AND IS) OR (IS AND IN) OR (IN) condition if given two nulls, one null, and no null" do + let theValues :: [Id WeirdNullableTagging] = [ + Id (Id $ Nothing, Id $ Nothing), + Id (Id $ Nothing, Id $ Just "7b183d12-0254-48b7-a759-68ceb80ff219"), + Id (Id $ Just "c6c80b50-f8b4-4b61-bb2d-8a20c171ae3e", Id $ Just "1a4713d4-b28f-470c-902d-3ed542800526") + ] + let theQuery = query @WeirdNullableTagging + |> filterWhereIdIn theValues + (toSQL theQuery) `shouldBe` ("SELECT weird_nullable_tagging.tag_iden, weird_nullable_tagging.parent_tag_iden FROM weird_nullable_tagging WHERE (weird_nullable_tagging.tag_iden IS NULL AND weird_nullable_tagging.parent_tag_iden IS NULL) OR (weird_nullable_tagging.tag_iden IS NULL AND weird_nullable_tagging.parent_tag_iden IN ?) OR ((weird_nullable_tagging.tag_iden, weird_nullable_tagging.parent_tag_iden) IN ?)", + [ Many [Plain "(", Many [ Plain "(", Plain "'df38c8e0-ca9b-41d0-9091-785ad19d3782'", Plain ")" ], Plain ",", + Many [ Plain "(", Plain "'7b183d12-0254-48b7-a759-68ceb80ff219'", Plain ")" ], Plain ")" + ] + ,Many [Plain "(", Many [ Plain "(", Plain "'c6c80b50-f8b4-4b61-bb2d-8a20c171ae3e'", Plain ",", Plain "'1a4713d4-b28f-470c-902d-3ed542800526'", Plain ")" ]] + ]) + describe "filterWhereInJoinedTable" do it "should produce a SQL with a WHERE condition" do From 167089f17361c77911c8bf9687724441bdbc82f6 Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Sat, 16 Mar 2024 11:39:39 +0100 Subject: [PATCH 13/23] Fix SchemaCompiler for nullable pks --- IHP/SchemaCompiler.hs | 3 ++- Test/SchemaCompilerSpec.hs | 26 ++++++++++++++++++++++---- 2 files changed, 24 insertions(+), 5 deletions(-) diff --git a/IHP/SchemaCompiler.hs b/IHP/SchemaCompiler.hs index 07de5ca69..b41945164 100644 --- a/IHP/SchemaCompiler.hs +++ b/IHP/SchemaCompiler.hs @@ -740,7 +740,8 @@ compilePrimaryKeyInstance table@(CreateTable { name, columns, constraints }) = [ idType :: Text idType = case primaryKeyColumns table of [] -> error $ "Impossible happened in compilePrimaryKeyInstance. No primary keys found for table " <> cs name <> ". At least one primary key is required." - [column] -> atomicType column.columnType -- PrimaryKey User = UUID + [column] | column.notNull -> atomicType column.columnType -- PrimaryKey User = UUID + [column] | not column.notNull -> "(Maybe " <> atomicType column.columnType <> ")" -- PrimaryKey User = UUID cs -> "(" <> intercalate ", " (map colType cs) <> ")" -- PrimaryKey PostsTag = (Id' "posts", Id' "tags") where colType column = haskellType table column diff --git a/Test/SchemaCompilerSpec.hs b/Test/SchemaCompilerSpec.hs index 54f1c704d..aa81a7b6d 100644 --- a/Test/SchemaCompilerSpec.hs +++ b/Test/SchemaCompilerSpec.hs @@ -148,7 +148,7 @@ tests = do it "should compile CanUpdate instance with an array type with an explicit cast" do let statement = StatementCreateTable $ CreateTable { name = "users", - columns = [ Column "id" PUUID Nothing False True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing], + columns = [ Column "id" PUUID Nothing True True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing], primaryKeyConstraint = PrimaryKeyConstraint ["id"], constraints = [] , unlogged = False @@ -164,7 +164,7 @@ tests = do let statement = StatementCreateTable CreateTable { name = "users" , columns = - [ Column "id" PUUID Nothing False True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing + [ Column "id" PUUID Nothing True True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing , Column {name = "electricity_unit_price", columnType = PDouble, defaultValue = Just (TypeCastExpression (DoubleExpression 0.17) PDouble), notNull = True, isUnique = False, generator = Nothing} ] , primaryKeyConstraint = PrimaryKeyConstraint ["id"] @@ -234,7 +234,7 @@ tests = do let statement = StatementCreateTable CreateTable { name = "users" , columns = - [ Column "id" PUUID Nothing False True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing + [ Column "id" PUUID Nothing True True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing , Column {name = "electricity_unit_price", columnType = PDouble, defaultValue = Just (IntExpression 0), notNull = True, isUnique = False, generator = Nothing} ] , primaryKeyConstraint = PrimaryKeyConstraint ["id"] @@ -304,7 +304,7 @@ tests = do let statement = StatementCreateTable CreateTable { name = "users" , columns = - [ Column "id" PUUID Nothing False True Nothing + [ Column "id" PUUID Nothing True True Nothing , Column {name = "ts", columnType = PTSVector, defaultValue = Nothing, notNull = True, isUnique = False, generator = Just (ColumnGenerator { generate = VarExpression "someResult", stored = False }) } ] , primaryKeyConstraint = PrimaryKeyConstraint ["id"] @@ -446,6 +446,23 @@ tests = do builder |> QueryBuilder.filterWhere (#id, id) {-# INLINE filterWhereId #-} |] + describe "compileStatementPreview for table with nullable primary key" do + let statements = parseSqlStatements [trimming| + CREATE TABLE things ( + thing_arbitrary_ident UUID DEFAULT uuid_generate_v4() PRIMARY KEY + ); + |] + let + isTargetTable :: Statement -> Bool + isTargetTable (StatementCreateTable CreateTable { name }) = name == "things" + isTargetTable otherwise = False + let (Just statement) = find isTargetTable statements + let compileOutput = compileStatementPreview statements statement |> Text.strip + it "should produce PrimaryKey instance" do + getInstanceDecl "PrimaryKey" compileOutput `shouldBe` [trimming| + type instance PrimaryKey "things" = (Maybe UUID) + |] + describe "compileStatementPreview for table with arbitrarily named primary key" do let statements = parseSqlStatements [trimming| CREATE TABLE things ( @@ -608,6 +625,7 @@ getInstanceDecl instanceName full = where findInstanceDecl (line:rest) | ("instance " <> instanceName) `isPrefixOf` line = line : rest + | ("type instance " <> instanceName) `isPrefixOf` line = line : rest | otherwise = findInstanceDecl rest findInstanceDecl [] = error ("didn't find instance declaration of " <> instanceName) From c954ef6391857cccbd75f6228197342c7404b8ab Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Mon, 18 Mar 2024 10:40:26 +0100 Subject: [PATCH 14/23] Revert "Create unit tests for nullable pks" This reverts commit 90071648e3fea2d58915e782a1a7da34aeef3d97. --- Test/QueryBuilderSpec.hs | 98 ---------------------------------------- 1 file changed, 98 deletions(-) diff --git a/Test/QueryBuilderSpec.hs b/Test/QueryBuilderSpec.hs index f19b4850c..a54a3f4dd 100644 --- a/Test/QueryBuilderSpec.hs +++ b/Test/QueryBuilderSpec.hs @@ -40,37 +40,6 @@ instance Table WeirdPkTag where columnNames = ["tag_iden", "tag_text"] primaryKeyColumnNames = ["tag_iden"] primaryKeyConditionForId (Id id) = [("tag_iden", toField id)] - - -data WeirdNullablePkTag = WeirdNullablePkTag - { tagIden :: Maybe UUID - , tagText :: Text - } - -type instance GetTableName WeirdNullablePkTag = "weird_nullable_tags" -type instance GetModelByTableName "weird_nullable_tags" = WeirdNullablePkTag -type instance PrimaryKey "weird_nullable_tags" = Maybe UUID - -instance Table WeirdNullablePkTag where - columnNames = ["tag_iden", "tag_text"] - primaryKeyColumnNames = ["tag_iden"] - primaryKeyConditionForId (Id id) = [("tag_iden", toField id)] - - -data WeirdNullableTagging = WeirdNullableTagging - { tagIden :: Maybe UUID - , parentTagIden :: Maybe UUID - } - -type instance GetTableName WeirdNullableTagging = "weird_nullable_tagging" -type instance GetModelByTableName "weird_nullable_tagging" = WeirdNullableTagging -type instance PrimaryKey "weird_nullable_tagging" = (Id' "weird_nullable_tags", Id' "weird_nullable_tags") - -instance Table WeirdNullableTagging where - columnNames = ["tag_iden", "parent_tag_iden"] - primaryKeyColumnNames = ["tag_iden", "parent_tag_iden"] - primaryKeyConditionForId (Id (tagIden, parentTagIden)) = [("tag_iden", toField tagIden), ("parent_tag_iden", toField parentTagIden)] - instance Table Post where columnNames = ["id", "title", "external_url", "created_at", "public", "created_by", "category_id"] @@ -105,8 +74,6 @@ type instance PrimaryKey "taggings" = UUID instance Table Tagging where columnNames = ["id", "post_id", "tag_id"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id id) = [("id", toField id)] - data CompositeTagging = CompositeTagging { postId :: UUID @@ -136,7 +103,6 @@ type instance PrimaryKey "users" = UUID instance Table User where columnNames = ["id", "name"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id id) = [("id", toField id)] data FavoriteTitle = FavoriteTitle { @@ -255,71 +221,7 @@ tests = do |> filterWhereIdIn theValues (toSQL theQuery) `shouldBe` ("SELECT composite_taggings.post_id, composite_taggings.tag_id FROM composite_taggings WHERE (composite_taggings.post_id, composite_taggings.tag_id) IN ?", [Plain "(null)"]) - describe "with nullable primary key" do - it "should produce a SQL with a WHERE IS OR IN condition" do - let theValues :: [Id WeirdNullablePkTag] = [Id (Just "b80e37a8-41d4-4731-b050-a716879ef1d1"), Id Nothing] - let theQuery = query @WeirdNullablePkTag - |> filterWhereIdIn theValues - - (toSQL theQuery) `shouldBe` ("SELECT weird_nullable_tags.tag_iden, weird_nullable_tags.tag_text FROM weird_nullable_tags WHERE weird_nullable_tags.tag_iden IN ?", [Many [Plain "(", Many [ Plain "(", Plain "'b80e37a8-41d4-4731-b050-a716879ef1d1'", Plain ")" ], Plain ",", Many [ Plain "(", Plain "null", Plain ")" ], Plain ")"]]) - - describe "with nullable composite primary key" do - it "should produce a SQL with a WHERE IN condition if given two non-null ids" do - let theValues :: [Id WeirdNullableTagging] = [ - Id (Id $ Just "b80e37a8-41d4-4731-b050-a716879ef1d1", Id $ Just "df38c8e0-ca9b-41d0-9091-785ad19d3782"), - Id (Id $ Just "8e5ecb74-a86b-428f-a647-683c3ee842a1", Id $ Just "7b183d12-0254-48b7-a759-68ceb80ff219") - ] - let theQuery = query @WeirdNullableTagging - |> filterWhereIdIn theValues - - (toSQL theQuery) `shouldBe` ("SELECT weird_nullable_tagging.tag_iden, weird_nullable_tagging.parent_tag_iden FROM weird_nullable_tagging WHERE (weird_nullable_tagging.tag_iden, weird_nullable_tagging.parent_tag_iden) IN ?", - [Many [Plain "(", Many [ Plain "(", Plain "'b80e37a8-41d4-4731-b050-a716879ef1d1'", Plain ",", Plain "'df38c8e0-ca9b-41d0-9091-785ad19d3782'", Plain ")" ], Plain ",", - Many [ Plain "(", Plain "'8e5ecb74-a86b-428f-a647-683c3ee842a1'", Plain ",", Plain "'7b183d12-0254-48b7-a759-68ceb80ff219'", Plain ")" ], Plain ")" - ]]) - it "should produce a SQL with a WHERE IS AND IN condition if given one null id exclusively" do - let theValues :: [Id WeirdNullableTagging] = [ - Id (Id $ Nothing, Id $ Just "df38c8e0-ca9b-41d0-9091-785ad19d3782"), - Id (Id $ Nothing, Id $ Just "7b183d12-0254-48b7-a759-68ceb80ff219") - ] - let theQuery = query @WeirdNullableTagging - |> filterWhereIdIn theValues - - (toSQL theQuery) `shouldBe` ("SELECT weird_nullable_tagging.tag_iden, weird_nullable_tagging.parent_tag_iden FROM weird_nullable_tagging WHERE (weird_nullable_tagging.tag_iden IS NULL AND weird_nullable_tagging.parent_tag_iden IN ?)", - [Many [Plain "(", Many [ Plain "(", Plain "'df38c8e0-ca9b-41d0-9091-785ad19d3782'", Plain ")" ], Plain ",", - Many [ Plain "(", Plain "'7b183d12-0254-48b7-a759-68ceb80ff219'", Plain ")" ], Plain ")" - ] - ]) - it "should produce a SQL with a WHERE (IS AND IN) OR IN condition if given one null id among others" do - let theValues :: [Id WeirdNullableTagging] = [ - Id (Id $ Nothing, Id $ Just "df38c8e0-ca9b-41d0-9091-785ad19d3782"), - Id (Id $ Nothing, Id $ Just "7b183d12-0254-48b7-a759-68ceb80ff219"), - Id (Id $ Just "c6c80b50-f8b4-4b61-bb2d-8a20c171ae3e", Id $ Just "1a4713d4-b28f-470c-902d-3ed542800526") - ] - let theQuery = query @WeirdNullableTagging - |> filterWhereIdIn theValues - - (toSQL theQuery) `shouldBe` ("SELECT weird_nullable_tagging.tag_iden, weird_nullable_tagging.parent_tag_iden FROM weird_nullable_tagging WHERE (weird_nullable_tagging.tag_iden IS NULL AND weird_nullable_tagging.parent_tag_iden IN ?) OR ((weird_nullable_tagging.tag_iden, weird_nullable_tagging.parent_tag_iden) IN ?)", - [ Many [Plain "(", Many [ Plain "(", Plain "'df38c8e0-ca9b-41d0-9091-785ad19d3782'", Plain ")" ], Plain ",", - Many [ Plain "(", Plain "'7b183d12-0254-48b7-a759-68ceb80ff219'", Plain ")" ], Plain ")" - ] - ,Many [Plain "(", Many [ Plain "(", Plain "'c6c80b50-f8b4-4b61-bb2d-8a20c171ae3e'", Plain ",", Plain "'1a4713d4-b28f-470c-902d-3ed542800526'", Plain ")" ]] - ]) - it "should produce a SQL with a WHERE (IS AND IS) OR (IS AND IN) OR (IN) condition if given two nulls, one null, and no null" do - let theValues :: [Id WeirdNullableTagging] = [ - Id (Id $ Nothing, Id $ Nothing), - Id (Id $ Nothing, Id $ Just "7b183d12-0254-48b7-a759-68ceb80ff219"), - Id (Id $ Just "c6c80b50-f8b4-4b61-bb2d-8a20c171ae3e", Id $ Just "1a4713d4-b28f-470c-902d-3ed542800526") - ] - let theQuery = query @WeirdNullableTagging - |> filterWhereIdIn theValues - (toSQL theQuery) `shouldBe` ("SELECT weird_nullable_tagging.tag_iden, weird_nullable_tagging.parent_tag_iden FROM weird_nullable_tagging WHERE (weird_nullable_tagging.tag_iden IS NULL AND weird_nullable_tagging.parent_tag_iden IS NULL) OR (weird_nullable_tagging.tag_iden IS NULL AND weird_nullable_tagging.parent_tag_iden IN ?) OR ((weird_nullable_tagging.tag_iden, weird_nullable_tagging.parent_tag_iden) IN ?)", - [ Many [Plain "(", Many [ Plain "(", Plain "'df38c8e0-ca9b-41d0-9091-785ad19d3782'", Plain ")" ], Plain ",", - Many [ Plain "(", Plain "'7b183d12-0254-48b7-a759-68ceb80ff219'", Plain ")" ], Plain ")" - ] - ,Many [Plain "(", Many [ Plain "(", Plain "'c6c80b50-f8b4-4b61-bb2d-8a20c171ae3e'", Plain ",", Plain "'1a4713d4-b28f-470c-902d-3ed542800526'", Plain ")" ]] - ]) - describe "filterWhereInJoinedTable" do it "should produce a SQL with a WHERE condition" do From 3d2aa44027063ffe4e5585da3e9b1a893440eedb Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Mon, 18 Mar 2024 10:41:29 +0100 Subject: [PATCH 15/23] Revert "Fix SchemaCompiler for nullable pks" This reverts commit 167089f17361c77911c8bf9687724441bdbc82f6. --- IHP/SchemaCompiler.hs | 3 +-- Test/SchemaCompilerSpec.hs | 26 ++++---------------------- 2 files changed, 5 insertions(+), 24 deletions(-) diff --git a/IHP/SchemaCompiler.hs b/IHP/SchemaCompiler.hs index b41945164..07de5ca69 100644 --- a/IHP/SchemaCompiler.hs +++ b/IHP/SchemaCompiler.hs @@ -740,8 +740,7 @@ compilePrimaryKeyInstance table@(CreateTable { name, columns, constraints }) = [ idType :: Text idType = case primaryKeyColumns table of [] -> error $ "Impossible happened in compilePrimaryKeyInstance. No primary keys found for table " <> cs name <> ". At least one primary key is required." - [column] | column.notNull -> atomicType column.columnType -- PrimaryKey User = UUID - [column] | not column.notNull -> "(Maybe " <> atomicType column.columnType <> ")" -- PrimaryKey User = UUID + [column] -> atomicType column.columnType -- PrimaryKey User = UUID cs -> "(" <> intercalate ", " (map colType cs) <> ")" -- PrimaryKey PostsTag = (Id' "posts", Id' "tags") where colType column = haskellType table column diff --git a/Test/SchemaCompilerSpec.hs b/Test/SchemaCompilerSpec.hs index aa81a7b6d..54f1c704d 100644 --- a/Test/SchemaCompilerSpec.hs +++ b/Test/SchemaCompilerSpec.hs @@ -148,7 +148,7 @@ tests = do it "should compile CanUpdate instance with an array type with an explicit cast" do let statement = StatementCreateTable $ CreateTable { name = "users", - columns = [ Column "id" PUUID Nothing True True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing], + columns = [ Column "id" PUUID Nothing False True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing], primaryKeyConstraint = PrimaryKeyConstraint ["id"], constraints = [] , unlogged = False @@ -164,7 +164,7 @@ tests = do let statement = StatementCreateTable CreateTable { name = "users" , columns = - [ Column "id" PUUID Nothing True True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing + [ Column "id" PUUID Nothing False True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing , Column {name = "electricity_unit_price", columnType = PDouble, defaultValue = Just (TypeCastExpression (DoubleExpression 0.17) PDouble), notNull = True, isUnique = False, generator = Nothing} ] , primaryKeyConstraint = PrimaryKeyConstraint ["id"] @@ -234,7 +234,7 @@ tests = do let statement = StatementCreateTable CreateTable { name = "users" , columns = - [ Column "id" PUUID Nothing True True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing + [ Column "id" PUUID Nothing False True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing , Column {name = "electricity_unit_price", columnType = PDouble, defaultValue = Just (IntExpression 0), notNull = True, isUnique = False, generator = Nothing} ] , primaryKeyConstraint = PrimaryKeyConstraint ["id"] @@ -304,7 +304,7 @@ tests = do let statement = StatementCreateTable CreateTable { name = "users" , columns = - [ Column "id" PUUID Nothing True True Nothing + [ Column "id" PUUID Nothing False True Nothing , Column {name = "ts", columnType = PTSVector, defaultValue = Nothing, notNull = True, isUnique = False, generator = Just (ColumnGenerator { generate = VarExpression "someResult", stored = False }) } ] , primaryKeyConstraint = PrimaryKeyConstraint ["id"] @@ -446,23 +446,6 @@ tests = do builder |> QueryBuilder.filterWhere (#id, id) {-# INLINE filterWhereId #-} |] - describe "compileStatementPreview for table with nullable primary key" do - let statements = parseSqlStatements [trimming| - CREATE TABLE things ( - thing_arbitrary_ident UUID DEFAULT uuid_generate_v4() PRIMARY KEY - ); - |] - let - isTargetTable :: Statement -> Bool - isTargetTable (StatementCreateTable CreateTable { name }) = name == "things" - isTargetTable otherwise = False - let (Just statement) = find isTargetTable statements - let compileOutput = compileStatementPreview statements statement |> Text.strip - it "should produce PrimaryKey instance" do - getInstanceDecl "PrimaryKey" compileOutput `shouldBe` [trimming| - type instance PrimaryKey "things" = (Maybe UUID) - |] - describe "compileStatementPreview for table with arbitrarily named primary key" do let statements = parseSqlStatements [trimming| CREATE TABLE things ( @@ -625,7 +608,6 @@ getInstanceDecl instanceName full = where findInstanceDecl (line:rest) | ("instance " <> instanceName) `isPrefixOf` line = line : rest - | ("type instance " <> instanceName) `isPrefixOf` line = line : rest | otherwise = findInstanceDecl rest findInstanceDecl [] = error ("didn't find instance declaration of " <> instanceName) From dbdd70d21ec6e9be4c1a1f95b85703076d7f1d62 Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Mon, 18 Mar 2024 10:46:02 +0100 Subject: [PATCH 16/23] Fix small oversights Fix incomplete instances in QueryBuilderSpec with primaryKeyConditionForId Fix pk-columns in SchemaCompilerSpec to be unique and non-nullable for completeness --- Test/QueryBuilderSpec.hs | 2 ++ Test/SchemaCompilerSpec.hs | 10 +++++----- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/Test/QueryBuilderSpec.hs b/Test/QueryBuilderSpec.hs index a54a3f4dd..ee4c71688 100644 --- a/Test/QueryBuilderSpec.hs +++ b/Test/QueryBuilderSpec.hs @@ -74,6 +74,7 @@ type instance PrimaryKey "taggings" = UUID instance Table Tagging where columnNames = ["id", "post_id", "tag_id"] primaryKeyColumnNames = ["id"] + primaryKeyConditionForId (Id id) = [("id", toField id)] data CompositeTagging = CompositeTagging { postId :: UUID @@ -103,6 +104,7 @@ type instance PrimaryKey "users" = UUID instance Table User where columnNames = ["id", "name"] primaryKeyColumnNames = ["id"] + primaryKeyConditionForId (Id id) = [("id", toField id)] data FavoriteTitle = FavoriteTitle { diff --git a/Test/SchemaCompilerSpec.hs b/Test/SchemaCompilerSpec.hs index 54f1c704d..b0445e5fe 100644 --- a/Test/SchemaCompilerSpec.hs +++ b/Test/SchemaCompilerSpec.hs @@ -148,7 +148,7 @@ tests = do it "should compile CanUpdate instance with an array type with an explicit cast" do let statement = StatementCreateTable $ CreateTable { name = "users", - columns = [ Column "id" PUUID Nothing False True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing], + columns = [ Column "id" PUUID Nothing True True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing], primaryKeyConstraint = PrimaryKeyConstraint ["id"], constraints = [] , unlogged = False @@ -164,7 +164,7 @@ tests = do let statement = StatementCreateTable CreateTable { name = "users" , columns = - [ Column "id" PUUID Nothing False True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing + [ Column "id" PUUID Nothing True True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing , Column {name = "electricity_unit_price", columnType = PDouble, defaultValue = Just (TypeCastExpression (DoubleExpression 0.17) PDouble), notNull = True, isUnique = False, generator = Nothing} ] , primaryKeyConstraint = PrimaryKeyConstraint ["id"] @@ -234,7 +234,7 @@ tests = do let statement = StatementCreateTable CreateTable { name = "users" , columns = - [ Column "id" PUUID Nothing False True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing + [ Column "id" PUUID Nothing True True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing , Column {name = "electricity_unit_price", columnType = PDouble, defaultValue = Just (IntExpression 0), notNull = True, isUnique = False, generator = Nothing} ] , primaryKeyConstraint = PrimaryKeyConstraint ["id"] @@ -304,7 +304,7 @@ tests = do let statement = StatementCreateTable CreateTable { name = "users" , columns = - [ Column "id" PUUID Nothing False True Nothing + [ Column "id" PUUID Nothing True True Nothing , Column {name = "ts", columnType = PTSVector, defaultValue = Nothing, notNull = True, isUnique = False, generator = Just (ColumnGenerator { generate = VarExpression "someResult", stored = False }) } ] , primaryKeyConstraint = PrimaryKeyConstraint ["id"] @@ -584,7 +584,7 @@ tests = do it "should compile FilterPrimaryKey instance when primary key is called id" do let statement = StatementCreateTable $ CreateTable { name = "things", - columns = [ Column "id" PUUID Nothing False False Nothing ], + columns = [ Column "id" PUUID Nothing True True Nothing ], primaryKeyConstraint = PrimaryKeyConstraint ["id"], constraints = [], unlogged = False From 30a18d0e579035f781dabeee1d745f86c6d1b9a4 Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Mon, 18 Mar 2024 11:07:03 +0100 Subject: [PATCH 17/23] Update Comment --- IHP/QueryBuilder.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/IHP/QueryBuilder.hs b/IHP/QueryBuilder.hs index d2f6edacf..6161ff0a9 100644 --- a/IHP/QueryBuilder.hs +++ b/IHP/QueryBuilder.hs @@ -833,9 +833,7 @@ filterWhereCaseInsensitive (name, value) queryBuilderProvider = injectQueryBuild 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 ?) + -- We don't need to treat null values differently here, because primary keys imply not-null let qualifyColumnName col = tableNameByteString @model <> "." <> col From 0bb5b4562b02567c17ac051da90e3a58f2cc5597 Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Tue, 26 Mar 2024 09:28:32 +0100 Subject: [PATCH 18/23] Add unit test to prevent regressions --- Test/QueryBuilderSpec.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Test/QueryBuilderSpec.hs b/Test/QueryBuilderSpec.hs index ee4c71688..c04a2a70a 100644 --- a/Test/QueryBuilderSpec.hs +++ b/Test/QueryBuilderSpec.hs @@ -155,6 +155,12 @@ tests = do (toSQL theQuery) `shouldBe` ("SELECT posts.id, posts.title, posts.external_url, posts.created_at, posts.public, posts.created_by, posts.category_id FROM posts WHERE posts.external_url IS NOT ?", [Plain "null"]) describe "filterWhereIn" do + it "should work with #id if the Model is suitable" do + let theValues :: [UUID] = ["b80e37a8-41d4-4731-b050-a716879ef1d1", "629b7ee0-3675-4b02-ba3e-cdbd7b513553"] + let theQuery = query @Post + |> filterWhereIn (#id, theValues) + + (toSQL theQuery) `shouldBe` ("SELECT posts.id, posts.title, posts.external_url, posts.created_at, posts.public, posts.created_by, posts.category_id FROM posts WHERE posts.id IN ?", [Many [Plain "(", Plain "'b80e37a8-41d4-4731-b050-a716879ef1d1'", Plain ",", Plain "'629b7ee0-3675-4b02-ba3e-cdbd7b513553'", Plain ")"]]) it "should produce a SQL with a WHERE condition" do let theValues :: [Text] = ["first", "second"] let theQuery = query @Post From dc62630c12c5f316c79a8e85409b8c3eb6201e17 Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Tue, 26 Mar 2024 11:08:11 +0100 Subject: [PATCH 19/23] Abstract primaryKeyCondition --- IHP/ModelSupport.hs | 51 ++++++++++++++++++++++++++------------------- IHP/QueryBuilder.hs | 13 ++---------- 2 files changed, 32 insertions(+), 32 deletions(-) diff --git a/IHP/ModelSupport.hs b/IHP/ModelSupport.hs index 79313489a..d92f8eed6 100644 --- a/IHP/ModelSupport.hs +++ b/IHP/ModelSupport.hs @@ -591,6 +591,28 @@ class -- [("post_id", "0ace9270-568f-4188-b237-3789aa520588"), ("tag_id", "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c")] primaryKeyConditionForId :: Id record -> [(Text, 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 . map snd . 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: @@ -647,19 +669,11 @@ deleteRecord record = -- deleteRecordById :: forall record table. (?modelContext :: ModelContext, Table record, Show (PrimaryKey table), GetTableName record ~ table, record ~ GetModelByTableName table) => Id' table -> IO () deleteRecordById id = do - 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 () + 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. @@ -682,15 +696,10 @@ deleteRecordByIds :: forall record table. (?modelContext :: ModelContext, Show ( 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 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 theQuery = "DELETE FROM " <> tableNameByteString @record <> " WHERE " <> (primaryKeyConditionColumnSelector @record) <> " IN ?" - let theParameters = PG.Only $ PG.In $ map (ActionTuple . map snd . primaryKeyConditionForId @record) ids - sqlExec (PG.Query . cs $! theQuery) theParameters + let theParameters = PG.Only $ PG.In $ map (primaryKeyConditionActionTupleForId @record) ids + sqlExec (PG.Query $! theQuery) theParameters pure () {-# INLINABLE deleteRecordByIds #-} diff --git a/IHP/QueryBuilder.hs b/IHP/QueryBuilder.hs index 6161ff0a9..ce28b2f07 100644 --- a/IHP/QueryBuilder.hs +++ b/IHP/QueryBuilder.hs @@ -835,20 +835,11 @@ filterWhereIdIn :: forall table model queryBuilderProvider (joinRegister :: *). filterWhereIdIn values queryBuilderProvider = -- We don't need to treat null values differently here, because primary keys imply not-null let - qualifyColumnName col = tableNameByteString @model <> "." <> col - - pkConds = map (primaryKeyConditionForId @model) values - - actionTuples = map (ActionTuple . map snd) pkConds - - 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) <> ")" + actionTuples = map (primaryKeyConditionActionTupleForId @model) values queryBuilder = getQueryBuilder queryBuilderProvider - whereInQuery = FilterByQueryBuilder {queryBuilder, queryFilter = (columnNames, InOp, toField (In actionTuples)), applyLeft = Nothing, applyRight = Nothing} + whereInQuery = FilterByQueryBuilder {queryBuilder, queryFilter = (primaryKeyConditionColumnSelector @model, InOp, toField (In actionTuples)), applyLeft = Nothing, applyRight = Nothing} in injectQueryBuilder whereInQuery {-# INLINE filterWhereIdIn #-} From cf5e5302d7c2840d63f1c2b56e486d4b00d07d86 Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Tue, 26 Mar 2024 12:20:44 +0100 Subject: [PATCH 20/23] Remove redundant info of primaryKeyConditionForId --- IHP/ModelSupport.hs | 20 +++++++++++--------- IHP/SchemaCompiler.hs | 2 +- Test/QueryBuilderSpec.hs | 12 ++++++------ Test/SchemaCompilerSpec.hs | 12 ++++++------ 4 files changed, 24 insertions(+), 22 deletions(-) diff --git a/IHP/ModelSupport.hs b/IHP/ModelSupport.hs index d92f8eed6..170bcc3ed 100644 --- a/IHP/ModelSupport.hs +++ b/IHP/ModelSupport.hs @@ -578,24 +578,26 @@ class -- primaryKeyColumnNames :: [ByteString] - -- | Returns WHERE conditions to match an entity by it's primary key, given the entities id + -- | Returns the parameters for a 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: + -- For tables with a simple primary key this simply the id: -- -- >>> primaryKeyConditionForId project.id - -- [("id", "d619f3cf-f355-4614-8a4c-e9ea4f301e39")] + -- ["d619f3cf-f355-4614-8a4c-e9ea4f301e39"] -- -- If the table has a composite primary key, this returns multiple elements: -- -- >>> primaryKeyConditionForId postTag.id - -- [("post_id", "0ace9270-568f-4188-b237-3789aa520588"), ("tag_id", "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c")] - primaryKeyConditionForId :: Id record -> [(Text, PG.Action)] + -- ["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 . map snd . primaryKeyConditionForId @record +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 @@ -618,13 +620,13 @@ primaryKeyConditionColumnSelector = -- For tables with a simple primary key this returns a tuple with the id: -- -- >>> primaryKeyCondition project --- [("id", "d619f3cf-f355-4614-8a4c-e9ea4f301e39")] +-- ["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)] +-- ["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 () diff --git a/IHP/SchemaCompiler.hs b/IHP/SchemaCompiler.hs index 07de5ca69..6fe9cc762 100644 --- a/IHP/SchemaCompiler.hs +++ b/IHP/SchemaCompiler.hs @@ -804,7 +804,7 @@ instance #{instanceHead} where |> \listInner -> "[" <> listInner <> "]" primaryKeyToCondition :: Column -> Text - primaryKeyToCondition column = "(\"" <> column.name <> "\", toField " <> columnNameToFieldName column.name <> ")" + primaryKeyToCondition column = "toField " <> columnNameToFieldName column.name columnNames = columns |> map (.name) diff --git a/Test/QueryBuilderSpec.hs b/Test/QueryBuilderSpec.hs index c04a2a70a..5b103f2cc 100644 --- a/Test/QueryBuilderSpec.hs +++ b/Test/QueryBuilderSpec.hs @@ -39,12 +39,12 @@ type instance PrimaryKey "weird_tags" = UUID instance Table WeirdPkTag where columnNames = ["tag_iden", "tag_text"] primaryKeyColumnNames = ["tag_iden"] - primaryKeyConditionForId (Id id) = [("tag_iden", toField id)] + primaryKeyConditionForId (Id id) = [toField id] instance Table Post where columnNames = ["id", "title", "external_url", "created_at", "public", "created_by", "category_id"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id id) = [("id", toField id)] + primaryKeyConditionForId (Id id) = [toField id] data Tag = Tag { id :: UUID @@ -58,7 +58,7 @@ type instance PrimaryKey "tags" = UUID instance Table Tag where columnNames = ["id", "tag_text"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id id) = [("id", toField id)] + primaryKeyConditionForId (Id id) = [toField id] data Tagging = Tagging { id :: UUID @@ -74,7 +74,7 @@ type instance PrimaryKey "taggings" = UUID instance Table Tagging where columnNames = ["id", "post_id", "tag_id"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id id) = [("id", toField id)] + primaryKeyConditionForId (Id id) = [toField id] data CompositeTagging = CompositeTagging { postId :: UUID @@ -89,7 +89,7 @@ type instance PrimaryKey "composite_taggings" = (Id' "posts", Id' "tags") instance Table CompositeTagging where columnNames = ["post_id", "tag_id"] primaryKeyColumnNames = ["post_id", "tag_id"] - primaryKeyConditionForId (Id (postId, tagId)) = [("post_id", toField postId), ("tag_id", toField tagId)] + primaryKeyConditionForId (Id (postId, tagId)) = [toField postId, toField tagId] data User = User @@ -104,7 +104,7 @@ type instance PrimaryKey "users" = UUID instance Table User where columnNames = ["id", "name"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id id) = [("id", toField id)] + primaryKeyConditionForId (Id id) = [toField id] data FavoriteTitle = FavoriteTitle { diff --git a/Test/SchemaCompilerSpec.hs b/Test/SchemaCompilerSpec.hs index b0445e5fe..bbfa1c5c9 100644 --- a/Test/SchemaCompilerSpec.hs +++ b/Test/SchemaCompilerSpec.hs @@ -190,7 +190,7 @@ tests = do tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ids","electricity_unit_price"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id (id)) = [("id", toField id)] + primaryKeyConditionForId (Id (id)) = [toField id] {-# INLINABLE primaryKeyConditionForId #-} @@ -260,7 +260,7 @@ tests = do tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ids","electricity_unit_price"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id (id)) = [("id", toField id)] + primaryKeyConditionForId (Id (id)) = [toField id] {-# INLINABLE primaryKeyConditionForId #-} @@ -330,7 +330,7 @@ tests = do tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ts"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id (id)) = [("id", toField id)] + primaryKeyConditionForId (Id (id)) = [toField id] {-# INLINABLE primaryKeyConditionForId #-} @@ -408,7 +408,7 @@ tests = do tableNameByteString = Data.Text.Encoding.encodeUtf8 "landing_pages" columnNames = ["id"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id (id)) = [("id", toField id)] + primaryKeyConditionForId (Id (id)) = [toField id] {-# INLINABLE primaryKeyConditionForId #-} @@ -495,7 +495,7 @@ tests = do tableNameByteString = Data.Text.Encoding.encodeUtf8 "things" columnNames = ["thing_arbitrary_ident"] primaryKeyColumnNames = ["thing_arbitrary_ident"] - primaryKeyConditionForId (Id (thingArbitraryIdent)) = [("thing_arbitrary_ident", toField thingArbitraryIdent)] + primaryKeyConditionForId (Id (thingArbitraryIdent)) = [toField thingArbitraryIdent] {-# INLINABLE primaryKeyConditionForId #-} |] it "should compile QueryBuilder.FilterPrimaryKey instance" $ \statement -> do @@ -560,7 +560,7 @@ tests = do tableNameByteString = Data.Text.Encoding.encodeUtf8 "bit_part_refs" columnNames = ["bit_ref","part_ref"] primaryKeyColumnNames = ["bit_ref","part_ref"] - primaryKeyConditionForId (Id (bitRef, partRef)) = [("bit_ref", toField bitRef), ("part_ref", toField partRef)] + primaryKeyConditionForId (Id (bitRef, partRef)) = [toField bitRef, toField partRef] {-# INLINABLE primaryKeyConditionForId #-} |] it "should compile FromRow instance of table that references part of a composite key" $ \statement -> do From 3da73f7a816a0b60bc30d6533c9b6434ea375f59 Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Tue, 26 Mar 2024 18:02:37 +0100 Subject: [PATCH 21/23] Remove ActionTuple --- IHP/ModelSupport.hs | 24 ++++-------------------- IHP/QueryBuilder.hs | 4 ++-- IHP/SchemaCompiler.hs | 8 ++++---- Test/QueryBuilderSpec.hs | 19 ++++++++++--------- Test/SchemaCompilerSpec.hs | 12 ++++++------ 5 files changed, 26 insertions(+), 41 deletions(-) diff --git a/IHP/ModelSupport.hs b/IHP/ModelSupport.hs index 170bcc3ed..6ddc11470 100644 --- a/IHP/ModelSupport.hs +++ b/IHP/ModelSupport.hs @@ -591,13 +591,7 @@ class -- ["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 + primaryKeyConditionForId :: Id record -> PG.Action -- | 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 @@ -626,7 +620,7 @@ primaryKeyConditionColumnSelector = -- -- >>> 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 :: 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 () @@ -673,7 +667,7 @@ deleteRecordById :: forall record table. (?modelContext :: ModelContext, Table r deleteRecordById id = do let theQuery = "DELETE FROM " <> tableNameByteString @record <> " WHERE " <> (primaryKeyConditionColumnSelector @record) <> " = ?" - let theParameters = PG.Only $ primaryKeyConditionActionTupleForId @record id + let theParameters = PG.Only $ primaryKeyConditionForId @record id sqlExec (PG.Query $! theQuery) theParameters pure () {-# INLINABLE deleteRecordById #-} @@ -700,7 +694,7 @@ deleteRecordByIds [] = do deleteRecordByIds ids@(firstId : _) = do let theQuery = "DELETE FROM " <> tableNameByteString @record <> " WHERE " <> (primaryKeyConditionColumnSelector @record) <> " IN ?" - let theParameters = PG.Only $ PG.In $ map (primaryKeyConditionActionTupleForId @record) ids + let theParameters = PG.Only $ PG.In $ map (primaryKeyConditionForId @record) ids sqlExec (PG.Query $! theQuery) theParameters pure () {-# INLINABLE deleteRecordByIds #-} @@ -973,16 +967,6 @@ 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 diff --git a/IHP/QueryBuilder.hs b/IHP/QueryBuilder.hs index ce28b2f07..4432b4ea0 100644 --- a/IHP/QueryBuilder.hs +++ b/IHP/QueryBuilder.hs @@ -835,11 +835,11 @@ filterWhereIdIn :: forall table model queryBuilderProvider (joinRegister :: *). 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 + pkConditions = map (primaryKeyConditionForId @model) values queryBuilder = getQueryBuilder queryBuilderProvider - whereInQuery = FilterByQueryBuilder {queryBuilder, queryFilter = (primaryKeyConditionColumnSelector @model, InOp, toField (In actionTuples)), applyLeft = Nothing, applyRight = Nothing} + whereInQuery = FilterByQueryBuilder {queryBuilder, queryFilter = (primaryKeyConditionColumnSelector @model, InOp, toField (In pkConditions)), applyLeft = Nothing, applyRight = Nothing} in injectQueryBuilder whereInQuery {-# INLINE filterWhereIdIn #-} diff --git a/IHP/SchemaCompiler.hs b/IHP/SchemaCompiler.hs index 6fe9cc762..10fd3dff3 100644 --- a/IHP/SchemaCompiler.hs +++ b/IHP/SchemaCompiler.hs @@ -798,10 +798,10 @@ instance #{instanceHead} where pattern = "Id (" <> intercalate ", " primaryKeyFieldNames <> ")" condition :: Text - condition = primaryKeyColumns table - |> map primaryKeyToCondition - |> intercalate ", " - |> \listInner -> "[" <> listInner <> "]" + condition = case primaryKeyColumns table of + [] -> error $ "Impossible happened in compileUpdate. No primary keys found for table " <> cs name <> ". At least one primary key is required." + [column] -> primaryKeyToCondition column + cols -> "Many [Plain \"(\", " <> intercalate ", Plain \",\", " (map primaryKeyToCondition cols)<> ", Plain \")\"]" primaryKeyToCondition :: Column -> Text primaryKeyToCondition column = "toField " <> columnNameToFieldName column.name diff --git a/Test/QueryBuilderSpec.hs b/Test/QueryBuilderSpec.hs index 5b103f2cc..049c4f413 100644 --- a/Test/QueryBuilderSpec.hs +++ b/Test/QueryBuilderSpec.hs @@ -39,12 +39,13 @@ type instance PrimaryKey "weird_tags" = UUID instance Table WeirdPkTag where columnNames = ["tag_iden", "tag_text"] primaryKeyColumnNames = ["tag_iden"] - primaryKeyConditionForId (Id id) = [toField id] + primaryKeyConditionForId (Id id) = toField id + instance Table Post where columnNames = ["id", "title", "external_url", "created_at", "public", "created_by", "category_id"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id id) = [toField id] + primaryKeyConditionForId (Id id) = toField id data Tag = Tag { id :: UUID @@ -58,7 +59,7 @@ type instance PrimaryKey "tags" = UUID instance Table Tag where columnNames = ["id", "tag_text"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id id) = [toField id] + primaryKeyConditionForId (Id id) = toField id data Tagging = Tagging { id :: UUID @@ -74,7 +75,7 @@ type instance PrimaryKey "taggings" = UUID instance Table Tagging where columnNames = ["id", "post_id", "tag_id"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id id) = [toField id] + primaryKeyConditionForId (Id id) = toField id data CompositeTagging = CompositeTagging { postId :: UUID @@ -89,7 +90,7 @@ type instance PrimaryKey "composite_taggings" = (Id' "posts", Id' "tags") instance Table CompositeTagging where columnNames = ["post_id", "tag_id"] primaryKeyColumnNames = ["post_id", "tag_id"] - primaryKeyConditionForId (Id (postId, tagId)) = [toField postId, toField tagId] + primaryKeyConditionForId (Id (postId, tagId)) = Many ([Plain "(", toField postId, Plain ",", toField tagId, Plain ")"]) data User = User @@ -104,7 +105,7 @@ type instance PrimaryKey "users" = UUID instance Table User where columnNames = ["id", "name"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id id) = [toField id] + primaryKeyConditionForId (Id id) = toField id data FavoriteTitle = FavoriteTitle { @@ -117,7 +118,7 @@ type instance GetModelByTableName "favorite_title" = FavoriteTitle instance Table FavoriteTitle where columnNames = ["title", "likes"] - primaryKeyConditionForId _ = [] + primaryKeyConditionForId _ = Many [] primaryKeyColumnNames = [] tests = do @@ -197,7 +198,7 @@ tests = do let theQuery = query @Post |> filterWhereIdIn theValues - (toSQL theQuery) `shouldBe` ("SELECT posts.id, posts.title, posts.external_url, posts.created_at, posts.public, posts.created_by, posts.category_id FROM posts WHERE posts.id IN ?", [Many [Plain "(", Many [ Plain "(", Plain "'b80e37a8-41d4-4731-b050-a716879ef1d1'", Plain ")" ], Plain ",", Many [ Plain "(", Plain "'629b7ee0-3675-4b02-ba3e-cdbd7b513553'", Plain ")" ], Plain ")"]]) + (toSQL theQuery) `shouldBe` ("SELECT posts.id, posts.title, posts.external_url, posts.created_at, posts.public, posts.created_by, posts.category_id FROM posts WHERE posts.id IN ?", [Many [Plain "(", Plain "'b80e37a8-41d4-4731-b050-a716879ef1d1'", Plain ",", Plain "'629b7ee0-3675-4b02-ba3e-cdbd7b513553'", Plain ")"]]) describe "with empty values" do it "should produce a SQL with a WHERE condition" do @@ -213,7 +214,7 @@ tests = do let theQuery = query @WeirdPkTag |> filterWhereIdIn theValues - (toSQL theQuery) `shouldBe` ("SELECT weird_tags.tag_iden, weird_tags.tag_text FROM weird_tags WHERE weird_tags.tag_iden IN ?", [Many [Plain "(", Many [ Plain "(", Plain "'b80e37a8-41d4-4731-b050-a716879ef1d1'", Plain ")" ], Plain ",", Many [ Plain "(", Plain "'629b7ee0-3675-4b02-ba3e-cdbd7b513553'", Plain ")" ], Plain ")"]]) + (toSQL theQuery) `shouldBe` ("SELECT weird_tags.tag_iden, weird_tags.tag_text FROM weird_tags WHERE weird_tags.tag_iden IN ?", [Many [Plain "(", Plain "'b80e37a8-41d4-4731-b050-a716879ef1d1'", Plain ",", Plain "'629b7ee0-3675-4b02-ba3e-cdbd7b513553'", Plain ")"]]) describe "with composite keys" do it "should produce a SQL with a WHERE condition" do let theValues :: [Id CompositeTagging] = [Id ("b80e37a8-41d4-4731-b050-a716879ef1d1", "629b7ee0-3675-4b02-ba3e-cdbd7b513553"), Id ("8e2ef0ef-f680-4fcf-837d-7e3171385621", "95096f81-8ca6-407f-a263-cbc33546a828")] diff --git a/Test/SchemaCompilerSpec.hs b/Test/SchemaCompilerSpec.hs index bbfa1c5c9..8329e26e4 100644 --- a/Test/SchemaCompilerSpec.hs +++ b/Test/SchemaCompilerSpec.hs @@ -190,7 +190,7 @@ tests = do tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ids","electricity_unit_price"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id (id)) = [toField id] + primaryKeyConditionForId (Id (id)) = toField id {-# INLINABLE primaryKeyConditionForId #-} @@ -260,7 +260,7 @@ tests = do tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ids","electricity_unit_price"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id (id)) = [toField id] + primaryKeyConditionForId (Id (id)) = toField id {-# INLINABLE primaryKeyConditionForId #-} @@ -330,7 +330,7 @@ tests = do tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ts"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id (id)) = [toField id] + primaryKeyConditionForId (Id (id)) = toField id {-# INLINABLE primaryKeyConditionForId #-} @@ -408,7 +408,7 @@ tests = do tableNameByteString = Data.Text.Encoding.encodeUtf8 "landing_pages" columnNames = ["id"] primaryKeyColumnNames = ["id"] - primaryKeyConditionForId (Id (id)) = [toField id] + primaryKeyConditionForId (Id (id)) = toField id {-# INLINABLE primaryKeyConditionForId #-} @@ -495,7 +495,7 @@ tests = do tableNameByteString = Data.Text.Encoding.encodeUtf8 "things" columnNames = ["thing_arbitrary_ident"] primaryKeyColumnNames = ["thing_arbitrary_ident"] - primaryKeyConditionForId (Id (thingArbitraryIdent)) = [toField thingArbitraryIdent] + primaryKeyConditionForId (Id (thingArbitraryIdent)) = toField thingArbitraryIdent {-# INLINABLE primaryKeyConditionForId #-} |] it "should compile QueryBuilder.FilterPrimaryKey instance" $ \statement -> do @@ -560,7 +560,7 @@ tests = do tableNameByteString = Data.Text.Encoding.encodeUtf8 "bit_part_refs" columnNames = ["bit_ref","part_ref"] primaryKeyColumnNames = ["bit_ref","part_ref"] - primaryKeyConditionForId (Id (bitRef, partRef)) = [toField bitRef, toField partRef] + primaryKeyConditionForId (Id (bitRef, partRef)) = Many [Plain "(", toField bitRef, Plain ",", toField partRef, Plain ")"] {-# INLINABLE primaryKeyConditionForId #-} |] it "should compile FromRow instance of table that references part of a composite key" $ \statement -> do From 84b309b2a49defb4d9eeb7d0b93a9eed22ba590f Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Tue, 26 Mar 2024 18:24:31 +0100 Subject: [PATCH 22/23] Simplify deleteRecordByIds --- IHP/ModelSupport.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/IHP/ModelSupport.hs b/IHP/ModelSupport.hs index 6ddc11470..efd7e90b7 100644 --- a/IHP/ModelSupport.hs +++ b/IHP/ModelSupport.hs @@ -689,11 +689,8 @@ deleteRecords records = -- DELETE FROM projects WHERE id IN ('..') -- 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 +deleteRecordByIds ids = do let theQuery = "DELETE FROM " <> tableNameByteString @record <> " WHERE " <> (primaryKeyConditionColumnSelector @record) <> " IN ?" - let theParameters = PG.Only $ PG.In $ map (primaryKeyConditionForId @record) ids sqlExec (PG.Query $! theQuery) theParameters pure () From 27f671413fb416660ff1ccca6416472992abbcb6 Mon Sep 17 00:00:00 2001 From: Mona Mayrhofer Date: Tue, 26 Mar 2024 20:46:58 +0100 Subject: [PATCH 23/23] Small cleanups --- IHP/ModelSupport.hs | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/IHP/ModelSupport.hs b/IHP/ModelSupport.hs index efd7e90b7..e083acae6 100644 --- a/IHP/ModelSupport.hs +++ b/IHP/ModelSupport.hs @@ -583,12 +583,12 @@ class -- For tables with a simple primary key this simply the id: -- -- >>> primaryKeyConditionForId project.id - -- ["d619f3cf-f355-4614-8a4c-e9ea4f301e39"] + -- Plain "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"] + -- Many [Plain "(", Plain "0ace9270-568f-4188-b237-3789aa520588", Plain ",", Plain "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c", Plain ")"] -- -- 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 @@ -614,14 +614,14 @@ primaryKeyConditionColumnSelector = -- For tables with a simple primary key this returns a tuple with the id: -- -- >>> primaryKeyCondition project --- ["d619f3cf-f355-4614-8a4c-e9ea4f301e39"] +-- Plain "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"] +-- Many [Plain "(", Plain "0ace9270-568f-4188-b237-3789aa520588", Plain ",", Plain "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c", Plain ")"] primaryKeyCondition :: forall record. (HasField "id" record (Id record), Table record) => record -> PG.Action -primaryKeyCondition r = primaryKeyConditionForId @record r.id +primaryKeyCondition record = primaryKeyConditionForId @record record.id logQuery :: (?modelContext :: ModelContext, PG.ToRow parameters) => Query -> parameters -> NominalDiffTime -> IO () logQuery query parameters time = do @@ -665,11 +665,10 @@ deleteRecord record = -- 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 " <> tableNameByteString @record <> " WHERE " <> (primaryKeyConditionColumnSelector @record) <> " = ?" - - let theParameters = PG.Only $ primaryKeyConditionForId @record id - sqlExec (PG.Query $! theQuery) theParameters - pure () + let theQuery = "DELETE FROM " <> tableNameByteString @record <> " WHERE " <> (primaryKeyConditionColumnSelector @record) <> " = ?" + let theParameters = PG.Only $ primaryKeyConditionForId @record id + sqlExec (PG.Query $! theQuery) theParameters + pure () {-# INLINABLE deleteRecordById #-} -- | Runs a @DELETE@ query for a list of records. @@ -690,10 +689,10 @@ deleteRecords records = -- deleteRecordByIds :: forall record table. (?modelContext :: ModelContext, Show (PrimaryKey table), Table record, GetTableName record ~ table, record ~ GetModelByTableName table) => [Id' table] -> IO () deleteRecordByIds ids = do - let theQuery = "DELETE FROM " <> tableNameByteString @record <> " WHERE " <> (primaryKeyConditionColumnSelector @record) <> " IN ?" - let theParameters = PG.Only $ PG.In $ map (primaryKeyConditionForId @record) ids - sqlExec (PG.Query $! theQuery) theParameters - pure () + let theQuery = "DELETE FROM " <> tableNameByteString @record <> " WHERE " <> (primaryKeyConditionColumnSelector @record) <> " IN ?" + let theParameters = PG.Only $ PG.In $ map (primaryKeyConditionForId @record) ids + sqlExec (PG.Query $! theQuery) theParameters + pure () {-# INLINABLE deleteRecordByIds #-} -- | Runs a @DELETE@ query to delete all rows in a table.