R/GenericTracker.R

In signaux-faibles/MLlogr:

#' Generic Tracker
#'
#' An object to create a tracker with specified fields.
#'
#' @section Attributes:
#' * `fields` -- `list(field)` \cr List of objects of class `field` that define
#'   what can be logged with the tracker.
#' * `database` -- `character(1)` \cr Mongodb database to which to log.
#' * `collection` -- `character(1)` \cr Mongodb collection to which to log.
#' * `control` -- `list(any)` \cr A named list to specify additional options.
#'
#' @section Methods:
#' `set`
#' * `...` -- List of named parameters that are stored in the tracker object
#'   for a future log.
#'
#' `log`
#' * `...` -- List of named parameters that are logged in addition to the
#'   stored parameters. Arguments of `log` have precedence on stored
#'   parameters, overwriting their value
#' @export
#'
#' @examples
#' \dontrun{
#' GenericTracker$new(
#'   database = "database",
#'   collection = "collection",
#'   fields = list(
#'     field("my_custom_field1"),
#'     field("my_custom_field2")
#'   )
#' )
#' }
GenericTracker <- R6::R6Class("GenericTracker", #nolint
  public = list(

    # -------- Attributes------------------------------------------------------
    fields = NULL,
    database = NULL,
    collection = NULL,
    control = list(),

    # -------- Methods -------------------------------------------------------
    # Object constructor
    initialize = function(
      database,
      collection,
      fields,
      control = list()
      ){


      self$database  <- database
      self$collection <- collection
      self$fields <- fields
      self$control <- control
      names(self$fields) <- purrr::map(fields, "name")
    },
    # Setting field
    set = function(...){
      fields_to_set <- list(...)
      assertthat::assert_that(
        !is.null(names(fields_to_set)),
        msg = "Arguments of set must be named."
        )
      assertthat::assert_that(
        all(names(fields_to_set) %in% names(self$fields)),
        msg = "Incorrect field name"
        )

      self$fields <- private$merge_input_fields(fields_to_set)
      return(invisible(self))
    },
    # Logging function
    log = function(...){

      fields_to_log <- private$merge_input_fields(list(...))

      private$check_all_compulsary_fields()

      dbconnection <- mongolite::mongo(
        db = self$database,
        collection = self$collection
        )

      objects_to_log <- purrr::map(fields_to_log, "value")
      objects_to_log <- objects_to_log[
        purrr::map_lgl(objects_to_log, ~!is.null(.))
        ]

      # To have time_stamp
      objects_to_log <- purrr::map_if(
        .x = objects_to_log,
        .p = ~inherits(., "expression"),
        .f = eval)


      dbconnection$insert(objects_to_log)
      return(invisible(self))
    }
    ),
  private = list(

    # Merging stored fields and new values given as function input
    merge_input_fields = function(
      additional_field_values
    ){

      merged_fields <- purrr::map_if(
        .x = self$fields,
        .p = ~ .[["name"]] %in% names(additional_field_values),
        .f = function(field){
          return(
              set_field(
                field,
                value = additional_field_values[[field[["name"]]]],
                control = self$control
              )
          )
        })

      return(merged_fields)
    },

    # Check that compulsary fields are present
    check_all_compulsary_fields = function(){

      comp_fields <- self$fields[
        purrr::map_lgl(self$fields, "is_compulsary")
        ]
      has_value <- purrr::map_lgl(comp_fields, ~!is.null(.x[["value"]]))
      assertthat::assert_that(
        all(has_value),
        msg = paste(
          "Field(s)",
          paste(
            purrr::map_chr(comp_fields[!has_value], "name"),
            collapse = ", "
            ),
          "are compulsary but missing.")
        )
      return(NULL)
    }

    )
  )