R/ga_v4_objects.R

In MarkEdmondson1234/googleAnalyticsR: Google Analytics API into R

#' @importFrom methods setClass setClassUnion
NULL

#' Make a date object
#'
#' @keywords internal
#' @noRd
date_ga4 <- function(dvector){
  if(is.null(dvector)) return(NULL)

  assertthat::assert_that(length(dvector) == 2)

  dvector <- as.character(dvector)

  structure(
    list(startDate = dvector[1],
         endDate = dvector[2]),
    class = c("date_ga4","list")
  )
}


#' Make a dimension object
#'
#' @param vector A character vector of dimension names
#' @param histogramBuckets Optional named list of histogram buckets vectors
#'
#' @section histograms:
#'
#'  If supplying histogramBuckets, the name will be used to create the buckets
#'
#'  e.g. `dimensions = c("source", "medium")
#'             histogramBuckets = list(source = c(1,5,10,20,200),
#'                                    medium = c(0,7,14,21,999))
#'                                    `
#'
#'  Warning: only makes sense to apply to dimensions that are numeric e.g. ga:hour
#'
#' @keywords internal
#' @return a list suitable for parsing in req
#' @noRd
dimension_ga4 <- function(vector, histogramBuckets=NULL){
  
  if(is.null(vector)) return(NULL)

  assertthat::assert_that(is.character(vector))
  expect_null_or_type(histogramBuckets, "list")

  dimensions <- vapply(vector, checkPrefix, character(1), prefix="ga", USE.NAMES = FALSE)

  structure(
    lapply(dimensions, function(x) list(name = x,
                                        histogramBuckets =
                                          unname(histogramBuckets[gsub("ga:","",x)])
                                        )),
    class = "dim_ga4")

}

#' Make a metric object
#'
#' @param vector A character vector of GA metric names
#' @param metricFormat Optional same length character vector of formats
#'   for the API to return
#'
#' @keywords internal
#' @noRd
#' @return a list suitable for parsing in req
metric_ga4 <- function(vector, metricFormat=NULL){

  assertthat::assert_that(is.character(vector))

  ## dont do prefix check for unnamed metrics if any named
  if(!is.null(names(vector))){
    do_prefix_check <- vector[names(vector) == ""]
    ## metrics may have a named vector so USE.NAMES must be TRUE
    metrics <- vapply(do_prefix_check, checkPrefix, character(1), prefix="ga", USE.NAMES = TRUE)
    metrics <- c(vector[names(vector) != ""], metrics)
  } else {
    do_prefix_check <- vector
    ## metrics may have a named vector so USE.NAMES must be TRUE
    metrics <- vapply(do_prefix_check, checkPrefix, character(1), prefix="ga", USE.NAMES = TRUE)
  }
  
  metrics
  


  if(is.null(metricFormat)) metricFormat <- rep("METRIC_TYPE_UNSPECIFIED",
                                                length(metrics))

  assertthat::assert_that(any(metricFormat %in% c("METRIC_TYPE_UNSPECIFIED",
                                                  "INTEGER",
                                                  "FLOAT",
                                                  "CURRENCY",
                                                  "PERCENT",
                                                  "TIME")),
                          length(metricFormat) == length(metrics))

  metrics <- lapply(seq_along(metrics), function(x) {
    entry <- metrics[x]
    al <- if(any(nchar(names(entry)) > 0, !is.null(names(entry)))) names(entry) else NULL
    list(expression = unname(entry),
         alias = al,
         formattingType = metricFormat[x])
  })

  metrics <- rmNullObs(metrics)

  structure(
    metrics,
    class = "met_ga4")

}


#' Make an OrderType object
#'
#' @param field One field to sort by
#' @param sort_order ASCENDING or DESCENDING
#' @param orderType Type of ordering
#'
#' @return A order_type_ga4 object for use in GAv4 fetch
#'
#' @details For multiple order sorting, create separate OrderType objects to pass
#'
#' @export
order_type <- function(field,
                       sort_order = c("ASCENDING", "DESCENDING"),
                       orderType = c("VALUE",
                                     "DELTA",
                                     "SMART",
                                     "HISTOGRAM_BUCKET",
                                     "DIMENSION_AS_INTEGER")){
  
  sort_order <- match.arg(sort_order)
  orderType <- match.arg(orderType)
  
  assertthat::assert_that(length(field) == 1)

  field <- vapply(field, checkPrefix, character(1), prefix = "ga")

  structure(
    list(
      fieldName = field,
      orderType = orderType,
      sortOrder = sort_order
    ),
    class = "order_type_ga4"
  )
}

#' `dim_ga4` class.
#'
#' Dimension.
#'
#' @rdname dim_ga4-class
#' @keywords internal
#' @export
setClass("dim_ga4")

#' `met_ga4` class.
#'
#' Metric.
#'
#' @rdname met_ga4-class
#' @keywords internal
#' @export
setClass("met_ga4")

#' `order_type_ga4` class.
#'
#' Order type.
#'
#' @rdname order_type_ga4-class
#' @keywords internal
#' @export
setClass("order_type_ga4")

#' `dim_fil_ga4` class.
#'
#' Dimension filter.
#'
#' @rdname dim_fil_ga4-class
#' @keywords internal
#' @export
setClass("dim_fil_ga4")

#' `met_fil_ga4` class.
#'
#' Metric filter.
#'
#' @rdname met_fil_ga4-class
#' @keywords internal
#' @export
setClass("met_fil_ga4")

#' `.filter_clauses_ga4` class.
#'
#' Filter clauses class union.
#'
#' @rdname filter_clauses_ga4-class
#' @keywords internal
#' @export
setClassUnion(".filter_clauses_ga4", members = c("dim_fil_ga4", "met_fil_ga4"))

#' `segmentFilterClause_ga4` class.
#'
#' Segment filter clause.
#'
#' @rdname segmentFilterClause_ga4-class
#' @keywords internal
#' @export
setClass("segmentFilterClause_ga4")

#' `orFiltersForSegment_ga4` class.
#'
#' Or-filter for segment.
#'
#' @rdname orFiltersForSegment_ga4-class
#' @keywords internal
#' @export
setClass("orFiltersForSegment_ga4")

#' `segmentSequenceStep_ga4` class.
#'
#' Segment sequence step.
#'
#' @rdname segmentSequenceStep_ga4-class
#' @keywords internal
#' @export
setClass("segmentSequenceStep_ga4")

#' `simpleSegment_ga4` class.
#'
#' Simple segment.
#'
#' @rdname simpleSegment_ga4-class
#' @keywords internal
#' @export
setClass("simpleSegment_ga4")

#' `sequenceSegment_ga4` class.
#'
#' Sequence segment.
#'
#' @rdname sequenceSegment_ga4-class
#' @keywords internal
#' @export
setClass("sequenceSegment_ga4")

#' `segmentFilter_ga4` class.
#'
#' Segment filter.
#'
#' @rdname segmentFilter_ga4-class
#' @keywords internal
#' @export
setClass("segmentFilter_ga4")

#' `segmentDef_ga4` class.
#'
#' Segment definition.
#'
#' @rdname segmentDef_ga4-class
#' @keywords internal
#' @export
setClass("segmentDef_ga4")

#' `segment_ga4` class.
#'
#' Segments list.
#'
#' @rdname segment_ga4-class
#' @keywords internal
#' @export
setClass("segment_ga4")

#' `dynamicSegment_ga4` class.
#'
#' Dynamic Segment.
#'
#' @rdname dynamicSegment_ga4-class
#' @keywords internal
#' @export
setClass("dynamicSegment_ga4")