# √5.7.1 - Variable Uniqueness
# √5.7.2 - Variable Default Values Are Correctly Typed
# √5.7.3 - Variables Are Input Types
# √5.7.4 - All Variable Uses Defined
# √5.7.5 - All Variables Used
# 5.7.6 - All Variable Usages are Allowed - TODO need type coercion
for_onload(function() {
VariableValdationHelper <- R6Class("VariableValdationHelper",
public = list(
names = character(0),
has_been_seen = list(),
type = list(),
variables = list(),
oh = NULL,
check_variable = function(var, argument_type) {
if (is.null(var)) {
return(invisible(TRUE))
}
var_name <- format(var$name)
var_obj <- self$variables[[var_name]]
# 5.7.4 - All Variable Uses Defined
if (is.null(var_obj)) {
self$oh$error_list$add(
"5.7.4",
"Matching variable definition can not be found for variable: $", var_name
# no loc
)
return(invisible(FALSE))
}
self$has_been_seen[[var_name]] <- TRUE
# 5.7.6
# AreTypesCompatible
variable_type <- var_obj$type
# If hasDefault is true, treat the variableType as non‐null.
if (!is.null(var_obj$defaultValue)) {
if (!inherits(variable_type, "NonNullType")) {
variable_type <- NonNullType$new(type = variable_type)
}
}
# If argumentType and variableType have different list dimensions, return false
# If any list level of variableType is not non‐null, and the corresponding level in argument
# is non‐null, the types are not compatible.
cur_var_type <- variable_type
cur_arg_type <- argument_type
while (
inherits(cur_var_type, "NonNullType") ||
inherits(cur_var_type, "ListType") ||
inherits(cur_arg_type, "NonNullType") ||
inherits(cur_arg_type, "ListType")
) {
if (
inherits(cur_var_type, "NonNullType") ||
inherits(cur_arg_type, "NonNullType")
) {
if (!inherits(cur_var_type, "NonNullType")) {
self$oh$error_list$add(
"5.7.6",
"Variable can not provide a nullible argument to a non-nullible definition",
loc = cur_var_type$loc
)
return(invisible(FALSE))
} else {
cur_var_type <- cur_var_type$type
}
if (inherits(cur_arg_type, "NonNullType")) {
cur_arg_type <- cur_arg_type$type
}
} else {
if (
!inherits(cur_var_type, "ListType") ||
!inherits(cur_arg_type, "ListType")
) {
# if either is not a list
self$oh$error_list$add(
"5.7.6",
"Variable list dimensions do not match argument's list dimensions",
loc = cur_var_type$loc
)
return(invisible(FALSE))
} else {
# must both be lists at this point
cur_var_type <- cur_var_type$type
cur_arg_type <- cur_arg_type$type
}
}
}
# If inner type of argumentType and variableType are different, return false
if (!identical(
format(cur_var_type),
format(cur_arg_type)
)) {
self$oh$error_list$add(
"5.7.6",
"Argument and variable inner types do not match. Found: ",
format(cur_arg_type), " and ", format(cur_var_type),
loc = cur_var_type$loc
)
return(invisible(FALSE))
}
invisible(TRUE)
},
finally = function() {
# 5.7.5 - All Variables Used
has_been_seen <- unlist(self$has_been_seen)
if (!all(has_been_seen)) {
self$oh$error_list$add(
"5.7.5",
"Not all variable definitions have been seen.",
" Unused variables: ", str_c("$", names(has_been_seen)[!has_been_seen], collapse = ", ")
)
invisible(FALSE)
} else {
invisible(TRUE)
}
},
default_value_can_be_coerced = function(from_input, to_type) {
validate_value_can_be_coerced(
from_input, to_type,
oh = self$oh,
rule_code = "5.7.2"
)
},
initialize = function(vars, oh) {
self$variables <- list()
self$oh <- oh
if (is.null(vars)) {
return(invisible(self))
}
if (!is.list(vars)) stop("vars must be a list")
vars %>%
lapply(function(var) {
name <- format(var$variable$name)
self$variables[[name]] <- var
self$has_been_seen[[name]] <- FALSE
self$type[[name]] <- var$type
# 5.7.2
default_value_obj <- var$defaultValue
if (!is.null(default_value_obj)) {
if (inherits(var$type, "NonNullType")) {
self$oh$error_list$add(
"5.7.2",
"Non-Null Variables are not allowed to have default values. ",
" Found a default value for variable: $", name,
loc = var$loc
)
return(name)
}
default_val <- var$defaultValue$value
if (!is.null(default_val)) {
type_obj <- self$oh$schema$get_type(name_value(var$type))
self$default_value_can_be_coerced(
from_input = var$defaultValue,
to_type = var$type
)
}
}
# 5.7.3 - Variables Are Input Types
core_var_type <- get_inner_type(var$type)
matching_core_type_object <- ifnull(
self$oh$schema$get_scalar(core_var_type), ifnull(
self$oh$schema$get_enum(core_var_type),
self$oh$schema$get_input_object(core_var_type)
))
if (is.null(matching_core_type_object)) {
self$oh$error_list$add(
"5.7.3",
"Can not find matching Scalar, Enum, or Input Object with type: ",
format(var$type),
" for variable: $", name,
loc = var$loc
)
return(name)
}
name
}) %>%
unlist() ->
names
self$names <- names
# 5.7.1 - Variable Uniqueness
if (length(names) != length(unique(names))) {
name_count <- table(names)
name_count <- name_count[name_count > 1]
duplicate_names <- names(name_count)
self$oh$error_list$add(
"5.7.1",
"All defined variables must be unique.",
" Found duplicates of name: ", str_c(duplicate_names, collapse = ", ")
)
}
self$names <- names
invisible(self)
}
)
)
}) # end for_onload
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.