Skip to content

Commit

Permalink
abort for empty string
Browse files Browse the repository at this point in the history
  • Loading branch information
@Yunuuuu
Yunuuuu committed Jan 8, 2025
1 parent 32f9d31 commit 0afda4e
Show file tree
Hide file tree
Showing 3 changed files with 65 additions and 28 deletions.
1 change: 1 addition & 0 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -252,6 +252,7 @@ S3method(obj_print_data,ggalign_pair_links)
S3method(obj_print_footer,ggalign_area)
S3method(obj_print_footer,ggalign_pair_links)
S3method(obj_print_header,ggalign_pair_link)
S3method(obj_print_header,ggalign_pair_links)
S3method(object_name,AlignGg)
S3method(object_name,AlignProto)
S3method(object_name,CircleLayout)
Expand Down
85 changes: 58 additions & 27 deletions R/pair-links.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,8 +20,13 @@
#' @examples
#' x <- pair_links(
#' # group on the left hand only
#' 1:2,
#' c("a", "b"),
#' # normally, integer index will be interpreted as the index of the
#' # origianl data
#' 1:2,
#' # wrapped with `I()` indicate` the integer index is ordering of the
#' # layout
#' I(1:2),
#' range_link(1, 6),
#' range_link("a", "b"),
#' # group on the right hand only
Expand Down Expand Up @@ -49,16 +54,32 @@
#' @export
pair_links <- function(...) {
pairs <- rlang::dots_list(..., .ignore_empty = "all", .named = NULL)
new_pair_links(lapply(pairs, as_pair_link, x_arg = "..."))
new_pair_links(
lapply(pairs, as_pair_link, x_arg = "...", call = current_call())
)
}

new_pair_links <- function(x = list(), ..., class = character()) {
new_vctr(x, ..., class = c(class, "ggalign_pair_links"))
}

#' @export
obj_print_header.ggalign_pair_links <- function(x, ...) {
cat("<", vec_ptype_full(x), ">", "\n", sep = "")
cat(
sprintf(
"A total of %d pair%s of link groups",
vec_size(x), if (vec_size(x) > 1L) "s" else ""
),
"\n",
sep = ""
)
invisible(x)
}

#' @export
obj_print_data.ggalign_pair_links <- function(x, ...) {
if (length(x) > 0L) {
if (vec_size(x) > 0L) {
hand1 <- vapply(x, function(hand) {
deparse_link(hand, ..., hand = "hand1")
}, character(1L), USE.NAMES = FALSE)
Expand All @@ -67,25 +88,31 @@ obj_print_data.ggalign_pair_links <- function(x, ...) {
}, character(1L), USE.NAMES = FALSE)
nms <- c("", paste0(names_or_index(x), ": "))
nms <- format(nms, justify = "right")
empty <- character(length(hand2))
empty <- character(vec_size(hand2))
empty[hand1 == "" & hand2 == ""] <- " <empty>"
empty <- format(c("", empty), justify = "left")
hand1 <- format(c("hand1", hand1), justify = "right")
hand2 <- format(c("hand2", hand2), justify = "left")
content <- paste0(" ", nms, hand1, " ~ ", hand2, empty)
cat("", content, "", sep = "\n")
cat("\n")
cat(paste0(" ", nms, hand1, " ~ ", hand2, empty), sep = "\n")
cat("\n")
}
invisible(x)
}

#' @export
obj_print_footer.ggalign_pair_links <- function(x, ...) {
NextMethod()
# `lengths`: will call `length.ggalign_pair_link()` method
n <- sum(lengths(x, use.names = FALSE))
cat(sprintf(
"A total of %d group%s", n,
if (n > 1L) "s" else ""
), sep = "\n")
cat(
sprintf(
"A total of %d link group%s", n,
if (n > 1L) "s" else ""
),
"\n",
sep = ""
)
invisible(x)
}

Expand Down Expand Up @@ -169,18 +196,17 @@ print.ggalign_pair_link <- function(x, ...) obj_print(x, ...)

#' @export
obj_print_header.ggalign_pair_link <- function(x, ...) {
cat(sprintf("<%s>", vec_ptype_full(x)), sep = "\n")
cat(sprintf("<%s>", vec_ptype_full(x)), "\n", sep = "")
invisible(x)
}

#' @export
obj_print_data.ggalign_pair_link <- function(x, ...) {
if (length(x) > 0L) {
content <- c(
cat(c(
sprintf(" hand1: %s", deparse_link(.subset2(x, "hand1"), ...)),
sprintf(" hand2: %s", deparse_link(.subset2(x, "hand2"), ...))
)
cat(content, sep = "\n")
), sep = "\n")
}
invisible(x)
}
Expand Down Expand Up @@ -280,12 +306,12 @@ vec_ptype2.ggalign_range_link.ggalign_pair_link <- function(x, y, ...) {

#' @export
vec_ptype2.ggalign_pair_link.AsIs <- function(x, y, ...) {
vec_ptype2(x, remove_class(y, "AsIs"))
vec_ptype2(x, remove_class(y, "AsIs"), ...)
}

#' @export
vec_ptype2.AsIs.ggalign_pair_link <- function(x, y, ...) {
vec_ptype2(remove_class(x, "AsIs"), y)
vec_ptype2(remove_class(x, "AsIs"), y, ...)
}

#' @export
Expand All @@ -311,15 +337,10 @@ vec_cast.ggalign_pair_link.numeric <- function(x, to, ...,
vec_cast.ggalign_pair_link.double <- vec_cast.ggalign_pair_link.numeric

#' @export
vec_cast.ggalign_pair_link.integer <- function(x, to, ...,
x_arg = caller_arg(x),
to_arg = "",
call = caller_env()) {
new_pair_link(x)
}
vec_cast.ggalign_pair_link.integer <- vec_cast.ggalign_pair_link.numeric

#' @export
vec_cast.ggalign_pair_link.character <- vec_cast.ggalign_pair_link.integer
vec_cast.ggalign_pair_link.character <- vec_cast.ggalign_pair_link.numeric

#' @export
vec_cast.ggalign_pair_link.ggalign_range_link <-
Expand All @@ -333,7 +354,11 @@ vec_cast.ggalign_pair_link.AsIs <- function(x, to, ...,
x_arg = caller_arg(x),
to_arg = "",
call = caller_env()) {
I(vec_cast(remove_class(x, "AsIs"), to, x_arg = x_arg, call = call))
I(vec_cast(
remove_class(x, "AsIs"),
to = to, ...,
x_arg = x_arg, call = call
))
}

#' @export
Expand Down Expand Up @@ -366,7 +391,7 @@ as_obs_link.NULL <- function(x, ...) x

#' @export
as_obs_link.AsIs <- function(x, ...) {
I(as_obs_link(remove_class(x, "AsIs")))
I(as_obs_link(remove_class(x, "AsIs"), ...))
}

#' @export
Expand All @@ -382,7 +407,13 @@ as_obs_link.integer <- as_obs_link.NULL
as_obs_link.double <- as_obs_link.numeric

#' @export
as_obs_link.character <- as_obs_link.NULL
as_obs_link.character <- function(x, ..., arg = caller_arg(x),
call = caller_env()) {
if (any(x == "")) {
cli_abort("empty string is not allowed", call = call)
}
x
}

#' @export
as_obs_link.waiver <- as_obs_link.NULL
Expand Down Expand Up @@ -469,7 +500,7 @@ deparse_link2.ggalign_pair_link <- function(x, ..., hand) {

#' @export
deparse_link2.AsIs <- function(x, ...) {
ans <- NextMethod()
ans <- deparse_link2(remove_class(x, "AsIs"), ...)
if (!is.null(ans)) ans <- sprintf("I(%s)", ans)
ans
}
Expand Down
7 changes: 6 additions & 1 deletion man/pair_links.Rd
View file

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

0 comments on commit 0afda4e

Please sign in to comment.