4. Extend blockr

    library(shiny)
    library(bslib)
    library(scoutbaR)
    library(blockr.core)

## Introduction

`blockr` can be extended in 3 main ways. The first way is to create new blocks, as described in the `Create block` vignette. The second way is to change the behavior at board level through the plugin system. Finally we can customize the UI library, as we will in the last section.

## Plugins

Most major features of a board are implemented through what we call plugins. A board of a given class, such as `"board"` (the basic legacy board) or `"dock_board"` (the board used by `blockr::run_app()`) supports a given set of plugins, implemented using shiny modules. Users can override the ui and server functions of these modules from the outside if they wish to tweak the display and logic of these features, as we’ll show further below.

### Available plugins

The legacy board supports the following plugins :

- `manage_blocks()`: Implements the way blocks are created, removed, appened…
- `manage_links()`: Implements how blocks are connected. Linking block A to block B means that block A passes its output data to block B.
- `manage_stacks()`: Implements how blocks can be grouped using stacks.
- `preserve_board()`: Implements how boards can be saved and restored.
- `generate_code()`: Implements the way the data manipulation code executed by the blocks is displayed to the user.
- `notify_user()`: Implements how notifications and warnings are relayed to the user.
- `edit_block()`: Implements how a block attributes such as titles are processed and rendered.
- `edit_stack()`: Implements how a stack attributes such as names are processed and rendered.

### Override a plugin’s server and ui functions

We will work from an example, we want to modify the `manage_blocks()` plugin to use the `scoutbaR` package to search for blocks to add.

By default `manage_blocks()` uses `manage_blocks_ui()` and `manage_blocks_server()`, a good workflow is to start from those and implement our modifications.

    # manage_blocks_ui
    function(id, board) {
      tagList(
        actionButton(
          NS(id, "add_block"),
          "Add block",
          icon = icon("circle-plus"),
          class = "btn-success"
        ),
        actionButton(
          NS(id, "rm_block"),
          "Remove block",
          icon = icon("circle-minus"),
          class = "btn-danger"
        )
      )
    }

For simplicity let’s assume we also want to drop the “Remove block” button, our new ui becomes:

    new_manage_blocks_ui <- function(id, board) {
      tagList(
        scoutbaR::scoutbar(
          NS(id, "scoutbar"),
          placeholder = "Search for a block",
          actions = blk_choices(),
          theme = "dark",
          showRecentSearch = TRUE
        ),
        actionButton(
          NS(id, "add_block"),
          "New block",
          icon = icon("circle-plus"),
        )
      )
    }

`blk_choices()` is a list of scoutbar actions, the details are not relevant here but the definition is provided below for information.

    blk_choices <- function() {
      blk_cats <- sort(
        unique(chr_ply(available_blocks(), \(b) attr(b, "category")))
      )

      lapply(blk_cats, \(cat) {
        scout_section(
          label = cat,
          .list = dropNulls(
            unname(
              lapply(available_blocks(), \(choice) {
                if (attr(choice, "category") == cat) {
                  scout_action(
                    id = attr(choice, "classes")[1],
                    label = attr(choice, "name"),
                    description = attr(choice, "description"),
                    icon = blk_icon(cat)
                  )
                }
              })
            )
          )
        )
      })
    }

    blk_icon <- function(category) {
      switch(
        category,
        "data" = "table",
        "file" = "file-import",
        "parse" = "cogs",
        "plot" = "chart-line",
        "transform" = "wand-magic-sparkles",
        "table" = "table"
      )
    }

    chr_ply <- function(x, fun, ..., length = 1L, use_names = FALSE) {
      vapply(x, fun, character(length), ..., USE.NAMES = use_names)
    }

    lgl_ply <- function(x, fun, ..., length = 1L, use_names = FALSE) {
      vapply(x, fun, logical(length), ..., USE.NAMES = use_names)
    }

    dropNulls <- function(x) {
      x[!lgl_ply(x, is.null)]
    }

In the same fashion we override the server function to handle the new logic.

We end up with the following server function, see additional explanations below.

    new_manage_blocks_server <- function(id, board, update, ...) {
      moduleServer(
        id,
        function(input, output, session) {
          # Trigger add block
          observeEvent(
            input$add_block,
            {
              update_scoutbar(
                session,
                "scoutbar",
                revealScoutbar = TRUE
              )
            }
          )

          observeEvent(input$scoutbar, {
            new_blk <- as_blocks(create_block(input$scoutbar))
            update(
              list(blocks = list(add = new_blk))
            )
          })

          NULL
        }
      )
    }

The server function’s signature must start with the module id, `board` refers to internal reactive values (read-only), `update` is a reactive value to send updates to the board module and `...` is used to recover parameters passed from the top level like `parent`. The plugin always returns `NULL`.

In the first observer we open the `scoutbaR` widget whenever the users clicks on the `Add block` button. We can achieve that by calling `update_scoutbar` passing `revealScoutbar = TRUE`.

In the second observer we listen to `input$scoutbar` which holds the name of the selected block, and use to create a “blocks” object with `create_block()` and `as_blocks()`. Finally, we signal this change to the board by refreshing the `update` reactive value, saying we want to add a new block `list(blocks = list(add = new_blk))`.

### Putting everything together

Once we have updated ui and server functions we can use the updated plugin by defining new main ui and server functions around them.

Code

    main_ui <- function(id, board) {
      ns <- NS(id)
      board_ui(
        ns("board"),
        board,
        plugins = custom_board_plugins(
          c(
            "manage_blocks"
          )
        )
      )
    }

    main_server <- function(id, board) {
      moduleServer(
        id,
        function(input, output, session) {
          ns <- session$ns

          # Board module
          board_server(
            "board",
            board,
            plugins = plugins(
              manage_blocks(server = new_manage_blocks_server, ui = new_manage_blocks_ui)
            ),
            callbacks = list()
          )
        }
      )
    }

    board <- new_board()

    ui <- page_fluid(
      main_ui("app", board)
    )

    server <- function(input, output, session) {
      main_server("app", board)
    }

    shinyApp(ui, server)

> Note

> The demo below runs with shinylive. Not all feature may work as expected due to compatibility issues with webR.

## Custom UI components

If you’d like to use the board with another UI kit than `bslib` you can create a new method for `board_ui()`. For that, you’ll need a little bit of S3 knowledge.

The function signature should contain `id` (module namespace), `x` (board object), and `plugins` to use `blockr.core` plugins. In the following, we leverage the brand new `shinyNextUI` to power the custom board UI:

    board_ui.custom_board <- function(id, x, plugins = list(), ...) {
      plugins <- as_plugins(plugins)
      div(
        id = paste0(id, "_board"),
        board_ui(id, plugins[["manage_blocks"]], x),
        div(
          id =  paste0(id, "_blocks"),
          block_ui(id, x)
        )
      )
    }

We have to customize the `block_ui` too. Overall, we leverage the `shinyNextUI::card` component to create the block layout:

    get_block_registry <- function(x) {
      stopifnot(is_block(x))
      available_blocks()[[strsplit(attr(x, "ctor"), "new_")[[1]][2]]]
    }

    block_ui.custom_board <- function(id, x, blocks = NULL, ...) {
      block_card <- function(x, id, ns) {
        id <- paste0("block_", id)

        blk_info <- get_block_registry(x)

        div(
          class = "m-2",
          id = ns(id),
          shinyNextUI::card(
            variant = "bordered",
            shinyNextUI::card_header(
              className = "d-flex justify-content-between",
              icon(blk_icon(attr(blk_info, "category"))),
              sprintf(
                "Block: %s (id: %s)",
                attr(blk_info, "name"),
                gsub("block_", "", id)
              ),
              shinyNextUI::tooltip(
                icon("info-circle"),
                content = tagList(
                  p(
                  icon("lightbulb"),
                  "How to use this block?",
                  ),
                  p(attr(blk_info, "description"), ".")
                )
              )
            ),
            shinyNextUI::divider(),
            shinyNextUI::card_body(
              expr_ui(ns(id), x),
              block_ui(ns(id), x)
            ),
            shinyNextUI::divider(),
            shinyNextUI::card_footer(
              sprintf(
                "Type: %s; Package: %s",
                attr(blk_info, "category"),
                attr(blk_info, "package")
              )
            )
          )
        )
      }

      stopifnot(is.character(id) && length(id) == 1L)

      if (is.null(blocks)) {
        blocks <- board_blocks(x)
      } else if (is.character(blocks)) {
        blocks <- board_blocks(x)[blocks]
      }

      stopifnot(is_blocks(blocks))

      tagList(
        Map(
          block_card,
          blocks,
          names(blocks),
          MoreArgs = list(ns = NS(id)),
          USE.NAMES = FALSE
        )
      )
    }

Notice the use of few `blockr.core` helpers along the way:

- `board_blocks()` to extract and validate the blocks of a board.
- `is_blocks()` check whether an object correspond to a list of blocks.
- `get_block_registry()` to get the current block metadata from the registry.

`add_rm_block_ui()` now leverages `shinyNextUI::actionButton`:

    add_rm_block_ui <- function(id, board) {
      tagList(
        scoutbar(
          NS(id, "scoutbar"),
          placeholder = "Search for a block",
          actions = blk_choices(),
          theme = "dark",
          showRecentSearch = TRUE
        ),
        shinyNextUI::actionButton(
          NS(id, "add_block"),
          "New block",
          icon = icon("circle-plus"),
        )
      )
    }

Since `blockr.core` blocks utilizes `shiny`/`bslib` UI, you’d also have to rewrite the UI and/or server part whenever necessary. This vignette provides a starting point to authoring blocks.

As a final step, when you call `new_board()` don’t forget to add it the `custom_board` class so that the custom S3 methods are invoked.

Code

    board <- new_board(class = "custom_board")

    ui <- nextui_page(
      board_ui(
        "board",
        board,
        plugins = custom_board_plugins(
          c(
            "manage_blocks"
          )
        )
      )
    )

    server <- function(input, output, session) {
      board_server(
        "board",
        board,
        plugins = custom_board_plugins(
          c(
            "manage_blocks"
          )
        ),
        callbacks = list()
      )
    }

    shinyApp(ui, server)

> Note

> The demo below runs with shinylive. Not all feature may work as expected due to compatibility issues with webR.