R/check_contrast.R

In savonliquide: Accessibility Toolbox for 'R' Users

#' Color Contrast Accessibility Report
#'
#' @description returns a report from the Contrast Checker API about color contrast for accessibility
#'
#' @param fg_col the Foreground Color
#' @param bg_col the Background Color
#'
#' @return Color Contrast Report
#' @export
#'
#' @examples
#'
#' check_contrast(fg_col = "#21EA06", bg_col = "#483D3D")
#'
#'




check_contrast <- function(fg_col, bg_col){

# We need to be sure that the user provide valid HEX colors
# here we focus on the minimum length (nchar) which is
# 4 if # is included or 3 if # is not included


if(grepl(pattern = "#", x = fg_col) && nchar(fg_col) < 4){

   stop("invalid color provided in fg_color, please use valid HEX colors")

}

if(!grepl(pattern = "#", x = fg_col) && nchar(fg_col) < 3){

   stop("invalid color provided in fg_color, few characters provided")

}


# Same stuff (copy and paste) for bg_col


if(grepl(pattern = "#", x = bg_col) && nchar(bg_col) < 4){

      stop("invalid color provided in bg_col, please use valid HEX colors")

}

if(!grepl(pattern = "#", x = bg_col) && nchar(bg_col) < 3){

      stop("invalid color provided in bg_col, few characters provided")

}


# The API doesn't take into account the # so let's remove it.

fg_col <- gsub(pattern = "#", replacement = "", x = fg_col)

bg_col <- gsub(pattern = "#", replacement = "", x = bg_col)



tryCatch(

  expr = {


   # Getting the response from the API. Here I use the glue package so that we
   # can interpolate the arguments (fg_col and bg_col) into the API call.


   response <-  httr::GET(glue::glue("https://webaim.org/resources/contrastchecker/?fcolor={fg_col}&bcolor={bg_col}&api"))


   # Now we need to parse the response
   text <- httr::content(response, as = "parsed", encoding = "UTF-8")


   # Now let's print the results of the contrast checker
   # in the form of a report. I'll use the glue package
   # in conjunction with crayon to print out a nice
   # formatted and colorized text output to the console.

   return(glue::glue("

* The Contrast Ratio is {crayon::bold(text$ratio)}

* The result for the AA check is : {if(text$AA == 'pass')
{{crayon::green('PASS')}} else {{crayon::red('FAIL')}}}

* The result for the AALarge check is : {if(text$AALarge == 'pass')
{{crayon::green('PASS')}} else {{crayon::red('FAIL')}}}

* The result for the AAA check is : {if(text$AAA == 'pass')
{{crayon::green('PASS')}} else {{crayon::red('FAIL')}}}

* The result for the AAALarge check is : {if(text$AAALarge == 'pass')
{{crayon::green('PASS')}} else {{crayon::red('FAIL')}}}

"

))},


  error = function(cond){

    # If there is an error, it would be cool to return the API response so that
    # the error can be investigated, right ?

    message(glue::glue("Error: here the API response status: {response$status_code}"))

    # in the case of an error, let's just return an NA so
    # that we don't break stuffs

    return(NA)

  }


)
}