Experimental fixes

Ironholds · Sep 14, 2017 · e67daac · e67daac
1 parent 98daa6d
commit e67daac
Show file tree

Hide file tree

Showing 11 changed files with 270 additions and 38 deletions.
diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -243,6 +243,14 @@ set_component_ <- function(urls, component, new_value) {
     .Call(`_urltools_set_component_`, urls, component, new_value)
 }
 
+set_component_r <- function(urls, component, new_value, comparator) {
+    .Call(`_urltools_set_component_r`, urls, component, new_value, comparator)
+}
+
+set_component_f <- function(urls, component, new_value, comparator) {
+    .Call(`_urltools_set_component_f`, urls, component, new_value, comparator)
+}
+
 rm_component_ <- function(urls, component) {
     .Call(`_urltools_rm_component_`, urls, component)
 }

diff --git a/R/accessors.R b/R/accessors.R
@@ -7,7 +7,8 @@
 #'
 #'@param x a URL, or vector of URLs
 #'
-#'@param value a replacement value for x's scheme.
+#'@param value a replacement value (or vector of replacement values)
+#'for x's scheme.
 #'
 #'@seealso \code{\link{domain}}, \code{\link{port}}, \code{\link{path}},
 #'\code{\link{parameters}} and \code{\link{fragment}} for other accessors.
@@ -32,10 +33,10 @@ scheme <- function(x){
 #'@rdname scheme
 #'@export
 setGeneric("scheme<-", useAsDefault = function(x, value){
-  if(is.null(value)){
+  if(length(value) == 0 && is.null(value)){
     return(rm_component_(x, 0))
   }
-  return(set_component_(x, 0, value))
+  return(set_component_r(x, 0, value, "://"))
 })
 
 #'@title Get or set a URL's domain
@@ -47,7 +48,8 @@ setGeneric("scheme<-", useAsDefault = function(x, value){
 #'
 #'@param x a URL, or vector of URLs
 #'
-#'@param value a replacement value for x's scheme.
+#'@param value a replacement value (or vector of replacement values)
+#'for x's scheme.
 #'
 #'@seealso \code{\link{scheme}}, \code{\link{port}}, \code{\link{path}},
 #'\code{\link{parameters}} and \code{\link{fragment}} for other accessors.
@@ -67,7 +69,7 @@ domain <- function(x){
 #'@rdname domain
 #'@export
 setGeneric("domain<-", useAsDefault = function(x, value){
-  if(is.null(value)){
+  if(length(value) == 0 && is.null(value)){
     return(rm_component_(x, 1))
   }
   return(set_component_(x, 1, value))
@@ -83,8 +85,8 @@ setGeneric("domain<-", useAsDefault = function(x, value){
 #'
 #'@param x a URL, or vector of URLs
 #'
-#'@param value a replacement value for x's port. If NULL, the port
-#'will be entirely removed.
+#'@param value a replacement value (or vector of replacement values)
+#'for x's port. If NULL, the port will be entirely removed.
 #'
 #'@seealso \code{\link{scheme}}, \code{\link{domain}}, \code{\link{path}},
 #'\code{\link{parameters}} and \code{\link{fragment}} for other accessors.
@@ -107,10 +109,10 @@ port <- function(x){
 #'@rdname port
 #'@export
 setGeneric("port<-", useAsDefault = function(x, value){
-  if(is.null(value)){
+  if(length(value) == 0 && is.null(value)){
     return(rm_component_(x, 2))
   }
-  return(set_component_(x, 2, value))
+  return(set_component_f(x, 2, value, ":"))
 })
 
 #'@title Get or set a URL's path
@@ -122,8 +124,8 @@ setGeneric("port<-", useAsDefault = function(x, value){
 #'
 #'@param x a URL, or vector of URLs
 #'
-#'@param value a replacement value for x's path. If NULL, the path
-#'will be removed entirely.
+#'@param value a replacement value (or vector of replacement values)
+#'for x's path. If NULL, the path will be removed entirely.
 #'
 #'@seealso \code{\link{scheme}}, \code{\link{domain}}, \code{\link{port}},
 #'\code{\link{parameters}} and \code{\link{fragment}} for other accessors.
@@ -146,10 +148,10 @@ path <- function(x){
 #'@rdname path
 #'@export
 setGeneric("path<-", useAsDefault = function(x, value){
-  if(is.null(value)){
+  if(length(value) == 0 && is.null(value)){
     return(rm_component_(x, 3))
   }
-  return(set_component_(x, 3, value))
+  return(set_component_f(x, 3, value, "/"))
 })
 
 #'@title Get or set a URL's parameters
@@ -162,8 +164,8 @@ setGeneric("path<-", useAsDefault = function(x, value){
 #'
 #'@param x a URL, or vector of URLs
 #'
-#'@param value a replacement value for x's parameters. If NULL, the
-#'parameters will be removed entirely.
+#'@param value a replacement value (or vector of replacement values)
+#'for x's parameters. If NULL, the parameters will be removed entirely.
 #'
 #'@seealso \code{\link{scheme}}, \code{\link{domain}}, \code{\link{port}},
 #'\code{\link{path}} and \code{\link{fragment}} for other accessors.
@@ -186,10 +188,10 @@ parameters <- function(x){
 #'@rdname parameters
 #'@export
 setGeneric("parameters<-", useAsDefault = function(x, value){
-  if(is.null(value)){
+  if(length(value) == 0 && is.null(value)){
     return(rm_component_(x, 4))
   }
-  return(set_component_(x, 4, value))
+  return(set_component_f(x, 4, value, "?"))
 })
 
 #'@title Get or set a URL's fragment
@@ -201,8 +203,8 @@ setGeneric("parameters<-", useAsDefault = function(x, value){
 #'
 #'@param x a URL, or vector of URLs
 #'
-#'@param value a replacement value for x's fragment. If NULL, the
-#'fragment will be removed entirely.
+#'@param value a replacement value (or vector of replacement values)
+#'for x's fragment. If NULL, the fragment will be removed entirely.
 #'
 #'@seealso \code{\link{scheme}}, \code{\link{domain}}, \code{\link{port}},
 #'\code{\link{path}} and \code{\link{parameters}} for other accessors.
@@ -228,8 +230,8 @@ fragment <- function(x){
 #'@rdname fragment
 #'@export
 setGeneric("fragment<-", useAsDefault = function(x, value){
-  if(is.null(value)){
+  if(length(value) == 0 && is.null(value)){
     return(rm_component_(x, 5))
   }
-  return(set_component_(x, 5, value))
+  return(set_component_f(x, 5, value, "#"))
 })
diff --git a/man/domain.Rd b/man/domain.Rd
diff --git a/man/fragment.Rd b/man/fragment.Rd
diff --git a/man/parameters.Rd b/man/parameters.Rd
diff --git a/man/path.Rd b/man/path.Rd
diff --git a/man/port.Rd b/man/port.Rd
diff --git a/man/scheme.Rd b/man/scheme.Rd
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
@@ -121,18 +121,46 @@ BEGIN_RCPP
 END_RCPP
 }
 // set_component_
-CharacterVector set_component_(CharacterVector urls, int component, String new_value);
+CharacterVector set_component_(CharacterVector urls, int component, CharacterVector new_value);
 RcppExport SEXP _urltools_set_component_(SEXP urlsSEXP, SEXP componentSEXP, SEXP new_valueSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;
     Rcpp::RNGScope rcpp_rngScope_gen;
     Rcpp::traits::input_parameter< CharacterVector >::type urls(urlsSEXP);
     Rcpp::traits::input_parameter< int >::type component(componentSEXP);
-    Rcpp::traits::input_parameter< String >::type new_value(new_valueSEXP);
+    Rcpp::traits::input_parameter< CharacterVector >::type new_value(new_valueSEXP);
     rcpp_result_gen = Rcpp::wrap(set_component_(urls, component, new_value));
     return rcpp_result_gen;
 END_RCPP
 }
+// set_component_r
+CharacterVector set_component_r(CharacterVector urls, int component, CharacterVector new_value, std::string comparator);
+RcppExport SEXP _urltools_set_component_r(SEXP urlsSEXP, SEXP componentSEXP, SEXP new_valueSEXP, SEXP comparatorSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< CharacterVector >::type urls(urlsSEXP);
+    Rcpp::traits::input_parameter< int >::type component(componentSEXP);
+    Rcpp::traits::input_parameter< CharacterVector >::type new_value(new_valueSEXP);
+    Rcpp::traits::input_parameter< std::string >::type comparator(comparatorSEXP);
+    rcpp_result_gen = Rcpp::wrap(set_component_r(urls, component, new_value, comparator));
+    return rcpp_result_gen;
+END_RCPP
+}
+// set_component_f
+CharacterVector set_component_f(CharacterVector urls, int component, CharacterVector new_value, std::string comparator);
+RcppExport SEXP _urltools_set_component_f(SEXP urlsSEXP, SEXP componentSEXP, SEXP new_valueSEXP, SEXP comparatorSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< CharacterVector >::type urls(urlsSEXP);
+    Rcpp::traits::input_parameter< int >::type component(componentSEXP);
+    Rcpp::traits::input_parameter< CharacterVector >::type new_value(new_valueSEXP);
+    Rcpp::traits::input_parameter< std::string >::type comparator(comparatorSEXP);
+    rcpp_result_gen = Rcpp::wrap(set_component_f(urls, component, new_value, comparator));
+    return rcpp_result_gen;
+END_RCPP
+}
 // rm_component_
 CharacterVector rm_component_(CharacterVector urls, int component);
 RcppExport SEXP _urltools_rm_component_(SEXP urlsSEXP, SEXP componentSEXP) {
@@ -227,6 +255,8 @@ static const R_CallMethodDef CallEntries[] = {
     {"_urltools_url_parse", (DL_FUNC) &_urltools_url_parse, 1},
     {"_urltools_get_component_", (DL_FUNC) &_urltools_get_component_, 2},
     {"_urltools_set_component_", (DL_FUNC) &_urltools_set_component_, 3},
+    {"_urltools_set_component_r", (DL_FUNC) &_urltools_set_component_r, 4},
+    {"_urltools_set_component_f", (DL_FUNC) &_urltools_set_component_f, 4},
     {"_urltools_rm_component_", (DL_FUNC) &_urltools_rm_component_, 2},
     {"_urltools_puny_encode", (DL_FUNC) &_urltools_puny_encode, 1},
     {"_urltools_puny_decode", (DL_FUNC) &_urltools_puny_decode, 1},