R/check.R

In EntirelyDS/modelr: R6 Class Library For Generic Modelling

check_model_name <- function(name, init = TRUE){
  status_fname <- file.path(path.package('modelr'), 'status', 'statuses.json')
  is_ok <- FALSE
  if (!missing(name)){
    if (is.character(name)){
      is_ok <- TRUE
    }else{
      if (init){
        status_id <- 'pm_init_name_warn'
      }else{
        status_id <- 'pm_assign_name_warn'
      }
      notify(status_id, 'modelr_statuses', status_fname)
    }
  }else{
    notify('pm_init_name_msg','modelr_statuses', status_fname)
  }
  return(is_ok)
}

check_opts <- function(opts, opts_str, class_str, init = TRUE){
  status_fname <- file.path(path.package('modelr'), 'status', 'statuses.json')
  is_ok <- FALSE
  if (!missing(opts)){
    if (is.list(opts)){
      is_ok <- TRUE
    }else{
      if (init){
        status_id <- stringr::str_c('init_opts_warn')
        notify(
          status_id, 'modelr_statuses', status_fname, FALSE, opts_str, opts_str,
          class_str
        )
      }else{
        status_id <- stringr::str_c('assign_opts_warn')
        notify(
          status_id, 'modelr_statuses', status_fname, FALSE, opts_str, class_str
        )
      }
    }
  }else{
    status_id <- stringr::str_c('init_opts_msg')
    notify(
      status_id, 'modelr_statuses', status_fname, FALSE, opts_str, opts_str,
      class_str
    )
  }
  return(is_ok)
}

check_method <- function(
  fn, required_args, fn_str, method_str, class_str, init = TRUE
){
  status_fname <- file.path(path.package('modelr'), 'status', 'statuses.json')
  is_ok <- FALSE
  if (!missing(fn)){
    if (class(fn) == 'function'){
      args <- names(formals(fn))
      nargs <- length(args)
      all_args <- nargs >= length(required_args)
      req_str <- ''
      if (all_args){
        for(i in 1:length(required_args)){
          if (!required_args[i] == args[i]){
            all_args <- FALSE
          }
          req_str <- stringr::str_c(
            req_str, stringr::str_c("'", required_args[i], "'"),
            sep = ifelse(i < length(required_args), ", ", "and ")
          )
        }
      }
    }
    if (class(fn) == 'function' && all_args){
      is_ok <- TRUE
    }else{
      if (init){
        status_id <- stringr::str_c('init_method_warn')
        notify(
          status_id, 'modelr_statuses', status_fname, FALSE, fn_str, req_str,
          method_str, class_str
        )
      }else{
        status_id <- stringr::str_c('assign_method_warn')
        notify(
          status_id, 'modelr_statuses', status_fname, FALSE, req_str,
          method_str, class_str
        )
      }
    }
  }else{
    status_id <- stringr::str_c('init_method_msg')
    notify(
      status_id, 'modelr_statuses', status_fname, FALSE, fn_str, method_str,
      class_str
    )
  }
  return(is_ok)
}

notify_success <- function(class_str){
  status_fname <- file.path(path.package('modelr'), 'status', 'statuses.json')
  notify('init_success', 'modelr_statuses', status_fname, FALSE, class_str)
}