Remove options.R, tool.R, units.R, utils.R

[adrbmdns]

Remove these files for now as I think we don't use it anymore, but I may need add a few functions back. Keeping a record here.

options.R

op.emend <- list(emend.model = model_ollama(.check_model_availability = FALSE),
               emend.language = "English")


#' @name emend_option
NULL

#' Get or set an option for the `emend` package
#'
#' @param x The name of the option to get or set.
#' @param val The value of the option to set.
#' @rdname emend_option
#' @export
emend_get_option <- function(x = c("model", "language", "all")) {
  x <- match.arg(x)
  if(x == "all") {
    op.emend
  } else {
    opt_name <- paste0("emend.", x)
    res <- getOption(opt_name)
    if(!is.null(res)) return(res)
    op.emend[[opt_name]]
  }
}


#' @rdname emend_option
#' @export
emend_set_option <- function(x = c("model", "language"), val) {
  x <- match.arg(x)
  args <- setNames(list(val), paste0("emend.", x))
  do.call(options, args)
}

#' @rdname emend_option
#' @export
emend_set_model <- function(val) {
  options(emend.model = val)
}

#' @rdname emend_option
#' @export
emend_set_model_args <- function(...) {
  args <- list(...)
  model <- getOption("emend.model") %||% op.emend[["emend.model"]]
    ifelse(is.null(res), op.emend[["emend.model"]], )
  for(nm in names(args)) model[[nm]] <- args[[nm]]
  options(emend.model = model)
}


#' @rdname emend_option
#' @export
emend_set_language <- function(val) {
  options(emend.language = val)
}

tool.R

# doesn't work!!

tool_prop <- function(description = "", type = "string", enum = NULL) {
  list(type = type, description = description, enum = enum)
}

tool_parameters <- function(...) {
  dots <- list(...)
  list(type = "object",
       properties = dots,
       required = names(dots))
}

tool_register <- function(name, description, parameters) {
  list(type = "function",
       `function` = list(name = name,
                         description = description,
                         parameters = parameters))
}

units.R

emend_standardise_units <- function(x, unit = "", ...) {
  emend_assist(c(list("Standardise the unit in {x*} to {unit}. If unknown, return NA. Return a vector."), list(...)), format = "json")[[1]]
}

utils.R

abort_if_not_single_text <- function(x, call = rlang::caller_env()) {
  if(!(is.character(x) & length(x) == 1)) cli::cli_abort("Please provide a single text only.", call = call)
}

abort_if_not_single_numeric <- function(x, call = rlang::caller_env()) {
  if(!(is.numeric(x) & length(x) == 1)) cli::cli_abort("Please provide a single number only.", call = call)
}

abort_if_not_text <- function(x, call = rlang::caller_env()) {
  if(!is.character(x)) cli::cli_abort("Please provide a single text only.", call = call)
}

abort_if_not_chr <- function(x, call = rlang::caller_env()) {
  if(!is.character(x) & !is.factor(x)) cli::cli_abort("Please provide a text only.", call = call)
}

# maybe below is not needed?
prompt_collapse <- function(x, sep = ", ") {
  paste0("[", paste0(x, collapse = sep), "]")
}

# as inspired by the glue doc
collapse_transformer <- function(regex) {
  function(text, envir) {
    collapse <- grepl(regex, text)
    if (collapse) {
      text <- sub(regex, "", text)
    }
    res <- glue::identity_transformer(text, envir)
    if (collapse) {
      paste0("[", glue::glue_collapse(paste0("'", res, "'"), sep = ", "), "]")
    } else {
      res
    }
  }
}

abort_if_model_not_available <- function(model, vendor, mlist, call = rlang::caller_env()) {
  if(!model %in% mlist) cli::cli_abort("The model {.var {model}} is not available from the vendor {.var {vendor}}.",
                                       call = call)
}



# Compatibility functions for `purrr`

map_mold <- function(.x, .f, .mold, ...) {
  out <- vapply(.x, .f, .mold, ..., USE.NAMES = FALSE)
  names(out) <- names(.x)
  out
}

map_chr <- function (.x, .f, ...) {
  map_mold(.x, .f, character(1), ...)
}

map_lgl <- function(.x, .f, ...) {
  map_mold(.x, .f, logical(1), ...)
}


`%||%` <- function(a, b) {
  if (!is.null(a)) a else b
}