R/VValidatorSetParent.R

In j2scode/nlpStudio: Natural Language Processing Environment

#==============================================================================#
#                                   VValidatorSetParent                        #
#==============================================================================#
#' VValidatorSetParent
#'
#'
#' \code{VValidatorSetParent} Visitor class responsible for validating the parameters for the SetParent methods
#' of aggregate and composite classes.
#'
#' \strong{VValidatorSetParent Methods:}
#' The VValidatorSetParent methods are as follows:
#'  \itemize{
#'   \item{\code{lab(object, parent)}}{Method for validating the SetParent method parameters of the Lab object}
#'   \item{\code{documentCollection(object, parent)}}{Method for validating the SetParent method parameters of the DocumentCollection object.}
#'   \item{\code{documentText(object, parent)}}{Method for validating the SetParent method parameters of the DocumentText object.}
#'   \item{\code{documentCsv(object, parent)}}{Method for validating the SetParent method parameters of the DocumentCsv object.}
#'   \item{\code{documentRdata(object, parent)}}{Method for validating the SetParent method parameters of the DocumentRdata object.}
#'   \item{\code{documentXlsx(object, parent)}}{Method for validating the SetParent method parameters of the DocumentXlsx object.}
#' }
#'
#' @param object The target object
#' @param parent  The parent object
#'
#' @docType class
#' @author John James, \email{jjames@@DataScienceSalon.org}
#' @family Validation Visitor Classes
#' @export
VValidatorSetParent <- R6::R6Class(
  classname = "VValidatorSetParent",
  inherit = VValidator,
  lock_objects = FALSE,
  lock_class = FALSE,

  private = list(

    ..object = character(0),
    ..parent = character(0),

    validate = function(classes, object) {

      # If setting parent to NULL, return TRUE
      if (is.null(private$..parent)) {
        return(TRUE)
      }

      # Confirm object and acceptor are a match
      if (private$..object$getName() != object$getName()) {
        v <- Validator0$new()
        v$notify(class = class(object)[1], method = "SetParent", fieldName = "object",
                 value = "", level = "Error",
                 msg = paste0("Object and visitor acceptor mismatch. ",
                              "See ?", class(self)[1], " for further assistance."),
                 expect = NULL)
        return(FALSE)
      }

      # Confirm class of parent
      v <- ValidatorClass$new()
      if (v$validate(class = class(private$..object)[1], method = "SetParent",
                     fieldName = "parent", value = private$..parent, level = "Error",
                     msg = paste0("Unable to set parent to object of ",
                                  class(private$..parent)[1], ".",
                                 "See ?", class(private$..object)[1],
                                 " for further assistance."),
                     expect = classes) == FALSE) {
        return(FALSE)
      }
      return(TRUE)
    }
  ),
  public = list(

    initialize = function(object, parent) {
      if(missing(object)) {
        v <- Validator0$new()
        v$notify(class = class(self)[1], method = "SetParent", fieldName = "object",
                 value = "", level = "Error",
                 msg = paste0("Object parameter missing with no default. "),
                 expect = NULL)
        stop()
      }
      if(missing(parent)) {
        v <- Validator0$new()
        v$notify(class = class(self)[1], method = "SetParent", fieldName = "parent",
                 value = "", level = "Error",
                 msg = paste0("Parent parameter missing with no default. "),
                 expect = NULL)
        stop()
      }

      private$..object <- object
      private$..parent <- parent

      invisible(self)
    },

    nlpStudio = function(object) {
      stop("Unable to set parent to an NLPStudio object")
    },

    lab = function(object) {
      classes <- "NLPStudio"
      return(private$validate(classes, object))
    },

    documentCollection = function(object) {
      classes <- c("DocumentCollection", "Lab")
      return(private$validate(classes, object))
    },

    documentText = function(object) {
      classes <- c("DocumentCollection")
      return(private$validate(classes, object))
    },

    documentCsv = function(object) {
      classes <- c("DocumentCollection")
      return(private$validate(classes, object))
    },

    documentRdata = function(object) {
      classes <- c("DocumentCollection")
      return(private$validate(classes, object))
    },

    documentXlsx = function(object) {
      classes <- c("DocumentCollection")
      return(private$validate(classes, object))
    }
  )
)