From 80dc58a298f057f52897c717d0ea91d213d21d0c Mon Sep 17 00:00:00 2001
From: Norwin Roosen <github@nroo.de>
Date: Fri, 19 Oct 2018 23:41:56 +0200
Subject: [PATCH] move methods for external generics into one place

---
 R/00utils.R           |   9 ---
 R/box_utils.R         |  38 -------------
 R/external_generics.R | 126 ++++++++++++++++++++++++++++++++++++++++++
 R/measurement_utils.R |  37 +------------
 R/tidyverse.R         |  41 --------------
 5 files changed, 128 insertions(+), 123 deletions(-)
 create mode 100644 R/external_generics.R
 delete mode 100644 R/tidyverse.R

diff --git a/R/00utils.R b/R/00utils.R
index a618dad..8099613 100644
--- a/R/00utils.R
+++ b/R/00utils.R
@@ -16,15 +16,6 @@ utc_date = function (date) {
 # NOTE: cannot handle mixed vectors of POSIXlt and POSIXct
 date_as_isostring = function (date) format.Date(date, format = '%FT%TZ')
 
-#' Simple factory function meant to implement dplyr functions for other classes,
-#' which call an callback to attach the original class again after the fact.
-#'
-#' @param callback The function to call after the dplyr function
-#' @noRd
-dplyr_class_wrapper = function(callback) {
-  function(.data, ..., .dots) callback(NextMethod())
-}
-
 #' Checks for an interactive session using interactive() and a knitr process in
 #' the callstack. See https://stackoverflow.com/a/33108841
 #'
diff --git a/R/box_utils.R b/R/box_utils.R
index 0dc5f3b..5775e11 100644
--- a/R/box_utils.R
+++ b/R/box_utils.R
@@ -71,8 +71,6 @@ summary.sensebox = function(object, ...) {
   invisible(object)
 }
 
-# ==============================================================================
-#
 #' Converts a foreign object to a sensebox data.frame.
 #' @param x A data.frame to attach the class to
 #' @export
@@ -81,39 +79,3 @@ osem_as_sensebox = function(x) {
   class(ret) = c('sensebox', class(x))
   ret
 }
-
-#' Return rows with matching conditions, while maintaining class & attributes
-#' @param .data A sensebox data.frame to filter
-#' @param .dots see corresponding function in package \code{\link{dplyr}}
-#' @param ... other arguments
-#' @seealso \code{\link[dplyr]{filter}}
-filter.sensebox = dplyr_class_wrapper(osem_as_sensebox)
-
-#' Add new variables to the data, while maintaining class & attributes
-#' @param .data A sensebox data.frame to mutate
-#' @param .dots see corresponding function in package \code{\link{dplyr}}
-#' @param ... other arguments
-#' @seealso \code{\link[dplyr]{mutate}}
-mutate.sensebox = dplyr_class_wrapper(osem_as_sensebox)
-
-# ==============================================================================
-#
-#' maintains class / attributes after subsetting
-#' @noRd
-#' @export
-`[.sensebox` = function(x, i, ...) {
-  s = NextMethod('[')
-  mostattributes(s) = attributes(s)
-  s
-}
-
-# ==============================================================================
-#
-#' Convert a \code{sensebox} dataframe to an \code{\link[sf]{st_sf}} object.
-#'
-#' @param x The object to convert
-#' @param ... maybe more objects to convert
-#' @return The object with an st_geometry column attached.
-st_as_sf.sensebox = function (x, ...) {
-  NextMethod(x, ..., coords = c('lon', 'lat'), crs = 4326)
-}
diff --git a/R/external_generics.R b/R/external_generics.R
new file mode 100644
index 0000000..54b233b
--- /dev/null
+++ b/R/external_generics.R
@@ -0,0 +1,126 @@
+# helpers for the dplyr & co related functions
+# also delayed method registration
+#
+# Methods for external generics (except when from `base`) should be registered,
+# but not exported: see https://github.com/klutometis/roxygen/issues/796
+# Until roxygen supports this usecase properly, we're using a different
+# workaround than suggested, copied from edzer's sf package:
+# dynamically register the methods only when the related package is loaded as well.
+
+
+# ====================== base generics =========================
+
+#' maintains class / attributes after subsetting
+#' @noRd
+#' @export
+`[.sensebox` = function(x, i, ...) {
+  s = NextMethod('[')
+  mostattributes(s) = attributes(s)
+  s
+}
+
+#' maintains class / attributes after subsetting
+#' @noRd
+#' @export
+`[.osem_measurements` = function(x, i, ...) {
+  s = NextMethod()
+  mostattributes(s) = attributes(x)
+  s
+}
+
+
+# ====================== dplyr generics =========================
+
+#' Simple factory function meant to implement dplyr functions for other classes,
+#' which call an callback to attach the original class again after the fact.
+#'
+#' @param callback The function to call after the dplyr function
+#' @noRd
+dplyr_class_wrapper = function(callback) {
+  function(.data, ..., .dots) callback(NextMethod())
+}
+
+#' Return rows with matching conditions, while maintaining class & attributes
+#' @param .data A sensebox data.frame to filter
+#' @param .dots see corresponding function in package \code{\link{dplyr}}
+#' @param ... other arguments
+#' @seealso \code{\link[dplyr]{filter}}
+filter.sensebox = dplyr_class_wrapper(osem_as_sensebox)
+
+#' Add new variables to the data, while maintaining class & attributes
+#' @param .data A sensebox data.frame to mutate
+#' @param .dots see corresponding function in package \code{\link{dplyr}}
+#' @param ... other arguments
+#' @seealso \code{\link[dplyr]{mutate}}
+mutate.sensebox = dplyr_class_wrapper(osem_as_sensebox)
+
+#' Return rows with matching conditions, while maintaining class & attributes
+#' @param .data A osem_measurements data.frame to filter
+#' @param .dots see corresponding function in package \code{\link{dplyr}}
+#' @param ... other arguments
+#' @seealso \code{\link[dplyr]{filter}}
+filter.osem_measurements = dplyr_class_wrapper(osem_as_measurements)
+
+#' Add new variables to the data, while maintaining class & attributes
+#' @param .data A osem_measurements data.frame to mutate
+#' @param .dots see corresponding function in package \code{\link{dplyr}}
+#' @param ... other arguments
+#' @seealso \code{\link[dplyr]{mutate}}
+mutate.osem_measurements = dplyr_class_wrapper(osem_as_measurements)
+
+
+# ====================== sf generics =========================
+
+#' Convert a \code{sensebox} dataframe to an \code{\link[sf]{st_sf}} object.
+#'
+#' @param x The object to convert
+#' @param ... maybe more objects to convert
+#' @return The object with an st_geometry column attached.
+st_as_sf.sensebox = function (x, ...) {
+  NextMethod(x, ..., coords = c('lon', 'lat'), crs = 4326)
+}
+
+#' Convert a \code{osem_measurements} dataframe to an \code{\link[sf]{st_sf}} object.
+#'
+#' @param x The object to convert
+#' @param ... maybe more objects to convert
+#' @return The object with an st_geometry column attached.
+st_as_sf.osem_measurements = function (x, ...) {
+  NextMethod(x, ..., coords = c('lon', 'lat'), crs = 4326)
+}
+
+
+# from: https://github.com/tidyverse/hms/blob/master/R/zzz.R
+# Thu Apr 19 10:53:24 CEST 2018
+register_s3_method <- function(pkg, generic, class, fun = NULL) {
+  stopifnot(is.character(pkg), length(pkg) == 1)
+  stopifnot(is.character(generic), length(generic) == 1)
+  stopifnot(is.character(class), length(class) == 1)
+  
+  if (is.null(fun)) {
+    fun <- get(paste0(generic, ".", class), envir = parent.frame())
+  } else {
+    stopifnot(is.function(fun))
+  }
+  
+  if (pkg %in% loadedNamespaces()) {
+    registerS3method(generic, class, fun, envir = asNamespace(pkg))
+  }
+  
+  # Always register hook in case package is later unloaded & reloaded
+  setHook(
+    packageEvent(pkg, "onLoad"),
+    function(...) {
+      registerS3method(generic, class, fun, envir = asNamespace(pkg))
+    }
+  )
+}
+
+.onLoad = function(libname, pkgname) {
+  register_s3_method('dplyr', 'filter', 'sensebox')
+  register_s3_method('dplyr', 'mutate', 'sensebox')
+  register_s3_method('dplyr', 'filter', 'osem_measurements')
+  register_s3_method('dplyr', 'mutate', 'osem_measurements')
+  register_s3_method('sf', 'st_as_sf', 'sensebox')
+  register_s3_method('sf', 'st_as_sf', 'osem_measurements')
+}
diff --git a/R/measurement_utils.R b/R/measurement_utils.R
index beba0ec..bcdd33b 100644
--- a/R/measurement_utils.R
+++ b/R/measurement_utils.R
@@ -14,44 +14,11 @@ print.osem_measurements = function (x, ...) {
 }
 
 #' Converts a foreign object to an osem_measurements data.frame.
-#' @param x A data.frame to attach the class to
+#' @param x A data.frame to attach the class to.
+#'   Should have at least a `value` and `createdAt` column.
 #' @export
 osem_as_measurements = function(x) {
   ret = tibble::as.tibble(x)
   class(ret) = c('osem_measurements', class(ret))
   ret
 }
-
-#' Return rows with matching conditions, while maintaining class & attributes
-#' @param .data A osem_measurements data.frame to filter
-#' @param .dots see corresponding function in package \code{\link{dplyr}}
-#' @param ... other arguments
-#' @seealso \code{\link[dplyr]{filter}}
-filter.osem_measurements = dplyr_class_wrapper(osem_as_measurements)
-
-#' Add new variables to the data, while maintaining class & attributes
-#' @param .data A osem_measurements data.frame to mutate
-#' @param .dots see corresponding function in package \code{\link{dplyr}}
-#' @param ... other arguments
-#' @seealso \code{\link[dplyr]{mutate}}
-mutate.osem_measurements = dplyr_class_wrapper(osem_as_measurements)
-
-#' maintains class / attributes after subsetting
-#' @noRd
-#' @export
-`[.osem_measurements` = function(x, i, ...) {
-  s = NextMethod()
-  mostattributes(s) = attributes(x)
-  s
-}
-
-# ==============================================================================
-#
-#' Convert a \code{osem_measurements} dataframe to an \code{\link[sf]{st_sf}} object.
-#'
-#' @param x The object to convert
-#' @param ... maybe more objects to convert
-#' @return The object with an st_geometry column attached.
-st_as_sf.osem_measurements = function (x, ...) {
-  NextMethod(x, ..., coords = c('lon', 'lat'), crs = 4326)
-}
diff --git a/R/tidyverse.R b/R/tidyverse.R
deleted file mode 100644
index be34d21..0000000
--- a/R/tidyverse.R
+++ /dev/null
@@ -1,41 +0,0 @@
-# helpers for the dplyr & co related functions
-# also custom method registration
-
-# they need to be registered, but not exported, see https://github.com/klutometis/roxygen/issues/796
-# we're using a different workaround than suggested, copied from edzer's sf package:
-# dynamically register the methods only when the related package is loaded as well.
-
-# from: https://github.com/tidyverse/hms/blob/master/R/zzz.R
-# Thu Apr 19 10:53:24 CEST 2018
-register_s3_method <- function(pkg, generic, class, fun = NULL) {
-  stopifnot(is.character(pkg), length(pkg) == 1)
-  stopifnot(is.character(generic), length(generic) == 1)
-  stopifnot(is.character(class), length(class) == 1)
-  
-  if (is.null(fun)) {
-    fun <- get(paste0(generic, ".", class), envir = parent.frame())
-  } else {
-    stopifnot(is.function(fun))
-  }
-  
-  if (pkg %in% loadedNamespaces()) {
-    registerS3method(generic, class, fun, envir = asNamespace(pkg))
-  }
-  
-  # Always register hook in case package is later unloaded & reloaded
-  setHook(
-    packageEvent(pkg, "onLoad"),
-    function(...) {
-      registerS3method(generic, class, fun, envir = asNamespace(pkg))
-    }
-  )
-}
-
-.onLoad = function(libname, pkgname) {
-  register_s3_method('dplyr', 'filter', 'sensebox')
-  register_s3_method('dplyr', 'mutate', 'sensebox')
-  register_s3_method('dplyr', 'filter', 'osem_measurements')
-  register_s3_method('dplyr', 'mutate', 'osem_measurements')
-  register_s3_method('sf', 'st_as_sf', 'sensebox')
-  register_s3_method('sf', 'st_as_sf', 'osem_measurements')
-}