R/TYPEDEF.R

In ReDaMoR: Relational Data Modeler

TYPETABLE <- list(
   MySQLWB=c(
      "^TINYINT([()].*[)])?$",    "TINYINT",    "logical",
      "^BIGINT([()].*[)])?$",     "BIGINT",     "integer",
      "^INT([()].*[)])?$",        "INT",        "integer",
      "^SMALLINT([()].*[)])?$",   "SMALLINT",   "integer",
      "^DOUBLE([()].*[)])?$",     "DOUBLE",     "numeric",
      "^FLOAT([()].*[)])?$",      "FLOAT",      "numeric",
      "^DECIMAL([()].*[)])?$",    "DECIMAL",    "numeric",
      "^VARCHAR([()].*[)])?$",    "VARCHAR",    "character",
      "^TEXT([()].*[)])?$",       "TEXT",       "character",
      "^TINYTEXT([()].*[)])?$",   "TINYTEXT",   "character",
      "^LONGTEXT([()].*[)])?$",   "LONGTEXT",   "character",
      "^MEDIUMTEXT([()].*[)])?$", "MEDIUMTEXT", "character",
      "^BLOB([()].*[)])?$",       "BLOB",       "base64",
      "^LONGBLOB([()].*[)])?$",   "LONGBLOB",   "base64",
      "^MEDIUMBLOB([()].*[)])?$", "MEDIUMBLOB", "base64",
      "^TINYBLOB([()].*[)])?$",   "TINYBLOB",   "base64",
      "^DATETIME([()].*[)])?$",   "DATETIME",   "POSIXct",
      "^DATE([()].*[)])?$",       "DATE",       "Date",
      "^ENUM([()].*[)])?$",       "ENUM",       "character",
      "^SET([()].*[)])?$",        "SET",        "character"
   ) %>%
      matrix(
         ncol=3, byrow=TRUE,
         dimnames=list(NULL, c("match", "inst", "R"))
      ) %>%
      dplyr::as_tibble(),
   ClickHouse=c(
      "Int32",           "Int32",           "integer",
      "Float64",         "Float64",         "numeric",
      "UInt8",           "UInt8",           "logical",
      "String",          "String",          "character",
      "Date",            "Date",            "Date",
      "DateTime",        "DateTime",        "POSIXct",
      "Array(String)",   "Array(String)",   "base64"
   ) %>%
      matrix(
         ncol=3, byrow=TRUE,
         dimnames=list(NULL, c("match", "inst", "R"))
      ) %>%
      dplyr::as_tibble()
)

###############################################################################@
#' Supported R types
#'
#' @export
#'
SUPPTYPES <- c(
   "integer", "numeric", "logical", "character", "Date", "POSIXct", "base64"
)

###############################################################################@
#' List supported types references
#'
#' @export
#'
list_type_ref <- function(){
   names(TYPETABLE)
}

###############################################################################@
#' Normalize type names
#'
#' @param x a character vector to normalize
#' @param typeRef a character vector of length one: the type
#' reference ([list_type_ref])
#' @param ignore.case should case be ignored (default: TRUE)
#'
#' @export
#'
norm_type_ref <- function(x, typeRef, ignore.case=TRUE){
   stopifnot(is.character(x))
   typeRef <- match.arg(typeRef, list_type_ref())
   ntypes <- unique(TYPETABLE[[typeRef]] %>% dplyr::pull("match"))
   toRet <- x
   for(nt in ntypes){
      toRet <- sub(
         nt,
         nt,
         toRet,
         ignore.case=ignore.case
      )
   }
   return(toRet)
}

###############################################################################@
#' Convert a set of types from or to R supported types
#'
#' @param x a character vector of types to be converted. If from is not null,
#' x should be a set of valid types in the from reference. If to is not null,
#' x should be a set of supported R types (SUPPTYPES).
#' @param from a character vector of length one: the type reference
#' ([list_type_ref]) of x
#' @param to a character vector of length one: the targeted type reference
#' ([list_type_ref])
#' @param ignore.case should case be ignored when converting `from``
#' type reference (default: TRUE)
#'
#' @details Only `from` XOR `to` should be set
#'
#' @export
#'
conv_type_ref <- function(x, from=NULL, to=NULL, ignore.case=TRUE){
   stopifnot(
      !is.null(from) | !is.null(to),
      is.null(from) | is.null(to)
   )
   if(!is.null(from)){
      r <- match.arg(from, list_type_ref())
      ct <- TYPETABLE[[r]]
      x <- norm_type_ref(x, from, ignore.case=ignore.case)
      notSupported <- setdiff(x, ct %>% dplyr::pull("match"))
      if(length(notSupported)>0){
         stop(paste(
            sprintf("The following types are not supported %s types:", r),
            paste(notSupported, collapse=", ")
         ))
      }
      toRet <- ct %>% dplyr::slice(match(x, .data$match)) %>% dplyr::pull("R")
   }
   if(!is.null(to)){
      r <- match.arg(to, list_type_ref())
      ct <- TYPETABLE[[r]]
      check_types(x)
      toRet <- ct %>% dplyr::slice(match(x, .data$R)) %>% dplyr::pull("inst")
   }
   return(toRet)
}

###############################################################################@
#' Check if a set of types is supported
#'
#' @param x a character vector of types to be checked
#'
#' @export
#'
check_types <- function(x){
   stopifnot(is.character(x))
   notSupported <- setdiff(x, SUPPTYPES)
   if(length(notSupported)>0){
      stop(paste(
         "The following types are not supported:",
         paste(notSupported, collapse=", ")
      ))
   }
}

###############################################################################@
#' Convert an object into a specific type
#'
#' @param x an object to convert
#' @param type the targeted type
#'
#' @export
#'
as_type <- function(x, type){
   type <- match.arg(type, SUPPTYPES)
   return(switch(
      type,
      "integer"=as.integer(x),
      "numeric"=as.numeric(x),
      "logical"=as.logical(x),
      "character"=as.character(x),
      "Date"=as.Date(x),
      "POSIXct"=as.POSIXct(x),
      "base64"=if(length(x)==0){
         character(0)
      }else{
         unlist(lapply(x, function(y){
            if(length(y)==0 || (length(y)==1 && is.na(y))){
               return(NA)
            }else{
               paste(y, collapse="")
            }
         }))
      }
   ))
}