Draft of a help function for method documentation similar to reference classes

R/help.R

@@ -0,0 +1,26 @@
+# Inspired by '.refMethodDoc' in src/libary/methods/R/refClass in R3.1.1
+# which is provided under the GPLv2 by The R Core Team
+get_method_doc <- function(method) {
+  bb <- body(method)
+  doc <- NULL
+  if (is(bb, "{") && length(bb) > 1 && is(bb[[2]], "character") ) {
+    doc <- bb[[2]]
+  }
+  doc
+}
+
+# If integrated into an R6 class, this prints the documentation string
+# of a method when called with its name as argument.
+R6_help <- function(method) {
+  if (!is.character(method))
+    stop('`method` must be the name of a public method (as character)')
+
+  method.name <- paste0(class(self)[1], '$', method)
+  method.func <- self[[method]]
+  if (is.null(method.func) || !is.function(method.func))
+    stop('help can only be printed for public methods')
+
+  doc <- get_method_doc(method.func)
+  if (is.null(doc)) doc <- 'No documentation available.'
+  cat(method.name, ': ',  doc, '\n', sep='')
+}

tests/testthat/test-r6-help.R

@@ -0,0 +1,30 @@
+context("R6-help")
+
+test_that('method documentation is recovered', {
+  f <- function(x) { 'abcd'; 1:10 }
+  expect_identical('abcd', get_method_doc(f))
+
+  g <- function(x, y) {
+    'efgh'
+  }
+  expect_identical('efgh', get_method_doc(g))
+
+  h <- function(x) 1:10
+  expect_identical(NULL, get_method_doc(h))
+})
+
+test_that('help prints methods documentation string', {
+  TC <- R6Class("test_class",
+                public = list(getx = function() { 'Gets x'; private$x },
+                              setx = function(x) { 'Sets x'; self$x <- x },
+                              one = function() 1,
+                              help = R6_help),
+                private = list(x = 1)
+  )
+  T <- TC$new()
+  T$help('setx')
+  T$help('getx')
+  T$help('one')
+  expect_error(T$help('abc'))
+  expect_error(T$help('x'))
+})