Revamp streaming

DESCRIPTION

@@ -36,6 +36,7 @@ Imports:
     tokenizers,
     tools,
     urltools,
+    vctrs,
     xml2,
     yaml
 Suggests: 

NAMESPACE

@@ -1,8 +1,12 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(as_gpttools_message,default)
+S3method(print,chat_list)
+S3method(print,gpttools_message)
 export(add_roxygen_addin)
 export(addin_run_scrape_pkgs)
 export(addin_run_select_pkgs)
+export(as_gpttools_message)
 export(chat)
 export(chat_with_context)
 export(chat_with_retrieval)
@@ -20,6 +24,7 @@ export(get_selection)
 export(get_transformer_model)
 export(ghost_chat)
 export(ghost_writer)
+export(ghost_writer_addin)
 export(gpt_sitrep)
 export(gpttools_index_all_scraped_data)
 export(ingest_pdf)
@@ -41,11 +46,21 @@ export(script_to_function_addin)
 export(set_user_config)
 export(suggest_unit_test_addin)
 export(transcribe_audio)
+export(vec_cast.gpttools_message.data.frame)
+export(vec_ptype_abbr.gpttools_message)
+export(vec_ptype_full.gpttools_message)
 import(cli)
 import(httr2)
 import(rlang)
+import(stringr)
 importFrom(glue,glue)
 importFrom(graphics,text)
+importFrom(jsonlite,fromJSON)
+importFrom(purrr,compact)
+importFrom(purrr,map)
+importFrom(purrr,map_chr)
+importFrom(purrr,map_dfr)
+importFrom(purrr,pluck)
 importFrom(utils,globalVariables)
 importFrom(utils,head)
 importFrom(utils,installed.packages)

R/addin_copilot.R

@@ -3,11 +3,11 @@
 #'
 #' @export
 copilot_addin <- function() {
-  cli::cli_alert_info("Attempting to add code suggestions")
+  cli_alert_info("Attempting to add code suggestions")
   ghost_chat(
     service = getOption("gpttools.service", "openai"),
     stream  = TRUE,
     where   = "source"
   )
-  cli::cli_alert_info("Done adding code suggestion")
+  cli_alert_info("Done adding code suggestion")
 }

R/chat.R

@@ -240,7 +240,6 @@ get_cursor_context <- function(context_lines = 20,
   } else {
     file_ext <- doc$path |> tools::file_ext()
   }
-
   list(
     above    = context_above,
     below    = context_below,

R/class-message.R

@@ -0,0 +1,106 @@
+new_gpttools_message <- function(role = character(),
+                                 content = character(),
+                                 datetime = character(),
+                                 model = character(),
+                                 service = character(),
+                                 temperature = double()) {
+  if (!is_character(role)) cli_abort("`role` must be a character vector.")
+  if (!is_character(content)) cli_abort("`content` must be a character vector.")
+  if (!is_character(datetime, n = 1)) {
+    cli_abort("`datetime` must be a character vector of length 1.")
+  }
+  if (!is_character(model, n = 1)) {
+    cli_abort("`model` must be a character vector of length 1.")
+  }
+  if (!is_character(service, n = 1)) {
+    cli_abort("`service` must be a character vector of length 1")
+  }
+  if (!is_double(temperature, n = 1)) {
+    cli_abort("`temperature` must be a numeric vector of length 1.")
+  }
+
+  new_rcrd(
+    fields =
+      tibble::tibble(
+        role = role,
+        content = content,
+      ),
+    datetime = datetime,
+    model = model,
+    service = service,
+    temperature = temperature,
+    class = "gpttools_message"
+  )
+}
+
+gpttools_message <- function(role = character(),
+                             content = character(),
+                             datetime = character(),
+                             model = character(),
+                             service = character(),
+                             temperature = double()) {
+  role <- vec_cast(role, character())
+  content <- vec_cast(content, character())
+  datetime <- vec_cast(datetime, character())
+  model <- vec_cast(model, character())
+  service <- vec_cast(service, character())
+  temperature <- vec_cast(temperature, double())
+
+  new_gpttools_message(role, content, datetime, model, service, temperature)
+}
+
+#' @export
+print.gpttools_message <- function(x, ...) {
+  x_valid <- which(!is.na(x))
+
+  role <- field(x, "role")[x_valid]
+  content <- field(x, "content")[x_valid]
+  datetime <- attr(x, "datetime")
+  model <- attr(x, "model")
+  service <- attr(x, "service")
+  temperature <- attr(x, "temperature")
+
+  n <- length(field(x, "role"))
+  for (i in seq_len(n)) {
+    writeLines(col_silver(rule(stringr::str_to_title(role[i]))))
+    writeLines(content[i])
+  }
+  writeLines(rule("Settings", col = "blue"))
+  writeLines(col_blue(paste0("date: ", unique(datetime))))
+  writeLines(col_blue(paste0("model: ", unique(model))))
+  writeLines(col_blue(paste0("service: ", unique(service))))
+  writeLines(col_blue(paste0("temperature: ", unique(temperature))))
+  invisible(x)
+}
+
+#' @export
+vec_ptype_full.gpttools_message <- function(x, ...) "gpttools_message"
+
+#' @export
+vec_ptype_abbr.gpttools_message <- function(x, ...) "msg"
+
+#' @export
+as_gpttools_message <- function(x, ...) {
+  UseMethod("as_gpttools_message")
+}
+
+#' @export
+as_gpttools_message.default <- function(x, ...) {
+  vec_cast(x, "gpttools_message")
+}
+
+#' @export
+vec_cast.gpttools_message.data.frame <- function(x, to, ...) {
+  if (to == "data.frame") {
+    tibble::tibble(
+      role        = field(x, "role"),
+      content     = field(x, "content"),
+      datetime    = attr(x, "datetime"),
+      model       = attr(x, "model"),
+      service     = attr(x, "service"),
+      temperature = attr(x, "temperature")
+    )
+  } else {
+    cli_abort("Can't cast gpttools_message to ", to)
+  }
+}

R/document_data.R

@@ -7,13 +7,13 @@
 #' @export
 collect_dataframes <- function() {
   objects <- names(rlang::global_env())
-  purrr::map_chr(
+  map_chr(
     .x = objects,
     .f = \(x) {
       if (is.data.frame(get(x))) x else NA
     }
   ) |>
-    purrr::compact() |>
+    compact() |>
     unlist()
 }
 
@@ -32,7 +32,7 @@ skim_lite <- function(data) {
 }
 
 collect_column_types <- function(data) {
-  purrr::map_dfr(
+  map_dfr(
     names(data),
     ~ data.frame(
       column = .x,

R/embedding.R

@@ -34,7 +34,7 @@ prepare_scraped_files <- function(domain) {
 
   scraped |>
     dplyr::mutate(
-      chunks = purrr::map(text, \(x) {
+      chunks = map(text, \(x) {
         chunk_with_overlap(x,
           chunk_size = 500,
           overlap_size = 50,
@@ -97,7 +97,7 @@ add_embeddings <- function(index,
     model <- get_transformer_model()
     index |>
       dplyr::mutate(
-        embeddings = purrr::map(
+        embeddings = map(
           .x = chunks,
           .f = \(x) create_text_embeddings(x, model),
           .progress = "Creating Embeddings Locally"
@@ -108,7 +108,7 @@ add_embeddings <- function(index,
   } else {
     index |>
       dplyr::mutate(
-        embeddings = purrr::map(
+        embeddings = map(
           .x = chunks,
           .f = create_openai_embedding,
           .progress = "Create Embeddings"
@@ -227,7 +227,7 @@ get_top_matches <- function(index, query_embedding, k = 5) {
   index |>
     tibble::as_tibble() |>
     dplyr::mutate(
-      similarity = purrr::map_dbl(embedding, \(x) {
+      similarity = map_dbl(embedding, \(x) {
         lsa::cosine(query_embedding, unlist(x))
       })
     ) |>
@@ -262,6 +262,6 @@ chunk_with_overlap <- function(x, chunk_size, overlap_size, doc_id, ...) {
   } else {
     names(chunks) <- NULL
   }
-  chunks <- purrr::compact(chunks)
-  purrr::map(chunks, \(x) stringr::str_c(x, collapse = " "))
+  chunks <- compact(chunks)
+  map(chunks, \(x) stringr::str_c(x, collapse = " "))
 }

R/gpt-query.R

@@ -40,7 +40,7 @@ gpt_chat <- function(instructions,
   cli_inform("Model: {model}")
   cli_inform("Sending query... this can take up to 3 minutes.")
   simple_prompt <- prompt |>
-    purrr::map_chr(.f = "content") |>
+    map_chr(.f = "content") |>
     paste(collapse = "\n\n")
 
   answer <- chat(

R/gpttools-package.R

@@ -2,10 +2,12 @@
 "_PACKAGE"
 
 ## usethis namespace: start
-#' @import cli
 #' @import rlang
 #' @importFrom glue glue
 #' @import httr2
+#' @import cli
+#' @import stringr
+#' @importFrom purrr map_dfr map_chr pluck compact map
 #' @importFrom utils globalVariables head installed.packages old.packages
 #' packageDescription packageVersion
 #' @importFrom graphics text

R/harvest-docs.R

@@ -77,12 +77,12 @@ recursive_hyperlinks <- function(local_domain,
 
   expanded_urls <- c(expanded_urls, links)
   cli_inform(c("i" = "Total urls: {length(expanded_urls)}"))
-  links_df <- purrr::map(links, get_hyperlinks,
+  links_df <- map(links, get_hyperlinks,
     .progress = "Getting more links"
   ) |>
     dplyr::bind_rows() |>
     dplyr::filter(!stringr::str_detect(link, "^\\.$|mailto:|\\#|^\\_$")) |>
-    dplyr::mutate(link = purrr::map2_chr(
+    dplyr::mutate(link = map2_chr(
       .x = parent,
       .y = link,
       .f = \(x, y) xml2::url_absolute(y, x)
@@ -91,7 +91,7 @@ recursive_hyperlinks <- function(local_domain,
   cli_inform("Going to check {length(unique(links_df$link))} links")
 
   new_links <-
-    purrr::map(unique(links_df$link), \(x) {
+    map(unique(links_df$link), \(x) {
       if (rlang::is_true(stringr::str_detect(x, domain_pattern))) {
         validate_link(x)
       } else {
@@ -239,7 +239,7 @@ scrape_and_process <- function(url,
     unique()
   cli_inform(c("i" = "Scraping validated links"))
   scraped_data <-
-    purrr::map(links, \(x) {
+    map(links, \(x) {
       if (identical(check_url(x), 200L)) {
         tibble::tibble(
           source  = local_domain,
@@ -322,11 +322,11 @@ extract_text <- function(url, use_html_text2 = TRUE) {
   )
 
   xpath_tags <- exclude_tags |>
-    purrr::map_chr(.f = \(x) glue::glue("self::{x}")) |>
+    map_chr(.f = \(x) glue::glue("self::{x}")) |>
     stringr::str_c(collapse = " or ")
 
   xpath_attributes <- exclude_attributes |>
-    purrr::map_chr(.f = \(x) {
+    map_chr(.f = \(x) {
       glue::glue(
         "contains(concat(' ', normalize-space(@class), ' '), ' {x}')"
       )
@@ -336,7 +336,7 @@ extract_text <- function(url, use_html_text2 = TRUE) {
   # Handling general attribute selectors
   general_attributes <- c("role", "aria-", "data-", "id", "class", "style")
   xpath_general_attributes <- general_attributes |>
-    purrr::map_chr(.f = \(x) glue::glue("@{x}")) |>
+    map_chr(.f = \(x) glue::glue("@{x}")) |>
     stringr::str_c(collapse = " or ")
 
   xpath_combined <- xpath_combined <- glue::glue(

R/history.R

@@ -58,7 +58,7 @@ delete_history <- function(local = FALSE) {
   }
   history_files <- get_history_path(local = local)
 
-  purrr::map(history_files, \(x) {
+  map(history_files, \(x) {
     delete_file <- ui_yeah("Do you want to delete {basename(x)}?")
     if (delete_file) {
       file.remove(x)
@@ -246,7 +246,7 @@ chat_with_context <- function(query,
     context <-
       full_context |>
       dplyr::select(source, link, chunks) |>
-      purrr::pmap(\(source, link, chunks) {
+      pmap(\(source, link, chunks) {
         glue::glue("Source: {source}
                    Link: {link}
                    Text: {chunks}")
@@ -331,7 +331,7 @@ chat_with_context <- function(query,
   )
 
   session_history <-
-    purrr::map(session_history, \(x) {
+    map(session_history, \(x) {
       if (x$role == "system") {
         NULL
       } else if (stringr::str_detect(
@@ -344,7 +344,7 @@ chat_with_context <- function(query,
         x
       }
     }) |>
-    purrr::compact()
+    compact()
 
   prompt <- c(
     session_history,
@@ -354,7 +354,7 @@ chat_with_context <- function(query,
   )
 
   simple_prompt <- prompt |>
-    purrr::map_chr(.f = "content") |>
+    map_chr(.f = "content") |>
     paste(collapse = "\n\n")
 
   cli_alert_info("Service: {service}")
@@ -390,7 +390,7 @@ chat_with_context <- function(query,
   }
 
   if (save_history) {
-    purrr::map(prompt, \(x) {
+    map(prompt, \(x) {
       save_user_history(
         file_name = history_name,
         role      = "system",

R/index.R

@@ -37,7 +37,7 @@ gpttools_index_all_scraped_data <- function(overwrite = FALSE,
                                             dont_ask = TRUE) {
   text_files <- list_index("text", full_path = TRUE)
 
-  purrr::walk(text_files, function(file_path) {
+  walk(text_files, function(file_path) {
     domain <- tools::file_path_sans_ext(basename(file_path))
     cli_alert_info(glue("Creating/updating index for domain {domain}..."))
     create_index(