R/addins.R

In dmpe/rbitly: R Wrapper for the 'Bit.ly' and 'Is.gd'/'v.gd' URL Shortening Services

#' Shorten an URL
#'
#' @description Call this function as an addin to prompt a url shortener.
#'   bit.ly accepts a custom domain, see \code{\link[urlshorteneR]{bitly_shorten_link}}.
#'
#' @export
shortenerAddin <- function() {
  ui <- miniUI::miniPage(
    miniUI::gadgetTitleBar("Shorten/Expand URL"),
    miniUI::miniContentPanel(
      padding = 10,
      shiny::textInput("url", label = "Long URL", value = "", width = "100%"),
      shiny::selectInput(
        "provider",
        label = "Provider",
        choices = c("bit.ly", "is.gd", "v.gd"),
        selected = "bit.ly",
        width = "100%"
      ),
      shiny::uiOutput("bitly_domain"),
      shiny::uiOutput("bitly_token"),
      shiny::actionButton("shorten", label = "Shorten"),
      shiny::actionButton("expand", label = "Expand")
    )
  )

  server <- function(input, output, session) {
    shortener_provider <- shiny::reactive({
      shiny::req(input$provider)
      input$provider
    })

    # bit.ly supports custom domains
    output$bitly_domain <- shiny::renderUI({
      if (shortener_provider() == "bit.ly") {
        shiny::tagList(
          shiny::textInput("domain",
            label = "Bit.ly domain", value = "bit.ly",
            width = "100%"
          )
        )
      } else {
        return(NULL)
      }
    })

    # bit.ly however also requires bearer tokens
    output$bitly_token <- shiny::renderUI({
      if (shortener_provider() == "bit.ly") {
        shiny::tagList(
          shiny::textInput("token",
            label = "Bearer Token", value = "",
            width = "100%"
          )
        )
      } else {
        return(NULL)
      }
    })

    # Shorten links
    shiny::observeEvent(input$shorten, {
      shiny::req(input$url)

      shortener <- get_shortener(provider_name = input$provider)

      # Conditionally pass custom bit.ly custom domain
      if (input$provider == "bit.ly") {
        res <- shortener(longUrl = input$url, domain = input$domain, accessToken = input$token)
      } else {
        res <- shortener(longUrl = input$url)
      }

      tryCatch(
        {
          parse_response(res) %>%
            copy_and_notify()
        },
        error = function(e) {
          cli::cli_alert_danger(e)
          shiny::showNotification(
            ui = paste("Something went wrong:", e, sep = " "),
            duration = 3L,
            closeButton = TRUE,
            type = "message"
          )
        }
      )
    })

    # Expand links
    shiny::observeEvent(input$expand, {
      shiny::req(input$url)

      expander <- get_expander(provider_name = input$provider)

      # bitly_expand_link uses bitly_id instead of a short URL - strip protocol accordingly
      if (input$provider == "bit.ly") {
        short_url <- gsub(pattern = "https://", x = input$url, replacement = "")
      } else {
        short_url <- input$url
      }

      tryCatch(
        {
          expander(shorturl = short_url, accessToken = input$token) %>%
            parse_response(expand = TRUE) %>%
            copy_and_notify()
        },
        error = function(e) {
          cli::cli_alert_danger(e)
          shiny::showNotification(
            ui = paste("Something went wrong:", e, sep = " "),
            duration = 3L,
            closeButton = TRUE,
            type = "warning"
          )
        }
      )
    })

    shiny::observeEvent(input$done, {
      invisible(shiny::stopApp())
    })
  }

  viewer <- shiny::dialogViewer(dialogName = "URL shortener", width = 600, height = 400)
  shiny::runGadget(ui, server, viewer = viewer)
}

#' Select shortener function
#'
#' @param provider_name (str) url shortener provider
#' @return A function
#'
#' @noRd
get_shortener <- function(provider_name) {
  switch(provider_name,
    "bit.ly" = bitly_shorten_link_,
    "is.gd" = isgd_LinksShorten,
    "v.gd" = vgd_LinksShorten
  )
}

#' Select expander function
#'
#' @inheritParams get_shortener
#' @noRd
get_expander <- function(provider_name) {
  switch(provider_name,
    "bit.ly" = bitly_expand_link_,
    "is.gd" = isgd_LinksExpand,
    "v.gd" = vgd_LinksExpand
  )
}

#' Copy result to clipboard and fire notifications
#'
#' @noRd
copy_and_notify <- function(url) {
  clipr::write_clip(url)
  shiny::showNotification(
    ui = paste(url, "copied to clipboard", sep = " "),
    duration = 3L,
    closeButton = TRUE,
    type = "message",
  )
  cli::cli_alert_success(paste(url, "copied to clipboard", sep = " "))
}

#' Parse response
#'
#' @description url shortener functions return results in different formats,
#'   this helper checks for length and grabs values accordingly.
#'   For example, \code{bitly_shorten_link} returns a \code{data.frame}.
#'
#' @noRd
parse_response <- function(res, expand = FALSE) {
  if (length(res) > 1 && expand == FALSE) {
    res$link[[1]]
  } else if (length(res) > 1 && expand == TRUE) {
    res$long_url[[1]]
  } else {
    res
  }
}