Column functions and pkgdown site (#63)

* end of sql char

* drop col fn

* check views option

* fix tests

* better col checks

* new documentation

* increment ver

* fix comment

* char string length calculations

* provisional process

* formattings

* help doc improvement

* cleaning col fn

* suffix for new name opt

* add col tests

* rename column and test

* help comment

* rename table function and test

* connection as external fn

* new help docs

* style changes

* linter fixes

* Increment ver

* improve fn help

* pkgdown site

* remove sapply

* add column for append

* update examples with uat

* extra message not needed

* rename load vignette

* rename scripts for main fn

* guidance updates

* ignore run_uat file

* updated manuals

* uat check issues

* fixes to pkgdown

* ordered articles

* docs edits

* pkgdown gha

.Rbuildignore

@@ -4,3 +4,8 @@
 \.lintr
 ^README\.Rmd$
 ^\.github$
+^_pkgdown\.yml$
+^docs$
+^pkgdown$
+^doc$
+^Meta$

.github/workflows/pkgdown.yaml

@@ -0,0 +1,46 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+  release:
+    types: [published]
+  workflow_dispatch:
+
+name: pkgdown
+
+jobs:
+  pkgdown:
+    runs-on: ubuntu-latest
+    # Only restrict concurrency for non-PR jobs
+    concurrency:
+      group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }}
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-pandoc@v2
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::pkgdown, local::.
+          needs: website
+
+      - name: Build site
+        run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE)
+        shell: Rscript {0}
+
+      - name: Deploy to GitHub pages 🚀
+        if: github.event_name != 'pull_request'
+        uses: JamesIves/[email protected]
+        with:
+          clean: false
+          branch: gh-pages
+          folder: docs

.gitignore

@@ -1,3 +1,7 @@
 .Rproj.user
 .Rhistory
 .RData
+docs
+inst/doc
+/doc/
+/Meta/

DESCRIPTION

@@ -1,10 +1,8 @@
 Package: RtoSQLServer
 Title: Load R Dataframes into SQL Server Database Tables
-Version: 0.2.1
+Version: 0.2.3
 Authors@R: c(
-    person("Tom", "Wilson", email = "[email protected]", role = "cre"),
-    person("Miles", "Drake", email = "[email protected]", role = "aut"),
-    person("Tom", "Crines", email = "[email protected]", role = "aut"))
+    person("Tom", "Wilson", email = "[email protected]", role = "cre"))
 Description: What the package does (one paragraph).
 License: MIT + file LICENSE
 Encoding: UTF-8
@@ -20,4 +18,7 @@ Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.1
 Suggests: 
     testthat (>= 2.1.0),
-    mockery
+    mockery,
+    knitr,
+    rmarkdown
+VignetteBuilder: knitr

NAMESPACE

@@ -1,10 +1,15 @@
 # Generated by roxygen2: do not edit by hand
 
+export(add_column)
+export(create_sqlserver_connection)
 export(db_table_metadata)
 export(delete_table_rows)
+export(drop_column)
 export(drop_table_from_db)
 export(execute_sql)
 export(read_table_from_db)
+export(rename_column)
+export(rename_table)
 export(show_schema_tables)
 export(write_dataframe_to_db)
 import(utils)

R/add_column.R

@@ -0,0 +1,145 @@
+create_add_column_sql <- function(schema,
+                                  table_name,
+                                  column_name,
+                                  column_type) {
+  schema_tbl <- quoted_schema_tbl(schema, table_name)
+  glue::glue_sql(
+    "ALTER TABLE {schema_tbl} ADD \\
+    {DBI::dbQuoteIdentifier(DBI::ANSI(), column_name)} \\
+    {DBI::SQL(column_type)} NULL;",
+    .con = DBI::ANSI()
+  )
+}
+
+validate_column_type <- function(sample_value) {
+  if (is.function(sample_value)) {
+    stop(glue::glue("Invalid input: column_data cannot be a function name. \\
+                    For example `character` or `numeric` are invalid, but \\
+                    `character()` or `numeric()` are valid argument values"))
+  }
+
+  tryCatch(
+    {
+      if (!is.null(sample_value)) {
+        class(sample_value)
+      }
+    },
+    error = function(e) {
+      stop("Invalid input: Unable to determine the class of column_type.")
+    }
+  )
+}
+
+clean_new_column_name <- function(table_name, column_name) {
+  initial_name <- column_name
+  column_name <- substr(column_name, start = 1, stop = 126)
+  column_name <- rename_reserved_column(column_name,
+    table_name,
+    suffix = "_new"
+  )
+  column_name <- gsub(pattern = "\\.", replacement = "_", column_name)
+  if (column_name != initial_name) {
+    warning(glue::glue("Column name {initial_name} is invalid \\
+                       using {column_name} instead."), call. = FALSE)
+  }
+  column_name
+}
+
+
+#' Add a Column to an existing database table.
+#'
+#' Adds a specified column to a table. The column data type must be mapped
+#' from an R object, or the database column data type explicitly specified.
+#' Checks if the table exists in the schema before attempting to add the column.
+#'
+#' @param server Server and instance where SQL Server database found.
+#' @param database Database containing the table to which the column
+#' will be added.
+#' @param schema Name of schema containing the table.
+#' @param table_name Name of the table to which the column should be added.
+#' @param column_name The name of the column to be added.
+#' @param sql_data_type The SQL datatype for the column as a character string.
+#' For example `"nvarchar(255)"`
+#' (optional, can be inferred from `sample_value` alternatively). Use
+#' [`db_table_metadata()`] to see the data types for existing tables/columns
+#'  in the database, or refer to MS SQL Server guidance on data types.
+#' @param sample_value Existing R data frame column,
+#'  or a value that defines the datatype of the column. The input
+#'  should be of the correct R class for its type, for example, strings as
+#'  character, numbers as `numeric`, dates as `Date`, date times as `POSIXct`
+#'  or `POSIXlt`.
+#' Optional and superseded by `sql_data_type` if specified. Some example
+#' valid inputs: `iris$Species`, `"a sample string"`, `numeric()`,
+#'  `as.Date("2024-01-01"`).
+#'
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' # Add a Species_new column to test_iris table
+#' add_column(
+#'   server = "my_server",
+#'   database = "my_database",
+#'   schema = "my_schema",
+#'   table_name = "test_iris",
+#'   column_name = "Species_new",
+#'   sample_value = character(0)
+#' )
+#' }
+add_column <- function(server,
+                       database,
+                       schema,
+                       table_name,
+                       column_name,
+                       sql_data_type = NULL,
+                       sample_value = NULL) {
+  if (!check_table_exists(
+    server,
+    database,
+    schema,
+    table_name,
+    include_views = FALSE
+  )) {
+    stop(glue::glue(
+      "Table: {schema}.{table_name} does not exist in the database. Is \\
+      {schema}.{table_name} a view instead of a table?"
+    ))
+  }
+
+  table_columns <- db_table_metadata(
+    server,
+    database,
+    schema,
+    table_name
+  )$column_name
+
+  # Ensure the column does not already exist
+  if (tolower(column_name) %in% tolower(table_columns)) {
+    stop(glue::glue("Column {column_name} already exists \\
+                    in {schema}.{table_name}."))
+  }
+
+  # Clean invalid column name
+  column_name <- clean_new_column_name(table_name, column_name)
+
+  # Infer SQL datatype from R data if not provided
+  if (is.null(sql_data_type)) {
+    if (is.null(sample_value)) {
+      stop(glue::glue("You must provide either `sample_value` \\
+           for data type inference or `sql_data_type` directly."))
+    }
+    validate_column_type(sample_value)
+    sql_data_type <- r_to_sql_data_type(sample_value)
+  }
+
+  # Create the SQL to add the column
+  sql <- create_add_column_sql(schema, table_name, column_name, sql_data_type)
+
+  # Execute the SQL to add the column
+  execute_sql(server, database, sql, output = FALSE)
+
+  message(glue::glue(
+    "Column {column_name} of type {sql_data_type} \\
+    added to {schema}.{table_name}."
+  ))
+}

R/create_sqlserver_connection.R

@@ -0,0 +1,48 @@
+#' Create a connection to a SQL Server database.
+#'
+#' Establishes a connection to a SQL Server database
+#' using the ODBC driver. It uses Windows authentication. Use
+#' [`DBI::dbDisconnect()`] to disconnect this connection once no longer in use.
+#'
+#' @param server Server and instance where SQL Server database found.
+#' @param database The name of the database to connect to.
+#' @param timeout The timeout period (in seconds) for establishing
+#' the connection. Defaults to 10.
+#'
+#' @return A connection object of class `"Microsoft SQL Server"`
+#' from the `odbc` package.
+#'
+#' @examples
+#' \dontrun{
+#' # Connect to a SQL Server database
+#' con <- create_sqlserver_connection(
+#'   server = "my_server",
+#'   database = "my_database"
+#' )
+#'
+#' # Remember to disconnect after usage
+#' DBI::dbDisconnect(con)
+#' }
+#'
+#' @export
+create_sqlserver_connection <- function(server, database, timeout = 10) {
+  tryCatch(
+    {
+      DBI::dbConnect(
+        odbc::odbc(),
+        Driver = "SQL Server",
+        Trusted_Connection = "True",
+        DATABASE = database,
+        SERVER = server,
+        timeout = timeout
+      )
+    },
+    error = function(cond) {
+      stop(glue::glue(
+        "Failed to create connection to database: \\
+        {database} on server: {server} \\
+        \n{cond}"
+      ), call. = FALSE)
+    }
+  )
+}

R/db_table_metadata.R

@@ -70,7 +70,7 @@ get_metadata <- function(server,
     return(columns_info)
   }
 
-  sql_parts <- lapply(1:nrow(columns_info),
+  sql_parts <- lapply(seq_len(nrow(columns_info)),
     get_table_stats,
     columns_info = columns_info,
     schema = schema,

R/delete_table_rows.R

@@ -1,9 +1,13 @@
 delete_sql <- function(schema, table_name) {
-  glue::glue_sql("DELETE FROM {`schema`}.{`table_name`}", .con = DBI::ANSI())
+  glue::glue_sql("DELETE FROM {`quoted_schema_tbl(schema, table_name)`}",
+    .con = DBI::ANSI()
+  )
 }
 
 truncate_sql <- function(schema, table_name) {
-  glue::glue_sql("TRUNCATE TABLE {`schema`}.{`table_name`}", .con = DBI::ANSI())
+  glue::glue_sql("TRUNCATE TABLE {`quoted_schema_tbl(schema, table_name)`};",
+    .con = DBI::ANSI()
+  )
 }
 
 add_filter_sql <- function(initial_sql, filter_stmt) {