Inspired by rust and haskell.

experiments_with_binary_operators.R

# getUser cfg =
#   lookup "username" cfg >>= \uname ->
#   lookup "age" cfg >>= \ageStr ->
#   readMaybe (trim ageStr) >>= \age ->
#   lookup "email" cfg >>= \emailRaw ->
#   validateEmail (trim emailRaw) >>= \email ->
#   Just (User uname age email)

# 1. Using atomic vectors -----

library(rlang)
library(purrr)
library(tibble)

# A binary operator that applies a function to its input only if the input 
# is not NULL. If the input (mval) is NULL, it returns NULL immediately
`%ifset%` <- function(mval, f) if (is.null(mval)) NULL else f(mval)

get_valid_integer <- function(s) {
  s_trimmed <- trimws(s)
  val <- suppressWarnings(as.integer(s_trimmed))
  if (is.na(val)) NULL else val
}

get_valid_email <- function(email) {
  if (grepl("@", email)) trimws(email) else NULL
}

get_user <- function(cfg) {
  cfg[["username"]] %ifset% \(uname)
  cfg[["age"]]  %ifset% \(ageStr)  
  get_valid_integer(ageStr) %ifset% \(age)
  cfg[["email"]]  %ifset% \(emailRaw)  
  get_valid_email(emailRaw) %ifset% \(email)
  list(username = uname, age = age, email = email)
}

config <- list(
  username = "Alice",
  age = "30",
  email = "[email protected]"
)
get_user(config) 
# $username
# [1] "Alice"
# 
# $age
# [1] 30
# 
# $email
# [1] "[email protected]"

bad_email_config <- list(
   username = "Alice",
   age = "30",
   email = "no-at-symbol"
)
get_user(bad_email_config)
# NULL

bad_age_config <- list(
  username = "Alice",
  age = "age",
  email = "[email protected]"
)
get_user(bad_age_config)
# NULL


# 2. Using vectors or lists -----

# Wrap the raw value into container
wrap_value <- function(x) {
  if (is.null(x)) list() else list(x)
}

# A binary operator that takes a scalar, vector, or list as LHS and a 
# non-vectorized function as RHS. It applies the function to each element 
# if the LHS is a vector or list, returns NULL immediately if the LHS is NULL,
# and flattens the results by one level if the LHS is a list.
`%and_then%` <- function(mval, f) {
  if (is.null(mval)) {
    NULL
  } else if (is.list(mval) || (is.vector(mval) && length(mval) > 1)) {
    unlist(lapply(mval, f), recursive = FALSE, use.names = TRUE)
  } else {
    f(mval)
  }
}

get_valid_integer <- function(s) {
  s_trimmed <- trimws(s)
  val <- suppressWarnings(as.integer(s_trimmed))
  if (is.na(val)) list() else list(val)
}

get_valid_email <- function(email) {
  if (grepl("@", email)) list(trimws(email)) else list()
}

get_user <- function(cfg) {
  wrap_value(cfg[["username"]]) %and_then% \(uname) {
    wrap_value(cfg[["age"]]) %and_then% \(ageStr) {
      get_valid_integer(ageStr) %and_then% \(age) {
        wrap_value(cfg[["email"]]) %and_then% \(emailRaw) {
          get_valid_email(emailRaw) %and_then% \(email) {
            list(username = uname, age = age, email = email)
          }
        }
      }
    }
  }
}


config <- list(
  username = "Alice",
  age = "30",
  email = "[email protected]"
)
get_user(config) 
# $username
# [1] "Alice"
# 
# $age
# [1] 30
# 
# $email
# [1] "[email protected]"

bad_email_config <- list(
   username = "Alice",
   age = "30",
   email = "no-at-symbol"
)
get_user(bad_email_config)
# NULL

bad_age_config <- list(
  username = "Alice",
  age = "age",
  email = "[email protected]"
)
get_user(bad_age_config)
# NULL


get_user <- function(cfg) {
  cfg[["username"]] %and_then% \(uname)
  cfg[["age"]]  %and_then% \(ageStr)  
  get_valid_integer(ageStr) %and_then% \(age)
  cfg[["email"]]  %and_then% \(emailRaw)  
  get_valid_email(emailRaw) %and_then% \(email)
  list(username = uname, age = age, email = email)
}

config <- list(
  username = "Alice",
  age = "30",
  email = "[email protected]"
)
get_user(config) 
# $username
# [1] "Alice"
# 
# $age
# [1] 30
# 
# $email
# [1] "[email protected]"

bad_email_config <- list(
   username = "Alice",
   age = "30",
   email = "no-at-symbol"
)
get_user(bad_email_config)
# NULL

bad_age_config <- list(
  username = "Alice",
  age = "age",
  email = "[email protected]"
)
get_user(bad_age_config)
# NULL# getUser cfg =
#   lookup "username" cfg >>= \uname ->
#   lookup "age" cfg >>= \ageStr ->
#   readMaybe (trim ageStr) >>= \age ->
#   lookup "email" cfg >>= \emailRaw ->
#   validateEmail (trim emailRaw) >>= \email ->
#   Just (User uname age email)

library(rlang)
library(purrr)
library(tibble)

`%and_then%` <- function(mval, f) if (is.null(mval)) NULL else f(mval)

get_valid_integer <- function(s) {
  s_trimmed <- trimws(s)
  val <- suppressWarnings(as.integer(s_trimmed))
  if (is.na(val)) NULL else val
}

get_valid_email <- function(email) {
  if (grepl("@", email)) trimws(email) else NULL
}

get_user <- function(cfg) {
  cfg[["username"]] %and_then% \(uname)
  cfg[["age"]]  %and_then% \(ageStr)  
  get_valid_integer(ageStr) %and_then% \(age)
  cfg[["email"]]  %and_then% \(emailRaw)  
  get_valid_email(emailRaw) %and_then% \(email)
  list(username = uname, age = age, email = email)
}

config <- list(
  username = "Alice",
  age = "30",
  email = "[email protected]"
)
get_user(config) 
# $username
# [1] "Alice"
# 
# $age
# [1] 30
# 
# $email
# [1] "[email protected]"

bad_email_config <- list(
   username = "Alice",
   age = "30",
   email = "no-at-symbol"
)
get_user(bad_email_config)
# NULL

bad_age_config <- list(
  username = "Alice",
  age = "age",
  email = "[email protected]"
)
get_user(bad_age_config)
# NULL


# 3. Take a list with some character values and return a integer vector with some NAs  -----

library(rlang)
library(purrr)
library(tibble)
library(testthat)

# OCaml distinguishes:
# None — global absence (NULL)
# [] — empty list
# Some x or None — optional elements in a list

# Haskell has:
# Nothing — global absence
# [] — empty list
# Maybe a — optional value inside a list

# Rust has:
# None — like NULL
# Vec<Option<String>> — list of possibly-missing strings

`%wrap_chr_int%` <- function(mval, f) {
  if (is.null(mval)) return(NULL)
  map_int(mval, function(x) {
    if (is.character(x) && length(x) == 1 && !is.na(x)) {
      result <- f(x)
      if (is.integer(result) && length(result) == 1 && !is.na(result)) {
        result
      } else {
        NA_integer_
      }
    } else {
      NA_integer_
    }
  })
}

test_that("wrap_chr_int handles the input of some character values in a list and teturns an integer vector", {
  expect_null(NULL %wrap_chr_int% \(x) x)
  expect_equal(character(0) %wrap_chr_int% \(x) x, integer(0))
  expect_equal(NA_character_ %wrap_chr_int% \(x) x, NA_integer_)
  expect_equal(c("scalar") %wrap_chr_int% \(x) x, NA_integer_)
  expect_equal(c("character", "vector") %wrap_chr_int% \(x) x, c(NA_integer_, NA_integer_))
  expect_equal(list("has", 2, "types") %wrap_chr_int% \(x) x, c(NA_integer_, NA_integer_, NA_integer_))
})


`%if_int%` <- function(mval, f) {
  if (is.null(mval)){
    return(NULL)
  } else {
    if(length(mval) > 1 || !is.integer(mval) || is.na(mval)) {
      NA_integer_
    } else {
      f(mval)
    }
  }
}

options(
  example_foo = 1L,
  example_bad = "error",
  example_bar = 2L
)
list("example_foo", 1, "example_bad", "example_bar") %wrap_chr_int%
  \(option_chr) getOption(option_chr) %if_int% 
  \(option_int) option_int + 1L
# [1]  2 NA NA  3


test_that("%if_int% handles NULL input", {
  expect_null(NULL %if_int% \(x) x + 1L)
})

test_that("%if_int% handles scalar valid integer", {
  expect_equal(1L %if_int% \(x) x + 1L, 2L)
  expect_equal(0L %if_int% \(x) x + 10L, 10L)
})

test_that("%if_int% handles NA_integer_ correctly", {
  expect_equal(NA_integer_ %if_int% \(x) x + 1L, NA_integer_)
})

test_that("%if_int% rejects non-integer types", {
  expect_equal("string" %if_int% \(x) x + 1L, NA_integer_)
  expect_equal(1.5 %if_int% \(x) x + 1L, NA_integer_)
  expect_equal(TRUE %if_int% \(x) x + 1L, NA_integer_)
  expect_equal(list(1L) %if_int% \(x) x + 1L, NA_integer_)
})

test_that("%if_int% rejects vectors of length > 1", {
  expect_equal(c(1L, 2L) %if_int% \(x) x + 1L, NA_integer_)
  expect_equal(c(NA_integer_, 1L) %if_int% \(x) x + 1L, NA_integer_)
})


test_that("wrap_chr_int + %if_int% integrates correctly with options", {
  options(
    example_foo = 1L,
    example_bad = "error",
    example_bar = 2L
  )

  input <- list("example_foo", 1, "example_bad", "example_bar")
  result <- input %wrap_chr_int% \(option_name) {
    getOption(option_name) %if_int% \(i) i + 1L
  }

  expect_equal(result, c(2L, NA_integer_, NA_integer_, 3L))
})