R/tweet.R

In nfrerebeau/twitterbot: A Twitter Bot for the Lab

# COMPOSE AND POST

# Compose ======================================================================
#' Compose Tweet
#'
#' @param x A [`list`] of document references
#'  (typically a list of class [`hal_documents`][get_hal_team]).
#' @param ... Currently not used.
#' @return
#'  Returns a [`character`] string (tweet message) or a [`list`] of `character`
#'  strings.
#' @author N. Frerebeau
#' @name compose
#' @rdname compose
NULL

#' @rdname compose
#' @export
compose <- function(x, ...) UseMethod("compose")

#' @rdname compose
#' @export
compose.hal_documents <- function(x, ...) {
  tweets <- lapply(
    X = x,
    FUN = compose
  )
  structure(tweets, class = "messages")
}

#' @rdname compose
#' @export
compose.hal_document <- function(x, ...) {
  ## Get data
  halId_s <- x$halId_s
  title_s <- x$title_s
  licence_s <- x$licence_s
  domain_s <- x$domainAllCode_s
  doiId_s <- x$doiId_s
  uri_s <- x$uri_s
  language_s <- x$language_s

  if (length(title_s) == 0) return(NULL)

  ## Detect language
  lang_s <- vapply(X = title_s, FUN = franc::franc, FUN.VALUE = character(1))
  lang_i <- strtrim(lang_s, 2) == language_s # FIXME: will not work every time
  lang <- ifelse(any(lang_i), language_s, "en") # Switch to English if no match

  ## Hashtags
  ## Open Access: 0 to 11 (en) or 15 (fr) char
  license <- hashtag_open(c(licence_s, doiId_s), lang = lang)

  ## Domains: 0 to 80 char
  if (!is.null(domain_s)) {
    tag <- hashtag_domain(domain_s, lang = lang)
    hashtag <- paste0(tag, collapse = " ")
    while(nchar(hashtag) > 80) {
      tag <- utils::head(tag, -1)
      hashtag <- paste0(tag, collapse = " ")
    }
  } else {
    hashtag <- ""
  }

  ## URL: 23 char (will be altered by Twitter)
  if (!is.null(doiId_s)) {
    url <- paste0("https://doi.org/", doiId_s)
  } else {
    url <- uri_s
  }

  ## Intro
  intro <- switch(
    lang,
    fr = "Nouvelle publication : ",
    "New publication: " # Defaults to English
  )

  ## Title: adjust length
  extra <- sprintf(" %s %s %s", license, hashtag, url)
  max_char <- 280 - nchar(intro) - nchar(extra) - 5
  title_s <- title_s[which.max(lang_i)]
  title <- trimws(strtrim(title_s, max_char))
  if (nchar(title_s) > max_char) title <- paste0(title, "...")
  text <- sprintf("%s\"%s\"%s", intro, title, extra)

  ## Remove extra spaces, if any
  tweet <- gsub("\\s+", " ", text)

  ## Check tweet length (without url)
  tweet_clean <- gsub("https?://[[:graph:]]+\\s?", "", tweet)
  if (nchar(tweet_clean) + 23 > 280)
    stop("Tweet must be less than 280 characters.", call. = FALSE)

  structure(tweet, class = "message", id = halId_s)
}

#' @rdname compose
#' @export
compose.rss_items <- function(x, ...) {
  tweets <- lapply(
    X = x,
    FUN = compose
  )
  structure(tweets, class = "messages")
}

#' @rdname compose
#' @export
compose.rss_item <- function(x, ...) {
  ## Get data
  feed_lang <- x$feed_language
  feed_link <- x$feed_link
  item_title <- x$item_title
  item_link <- x$item_link
  item_text <- x$item_description
  item_guid <- x$item_guid
  item_date <- x$item_pub_date
  item_category <- x$item_category

  ## URL: 23 char (will be altered by Twitter)
  url <- ifelse(is.null(item_link), feed_link, item_link)

  ## Intro
  intro <- switch(
    feed_lang,
    fr = "En direct du labo : ",
    "News from the lab: " # Defaults to English
  )

  ## Categories: 0 to 80 char
  if (length(item_category) > 0) {
    tag <- hashtag_keyword(unlist(item_category))
    hashtag <- paste0(tag, collapse = " ")
    while(nchar(hashtag) > 80) {
      tag <- utils::head(tag, -1)
      hashtag <- paste0(tag, collapse = " ")
    }
  } else {
    hashtag <- ""
  }

  ## Message: adjust length
  extra <- sprintf(" %s\n\n%s", hashtag, url)
  max_char <- 280 - nchar(intro) - nchar(extra)
  message <- trimws(strtrim(item_title, max_char))
  if (nchar(item_title) > max_char) message <- paste0(message, "...")
  text <- sprintf("%s%s%s", intro, message, extra)

  ## Remove extra spaces, if any
  tweet <- gsub("\\s+", " ", text)

  ## Check tweet length (without url)
  tweet_clean <- gsub("https?://[[:graph:]]+\\s?", "", tweet)
  if (nchar(tweet_clean) + 23 > 280)
    stop("Tweet must be less than 280 characters.", call. = FALSE)

  structure(tweet, class = "message", id = item_guid)
}

# Clean ========================================================================
#' Clean Tweet
#'
#' @param x A [`list`] of class `messages`.
#' @param log A [`character`] string giving the path of the log file
#'  (see below).
#' @param select An [`integer`] or a [`logical`] vector specifying the indices
#'  of the messages to keep.
#' @section Prevent Double Post:
#'  A log file can be used to avoid posting the same documents several times.
#'  This file records the unique identifier of each message (generated by
#'  `compose()`). The log file must have four columns separated by a single
#'  white space:
#'
#'  * Date (YYYY-MM-DD);
#'  * Time (HH-MM-SS);
#'  * Tweet status id;
#'  * Message unique id.
#'
#' @param ... Currently not used.
#' @return
#'  A [`list`] of [`character`] string (tweet message).
#' @author N. Frerebeau
#' @name clean
#' @rdname clean
#' @keywords internal
NULL

#' @rdname clean
clean <- function(x, ...) UseMethod("clean")

#' @rdname clean
clean.messages <- function(x, log = NULL, select = NULL, ...) {
  ## Check that no document is tweeted twice
  if (!is.null(log)) {
    tweet_log <- read_log(log)
    if (is.data.frame(tweet_log)) {
      msg_id <- vapply(X = x, FUN = attr, FUN.VALUE = character(1),
                       which = "id")
      index <- !(msg_id %in% tweet_log[[4]])
      x <- x[index] # Remove documents if already tweeted
    }
  }

  ## Keep only the selected documents
  if (!is.null(select)) {
    x <- x[select]
  }

  ## Remove empty documents
  x <- Filter(Negate(is.null), x)

  structure(x, class = "messages")
}

# Post =========================================================================
#' Post Tweet
#'
#' @param x A [`list`] of messages.
#' @param log A [`character`] string giving the path of the log file (see
#'  below).
#' @param select An [`integer`] or a [`logical`] vector specifying the indices
#'  of the messages to be posted.
#' @param silent A [`logical`] scalar: should the report of error messages be
#'  suppressed?
#' @param test A [`logical`] scalar.
#' @param ... Currently not used.
#' @inheritSection clean Prevent Double Post
#' @return
#'  Invisibly returns the tweet date, time and status id.
#' @note
#'  Authenticate via access token (see `vignette("auth", package = "rtweet")`).
#' @author N. Frerebeau
#' @name post
#' @rdname post
NULL

#' @rdname post
#' @export
post <- function(x, ...) UseMethod("post")

#' @rdname post
#' @export
post.hal_documents <- function(x, log = NULL, select = NULL,
                               silent = TRUE, test = FALSE, ...) {
  ## Compose message
  txt <- compose(x)

  ## Clean messages
  msg <- clean(txt, log = log, select = select)

  ## Post message
  post_log <- logger(post, file = log)
  tweet <- post_log(msg, silent = silent, test = test, ...)

  invisible(tweet)
}

#' @rdname post
#' @export
post.rss_items <- function(x, log = NULL, select = NULL,
                           silent = TRUE, test = FALSE, ...) {
  ## Compose message
  txt <- compose(x)

  ## Clean messages
  msg <- clean(txt, log = log, select = select)

  ## Post message
  post_log <- logger(post, file = log)
  tweet <- post_log(msg, silent = silent, test = test, ...)

  invisible(tweet)
}

#' @rdname post
#' @export
post.messages <- function(x, silent = TRUE, test = FALSE, ...) {
  ## Check that there is something to tweet
  if (length(x) == 0) {
    message("There is nothing to tweet about!")
    return(character(0))
  }

  ## Tweet
  tweet <- lapply(
    X = x,
    FUN = post,
    silent = silent,
    test = test
  )

  tweet <- do.call(rbind, tweet)
  invisible(tweet)
}

#' @rdname post
#' @export
post.message <- function(x, silent = TRUE, test = FALSE, ...) {
  # Get IDs
  doc_id <- attr(x, "id")
  tweet_date <- strftime(Sys.time(), format = "%F %T")
  tweet_id <- ""

  if (!test) {
    # Send tweet
    tweet <- try(
      expr = rtweet::post_tweet(status = x),
      silent = silent
    )

    if (!inherits(tweet, "try-error")) {
      # Lookup status_id
      timeline <- rtweet::get_my_timeline()

      # Date and time
      tweet_date <- timeline$created_at[[1]]

      # ID for reply
      tweet_id <- timeline$id_str[[1]]
    }
  }

  # Return results
  out <- sprintf("%s %s %s\n", tweet_date, tweet_id, doc_id)
  invisible(out)
}