Drop parsedate dependency

DESCRIPTION

@@ -16,8 +16,7 @@ URL: https://github.com/r-hub/pkgsearch, https://r-hub.github.io/pkgsearch/
 BugReports: https://github.com/r-hub/pkgsearch/issues
 Imports:
     curl,
-    jsonlite,
-    parsedate (>= 1.3.0)
+    jsonlite
 Suggests:
     mockery,
     covr,

NAMESPACE

@@ -21,7 +21,4 @@ export(ps)
 importFrom(jsonlite,fromJSON)
 importFrom(jsonlite,toJSON)
 importFrom(jsonlite,unbox)
-importFrom(parsedate,format_iso_8601)
-importFrom(parsedate,parse_date)
-importFrom(parsedate,parse_iso_8601)
 importFrom(utils,capture.output)

R/addin.R

@@ -782,7 +782,7 @@ rectangle_pkgs <- function(pkgs) {
     version =          pkgs$Version %||% character(),
     title =            pkgs$Title %||% character(),
     description =      pkgs$Description %||% character(),
-    date =             parsedate::parse_iso_8601(pkgs$date %||% character()),
+    date =             parse_iso_8601(pkgs$date %||% character()),
     maintainer_name =  maintainer$maintainer_name,
     maintainer_email = maintainer$maintainer_email,
     license =          pkgs$License %||% character(),
@@ -805,8 +805,7 @@ rectangle_events <- function(ev) {
     version =          map_chr(ev, function(x) x$package$Version),
     title =            map_chr(ev, function(x) x$package$Title),
     description =      map_chr(ev, function(x) x$package$Description),
-    date =
-      parsedate::parse_iso_8601(map_chr(ev, "[[", "date")),
+    date =             parse_iso_8601(map_chr(ev, "[[", "date")),
     maintainer_name =  maintainer$maintainer_name,
     maintainer_email = maintainer$maintainer_email,
     license =          map_chr(ev, function(x) x$package$License),

R/api.R

@@ -237,8 +237,6 @@ print.pkgsearch_query_error <- function(x, ...) {
   invisible(x)
 }
 
-#' @importFrom parsedate parse_iso_8601
-
 format_result <- function(result, query, format, from, size, server,
                           port, ...) {
   result <- fromJSON(result, simplifyVector = FALSE)

R/crandb-public-api.R

@@ -173,7 +173,6 @@ cran_top_downloaded <- function() {
 #' @return Data frame of package descriptions.
 #'
 #' @export
-#' @importFrom parsedate format_iso_8601
 #' @examplesIf identical(Sys.getenv("IN_PKGDOWN"), "true")
 #' # Last week
 #' cran_new("last-week")

R/date.R

@@ -0,0 +1,158 @@
+iso_8601 <- local({
+  format_iso_8601 <- function(date) {
+    format(as.POSIXlt(date, tz = "UTC"), "%Y-%m-%dT%H:%M:%S+00:00")
+  }
+
+  milliseconds <- function(x) as.difftime(as.numeric(x) / 1000, units = "secs")
+  seconds <- function(x) as.difftime(as.numeric(x), units = "secs")
+  minutes <- function(x) as.difftime(as.numeric(x), units = "mins")
+  hours <- function(x) as.difftime(as.numeric(x), units = "hours")
+  days <- function(x) as.difftime(as.numeric(x), units = "days")
+  weeks <- function(x) as.difftime(as.numeric(x), units = "weeks")
+  wday <- function(x) as.POSIXlt(x, tz = "UTC")$wday + 1
+  with_tz <- function(x, tzone = "") as.POSIXct(as.POSIXlt(x, tz = tzone))
+  ymd <- function(x) as.POSIXct(x, format = "%Y %m %d", tz = "UTC")
+  yj <- function(x) as.POSIXct(x, format = "%Y %j", tz = "UTC")
+
+  parse_iso_8601 <- function(dates, default_tz = "UTC") {
+    if (default_tz == "") default_tz <- Sys.timezone()
+    dates <- as.character(dates)
+    match <- re_match(dates, iso_regex)
+    matching <- !is.na(match$.match)
+    result <- rep(.POSIXct(NA_real_, tz = ""), length.out = length(dates))
+    result[matching] <- parse_iso_parts(match[matching, ], default_tz)
+    class(result) <- c("POSIXct", "POSIXt")
+    with_tz(result, "UTC")
+  }
+
+  parse_iso_parts <- function(mm, default_tz) {
+    num <- nrow(mm)
+
+    ## -----------------------------------------------------------------
+    ## Date first
+
+    date <- .POSIXct(rep(NA_real_, num), tz = "")
+
+    ## Years-days
+    fyd <- is.na(date) & mm$yearday != ""
+    date[fyd] <- yj(paste(mm$year[fyd], mm$yearday[fyd]))
+
+    ## Years-weeks-days
+    fywd <- is.na(date) & mm$week != "" & mm$weekday != ""
+    date[fywd] <- iso_week(mm$year[fywd], mm$week[fywd], mm$weekday[fywd])
+
+    ## Years-weeks
+    fyw <- is.na(date) & mm$week != ""
+    date[fyw] <- iso_week(mm$year[fyw], mm$week[fyw], "1")
+
+    ## Years-months-days
+    fymd <- is.na(date) & mm$month != "" & mm$day != ""
+    date[fymd] <- ymd(paste(mm$year[fymd], mm$month[fymd], mm$day[fymd]))
+
+    ## Years-months
+    fym <- is.na(date) & mm$month != ""
+    date[fym] <- ymd(paste(mm$year[fym], mm$month[fym], "01"))
+
+    ## Years
+    fy <- is.na(date)
+    date[fy] <- ymd(paste(mm$year, "01", "01"))
+
+    ## -----------------------------------------------------------------
+    ## Now the time
+
+    th <- mm$hour != ""
+    date[th] <- date[th] + hours(mm$hour[th])
+
+    tm <- mm$min != ""
+    date[tm] <- date[tm] + minutes(mm$min[tm])
+
+    ts <- mm$sec != ""
+    date[ts] <- date[ts] + seconds(mm$sec[ts])
+
+    ## -----------------------------------------------------------------
+    ## Fractional time
+
+    frac <- as.numeric(sub(",", ".", mm$frac))
+
+    tfs <- !is.na(frac) & mm$sec != ""
+    date[tfs] <- date[tfs] + milliseconds(round(frac[tfs] * 1000))
+
+    tfm <- !is.na(frac) & mm$sec == "" & mm$min != ""
+    sec <- trunc(frac[tfm] * 60)
+    mil <- round((frac[tfm] * 60 - sec) * 1000)
+    date[tfm] <- date[tfm] + seconds(sec) + milliseconds(mil)
+
+    tfh <- !is.na(frac) & mm$sec == "" & mm$min == ""
+    min <- trunc(frac[tfh] * 60)
+    sec <- trunc((frac[tfh] * 60 - min) * 60)
+    mil <- round((((frac[tfh] * 60) - min) * 60 - sec) * 1000)
+    date[tfh] <- date[tfh] + minutes(min) + seconds(sec) + milliseconds(mil)
+
+    ## -----------------------------------------------------------------
+    ## Time zone
+
+    ftzpm <- mm$tzpm != ""
+    m <- ifelse(mm$tzpm[ftzpm] == "+", -1, 1)
+    ftzpmh <- ftzpm & mm$tzhour != ""
+    date[ftzpmh] <- date[ftzpmh] + m * hours(mm$tzhour[ftzpmh])
+    ftzpmm <- ftzpm & mm$tzmin != ""
+    date[ftzpmm] <- date[ftzpmm] + m * minutes(mm$tzmin[ftzpmm])
+
+    ftzz <- mm$tz == "Z"
+    date[ftzz] <- as.POSIXct(date[ftzz], "UTC")
+
+    ftz <- mm$tz != "Z" & mm$tz != ""
+    date[ftz] <- as.POSIXct(date[ftz], mm$tz[ftz])
+
+    if (default_tz != "UTC") {
+      ftna <- mm$tzpm == "" & mm$tz == ""
+      if (any(ftna)) {
+        dd <- as.POSIXct(format_iso_8601(date[ftna]),
+          "%Y-%m-%dT%H:%M:%S+00:00",
+          tz = default_tz
+        )
+        date[ftna] <- dd
+      }
+    }
+
+    as.POSIXct(date, "UTC")
+  }
+
+  iso_regex <- paste0(
+    "^\\s*",
+    "(?<year>[\\+-]?\\d{4}(?!\\d{2}\\b))",
+    "(?:(?<dash>-?)",
+    "(?:(?<month>0[1-9]|1[0-2])",
+    "(?:\\g{dash}(?<day>[12]\\d|0[1-9]|3[01]))?",
+    "|W(?<week>[0-4]\\d|5[0-3])(?:-?(?<weekday>[1-7]))?",
+    "|(?<yearday>00[1-9]|0[1-9]\\d|[12]\\d{2}|3",
+    "(?:[0-5]\\d|6[1-6])))",
+    "(?<time>[T\\s](?:(?:(?<hour>[01]\\d|2[0-3])",
+    "(?:(?<colon>:?)(?<min>[0-5]\\d))?|24\\:?00)",
+    "(?<frac>[\\.,]\\d+(?!:))?)?",
+    "(?:\\g{colon}(?<sec>[0-5]\\d)(?:[\\.,]\\d+)?)?",
+    "(?<tz>[zZ]|(?<tzpm>[\\+-])",
+    "(?<tzhour>[01]\\d|2[0-3]):?(?<tzmin>[0-5]\\d)?)?)?)?$"
+  )
+
+  iso_week <- function(year, week, weekday) {
+    wdmon <- function(date) {
+      (wday(date) + 5L) %% 7L
+    }
+    thu <- function(date) {
+      date - days(wdmon(date) - 3L)
+    }
+
+    thu(ymd(paste(year, "01", "04"))) + weeks(as.numeric(week) - 1L) +
+      days(as.numeric(weekday) - 4L)
+  }
+
+  list(
+    .envir = environment(),
+    format = format_iso_8601,
+    parse = parse_iso_8601
+  )
+})
+
+format_iso_8601 <- iso_8601$format
+parse_iso_8601 <- iso_8601$parse

R/print.R

@@ -154,11 +154,10 @@ summary.cran_event_list <- function(object, ...) {
 #' @rdname cran_events
 #' @param x Object to print.
 #' @param ... Additional arguments are ignored currently.
-#' @importFrom parsedate parse_date
 
 print.cran_event_list <- function(x, ...) {
   cat_fill("CRAN events (" %+% attr(x, "mode") %+% ")")
-  when <- format_time_ago$time_ago(format = "short", parse_date(sapply(x, "[[", "date")))
+  when <- format_time_ago$time_ago(format = "short", parse_iso_8601(sapply(x, "[[", "date")))
   pkgs <- data.frame(
     stringsAsFactors = FALSE, check.names = FALSE,
     "." = ifelse(sapply(x, "[[", "event") == "released", "+", "-"),

R/rematch2.R

@@ -0,0 +1,33 @@
+
+re_match <- function(text, pattern, perl = TRUE, ...) {
+
+  assert_that(is_string(pattern))
+  text <- as.character(text)
+
+  match <- regexpr(pattern, text, perl = perl, ...)
+
+  start  <- as.vector(match)
+  length <- attr(match, "match.length")
+  end    <- start + length - 1L
+
+  matchstr <- substring(text, start, end)
+  matchstr[ start == -1 ] <- NA_character_
+
+  res <- data_frame(.text = text, .match = matchstr)
+
+  if (!is.null(attr(match, "capture.start"))) {
+
+    gstart  <- attr(match, "capture.start")
+    glength <- attr(match, "capture.length")
+    gend    <- gstart + glength - 1L
+
+    groupstr <- substring(text, gstart, gend)
+    groupstr[ gstart == -1 ] <- NA_character_
+    dim(groupstr) <- dim(gstart)
+
+    res <- cbind(groupstr, res, stringsAsFactors = FALSE)
+  }
+  names(res) <- c(attr(match, "capture.names"), ".text", ".match")
+  class(res) <- c("tbl", class(res))
+  res
+}