R/gtm_tbl_converters.R

Defines functions gtm_list_tags gtm_df_trigs gtm_df_vars

gtm_df_vars <- function(call_content) {

  #convert all into one table

  cc_tbl <- tibble()

  for (i in 1:length(call_content$variable)) {

  var <- call_content$variable[[i]]

  vartype <- var$type

  if (vartype == 'gas') {

    new_tbl <- gtm_var_gas(var) %>% gtm_var_missing()

  } else if (vartype == 'fup') {

    new_tbl <- gtm_var_fup(var)

  } else if (vartype == 'md') {

    new_tbl <- gtm_var_md(var)

  } else if (vartype == 'smm') {

    new_tbl <- gtm_var_lookup_tbl(var)

  } else {

    #should be revised as this only works on certain variable types, but this stops the function from breaking

    next()

  }

  cc_tbl <- bind_rows(cc_tbl,new_tbl)

  }

  return(cc_tbl)

}

gtm_df_trigs <-  function(call_content) {

  require(purrr)
  require(tidyverse)

  trigger_tbl <- tibble()

  for (i in 1:length(call_content$trigger)) {

    trigger <- call_content$trigger[[i]]

    if (trigger$type == 'always' & is_empty(trigger$filter) == FALSE) {

    filter_tbl <- tibble()

    for (i in 1:length(trigger$filter)) {

      new_tbl <- tibble(filter_arg0 = trigger$filter[[i]]$parameter[[1]]$value,
                        filter_type = trigger$filter[[i]]$type,
                        filter_arg1 = trigger$filter[[i]]$parameter[[2]]$value,
                        triggerId = trigger$triggerId
      )

      filter_tbl <- bind_rows(filter_tbl,new_tbl)

    }

    trigger$filter <- NULL

    filter_tbl <- as_tibble(trigger) %>%
      left_join(filter_tbl,by='triggerId')

    trigger_tbl <- bind_rows(trigger_tbl,filter_tbl)

    } else {

      trigger_tbl <- as_tibble(trigger) %>%
        bind_rows(trigger_tbl)

    }

  }

  trigger_tbl <- trigger_tbl %>%
    tidycols() %>%
    mutate(trigger_id = as.numeric(trigger_id)) %>%
    arrange(trigger_id)

    return(trigger_tbl)

}

gtm_list_tags <- function(call_content) {

  require(rlist)
  require(purrr)
  require(neugelbtools)
  require(tidyverse)

  tag_list <- list()

  for (i in 1:length(call_content$tag)) {

    single_tag <- call_content$tag[[i]]

    #set up the table for the firing triggers

    if (is_empty(single_tag$firingTriggerId) == FALSE) {

      firing_triggers <- do.call('bind_rows',map(single_tag$firingTriggerId,as_tibble)) %>%
        rename(firing_trigger_id = 1)

      } else {

      firing_triggers <- NULL

    }

    #set up the table for the blocking triggers

    if (is_empty(single_tag$blockingTriggerId) == FALSE) {

      blocking_triggers <- do.call('bind_rows',map(single_tag$blockingTriggerId,as_tibble)) %>%
        rename(blocking_trigger_id = 1)

    } else {

      blocking_triggers <- NULL

    }

    settings <- tibble(index = i)
    fields_to_set <- tibble()
    parameters <- tibble()

    params <- map(single_tag$parameter,paramsfunc)

    for (i in 1:length(params)) {

      y <- params[[i]]

      if (nrow(y) == 1 & ncol(y) == 1) {

        settings <- bind_cols(settings,y)

      } else if (names(y)[[1]] == 'fields_to_set') {

        fields_to_set <- bind_rows(fields_to_set,y)

      } else {

        parameters <- bind_rows(parameters,y)

      }

    }

    settings <- settings %>%
      select(-index)

    single_tag$firingTriggerId <- NULL
    single_tag$blockingTriggerId <- NULL
    single_tag$parameter <- NULL

    single_tag_values <- as_tibble(single_tag) %>%
      tidycols()

    parameter_list <- list(tag_metadata = single_tag_values,
                           tag_settings = settings,
                           tag_fields_to_set = fields_to_set,
                           tag_parameters = parameters,
                           tag_triggers = firing_triggers,
                           tag_blockers = blocking_triggers)

    tag_list <- list.append(tag_list,parameter_list)

  }

  return(tag_list)

}
neugelb/gtmr documentation built on June 25, 2020, 10:06 a.m.