ACAS-736: Append new experiment endpoints to protocol endpoints

modules/GenericDataParser/src/server/generic_data_parser.R

@@ -3673,19 +3673,14 @@ runMain <- function(pathToGenericDataFormatExcelFile, reportFilePath=NULL,
     })
   }
 
-  # Validate Experiment Columns against Protocol Endpoints
-  # only proceed if it associated with an existing protocol (the protocol is not new)
-  # also, only proceed if endpoint manager is enabled
-
-  # We create experimentPassedEndpointValidation holding variable in case it is a new protocol and it is not assigned
-  # (Since we can't check if an empty variable is true or false later)
-  experimentPassedEndpointValidation <- FALSE 
+  # Validate Experiment Columns against Protocol Endpoints when using existing protocol and endpoint manager is enabled
+  expProtocolEndpointValiation <- list(passed = FALSE, nonMatchingRows = data.frame()) 
 
   if (!newProtocol && racas::applicationSettings$client.protocol.endpointManager.enabled) {
     # extract the endpoint data from the protocol object to check against
     protocolEndpointData <- getProtocolEndpointData(protocol)
     # Check the experiment columns against the protocolEndpointData
-    experimentPassedEndpointValidation <- validateExperimentColumns(selColumnOrderInfo, protocolEndpointData, getProtocolStrictEndpointMatching(protocol), protocol$lsLabels[[1]]$labelText)
+    expProtocolEndpointValiation <- validateExperimentColumns(selColumnOrderInfo, protocolEndpointData, getProtocolStrictEndpointMatching(protocol), protocol$lsLabels[[1]]$labelText)
   }
 
   # If there are errors, do not allow an upload
@@ -3707,7 +3702,6 @@ runMain <- function(pathToGenericDataFormatExcelFile, reportFilePath=NULL,
     validatedCustomMetaDataStates <- NULL
     customExperimentMetaDataValues <- NULL
   }
-
   columnOrderStates <- createColumnOrderStates(selColumnOrderInfo, errorEnv, recordedBy, lsTransaction)
 
 
@@ -3722,6 +3716,11 @@ runMain <- function(pathToGenericDataFormatExcelFile, reportFilePath=NULL,
 
     if (newProtocol) {
       protocol <- createNewProtocol(metaData = validatedMetaData, lsTransaction, recordedBy, columnOrderStates)
+    } else {
+      # If the protocol has passed endpoint validation and we are not in a dry run, update the protocol with any new endpoints
+      if (expProtocolEndpointValiation$passed && nrow(expProtocolEndpointValiation$nonMatchingRows) > 0) {
+        protocol <- updateColumnOrderStates(protocol, "protocols", expProtocolEndpointValiation$nonMatchingRows, errorEnv, recordedBy, lsTransaction)
+      }
     }
   }
 
@@ -4257,7 +4256,7 @@ getProtocolEndpointData <- function(protocol) {
 
   #go through the protocol data to wrangle the endpoint data into the dataframe
   for (lsState in protocol$lsStates) {
-    if (lsState[['lsKind']] == "data column order") {
+    if (lsState$ignored != TRUE && lsState$deleted != TRUE && lsState[['lsKind']] == "data column order") {
 
       #if the name/units/data type cant be found, submit a NA
       columnNameEntry = NA
@@ -4357,6 +4356,7 @@ validateExperimentColumns <- function(selColumnOrderInfo, protocolEndpointDataFr
   # Returns TRUE/FALSE (whether the experiment passed validation)
 
   experimentPassedValidation = TRUE
+  nonMatchingRows <- data.frame()
 
   for (experimentRowNum in seq(1, nrow(selColumnOrderInfo))) {
     experimentRowData <- selColumnOrderInfo[experimentRowNum,]
@@ -4406,6 +4406,7 @@ validateExperimentColumns <- function(selColumnOrderInfo, protocolEndpointDataFr
 
     if (experimentRowMatchesEndpoint == FALSE) {
       # If strict endpoint matching is enabled, we throw an error, otherwise we throw a warning
+      nonMatchingRows <- rbind(nonMatchingRows, experimentRowData)
       if (protocolStrictEndpointMatchingEnabled == TRUE) {
         addError(paste0("The result type '", experimentRowName, "' with data type '", experimentRowDataType, "' and units '", experimentRowUnits, "' is not one of the allowed result types for this ", racas::applicationSettings$client.protocol.label, ". Please revise your file or contact an ACAS administrator to update the allowed result types for this ", racas::applicationSettings$client.protocol.label, "."))
 
@@ -4416,10 +4417,9 @@ validateExperimentColumns <- function(selColumnOrderInfo, protocolEndpointDataFr
         warnUser(paste0("The result type '", experimentRowName, "' with data type '", experimentRowDataType, "' and units '", experimentRowUnits, "' is not configured for this ", racas::applicationSettings$client.protocol.label, ". If this is expected, you may proceed with the upload. Otherwise contact an ACAS Administrator to update the configured result types for this ", racas::applicationSettings$client.protocol.label ,"."))
       } 
     }
-
   }
 
-  return(experimentPassedValidation)
+  return(list(passed = experimentPassedValidation, nonMatchingRows = nonMatchingRows))
 }
 
 getProtocolStrictEndpointMatching <- function(protocol) {
@@ -4783,3 +4783,30 @@ createColumnOrderStates <- function(exptDataColumns=selColumnOrderInfo, errorEnv
     }
     return(experimentStates)
 }
+updateColumnOrderStates <- function(entity, acasCategory, columnOrderRows, errorEnv, recordedBy, lsTransaction){
+    # Check if the entity has a column order state, if it does, update it, if not, create it
+    # Returns the updated or created state
+    columnOrderStates <- getStatesByTypeAndKind(entity, "metadata_data column order")
+
+    if(length(columnOrderStates) > 0) {
+      # If the column order state > 0 then find the highest "column order" and update the selected column order info
+      columnOrders <- sapply(columnOrderStates, getValuesByTypeAndKind, typeAndKind = "numericValue_column order")
+      maxOrder <- max(unlist(lapply(columnOrders, function(x) x$numericValue)))
+    } else {
+      maxOrder <- 0
+    }
+
+    # Apply the max order to the new column order info
+    columnOrderRows$order <- maxOrder + 1:nrow(columnOrderRows)
+
+    # Create the new column order states
+    newColumnOrderStates <- createColumnOrderStates(columnOrderRows, errorEnv, recordedBy, lsTransaction)
+
+    # Append the new column order states to the entity
+    entity$lsStates <- c(entity$lsStates, newColumnOrderStates)
+
+    # Update the entity
+    updatedEntity <- rjson::fromJSON(updateAcasEntity(entity, acasCategory))
+
+    return(updatedEntity)
+}