## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup--------------------------------------------------------------------
library(stbl)

## -----------------------------------------------------------------------------
register_user <- function(username,
                          email_address,
                          age,
                          is_premium_member,
                          interests) {
  # Imagine this is a slow API call, rather than simply returning the list()
  list(
    username = username,
    email_address = email_address,
    age = age,
    is_premium_member = is_premium_member,
    interests = interests
  )
}

## -----------------------------------------------------------------------------
register_user <- function(username,
                          email_address,
                          age,
                          is_premium_member,
                          interests) {
  interests <- to_chr(interests)

  list(
    username = username,
    email_address = email_address,
    age = age,
    is_premium_member = is_premium_member,
    interests = interests
  )
}

## -----------------------------------------------------------------------------
register_user(
  username = "test_user", 
  email_address = "test@example.com", 
  age = 42, 
  is_premium_member = TRUE, 
  interests = c("R", "hiking")    # Note that this is already a character vector
) |> 
  # Note: Throughout this article, we pipe the result into `str()` to make it
  # easier to see the differences.
  str()

## -----------------------------------------------------------------------------
register_user(
  username = "test_user", 
  email_address = "test@example.com", 
  age = 42, 
  is_premium_member = TRUE, 
  # This is a list, but becomes a character vector
  interests = list("R", "hiking") 
) |> str()

## ----error = TRUE-------------------------------------------------------------
try({
# Fails because the list contains a function, which is not character-like.
register_user(
  username = "test_user", 
  email_address = "test@example.com", 
  age = 42, 
  is_premium_member = TRUE, 
  interests = list("R", mean)
)
})

## -----------------------------------------------------------------------------
register_user <- function(username,
                          email_address,
                          age,
                          is_premium_member,
                          interests) {
  interests <- to_chr(interests)
  age <- to_int_scalar(age)
  is_premium_member <- to_lgl_scalar(is_premium_member)

  list(
    username = username,
    email_address = email_address,
    age = age,
    is_premium_member = is_premium_member,
    interests = interests
  )
}

## -----------------------------------------------------------------------------
register_user(
  username = "test_user", 
  email_address = "test@example.com", 
  age = "42",                 # Coercible to integer
  is_premium_member = "True", # Coercible to logical
  interests = c("R", "hiking")
) |> str()

## ----error = TRUE-------------------------------------------------------------
try({
register_user(
  username = "test_user", 
  email_address = "test@example.com", 
  age = c(30, 31),            # Not a single value
  is_premium_member = TRUE, 
  interests = c("R", "hiking")
)
})

## ----error = TRUE-------------------------------------------------------------
try({
register_user(
  username = "test_user", 
  email_address = "test@example.com", 
  age = "forty-two",          # Not coercible to integer
  is_premium_member = TRUE, 
  interests = c("R", "hiking")
)
})

## -----------------------------------------------------------------------------
register_user <- function(username,
                          email_address,
                          age,
                          is_premium_member,
                          interests) {
  # Simple checks.
  interests <- to_chr(interests)
  age <- to_int_scalar(age)
  is_premium_member <- to_lgl_scalar(is_premium_member)

  # Make sure the username is a length-1 character vector without any spaces,
  # tabs, or newlines. "\\s" means "any space character".
  space_regex <- c("must not contain spaces" = "\\s")
  attr(space_regex, "negate") <- TRUE
  username <- stabilize_chr_scalar(
    username,
    regex = space_regex
  )

  # The email address has to have the pattern "*@*.*". Or, in regex, "^" (start
  # of string), "[...]+" (one or more of any character in the brackets), "@"
  # (the at sign), "[...]+" (one or more of any character in the brackets),
  # "\\." (a literal period), "[...]{2,}" (two or more of any character in the
  # brackets), "$" (end of string).
  email_regex <- "^[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\\.[a-zA-Z]{2,}$"
  email_address <- stabilize_chr_scalar(
    email_address,
    regex = c("must be a valid email address" = email_regex)
  )

  list(
    username = username,
    email_address = email_address,
    age = age,
    is_premium_member = is_premium_member,
    interests = interests
  )
}

## -----------------------------------------------------------------------------
register_user(
  username = "test_user", 
  email_address = "test@example.com", 
  age = 42, 
  is_premium_member = TRUE, 
  interests = c("R", "hiking")
) |> str()

## ----error = TRUE-------------------------------------------------------------
try({
register_user(
  username = "test user", 
  email_address = "test@example.com", 
  age = 42, 
  is_premium_member = TRUE, 
  interests = c("R", "hiking")
)
})

## ----error = TRUE-------------------------------------------------------------
try({
register_user(
  username = "test_user", 
  email_address = "not-a-valid-email", 
  age = 42, 
  is_premium_member = TRUE, 
  interests = c("R", "hiking")
)
})

