initial refactor

Author: Mike Johnson

.Rbuildignore

@@ -0,0 +1,5 @@
+^LICENSE\.md$
+^.*\.Rproj$
+^\.Rproj\.user$
+^\.github$
+^_pkgdown\.yaml$

.github/workflows/pkgdown.yaml

@@ -0,0 +1,49 @@
+# 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: Website
+
+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 }}
+    permissions:
+      contents: write
+    steps:
+      - uses: actions/checkout@v3
+
+      - 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/github-pages-deploy-action@v4.4.1
+        with:
+          clean: false
+          branch: gh-pages
+          folder: docs

.gitignore

@@ -0,0 +1,5 @@
+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata
+.DS_Store

DESCRIPTION

@@ -0,0 +1,45 @@
+Package: hfutils
+Type: Package
+Title: hfutils
+Description: Core hydrofabric manipulation utilities.
+Version: 0.3.3
+Authors@R: 
+    c(person(given = "Mike", 
+             family = "Johnson", 
+             role = c("aut", "cre"),
+             email = "mjohnson@lynker.com"),
+             person(given = "Justin", family = "Singh-Mohudpur", 
+             role = c("aut")))
+Maintainer: Mike Johnson <mjohnson@lynker.com>
+BugReports: https://github.com/lynker-spatial/hfutils
+URL: https://github.com/lynker-spatial/hfutils  
+Depends: 
+    R (>= 4.2)
+Imports: 
+    DBI,
+    dbplyr,
+    dplyr,
+    glue,
+    httr,
+    igraph,
+    methods,
+    sf,
+    stats,
+    utils
+Suggests: 
+    testthat
+License: GPL (>= 3)
+Encoding: UTF-8
+LazyData: true
+RoxygenNote: 7.3.2
+Config/testthat/edition: 3
+Config/testthat/parallel: true
+Collate: 
+    'OGRSQL.R'
+    'OGRSQLConnection.R'
+    'OGRSQLDriver.R'
+    'OGRSQLResult.R'
+    'hfutils-package.R'
+    'network_properties.R'
+    'sf_ogr.R'
+    'zzz.R'

LICENSE.md

@@ -0,0 +1,73 @@
+# Generated by roxygen2: do not edit by hand
+
+S3method(as_ogr,OGRSQLConnection)
+S3method(as_ogr,character)
+S3method(dbplyr_edition,OGRSQLConnection)
+S3method(st_as_sf,tbl_OGRSQLConnection)
+export(OGRSQL)
+export(accumulate_downstream)
+export(as_ogr)
+export(collect)
+export(st_as_sf)
+exportClasses(OGRSQLConnection)
+exportClasses(OGRSQLDriver)
+exportClasses(OGRSQLResult)
+exportMethods(dbClearResult)
+exportMethods(dbConnect)
+exportMethods(dbDataType)
+exportMethods(dbDisconnect)
+exportMethods(dbExistsTable)
+exportMethods(dbFetch)
+exportMethods(dbGetInfo)
+exportMethods(dbHasCompleted)
+exportMethods(dbIsValid)
+exportMethods(dbListTables)
+exportMethods(dbReadTable)
+exportMethods(dbSendQuery)
+exportMethods(dbUnloadDriver)
+exportMethods(show)
+importFrom(DBI,dbClearResult)
+importFrom(DBI,dbConnect)
+importFrom(DBI,dbDataType)
+importFrom(DBI,dbDisconnect)
+importFrom(DBI,dbExistsTable)
+importFrom(DBI,dbFetch)
+importFrom(DBI,dbGetInfo)
+importFrom(DBI,dbHasCompleted)
+importFrom(DBI,dbIsValid)
+importFrom(DBI,dbListTables)
+importFrom(DBI,dbReadTable)
+importFrom(DBI,dbSendQuery)
+importFrom(DBI,dbUnloadDriver)
+importFrom(dbplyr,dbplyr_edition)
+importFrom(dbplyr,sql)
+importFrom(dplyr,`%>%`)
+importFrom(dplyr,any_of)
+importFrom(dplyr,collect)
+importFrom(dplyr,distinct)
+importFrom(dplyr,everything)
+importFrom(dplyr,filter)
+importFrom(dplyr,if_any)
+importFrom(dplyr,mutate)
+importFrom(dplyr,pull)
+importFrom(dplyr,rename)
+importFrom(dplyr,select)
+importFrom(dplyr,tbl)
+importFrom(glue,glue)
+importFrom(httr,GET)
+importFrom(httr,progress)
+importFrom(httr,write_disk)
+importFrom(igraph,as_ids)
+importFrom(igraph,graph_from_edgelist)
+importFrom(igraph,is_dag)
+importFrom(igraph,topo_sort)
+importFrom(methods,callNextMethod)
+importFrom(methods,new)
+importFrom(methods,setClass)
+importFrom(methods,setMethod)
+importFrom(methods,setOldClass)
+importFrom(methods,show)
+importFrom(sf,sf_extSoftVersion)
+importFrom(sf,st_as_sf)
+importFrom(sf,st_layers)
+importFrom(utils,packageVersion)

NAMESPACE

@@ -0,0 +1,7 @@
+# OGRSQLDriver.R -------------------------------------------------------------
+
+# OGRSQLConnection.R --------------------------------------------------------
+
+# OGRSQLResult.R ------------------------------------------------------------
+
+# sf_ogr.R ------------------------------------------------------------------

R/OGRSQL.R

@@ -0,0 +1,101 @@
+#' Class OGRSQLConnection (and methods)
+#'
+#' OGRSQLConnection objects are created by passing [OGRSQL()] as first
+#' argument to [DBI::dbConnect()].
+#' They are a superclass of the [DBIConnection-class] class.
+#' @keywords internal
+#' @export
+setClass(
+  "OGRSQLConnection",
+  contains = "DBIConnection",
+  slots = list(DSN = "character", 
+               readonly = "logical")
+)
+
+#' @rdname OGRSQLConnection-class
+#' @export
+
+setMethod("show", "OGRSQLConnection", function(object) {
+  cat("<OGRSQLConnection>\n")
+  tables <- DBI::dbListTables(object)
+  dsn <- object@DSN
+  if (grepl("pass", dsn, ignore.case = TRUE) ||
+      grepl("user", dsn, ignore.case = TRUE)) {
+    dsn <- paste0(strsplit(dsn, "\\s")[[1L]][1L], "...")
+  }
+  cat("\tDSN: ", dsn, "\n", sep = "")
+  cat("tables: ", paste(tables, collapse = ", "), "\n", sep = "")
+})
+
+#' @rdname OGRSQLConnection-class
+#' @export
+
+setMethod("dbSendQuery", "OGRSQLConnection", function(conn, statement, ...) {
+  ## quiet and fake layer because we aren't using layer  = (it's in the query)
+  args <- list(...)
+  args$dsn <- conn@DSN
+  args$layer <- "<fake layer>"
+  args$query <- statement   
+  args$quiet <- TRUE
+  args$as_tibble <- TRUE
+  #browser()
+  qu <- as.character(args$query)
+  
+  if (grepl("AS.*q", qu) &&
+      grepl("WHERE \\(0 = 1)", qu)) {
+    ## workaround for non-DB sources
+    args$query <- dbplyr::sql(gsub("WHERE \\(0 = 1)", "LIMIT 0", qu))
+  }
+  op <- options(warn = -1)
+  on.exit(options(op), add = TRUE)
+  layer_data <- do.call(sf::st_read, args)
+  
+  if (getOption("ogr.query.debug")) {
+    message(
+      sprintf(
+        "-------------\nOGR debug ....\nSQL:\n%s\nnrows read:\n%i",
+        statement
+      ),
+      nrow(layer_data)
+    )
+  }
+  if (inherits(layer_data, "try-error")) {
+    if (length(gregexpr("SELECT", statement, ignore.case = TRUE)[[1]]) > 1) {
+      stop(
+        sprintf(
+          "executing SQL failed: \n%s\n\nperhaps driver in use does not support sub-queries?",
+          statement
+        )
+      )
+    } else {
+      stop("executing SQL failed")
+    }
+  }
+  new("OGRSQLResult", layer_data = layer_data)
+  
+})
+
+#' @rdname OGRSQLConnection-class
+#' @export
+setMethod("dbReadTable", c(conn = "OGRSQLConnection", name = "character"), function(conn, name, ...) {
+  x <- dbSendQuery(conn, sprintf("SELECT * FROM %s", name))
+  dbFetch(x)
+})
+
+#' @rdname OGRSQLConnection-class
+#' @export
+
+setMethod("dbListTables", c(conn = "OGRSQLConnection"), function(conn, ...) {
+  layers <- sf::st_layers(conn@DSN, ...)
+  layers$name
+})
+
+#' @rdname OGRSQLConnection-class
+#' @export
+setMethod("dbExistsTable", c(conn = "OGRSQLConnection"), function(conn, name, ...) {
+  name %in% dbListTables(conn, ...)
+})
+
+#' @importFrom dbplyr dbplyr_edition
+#' @export
+dbplyr_edition.OGRSQLConnection <- function(con) 2L

R/OGRSQLConnection.R

@@ -0,0 +1,59 @@
+#' Class OGRSQLDriver
+#'
+#' OGRSQLDriver objects are created by [OGRSQL()] and used to select the correct
+#' method in [dbConnect()].
+#' They are a superclass of the [DBIDriver-class] class, and used purely for dispatch.
+#' @keywords internal
+#' @export
+
+setClass("OGRSQLDriver", contains = "DBIDriver")
+
+#' @rdname OGRSQLDriver-class
+#' @export
+
+setMethod("dbDataType", "OGRSQLDriver", function(dbObj, obj, ...) {
+  ## see "type of the fields" http://www.gdal.org/ogr_sql.html
+  if (is.factor(obj)) return("character")
+  if (is.data.frame(obj)) return(callNextMethod(dbObj, obj))
+
+  switch(typeof(obj),
+         logical = "boolean",
+         character = "character",
+         double = "numeric",
+         integer = "integer",
+         list = "character",
+         raw = "character",
+         blob = "character",
+         stop("Unsupported type", call. = FALSE)
+  )
+}
+)
+
+#' @rdname OGRSQLDriver-class
+#' @export
+
+setMethod("dbIsValid", "OGRSQLDriver", function(dbObj, ...) { TRUE })
+
+#' @rdname OGRSQLDriver-class
+#' @export
+
+setMethod("dbUnloadDriver", "OGRSQLDriver", function(drv, ...) {
+  TRUE
+})
+
+#' @rdname OGRSQLDriver-class
+#' @export
+
+setMethod("dbGetInfo", "OGRSQLDriver", function(dbObj, ...) {
+  vers <- sf::sf_extSoftVersion()
+  list(
+    name = "OGRSQLDriver",
+    note = "virtual SQL driver for OGR Resources",
+    driver.version = vers["GDAL"],
+    client.version = utils::packageVersion("hfsubsetR")
+  )
+})
+
+
+
+

R/OGRSQLDriver.R

@@ -0,0 +1,38 @@
+#' Class OGRSQLResult (and methods)
+#'
+#' OGRSQLResult objects are created by [dbSendQuery()] or [dbSendStatement()],
+#' and encapsulate the result of an SQL statement.
+#' They are a superclass of the [DBIResult-class] class.
+#' The "Usage" section lists the class methods overridden by \pkg{lazsf}.
+#' @seealso
+#' The corresponding generic functions
+#' [DBI::dbFetch()], [DBI::dbClearResult()], and
+#' [DBI::dbHasCompleted()].
+#'
+#' @export
+#' @keywords internal
+setClass("OGRSQLResult", contains = "DBIResult", slots = c(layer_data = "ANY"))
+
+
+#' @rdname OGRSQLResult-class
+#' @export
+
+setMethod("show", "OGRSQLResult", function(object) {
+            cat(sprintf("Field names: %s\n",
+                        paste(names(object@layer_data), collapse = ", ")))
+            invisible(NULL)
+})
+
+#' @rdname OGRSQLResult-class
+#' @export
+setMethod("dbFetch", "OGRSQLResult", function(res, n = -1, ...) { res@layer_data })
+
+#' @rdname OGRSQLResult-class
+#' @export
+setMethod("dbClearResult", "OGRSQLResult", function(res, ...) { TRUE })
+
+#' @rdname OGRSQLResult-class
+#' @export
+setMethod("dbHasCompleted", "OGRSQLResult", function(res, ...) { TRUE })
+
+