Route <- R6::R6Class(
  "Route",
  public = list(
    path = NULL,
    components = list(),
    pattern = NULL,
    dynamic = FALSE,
    params = NULL,
    basepath = NULL,
    initialize = function(path) {
      assert_that(not_missing(path))
      self$path <- gsub("\\?.*$", "", path) # remove query
      self$dynamic <- grepl(":", path)
    },
    as_pattern = function(parent = "") {
      if (!is.null(.globals$pathToPattern)) {
        self$pattern <- .globals$pathToPattern(self$path)
        return(
          invisible(self)
        )
      }

      pattern <- sapply(self$components, function(comp) {
        if (comp$dynamic) {
          self$params <- append(self$params, comp$name)
          return("[[:alnum:][:space:][:punct:]]*")
        }

        return(comp$name)
      })

      pattern <- paste0(pattern, collapse = "/")
      self$pattern <- paste0("^", parent, "/", pattern, "$")
      invisible(self)
    },
    decompose = function(parent = "") {
      path <- paste0(parent, self$path)
      # split
      components <- strsplit(path, "(?<=.)(?=[:/])", perl = TRUE)[[1]]

      # remove lonely /
      components <- components[components != "/"]

      if (length(components) == 0) {
        self$components <- list(
          list(
            index = 1L,
            dynamic = FALSE,
            name = ""
          )
        )
        return()
      }

      # cleanup
      components <- gsub("/", "", components)

      components <- as.list(components)
      comp <- list()
      for (i in seq_along(components)) {
        c <- list(
          index = i,
          dynamic = grepl(":", components[[i]]),
          name = gsub(":|$", "", components[[i]])
        )
        comp <- append(comp, list(c))
      }

      self$components <- comp
      invisible(self)
    },
    print = function() {
      cli::cli_rule("Ambiorix", right = "route")
      message("Only used internally")
    }
  )
)

#' Path to pattern
#'
#' Identify a function as a path to pattern function;
#' a function that accepts a path and returns a matching pattern.
#'
#' @param path A function that accepts a character vector of length 1
#' and returns another character vector of length 1.
#'
#' @examples
#' fn <- function(path) {
#'   pattern <- gsub(":([^/]+)", "(\\\\w+)", path)
#'   paste0("^", pattern, "$")
#' }
#'
#' path_to_pattern <- as_path_to_pattern(fn)
#'
#' path <- "/dashboard/profile/:user_id"
#' pattern <- path_to_pattern(path) # "^/dashboard/profile/(\\w+)$"
#'
#' @return Object of class "pathToPattern".
#' @export
as_path_to_pattern <- function(path) {
  assert_that(is_function(path))

  structure(
    path,
    class = c(
      "pathToPattern",
      class(path)
    )
  )
}


#' @export
print.pathToPattern <- function(x, ...) {
  cli::cli_alert_info("A path to pattern converter")
}

#' @keywords internal
#' @noRd
is_path_to_pattern <- function(obj) {
  inherits(obj, "pathToPattern")
}
