Add contents_*() helper functions (#170)

Fixes #167

NAMESPACE

@@ -24,6 +24,9 @@ export(chat_perplexity)
 export(content_image_file)
 export(content_image_plot)
 export(content_image_url)
+export(contents_html)
+export(contents_markdown)
+export(contents_text)
 export(cortex_credentials)
 export(create_tool_def)
 export(interpolate)

R/chat.R

@@ -452,3 +452,21 @@ print.Chat <- function(x, ...) {
 
   invisible(x)
 }
+
+method(contents_markdown, new_S3_class("Chat")) <- function(content, heading_level = 2) {
+  turns <- content$get_turns()
+  if (length(turns) == 0) {
+    return("")
+  }
+
+  hh <- strrep("#", heading_level)
+
+  res <- vector("character", length(turns))
+  for (i in seq_along(res)) {
+    role <- turns[[i]]@role
+    substr(role, 0, 1) <- toupper(substr(role, 0, 1))
+    res[i] <- glue::glue("{hh} {role}\n\n{contents_markdown(turns[[i]])}")
+  }
+
+  paste(res, collapse="\n\n")
+}

R/content.R

@@ -1,6 +1,54 @@
 #' @include utils-S7.R
 NULL
 
+#' Format contents into a textual representation
+#' 
+#' @description
+#' These generic functions can be use to convert [Turn] contents or [Content]
+#' objects into textual representations. 
+#' 
+#' * `contents_text()` is the most minimal and only includes [ContentText]
+#'   objects in the output.
+#' * `contents_markdown()` returns the text content (which it assumes to be
+#'   markdown and does not convert it) plus markdown representations of images
+#'   and other content types.
+#' * `contents_html()` returns the text content, converted from markdown to
+#'   HTML with [commonmark::markdown_html()], plus HTML representations of
+#'   images and other content types.
+#' 
+#' @examples
+#' turns <- list(
+#'   Turn("user", contents = list(
+#'     ContentText("What's this image?"),
+#'     content_image_url("https://placehold.co/200x200")
+#'   )),
+#'   Turn("assistant", "It's a placeholder image.")
+#' )
+#'
+#' lapply(turns, contents_text)
+#' lapply(turns, contents_markdown)
+#' if (rlang::is_installed("commonmark")) {
+#'   contents_html(turns[[1]])
+#' }
+#' 
+#' @param content The [Turn] or [Content] object to be converted into text.
+#'   `contents_markdown()` also accepts [Chat] instances to turn the entire
+#'   conversation history into markdown text.
+#' @param ... Additional arguments passed to methods.
+#' 
+#' @return A string of text, markdown or HTML.
+#' @export
+contents_text <- new_generic("contents_text", "content")
+
+#' @rdname contents_text
+#' @export
+contents_html <- new_generic("contents_html", "content")
+
+#' @rdname contents_text
+#' @export
+contents_markdown <- new_generic("contents_markdown", "content")
+
+
 #' Content types received from and sent to a chatbot
 #'
 #' @description
@@ -24,6 +72,19 @@ NULL
 #' @export
 Content <- new_class("Content")
 
+method(contents_text, Content) <- function(content) {
+  NULL
+}
+
+method(contents_markdown, Content) <- function(content) {
+  # Fall back to text representation in markdown
+  contents_text(content)
+}
+
+method(contents_html, Content) <- function(content) {
+  NULL
+}
+
 #' @rdname Content
 #' @export
 #' @param text A single string.
@@ -36,14 +97,16 @@ method(format, ContentText) <- function(x, ...) {
   paste0(unlist(strwrap(x@text, width = getOption("width"))), collapse = "\n")
 }
 
-# Internal generic for content that has a textual representation.
-contents_text <- new_generic("contents_text", "content")
+method(contents_text, ContentText) <- function(content) {
+  content@text
+}
 
-method(contents_text, Content) <- function(content) {
-  NULL
+method(contents_html, ContentText) <- function(content) {
+  check_installed("commonmark")
+  commonmark::markdown_html(content@text)
 }
 
-method(contents_text, ContentText) <- function(content) {
+method(contents_markdown, ContentText) <- function(content) {
   content@text
 }
 
@@ -71,6 +134,12 @@ ContentImageRemote <- new_class(
 method(format, ContentImageRemote) <- function(x, ...) {
   cli::format_inline("[{.strong remote image}]: {.url {x@url}}")
 }
+method(contents_html, ContentImageRemote) <- function(content) {
+  sprintf('<img src="%s">', content@url)
+}
+method(contents_markdown, ContentImageRemote) <- function(content) {
+  sprintf('![](%s)', content@url)
+}
 
 #' @rdname Content
 #' @export
@@ -87,6 +156,12 @@ ContentImageInline <- new_class(
 method(format, ContentImageInline) <- function(x, ...) {
   cli::format_inline("[{.strong inline image}]")
 }
+method(contents_html, ContentImageInline) <- function(content) {
+  sprintf('<img src="data:%s;base64,%s">', content@type, content@data)
+}
+method(contents_markdown, ContentImageInline) <- function(content) {
+  sprintf('![](data:%s;base64,%s)', content@type, content@data)
+}
 
 # Tools ------------------------------------------------------------------
 
@@ -156,6 +231,12 @@ method(format, ContentJson) <- function(x, ...) {
     pretty_json(x@value)
   )
 }
+method(contents_html, ContentJson) <- function(content) {
+  sprintf('<pre><code>%s</code></pre>\n', pretty_json(content@value))
+}
+method(contents_markdown, ContentJson) <- function(content) {
+  sprintf('```json\n%s\n```\n', pretty_json(content@value))
+}
 
 # Helpers ----------------------------------------------------------------------
 

R/provider-cortex.R

@@ -335,9 +335,17 @@ method(as_json, list(ProviderCortex, ContentSql)) <- function(provider, x) {
 
 method(contents_text, ContentSql) <- function(content) {
   # Emit a Markdown-formatted SQL code block as the textual representation.
+  contents_markdown(content)
+}
+
+method(contents_markdown, ContentSql) <- function(content) {
   paste0("\n\n```sql\n", content@statement, "\n```")
 }
 
+method(contents_html, ContentSql) <- function(content) {
+  sprintf('<pre><code>%s</code></pre>\n', content@statement)
+}
+
 method(format, ContentSql) <- function(x, ...) {
   cli::format_inline("{.strong SQL:} {.code {x@statement}}")
 }

R/shiny.R

@@ -78,7 +78,7 @@ live_browser <- function(chat, quiet = FALSE) {
     for (turn in chat$get_turns()) {
       shinychat::chat_append_message("chat", list(
         role = turn@role,
-        content = turn@text
+        content = contents_markdown(turn)
       ))
     }
 

R/turns.R

@@ -44,9 +44,7 @@ Turn <- new_class(
     ),
     text = new_property(
       class = class_character,
-      getter = function(self) {
-        paste0(unlist(lapply(self@contents, contents_text)), collapse = "")
-      }
+      getter = function(self) contents_text(self)
     )
   ),
   constructor = function(role,
@@ -70,6 +68,15 @@ method(format, Turn) <- function(x, ...) {
   contents <- map_chr(x@contents, format, ...)
   paste0(contents, "\n", collapse = "")
 }
+method(contents_text, Turn) <- function(content) {
+  paste0(unlist(lapply(content@contents, contents_text)), collapse = "")
+}
+method(contents_html, Turn) <- function(content) {
+  paste0(unlist(lapply(content@contents, contents_html)), collapse = "\n")
+}
+method(contents_markdown, Turn) <- function(content) {
+  paste0(unlist(lapply(content@contents, contents_markdown)), collapse = "\n\n")
+}
 
 user_turn <- function(..., .error_call = caller_env()) {
   if (...length() == 0) {

_pkgdown.yml

@@ -38,3 +38,7 @@ reference:
   - Provider
   - Content
   - Chat
+
+- title: Utilities
+  contents:
+  - contents_text

tests/testthat/_snaps/content.md

@@ -13,3 +13,108 @@
       Error in `FUN()`:
       ! `...` must be made up strings or <content> objects, not `TRUE`.
 
+# turn contents can be converted to text, markdown and HTML
+
+    Code
+      cat(contents_text(turn))
+    Output
+      User input.
+      
+      ```sql
+      SELECT * FROM mtcars
+      ```
+      
+      #### Suggestions
+      
+      - What is the total quantity sold for each product last quarter?
+      - What is the average discount percentage for orders from the United States?
+      - What is the average price of products in the 'electronics' category?
+
+---
+
+    Code
+      cat(contents_markdown(turn))
+    Output
+      User input.
+      
+      ![](data:image/png;base64,abcd123)
+      
+      ![](https://example.com/image.jpg)
+      
+      ```json
+      {
+        "a": [1, 2],
+        "b": "apple"
+      }
+      ```
+      
+      
+      
+      
+      ```sql
+      SELECT * FROM mtcars
+      ```
+      
+      
+      
+      #### Suggestions
+      
+      - What is the total quantity sold for each product last quarter?
+      - What is the average discount percentage for orders from the United States?
+      - What is the average price of products in the 'electronics' category?
+
+---
+
+    Code
+      cat(contents_markdown(chat))
+    Output
+      ## User
+      
+      User input.
+      
+      ![](data:image/png;base64,abcd123)
+      
+      ![](https://example.com/image.jpg)
+      
+      ```json
+      {
+        "a": [1, 2],
+        "b": "apple"
+      }
+      ```
+      
+      
+      
+      
+      ```sql
+      SELECT * FROM mtcars
+      ```
+      
+      
+      
+      #### Suggestions
+      
+      - What is the total quantity sold for each product last quarter?
+      - What is the average discount percentage for orders from the United States?
+      - What is the average price of products in the 'electronics' category?
+      
+      ## Assistant
+      
+      Here's your answer.
+
+---
+
+    Code
+      cat(contents_html(turn))
+    Output
+      <p>User input.</p>
+      
+      <img src="data:image/png;base64,abcd123">
+      <img src="https://example.com/image.jpg">
+      <pre><code>{
+        "a": [1, 2],
+        "b": "apple"
+      }</code></pre>
+      
+      <pre><code>SELECT * FROM mtcars</code></pre>
+