Skip to content

Commit

Permalink
Merge pull request #58 from serkor1/master
Browse files Browse the repository at this point in the history
Issue #57 fix 🔧
  • Loading branch information
Robinlovelace authored Aug 10, 2024
2 parents 4c7dc1c + 24c1211 commit 8480329
Show file tree
Hide file tree
Showing 8 changed files with 248 additions and 31 deletions.
1 change: 1 addition & 0 deletions .Rbuildignore
Original file line number Diff line number Diff line change
Expand Up @@ -17,3 +17,4 @@
^NEWS\.md$
^\.github$
^pkgdown$
^sandbox
16 changes: 11 additions & 5 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
Package: calendar
Title: Create, Read, Write, and Work with 'iCalander' Files, Calendars and
Title: Create, Read, Write, and Work with 'iCalendar' Files, Calendars and
Scheduling Data
Version: 0.1.0
Authors@R:
Expand All @@ -22,9 +22,15 @@ Authors@R:
family = "Scarafia",
role = "ctb",
email = "[email protected]",
comment = c(ORCID = "0009-0005-9822-169X")))
comment = c(ORCID = "0009-0005-9822-169X")),
person(given = "Serkan",
family = "Korkmaz",
email = "[email protected]",
role = c("ctb"),
comment = c(ORCID = "0000-0002-5052-0982"))
)
Description: Provides function to create, read, write, and work with
'iCalander' files (which typically have '.ics' or '.ical' extensions),
'iCalendar' files (which typically have '.ics' or '.ical' extensions),
and the scheduling data, calendars and timelines of people,
organisations and other entities that they represent. 'iCalendar' is
an open standard for exchanging calendar and scheduling information
Expand All @@ -35,8 +41,8 @@ BugReports: https://github.com/ATFutures/calendar/issues
Depends:
R (>= 3.4.0)
Imports:
cli,
lubridate,
methods,
tibble
Suggests:
covr,
Expand All @@ -48,4 +54,4 @@ VignetteBuilder:
Encoding: UTF-8
LazyData: true
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.1.1
RoxygenNote: 7.3.1
20 changes: 16 additions & 4 deletions R/ic_dataframe.R
Original file line number Diff line number Diff line change
Expand Up @@ -17,15 +17,24 @@
#' identical(x, x_df2)
ic_dataframe <- function(x) {

if (methods::is(object = x, class2 = "data.frame")) {
if (inherits(x = x, what = "data.frame")) {

return(x)

}

stopifnot(methods::is(object = x, class2 = "character") | methods::is(object = x, class2 = "list"))
assert(
inherits(x = x, what = "character") | inherits(x = x, what = "list"),
error_message = c(
"x" = sprintf(
"{.arg x} is passed as {.cls %s}.",
class(x)
),
"i" = "{.arg x} has to be {.cls character} or {.cls list}."
)
)

if (methods::is(object = x, class2 = "character")) {
if (inherits(x = x, what = "character")) {

x_list <- ic_list(x)

Expand All @@ -44,7 +53,10 @@ ic_dataframe <- function(x) {

x_df <- ic_bind_list(x_list_named)

date_cols <- grepl(pattern = "VALUE=DATE", x = names(x_df))
date_cols <- grepl(
pattern = "VALUE=DATE",
x = names(x_df)
)

if (any(date_cols)) {

Expand Down
75 changes: 55 additions & 20 deletions R/ical.R
Original file line number Diff line number Diff line change
Expand Up @@ -14,35 +14,66 @@
#' ic2 <- ical(ic_df)
#' class(ic2)
#' attributes(ic2)
ical <- function(x, ic_attributes = NULL) {
is_df <- is.data.frame(x)
if(methods::is(x, "character")) {
ical <- function(
x,
ic_attributes = NULL) {

assert(
inherits(x = x, what = "character") | inherits(x = x, what = "data.frame"),
error_message = c(
"x" = sprintf(
"{.arg x} is passed as {.cls %s}.",
class(x)
),
"i" = "{.arg x} has to be {.cls character} or {.cls data.frame}."
)
)

# is_df <- is.data.frame(x)
if (inherits(x = x, what = "character")) {

ical_df <- ic_dataframe(x)
ical_tibble <- tibble::as_tibble(ical_df)
if(is.null(ic_attributes)) {

if (is.null(ic_attributes)) {

attr(ical_tibble, "ical") <- ic_attributes_vec(x)

} else {

attr(ical_tibble, "ical") <- ic_attributes
}

} else {
if(!is_df) stop("x must be a data frame or charcter strings")
n <- names(x)
is_core = calendar::properties_core %in% n
if(!all(is_core)) {
stop(paste0(
"x must contain column names: ",
paste0(calendar::properties_core, collapse = ", ")
))
}

is_core <- calendar::properties_core %in% names(x)

assert(
all(is_core),
error_message = c(
"x" = paste(
"{.arg x} must contain the column names",
paste0(calendar::properties_core, collapse = ", ")
)
)
)

ical_tibble <- tibble::as_tibble(x)
if(is.null(ic_attributes)) {

if (is.null(ic_attributes)) {

attr(ical_tibble, "ical") <- ic_attributes_vec()

} else {

attr(ical_tibble, "ical") <- ic_attributes

}

}

class(ical_tibble) <- c("ical", class(ical_tibble))

ical_tibble
}
#' Extract attributes from ical text
Expand All @@ -54,20 +85,23 @@ ical <- function(x, ic_attributes = NULL) {
ic_attributes_vec <- function(
x = NULL,
ic_attributes = c(
BEGIN = "VCALENDAR",
PRODID = "ATFutures/calendar",
VERSION = "2.0",
BEGIN = "VCALENDAR",
PRODID = "ATFutures/calendar",
VERSION = "2.0",
CALSCALE = "GREGORIAN",
METHOD = "PUBLISH"
)
) {
METHOD = "PUBLISH"
)) {

if(is.null(x)) {
return(ic_attributes)
}

line_first_event <- grep("BEGIN:VEVENT", x)[1]
x_attributes <- x[1:(line_first_event - 1)]

ic_vector(x_attributes, pattern = "*")
}

#' Convert ical object to character strings of attributes
#'
#' @param ic object of class `ical`
Expand All @@ -84,6 +118,7 @@ ic_character <- function(ic, zulu = FALSE) {
char_events <- ic_char_event(ic, zulu)
c(char_attributes, char_events, "END:VCALENDAR")
}

#' Convert ical object to character strings of events
#'
#' @inheritParams ic_character
Expand Down
111 changes: 111 additions & 0 deletions R/utils.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,111 @@
# script: Utilities
# author: Serkan Korkmaz, [email protected]
# date: 2024-08-09
# objective: Generate a set of utility functions
# to reduce repeated coding, and simple tasks.
# script start;

#' Assert truthfulness of conditions before evaluation
#'
#' @description
#' This function is a wrapper of [stopifnot()], [tryCatch()] and
#' [cli::cli_abort()] and asserts the truthfulness of the passed expression(s).
#' @param ... expressions >= 1. If named the names are used
#' as error messages, otherwise R's internal error-messages are thrown
#'
#' @param error_message character. An error message, supports [cli]-formatting.
#' @seealso [stopifnot()], [cli::cli_abort()], [tryCatch()]
#' @keywords internal
#'
#' @returns [NULL] if all statements in ... are [TRUE]
assert <- function(
...,
error_message = NULL) {

# 1) count number of expressions
# in the ellipsis - this
# is the basis for the error-handling
number_expressions <- ...length()
named_expressions <- ...names()


# 2) if there is more than
# one expression the condtions
# will either be stored in an list
# or pased directly into the tryCatch/stopifnot
if (number_expressions != 1 & !is.null(named_expressions)){

# 2.1) store all conditions
# in a list alongside its
# names
conditions <- c(...)

# 2.2) if !is.null(condition_names) the
# above condition never gets evaluated and
# stopped otherwise, if there is errors
#
# The condition is the names(list()), and is
# the error messages written on lhs of the the assert
# function
if (all(conditions)) {

# Stop the funciton
# here if all conditions
# are [TRUE]
return(NULL)

} else {

cli::cli_abort(
message = c(
"x" = named_expressions[which.min(conditions)]
),
call = sys.call(
1 - length(sys.calls())
)
)

}

}

# 3) if there length(...) == 1 then
# above will not run, and stopped if anything

tryCatch(
expr = {
eval.parent(
substitute(
stopifnot(exprs = ...)
)
)
},
error = function(error){

# each error message
# has a message and call
#
# the call will reference the caller
# by default, so we need the second
# topmost caller

cli::cli_abort(
# 3.1) if the length of expressions
# is >1, then then the error message
# is forced to be the internal otherwise
# the assert function will throw the same error-message
# for any error.
message = if (is.null(error_message) || number_expressions != 1)
error$message else
error_message,
call = sys.call(
1 - length(sys.calls())
)
)

}
)

}

# script end;
25 changes: 25 additions & 0 deletions man/assert.Rd

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

27 changes: 27 additions & 0 deletions man/calendar.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/ic_attributes_vec.Rd

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

0 comments on commit 8480329

Please sign in to comment.