Extend jsonString R6 class to support ordered json type

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(jsonString)
+export(ojsonString)
 importFrom(R6,R6Class)
 importFrom(Rcpp,evalCpp)
 importFrom(Rcpp,setRcppClass)

R/RcppExports.R

@@ -9,3 +9,11 @@ read_json <- function(filename) {
     .Call(`_jsonStrings_read_json`, filename)
 }
 
+toOJSONXptr <- function(string) {
+    .Call(`_jsonStrings_toOJSONXptr`, string)
+}
+
+read_ojson <- function(filename) {
+    .Call(`_jsonStrings_read_ojson`, filename)
+}
+

R/jsonStrings.R

@@ -4,6 +4,7 @@
 NULL
 
 JsonString <- setRcppClass("JsonString")
+oJsonString <- setRcppClass("oJsonString")
 
 Xptr <- function(jstring){
   jstring[[".__enclos_env__"]][["private"]][[".jsonString"]][["ptr"]]
@@ -23,11 +24,26 @@ jsonString <- R6Class(
 
   private = list(
     .prettyPrint = TRUE,
-    .jsonString = NULL
+    .jsonString = NULL,
+    .is_ordered_json = NULL,
+    getPtr = function(x) {
+      if (isJsonString(x)) {
+        if (private$.is_ordered_json != x$is_ordered_json) {
+          stop(sprintf("Json type mismatch: input json string should be of type '%s' not '%s'",
+                       self$json_type, x$json_type), call. = FALSE)
+        }
+        ptr <- Xptr(x)
+      } else if(isString(x)) {
+        ptr <- if(private$.is_ordered_json) toOJSONXptr(x) else toJSONXptr(x)
+      } else {
+        stop(sprintf("Invalid %s argument.", sQuote(deparse(substitute(x)))), call. = FALSE)
+      }
+      ptr
+    }
   ),
 
   active = list(
-    #' @field prettyPrint get or set the value of \code{prettyPrint}
+    #' @field prettyPrint Get or set the value of \code{prettyPrint}
     #' @examples 
     #' jstring <- jsonString$new(
     #'   "[1, [\"a\", 99], {\"x\": [2,3,4], \"y\": 42}]"
@@ -45,6 +61,37 @@ jsonString <- R6Class(
         )
         private[[".prettyPrint"]] <- value
       }
+    },
+    #' @field json_type Get the json type: either \code{json} or \code{ordered_json}
+    #' @examples 
+    #' jstring <- jsonString$new(
+    #'   "[1, [\"a\", 99], {\"x\": [2,3,4], \"y\": 42}]"
+    #' )
+    #' jstring$json_type
+    #' # "json"
+    json_type = function(value) {
+      if (!missing(value)) {
+        stop("'json_type' is read only field.", call. = FALSE)
+      }
+      if (private$.is_ordered_json) {
+        json_type <- "ordered_json"
+      } else {
+        json_type <- "json"
+      }
+      json_type
+    },
+    #' @field is_ordered_json Check if object is of type \code{ordered_json}
+    #' @examples 
+    #' jstring <- jsonString$new(
+    #'   "[1, [\"a\", 99], {\"x\": [2,3,4], \"y\": 42}]"
+    #' )
+    #' jstring$is_ordered_json
+    #' # FALSE
+    is_ordered_json = function(value) {
+      if (!missing(value)) {
+        stop("'is_ordered_json' is read only field.", call. = FALSE)
+      }
+      private$.is_ordered_json
     }
   ),
 
@@ -54,24 +101,36 @@ jsonString <- R6Class(
     #'
     #' @param string a string representing a JSON object, or the path to a 
     #'   JSON file
-    #'
+    #' @param ordered_json Should the \code{jsonString} object be of type
+    #' \code{json} (default) or \code{ordered_json}.
+    #' 
     #' @return A \code{jsonString} object.
     #'
     #' @examples
     #' jstring <- "[1, [\"a\", 99], {\"x\": [2,3,4], \"y\": 42}]"
     #' jsonString$new(jstring)
-    initialize = function(string) {
+    initialize = function(string, ordered_json = FALSE) {
+
+      stopifnot(isBoolean(ordered_json))
+      private[[".is_ordered_json"]] <- ordered_json
+
       # initialization from a pointer is hidden to the user
       if(inherits(string, "externalptr")) {
-        private[[".jsonString"]] <- JsonString$new(string, 0L)
+        private[[".jsonString"]] <- if (ordered_json) oJsonString$new(string, 0L) else JsonString$new(string, 0L)
         return(invisible(self))
       }
       stopifnot(isString(string))
       if(file.exists(string)) {
-        ptr <- read_json(path.expand(string))
-        private[[".jsonString"]] <- JsonString$new(ptr, 0L)
+
+        private[[".jsonString"]] <- if (ordered_json) { 
+          ptr <- read_ojson(path.expand(string))
+          oJsonString$new(ptr, 0L)
+        } else {
+          ptr <- read_json(path.expand(string))
+          JsonString$new(ptr, 0L)
+        }
       } else {
-        private[[".jsonString"]] <- JsonString$new(string)
+        private[[".jsonString"]] <- if (ordered_json) oJsonString$new(string) else JsonString$new(string)
       }
       invisible(self)
     },
@@ -117,7 +176,7 @@ jsonString <- R6Class(
     #' jstring$at(2, "x")
     at = function(...) {
       ptr <- private[[".jsonString"]]$at(list(...))
-      jsonString$new(ptr)
+      jsonString$new(ptr, private$.is_ordered_json)
     },
 
     #' @description Checks whether a key exists in the reference JSON string.
@@ -170,14 +229,10 @@ jsonString <- R6Class(
     #' jstring
     addProperty = function(key, value) {
       stopifnot(isString(key))
-      if(isJsonString(value)) {
-        ptr <- Xptr(value)
-      } else if(isString(value)) {
-        ptr <- toJSONXptr(value)
-      } else {
-        stop("Invalid `value` argument.")
-      }
+
+      ptr <- private$getPtr(value)
       private[[".jsonString"]]$addProperty(key, ptr)
+
       invisible(self)
     },
 
@@ -239,14 +294,10 @@ jsonString <- R6Class(
     #' jstring$update(jstring2)
     #' jstring
     update = function(jstring) {
-      if(isJsonString(jstring)) {
-        ptr <- Xptr(jstring)
-      } else if(isString(jstring)) {
-        ptr <- toJSONXptr(jstring)
-      } else {
-        stop("Invalid `jstring` argument.")
-      }
+
+      ptr <- private$getPtr(jstring)
       private[[".jsonString"]]$update(ptr)
+
       invisible(self)
     },
 
@@ -266,14 +317,10 @@ jsonString <- R6Class(
     #' jstring$merge(jstring2)
     #' jstring
     merge = function(jstring) {
-      if(isJsonString(jstring)) {
-        ptr <- Xptr(jstring)
-      } else if(isString(jstring)) {
-        ptr <- toJSONXptr(jstring)
-      } else {
-        stop("Invalid `jstring` argument.")
-      }
+
+      ptr <- private$getPtr(jstring)
       private[[".jsonString"]]$merge(ptr)
+
       invisible(self)
     },
 
@@ -299,15 +346,11 @@ jsonString <- R6Class(
     #' ]"
     #' jstring$patch(jspatch)
     patch = function(jspatch) {
-      if(isJsonString(jspatch)) {
-        ptrpatch <- Xptr(jspatch)
-      } else if(isString(jspatch)) {
-        ptrpatch <- toJSONXptr(jspatch)
-      } else {
-        stop("Invalid `jspatch` argument.")
-      }
+
+      ptrpatch <- private$getPtr(jspatch)
       ptr <- private[[".jsonString"]]$patch(ptrpatch)
-      jsonString$new(ptr)
+
+      jsonString$new(ptr, private$.is_ordered_json)
     },
 
     #' @description Append an element to the reference JSON string (if it 
@@ -326,14 +369,10 @@ jsonString <- R6Class(
     #' jstring$push(jstring2)
     #' jstring
     push = function(jstring) {
-      if(isJsonString(jstring)) {
-        ptr <- Xptr(jstring)
-      } else if(isString(jstring)) {
-        ptr <- toJSONXptr(jstring)
-      } else {
-        stop("Invalid `jstring` argument.")
-      }
+
+      ptr <- private$getPtr(jstring)
       private[[".jsonString"]]$push(ptr)
+
       invisible(self)
     },
 
@@ -395,7 +434,7 @@ jsonString <- R6Class(
     #' jstring$flatten()
     flatten = function() {
       ptr <- private[[".jsonString"]]$flatten()
-      jsonString$new(ptr)
+      jsonString$new(ptr, private$.is_ordered_json)
     },
 
     #' @description Unflatten the reference JSON string (if it is flattened).
@@ -412,7 +451,7 @@ jsonString <- R6Class(
     #' jstring$unflatten()
     unflatten = function() {
       ptr <- private[[".jsonString"]]$unflatten()
-      jsonString$new(ptr)
+      jsonString$new(ptr, private$.is_ordered_json)
     },
 
     #' @description Write the reference JSON string to a file.
@@ -449,7 +488,7 @@ jsonString <- R6Class(
     #' naive_copy$erase("b")
     #' jstring
     copy = function() {
-      jsonString$new(Xptr(self))
+      jsonString$new(Xptr(self), private$.is_ordered_json)
     }
 
   )

R/ojsonStrings.R

@@ -0,0 +1,27 @@
+#' @title R6 class to represent an ordered JSON string
+#' @description R6 class to represent a JSON string that
+#' preserves the insertion order of object keys.
+#'
+#' @export 
+ojsonString <- R6Class(
+
+  lock_class = TRUE,
+  cloneable = FALSE,
+  classname = "ojsonString",
+  inherit = jsonString,
+  public = list(
+    #' @description Creates a new \code{ojsonString} object.
+    #'
+    #' @param string a string representing an JSON object, or the path to a 
+    #'   JSON file
+    #'
+    #' @return A \code{ojsonString} object.
+    #'
+    #' @examples
+    #' jstring <- "[1, [\"a\", 99], {\"y\": [2,3,4], \"x\": 42}]"
+    #' ojsonString$new(jstring)
+    initialize = function(string) {
+      super$initialize(string = string, ordered_json = TRUE)
+    }
+  )
+)

inst/include/jsonStrings.h

@@ -3,9 +3,12 @@
 
 #include "nlohmann/json_cran.h"
 using json = nlohmann::json;
+using ordered_json = nlohmann::ordered_json;
+
 #include <Rcpp.h>
 #include <fstream>
 
 typedef Rcpp::XPtr<json> jsonXptr;
+typedef Rcpp::XPtr<ordered_json> ojsonXptr;
 
 #endif