#' @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")
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.