Use hack to create compound primary keys

R/db-helpers.R

@@ -25,7 +25,7 @@ get_pid <- function() {
 }
 
 # Internal copy helper functions
-build_copy_data <- function(dm, dest, table_names, set_key_constraints) {
+build_copy_data <- function(dm, dest, table_names, set_key_constraints, con) {
   source <-
     dm %>%
     dm_apply_filters() %>%
@@ -40,18 +40,22 @@ build_copy_data <- function(dm, dest, table_names, set_key_constraints) {
 
     pks <-
       dm_get_all_pks_impl(dm) %>%
-      transmute(source_name = table, column = pk_col, pk = TRUE)
+      select(source_name = table, pk_col)
+
+    pks_clause <-
+      pks %>%
+      mutate(sql = map_chr(pk_col, ~ paste(DBI::dbQuoteIdentifier(con, .x), collapse = ", ")))
 
-    # FIXME: COMPOUND: Need support for multiple primary keys, https://github.com/r-dbi/DBI/pull/351
-    # Discard primary keys of length > 1 for now
     pks_flat <-
       pks %>%
-      filter(lengths(column) == 1) %>%
-      mutate(column = as.character(unlist(column)))
+      # Expanding summarize()
+      group_by(source_name) %>%
+      summarize(column = as.character(unlist(pk_col)), pk = TRUE) %>%
+      ungroup()
 
     fks <-
       dm_get_all_fks_impl(dm) %>%
-      transmute(source_name = child_table, column = child_fk_cols, fk = TRUE)
+      select(source_name = child_table, child_fk_cols)
 
     # Need to supply NOT NULL modifiers for primary keys
     # because they are difficult to add to MSSQL after the fact
@@ -63,21 +67,32 @@ build_copy_data <- function(dm, dest, table_names, set_key_constraints) {
       select(-df) %>%
       unnest(c(column, type)) %>%
       left_join(pks_flat, by = c("source_name", "column")) %>%
-      mutate(full_type = paste0(type, if_else(pk, " NOT NULL PRIMARY KEY", "", ""))) %>%
+      mutate(full_type = paste0(type, if_else(pk, " NOT NULL", "", ""))) %>%
+
+      left_join(pks_clause, by = "source_name") %>%
       group_by(source_name) %>%
+
+      # HACK: Append PRIMARY KEY clause to end, https://github.com/r-dbi/DBI/pull/351
+      # So far this is the only reason to use `con` in this function
+      mutate(full_type = paste0(full_type, if_else(
+        !!set_key_constraints & !is.na(sql) & (row_number() == n()),
+        paste0(", PRIMARY KEY (", sql, ")"),
+        ""
+      ))) %>%
+
       summarize(types = list(deframe(tibble(column, full_type))))
 
     copy_data_unique_indexes <-
       pks %>%
       group_by(source_name) %>%
-      summarize(unique_indexes = list(column)) %>%
+      summarize(unique_indexes = list(pk_col)) %>%
       ungroup()
 
     copy_data_non_unique_indexes <-
       fks %>%
-      select(source_name, column) %>%
       group_by(source_name) %>%
-      summarize(indexes = list(column))
+      summarize(indexes = list(child_fk_cols)) %>%
+      ungroup()
 
     copy_data_indexes <-
       full_join(copy_data_unique_indexes, copy_data_non_unique_indexes, by = "source_name") %>%

R/db-interface.R

@@ -183,7 +183,7 @@ copy_dm_to <- function(dest, dm, ...,
     return(dm)
   }
 
-  copy_data <- build_copy_data(dm, dest, table_names_out, set_key_constraints)
+  copy_data <- build_copy_data(dm, dest, table_names_out, set_key_constraints, dest_con)
 
   new_tables <- copy_list_of_tables_to(
     dest,