[rkward] packages/XiMpLe/R: first attemts for more recursion

[m.eik michalke]

Git commit 2a2e768199c12a2a4cf7c51fd1d252f62e06308c by m.eik michalke.
Committed on 09/12/2015 at 15:29.
Pushed by meikm into branch 'master'.

first attemts for more recursion

M  +23   -8    packages/XiMpLe/R/00_class_03_XiMpLe.validity.R

http://commits.kde.org/rkward/2a2e768199c12a2a4cf7c51fd1d252f62e06308c

diff --git a/packages/XiMpLe/R/00_class_03_XiMpLe.validity.R b/packages/XiMpLe/R/00_class_03_XiMpLe.validity.R
index 0df0258..aa711b3 100644
--- a/packages/XiMpLe/R/00_class_03_XiMpLe.validity.R
+++ b/packages/XiMpLe/R/00_class_03_XiMpLe.validity.R
@@ -22,13 +22,16 @@
 #' 
 #' You should use \code{\link[XiMpLe:XMLValidity]{XMLValidity}} to create objects of this class.
 #'
-#' @slot children Named list of character vectors, where the element name defines the parent node
-#'   name and each character string a valid child node name.
-#' @slot attrs Named list of character vectors, where the element name defines the parent node
-#'   name and each character string a valid attribute name.
+#' @slot children Named list of vectors or lists. The element name defines the parent node
+#'   name and each character string a valid child node name. If a value is in turn of class XiMpLe.validity,
+#'   this object will be used for recursive validation of deeper nodes.
+#' @slot attrs Named list of vectors or lists. The element name defines the parent node
+#'   name and each character string a valid attribute name. If a value is in turn of class XiMpLe.validity,
+#'   this object will be used for recursive validation of deeper nodes.
 #' @slot allChildren Character vector, names of globally valid child nodes for all nodes, if any.
 #' @slot allAttrs Character vector, names of globally valid attributes for all nodes, if any.
 #' @slot empty Character vector, names of nodes that must be empty nodes (i.e., no closing tag), if any.
+#' @slot ignore Character vector, names of nodes that should be ignored, if any.
 #' @name XiMpLe.validity,-class
 #' @aliases XiMpLe.validity-class XiMpLe.validity,-class
 #' @import methods
@@ -45,14 +48,16 @@ setClass("XiMpLe.validity",
     attrs="list",
     allChildren="character",
     allAttrs="character",
-    empty="character"
+    empty="character",
+    ignore="character"
   ),
   prototype(
     children=list(),
     attrs=list(),
     allChildren=character(),
     allAttrs=character(),
-    empty=character()
+    empty=character(),
+    ignore=character()
   )
 )
 
@@ -61,13 +66,23 @@ setValidity("XiMpLe.validity", function(object){
   obj.attrs <- slot(object, "attrs")
 
   for (thisChild in obj.children){
+    if(is.list(thisChild)){
+      # check for XiMpLe.validity object
+      isValidity <- which(sapply(thisChild, is.XiMpLe.validity))
+      if(length(isValidity) == 1){
+        thisChild[[isValidity]] <- NULL
+        thisChild <- unlist(thisChild)
+      } else if(length(isValidity) > 1){
+        stop(simpleError("Invalid object: all \"children\" can only have one value of class XiMpLe.validity for recursion!"))
+      } else {}
+    } else {}
     if(!is.character(thisChild)){
-      stop(simpleError("Invalid object: all \"children\" must be character vectors!"))
+      stop(simpleError("Invalid object: all \"children\" must be of class character or XiMpLe.validity!"))
     } else {}
   }
   for (thisAttr in obj.attrs){
     if(!is.character(thisAttr)){
-      stop(simpleError("Invalid object: all \"attrs\" must be character vectors!"))
+      stop(simpleError("Invalid object: all \"attrs\" must be of class character or XiMpLe.validity!"))
     } else {}
   }
   return(TRUE)