support #401

NAMESPACE

@@ -34,6 +34,7 @@ export(geoflow_provenance)
 export(geoflow_register)
 export(geoflow_relation)
 export(geoflow_right)
+export(geoflow_skos_vocabulary)
 export(geoflow_software)
 export(geoflow_subject)
 export(geoflow_validator)
@@ -56,6 +57,7 @@ export(geoflow_validator_entity_Subject)
 export(geoflow_validator_entity_TemporalCoverage)
 export(geoflow_validator_entity_Title)
 export(geoflow_validator_entity_Type)
+export(geoflow_vocabulary)
 export(getDBTableColumnComment)
 export(getDBTableComment)
 export(get_config_resource_path)
@@ -79,6 +81,7 @@ export(list_registers)
 export(list_software)
 export(list_software_parameters)
 export(list_software_properties)
+export(list_vocabularies)
 export(loadMetadataHandler)
 export(load_workflow_environment)
 export(posix_to_str)
@@ -89,6 +92,7 @@ export(register_dictionary_handlers)
 export(register_entity_handlers)
 export(register_registers)
 export(register_software)
+export(register_vocabularies)
 export(sanitize_date)
 export(sanitize_str)
 export(set_line_separator)

R/executeWorkflowJob.R

@@ -173,6 +173,9 @@ executeWorkflowJob <- function(config, jobdir = NULL, queue = NULL, monitor = NU
           #enrich entities with metadata (other properties)
           entity$enrichWithMetadata(config)
 
+          #enrich entities with vocabularies
+          entity$enrichWithVocabularies(config)
+
           #run sequence of entity data actions (if any)
           if(!is.null(entity$data)) {
             if(entity$data$run){

R/geoflow_entity.R

@@ -1864,6 +1864,42 @@ geoflow_entity <- R6Class("geoflow_entity",
       }
     },
 
+
+    #'@description Enrichs the entity with vocabularies
+    #'@param config geoflow config object
+    enrichWithVocabularies = function(config){
+
+      self$subjects = lapply(self$subjects, function(subject){
+
+        if(is.null(subject$uri)) return(subject)
+
+        #find vocabulary
+        vocabs = list_vocabularies(raw = T)
+        target_vocab = vocabs[sapply(vocabs, function(vocab){vocab$id == subject$uri})]
+        if(length(target_vocab)>0){
+          target_vocab = target_vocab[[1]]
+          subject$uri = target_vocab$uri
+          subject$keywords = lapply(subject$keywords, function(keyword){
+            if(!is.null(keyword$uri)){
+              #enrich from URI to add labels
+              rs = target_vocab$query_from_uri(uri = keyword$uri)
+              if(nrow(rs)>0){
+                keyword$name = rs[rs$lang == "en",]$prefLabel
+                for(lang in rs$lang){
+                  attr(keyword$name, paste0("locale#",toupper(lang))) = rs[rs$lang == lang,]$prefLabel
+                }
+              }
+            }else{
+              #enrich from an existing term to get URI + other labels
+            }
+            return(keyword)
+          })
+        }
+
+        return(subject)
+      })
+    },
+
     #'@description Enrichs the entity with formats
     #'@param config geoflow config object
     enrichWithFormats = function(config){

R/geoflow_software.R

@@ -705,6 +705,18 @@ register_software <- function(){
         port = list(label = "Port", def = "Port", class = "integer"),
         use_ssl = list(label = "Use SSL", def = "Use SSL", class = "logical", default = TRUE)
       )
+    ),
+    #-------------------------------------------------------------------------------------------------------
+    #SPARQL CLIENT
+    #-------------------------------------------------------------------------------------------------------
+    geoflow_software$new(
+      software_type = "sparql",
+      definition = "A SPARQL endpoint client",
+      packages = list(),
+      handler = list,
+      arguments = list(
+        endpoint = list(label = "Endpoint", def = "SPARQL endpoint URL", class = "character")
+      )
     )
   )
   .geoflow$software <- software

R/geoflow_vocabulary.R

@@ -0,0 +1,198 @@
+#' geoflow_vocabulary
+#'
+#' @docType class
+#' @importFrom R6 R6Class
+#' @export
+#' 
+#' @name geoflow_vocabulary
+#' @title Geoflow vocabulary class
+#' @description This class models a vocabulary
+#' @keywords action
+#' @return Object of \code{\link{R6Class}} for modelling a vocabulary
+#' @format \code{\link{R6Class}} object.
+#'
+geoflow_vocabulary <- R6Class("geoflow_vocabulary",
+  public = list(
+
+    #'@field id id
+    id = NA,
+    #'@field def def
+    def = NA,
+    #'@field uri uri
+    uri = NA,
+    #'@field software_type software_type
+    software_type = NA,
+    #'@field software software
+    software = NULL,
+
+    #'@name Initializes a vocabulary
+    #'@param id id
+    #'@param def def
+    #'@param uri uri
+    #'@param software_type software type
+    initialize = function(id, def, uri, software_type){
+      self$id = id
+      self$def = def
+      self$uri = uri
+      self$software_type = software_type
+    },
+
+    setSoftware = function(sofware){
+
+    }
+  )
+)
+
+#' geoflow_skos_vocabulary
+#'
+#' @docType class
+#' @importFrom R6 R6Class
+#' @export
+#' 
+#' @name geoflow_skos_vocabulary
+#' @title Geoflow SKOS vocabulary class
+#' @description This class models a SKOS vocabulary
+#' @keywords action
+#' @return Object of \code{\link{R6Class}} for modelling a SKOS vocabulary
+#' @format \code{\link{R6Class}} object.
+#'
+geoflow_skos_vocabulary <- R6Class("geoflow_skos_vocabulary",
+  inherit = geoflow_vocabulary,
+  public = list(
+    #'@field endpoint endpoint
+    endpoint = NA,
+
+    #'@name Initializes a vocabulary
+    #'@param id id
+    #'@param def def
+    #'@param uri uri
+    #'@param endpoint endpoint
+    initialize = function(id, def, uri, endpoint){
+      super$initialize(id, def, uri, software_type = "sparql")
+      self$endpoint = endpoint
+    },
+
+    #'@name query
+    #'@param str str
+    #'@param graphUri graphUri
+    #'@param mimetype mimetype
+    #'@return the response of the SPARQL query
+    query = function(str, graphUri = NULL, mimetype = "text/csv"){
+      req_body = list(query = str)
+      if(!is.null(graphUri)) req_body$graphUri = graphUri 
+
+      req = httr::with_verbose(httr::POST(
+        url = self$endpoint,
+        encode = "form",
+        body = req_body,
+        httr::add_headers(
+          "Content-Type" = "application/x-www-form-urlencoded",
+          "Accept" = mimetype
+        )
+      ))
+      httr::content(req)
+    },
+
+    #'@name ping
+    ping = function(){
+      str = "SELECT ?s ?p ?o WHERE { 
+                  	?s ?p ?o 
+                  } LIMIT 10"
+      self$query(str)
+    },
+
+    #'@name query_from_uri
+    #'@param uri uri
+    #'@param graphUri graphUri
+    #'@param mimetype mimetype
+    #'@return the response of the SPARQL query
+    query_from_uri = function(uri, graphUri = NULL, mimetype = "text/csv"){
+
+      str = paste0(
+       "PREFIX skos: <http://www.w3.org/2004/02/skos/core#> 
+        PREFIX rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> 
+        SELECT ?concept ?lang ?prefLabel (GROUP_CONCAT ( DISTINCT concat('\"',?altLabel,'\"@',lang(?altLabel)); separator=\"|_|\" ) as ?altLabels) 
+        WHERE { 
+          BIND(<",uri,"> AS ?concept) 
+          ?concept skos:prefLabel ?prefLabel . 
+          BIND(lang(?prefLabel) AS ?lang) 
+          OPTIONAL{ 
+          	?concept skos:altLabel ?altLabel . 
+          	FILTER(lang(?altLabel) = ?lang) 
+          } 
+        } 
+        GROUP BY ?concept ?lang ?prefLabel 
+        ORDER BY ?lang "
+      )
+
+      self$query(str = str, graphUri = graphUri, mimetype = mimetype)
+    }
+  )
+)
+
+#' @name register_vocabularies
+#' @aliases register_vocabularies
+#' @title register_vocabularies
+#' @description \code{register_vocabularies} registers default geoflow vocabularies
+#'
+#' @usage register_vocabularies()
+#' 
+#' @note Function called on load by geoflow
+#' @export
+#'
+register_vocabularies = function(){
+  vocabularies <- list(
+    geoflow_skos_vocabulary$new(
+      id = "agrovoc",
+      def = "AGROVOC Thesaurus",
+      uri = "https://aims.fao.org/aos/agrovoc/",
+      endpoint = "https://agrovoc.fao.org/sparql"
+    ),
+    geoflow_skos_vocabulary$new(
+      id = "edmo.seadatanet",
+      def = "EDMO Seadatanet Thesaurus",
+      uri = "https://edmo.seadatanet.org",
+      endpoint = "https://edmo.seadatanet.org/sparql/sparql"
+    ),
+    geoflow_skos_vocabulary$new(
+      id = "nvs",
+      def = "NERC Vocabulary Server",
+      uri = "https://vocab.nerc.ac.uk",
+      endpoint = "https://vocab.nerc.ac.uk/sparql/sparql"
+    )
+  )
+  .geoflow$vocabularies <- vocabularies
+}
+
+#' @name list_vocabularies
+#' @aliases list_vocabularies
+#' @title list_vocabularies
+#' @description \code{list_vocabularies} lists the vocabularies supported by geoflow.
+#'
+#' @usage list_vocabularies(raw)
+#' 
+#' @param raw Default value is \code{FALSE}, meaning the vocabularies will be listed as
+#' \code{data.frame}. The output If \code{TRUE} the raw list of \link{geoflow_vocabulary} 
+#' is returned.
+#' 
+#' @return an object of class \code{data.frame} (or \code{list} of \link{geoflow_vocabulary} if raw = FALSE)
+#' @export
+#'
+list_vocabularies <- function(raw = FALSE){
+  vocabularies <- .geoflow$vocabularies
+  if(raw){
+    return(vocabularies)
+  }else{
+    vocabularies <- do.call("rbind", lapply(vocabularies, function(obj){
+      obj.out <- data.frame(
+        id = obj$id,
+        def = obj$def,
+        uri = obj$uri,
+        endpoint = if(!is.null(obj$endpoint)) obj$endpoint else NA,
+        stringsAsFactors = FALSE
+      )
+      return(obj.out)
+    }))
+  }
+  return(vocabularies)
+}

R/profile.R

@@ -22,4 +22,7 @@
   #embedded actions
   register_actions()
 
+  #vocabularies
+  register_vocabularies()
+
 } # nocov end