Skip to content

Commit

Permalink
Fixes to get CHECK to pass.
Browse files Browse the repository at this point in the history
  • Loading branch information
LTLA committed Nov 17, 2023
1 parent e39592e commit 799cf5f
Show file tree
Hide file tree
Showing 20 changed files with 54 additions and 48 deletions.
3 changes: 2 additions & 1 deletion R/AllGenerics.R
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,8 @@
#' list.files(tmp, recursive=TRUE)
#'
#' @export
#' @aliases stageObject,ANY-method
#' @aliases
#' stageObject stageObject,ANY-method
#' searchForMethods .searchForMethods
#' @import methods
#' @importFrom jsonlite fromJSON
Expand Down
7 changes: 3 additions & 4 deletions R/altReadObject.R
Original file line number Diff line number Diff line change
Expand Up @@ -46,17 +46,16 @@
#' library(S4Vectors)
#' df <- DataFrame(A=1:10, B=LETTERS[1:10])
#' tmp <- tempfile()
#' dir.create(tmp)
#' out <- stageObject(df, tmp, path="coldata")
#' saveObject(df, tmp)
#'
#' # And now reading it - this should print our message.
#' altReadObject(out, tmp)
#' altReadObject(tmp)
#'
#' # Restoring the old reader:
#' altReadObjectFunction(old)
#'
#' @export
#' @aliases .altReadObject .readObject
#' @aliases .altLoadObject .loadObject altLoadObject altLoadObjectFunction
altReadObject <- function(...) {
FUN <- altReadObjectFunction()
if (is.null(FUN)) {
Expand Down
5 changes: 2 additions & 3 deletions R/altSaveObject.R
Original file line number Diff line number Diff line change
Expand Up @@ -50,9 +50,8 @@
#' library(S4Vectors)
#' df <- DataFrame(A=1:10, B=LETTERS[1:10])
#' tmp <- tempfile()
#' dir.create(tmp)
#' out <- altSaveObject(df, tmp, path="coldata")
#'
#' altSaveObject(df, tmp)
#'
#' # Restoring the old loader:
#' altSaveObjectFunction(old)
#'
Expand Down
4 changes: 2 additions & 2 deletions R/listObjects.R
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
#' List all objects in a directory, along with their types.
#'
#' @param dir String containing a path to a staging directory.
#' @param ignore.children Logical scalar indicating whether to ignore child objects.
#' @param include.children Logical scalar indicating whether to include child objects.
#'
#' @return \linkS4class{DataFrame} where each row corresponds to an object and contains;
#' \itemize{
Expand All @@ -12,7 +12,7 @@
#' \item \code{child}, whether or not the object is a child of another object.
#' }
#'
#' If \code{ignore.children=TRUE}, metadata is only returned for non-child objects.
#' If \code{include.children=FALSE}, metadata is only returned for non-child objects.
#'
#' @author Aaron Lun
#'
Expand Down
2 changes: 1 addition & 1 deletion R/readDataFrameFactor.R
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@
#' readDataFrameFactor(tmp)
#'
#' @export
#' @aliases readDataFrameFactor
#' @aliases loadDataFrameFactor
#' @importFrom S4Vectors DataFrameFactor
readDataFrameFactor <- function(path, ...) {
fpath <- file.path(path, "contents.h5")
Expand Down
9 changes: 4 additions & 5 deletions R/readObject.R
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@
#'
#' @section Comments for extension developers:
#' When writing alabaster extensions, developers may need to load child objects inside the loading functions for their classes.
#' In such cases, developers should use \code{\link{altRoadObject}} rather than calling \code{readObject} directly.
#' In such cases, developers should use \code{\link{altReadObject}} rather than calling \code{readObject} directly.
#' This ensures that any application-level overrides of the loading functions are respected.
#' Once in memory, the child objects can then be assembled into more complex objects by the developer's loading function.
#'
Expand All @@ -39,16 +39,15 @@
#'
#' @author Aaron Lun
#' @examples
#' # Same example as stageObject, but reversed.
#' library(S4Vectors)
#' df <- DataFrame(A=1:10, B=LETTERS[1:10])
#'
#' tmp <- tempfile()

#' readObject(out, tmp)
#' saveObject(df, tmp)
#' readObject(tmp)
#'
#' @export
#' @aliases loadObject schemaLocations customLoadObjectHelper .loadObjectInternal
#' @aliases loadObject schemaLocations customloadObjectHelper .loadObjectInternal
readObject <- function(path, type=NULL, ...) {
if (is.null(type)) {
type <- readLines(file.path(path, "OBJECT"))
Expand Down
1 change: 1 addition & 0 deletions R/saveAtomicVector.R
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,7 @@
#' stageObject,character-method
#' stageObject,double-method
#' stageObject,POSIXct-method
#' stageObject,POSIXlt-method
#' stageObject,Date-method
NULL

Expand Down
4 changes: 3 additions & 1 deletion R/saveBaseFactor.R
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,9 @@
#'
#' @export
#' @name saveBaseFactor
#' @aliases stageObject,factor-method
#' @aliases
#' saveObject,factor-method
#' stageObject,factor-method
setMethod("saveObject", "factor", function(x, path, ...) {
dir.create(path, showWarnings=FALSE)

Expand Down
8 changes: 6 additions & 2 deletions R/saveBaseList.R
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
#' Save a \link{list} or \linkS4class{List} to a JSON or HDF5 file, with extra files created for any of the more complex list elements (e.g., DataFrames, arrays).
#' This uses the \href{https://github.com/LTLA/uzuki2}{uzuki2} specification to ensure that appropriate types are declared.
#'
#' @param A list or \linkS4class{List}.
#' @param x A list or \linkS4class{List}.
#' @inheritParams saveObject
#' @param list.format String specifying the format in which to save the list.
#' @param ... Further arguments, passed to \code{\link{altSaveObject}} for complex child objects.
Expand Down Expand Up @@ -32,7 +32,11 @@
#' list.files(tmp, recursive=TRUE)
#'
#' @export
#' @rdname saveBaseList
#' @name saveBaseList
#' @aliases
#' saveObject,list-method
#' stageObject,list-method
#' stageObject,List-method
#' @importFrom jsonlite toJSON
setMethod("saveObject", "list", function(x, path, list.format=saveBaseListFormat(), ...) {
dir.create(path, showWarnings=FALSE)
Expand Down
2 changes: 0 additions & 2 deletions R/saveDataFrame.R
Original file line number Diff line number Diff line change
Expand Up @@ -28,9 +28,7 @@
#' df <- DataFrame(A=1:10, B=LETTERS[1:10])
#'
#' tmp <- tempfile()
#' dir.create(tmp)
#' saveObject(df, tmp)
#'
#' list.files(tmp, recursive=TRUE)
#'
#' @export
Expand Down
11 changes: 6 additions & 5 deletions man/altReadObject.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

3 changes: 1 addition & 2 deletions man/altSaveObject.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

4 changes: 2 additions & 2 deletions man/listObjects.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 1 addition & 0 deletions man/readDataFrameFactor.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

22 changes: 11 additions & 11 deletions man/readObject.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 1 addition & 0 deletions man/saveAtomicVector.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 1 addition & 0 deletions man/saveBaseFactor.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

11 changes: 6 additions & 5 deletions man/saveBaseList.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 1 addition & 0 deletions man/saveObject.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 0 additions & 2 deletions man/stageDataFrame.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 799cf5f

Please sign in to comment.