R/trello.R

In msberends/certedata: Tools for Data Analysis at Certe

# ==================================================================== #
# TITLE                                                                #
# Tools for Data Analysis at Certe                                     #
#                                                                      #
# AUTHORS                                                              #
# Berends MS (m.berends@certe.nl)                                      #
# Meijer BC (b.meijer@certe.nl)                                        #
# Hassing EEA (e.hassing@certe.nl)                                     #
#                                                                      #
# COPYRIGHT                                                            #
# (c) 2019 Certe Medische diagnostiek & advies - https://www.certe.nl  #
#                                                                      #
# LICENCE                                                              #
# This R package is free software; you can redistribute it and/or      #
# modify it under the terms of the GNU General Public License          #
# version 2.0, as published by the Free Software Foundation.           #
# This R package is distributed in the hope that it will be useful,    #
# but WITHOUT ANY WARRANTY; without even the implied warranty of       #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the         #
# GNU General Public License for more details.                         #
# ==================================================================== #

#' Synchronisatie met Trello.com
#'
#' Gebruik deze functies om gegevens naar Trello te sturen en op te halen. Proxy-gegevens worden automatisch zo nodig toegepast met \code{\link{set_certe_proxy}}. De \code{trello_get*}-functies halen een \code{data.frame} op met gegevens. De functie \code{trello_searchcard} retourneert een vector van URL's met kaarttitels als namen.
#' @param title Titel van de kaart
#' @param desc Standaard is leeg. Omschrijving op de kaart.
#' @param requested_by Standaard is leeg. Klant die aanvraag deed (voor- en achternaam).
#' @param project_path Standaard is leeg. Map waarin RStudio-project staat.
#' @param member Standaard is de huidige gebruiker. Le(e)d(en) om toe te voegen aan de kaart.
#' @param prio Standaard is \code{"Normaal"}. Prioriteit om als extra label toe te voegen. Geldige opties zijn \code{"Laag"}, \code{"Normaal"}, \code{"Hoog"}. Kaarten met hoge prioriteit worden bovenaan een lijst geplaatst.
#' @param duedate Standaard is leeg. Vervaldatum/deadline van de taak.
#' @param checklist Standaard is leeg. Vector met taken om toe te voegen als checklist.
#' @param checklist_name Standaard is \code{"Taken"}. Naam van de checklist.
#' @param comments Standaard is leeg. Opmerking die op kaart geplaatst wordt.
#' @param attachments Standaard is leeg. Vector met (URL's van) bijlagen, zoals andere Trello-kaarten.
#' @param list Standaard is \code{"To do"}. Trello-lijst waar kaart aan toegevoegd moet worden.
#' @param board Standaard is het bord van Data-analisten. Bord waarop \code{list} voorkomt.
#' @param username,key,token API-gegevens.
#' @param x Zoekterm of eigenschap (die opgehaald wordt uit \code{Trello.yml} in de refmap).
#' @param item Hoeveelste waarde geselecteerd moet worden. Gebruik \code{item = NULL} om alle waarden te retourneren als vector.
#' @details De gegevens worden geladen uit certedata:::.R_REFMAP("Trello.yml"). De kunnen overschreven worden met systeemvariabelen van R (\code{\link{Sys.getenv}}). De namen van die variabelen komen beginnen met \code{"trello_"} en eindigen op de naam van de parameter. Dus \code{trello_credentials("key")} zoekt als eerst naar \code{Sys.getenv("trello_key")}.
#' @rdname trello
#' @name trello
#' @return Trello-URL van de kaart
#' @export
trello_upload <- function(title,
                          desc = "",
                          requested_by = "",
                          project_path = "",
                          member = Sys.getenv("R_USERNAME"),
                          prio = "Normaal",
                          duedate = "",
                          checklist = "",
                          checklist_name = "Taken",
                          comments = "",
                          attachments = "",
                          list = "Nog mee beginnen",
                          board = trello_credentials("board_default"),
                          key = trello_credentials("key"),
                          token = trello_credentials("token")) {
  
  set_certe_proxy()
  
  prio <- prio[1]
  
  # eigenschappen ophalen
  lists <- trello_getlists(board = board, key = key, token = token)
  members <- trello_getmembers(board = board, key = key, token = token)
  labels <- trello_getlabels(board = board, key = key, token = token)
  # customfield <- trello_getcustomfields(board = board, key = key, token = token)
  
  # controleren of `list` een id is
  if (list %in% lists$id) {
    list_id <- list
  } else {
    if (!tolower(list) %in% tolower(lists$name)) {
      warning("List ", list, " does not exist on this Trello board. Adding card to the first available list.", call. = FALSE)
      list_id <- lists[1, 'id']
    }
    list_id <- lists[which(tolower(lists$name) == tolower(list)), 'id'][1]
  }
  
  description <- ""
  if (all(is.null(requested_by)) | length(requested_by) == 0) {
    requested_by <- ""
  }
  for (i in 1:length(requested_by)) {
    if (requested_by[i] != get_certe_user(requested_by[i])) {
      job <- get_certe_user(requested_by[i], 'job')
      if (is.na(job)) {
        job <- ''
      } else {
        job <- paste0(' (', tolower(job), ')')
      }
      requested_by[i] <- paste0("[",
                                get_certe_user(requested_by[i], 'name'),
                                "](mailto:",
                                get_certe_user(requested_by[i], 'mail'),
                                "?subject=", URLencode(title),
                                ")",
                                job)
    }
  }
  requested_by <- concat(get_certe_user(requested_by), ", ")
  if (requested_by != "") {
    description <- paste0("*Aangevraagd door: ", requested_by, '*')
    title <- paste0(strsplit.select(requested_by, 1, "( |,|/)"), " - ", title)
    title <- gsub("^\\[", "", title) # eerste [ verwijderen bij naam met maillink
  }
  if (project_path != "") {
    description <- c(description,
                     paste0("*Maplocatie: [", basename(project_path), "](file://", URLencode(project_path), ")*"))
  }
  if (desc != "") {
    description <- c(description,
                     "",
                     desc)
  }
  
  if (as.character(duedate) != "") {
    duedate <- paste(as.Date(duedate), "11:00:00") # Trello voegt 6 uur toe...??
  }
  
  # kaart aanmaken
  request_card <- POST(url = "https://api.trello.com/1/cards",
                       body = list(idList = list_id,
                                   name = title,
                                   # https://stackoverflow.com/a/45218244/4575331:
                                   desc = paste0(description, collapse = "\x0A"),
                                   pos = 'top', #if_else(prio %like% "^(Hoog|Hoge)", 'top', 'bottom'),
                                   due = duedate,
                                   key = key,
                                   token = token))
  card_id <- content(request_card, "parsed", "application/json")$id
  card_nr <- content(request_card, "parsed", "application/json")$idShort
  stop_for_status(request_card, task = paste("add card", title))
  # startdatum toevoegen
  # if ("d.d." %in% customfield$name) {
  #   customfield <- customfield %>%
  #     filter(name == "d.d.") %>%
  #     pull(id) %>%
  #     .[1]
  #   request_startdate <- PUT(url = paste0("https://api.trello.com/1/cards/", card_id, "/customField/", customfield, "/item"),
  #                                   body = list(value = c(date = as.character(Sys.time())),
  #                                              # idValue = "5a6a23abf958725e1ac86c22",
  #                                               key = key,
  #                                               token = token))
  #   stop_for_status(request_startdate, task = "add startdate")
  # }
  
  # opmerking toevoegen
  if (is.null(comments)) {
    comments <- ""
  }
  if (comments != "") {
    request_comments <- POST(url = paste0("https://api.trello.com/1/cards/", card_id, "/actions/comments"),
                             body = list(text = comments,
                                         key = key,
                                         token = token))
    stop_for_status(request_comments, task = paste("add comment", comments))
  }
  
  # bijlagen toevoegen
  if (!all(attachments == "")) {
    for (i in 1:length(attachments)) {
      request_attachment <- POST(url = paste0("https://api.trello.com/1/cards/", card_id, "/attachments"),
                                 body = list(url = attachments[i],
                                             key = key,
                                             token = token))
      stop_for_status(request_attachment, task = paste("add attachment", attachments[i]))
    }
  }
  
  # gebruikers toevoegen
  if (!all(member == "")) {
    
    for (i in 1:length(member)) {
      member_id <- members[which(members$id %like% member[i]
                                 | members$fullName %like% member[i]
                                 | members$username %like% member[i]), 'id']
      if (length(member_id) == 0) {
        warning('Member ', member[i], ' not found on this Trello board.', call. = FALSE)
      } else {
        request_member <- POST(url = paste0("https://api.trello.com/1/cards/", card_id, "/idMembers"),
                               body = list(value = member_id,
                                           key = key,
                                           token = token))
        stop_for_status(request_member, task = paste("add member", member[i]))
      }
    }
  }
  
  # RStudio label toevoegen als er een projectmap is
  # if (project_path != "") {
  #   label_RStudio <- labels[which(labels$name %like% 'RStudio'), 'id']
  #   if (length(label_RStudio) > 0) {
  #     request_labelRstudio <- POST(url = paste0("https://api.trello.com/1/cards/", card_id, "/idLabels"),
  #                                        body = list(value = label_RStudio[1],
  #                                                    key = key,
  #                                                    token = token))
  #     stop_for_status(request_labelRstudio, task = paste("add RStudio label", label_RStudio))
  #   }
  # }
  
  # Prio-label toevoegen
  if (prio %like% "^(Laag|Lage)") {
    prio <- labels[which(labels$name %like% 'Prio.*Laa?g.*'), 'id']
  } else if (prio %like% "^(Normaal|Normale)") {
    prio <- labels[which(labels$name %like% 'Prio.*Norma.*'), 'id']
  } else if (prio %like% "^(Hoog|Hoge)") {
    prio <- labels[which(labels$name %like% 'Prio.*Hoo?g.*'), 'id']
  } else {
    warning('Label like "', prio, '" not found on this Trello board, adding first empty label instead.', call. = FALSE)
    prio <- labels[which(labels$name == ""), 'id'][1]
  }
  if (length(prio) > 0) {
    request_labelPrio <- POST(url = paste0("https://api.trello.com/1/cards/", card_id, "/idLabels"),
                              body = list(value = prio[1],
                                          key = key,
                                          token = token))
    stop_for_status(request_labelPrio, task = paste("add label", prio))
  } else {
    warning('Label for priority not found on this Trello board.', call. = FALSE)
  }
  # lege checklist toevoegen
  request_checklist <- POST(url = "https://api.trello.com/1/checklists",
                            body = list(idCard = card_id,
                                        name = checklist_name,
                                        pos = "top",
                                        key = key,
                                        token = token))
  checklist_id <- content(request_checklist, "parsed", "application/json")$id
  stop_for_status(request_checklist, task = "add checklist")
  # checklist items toevoegen
  if (all(is.null(checklist)) | length(checklist) == 0) {
    checklist <- ""
  }
  for (i in 1:length(checklist)) {
    checklist[i] <- trimws(checklist[i])
    if (checklist[i] != "") {
      request_checklist_add <- POST(url = paste0("https://api.trello.com/1/checklists/", checklist_id, "/checkItems"),
                                    body = list(name = checklist[i],
                                                pos = "bottom",
                                                key = key,
                                                token = token))
      stop_for_status(request_checklist_add, task = paste("add checklist item", checklist[i]))
    }
  }
  
  # Kaart # retourneren
  card_nr
}

#' @rdname trello
#' @export
trello_credentials <- function(x = c("board", "board_default", "member", "key", "token"),
                               item = 1) {
  
  if (Sys.getenv(paste0("trello_", x)) != "") {
    found <- Sys.getenv(paste0("trello_", x))
  } else {
    yaml_file <- .R_REFMAP("Trello.yml")
    if (!file.exists(yaml_file)) {
      stop("File not found: ", yaml_file, call. = FALSE)
    }
    yaml <- yaml::read_yaml(file = yaml_file)
    if (!x %in% names(yaml)) {
      stop("Invalid Trello credential: ", x, call. = FALSE)
    }
    found <- yaml[[x]]
  }
  if (is.null(item)) {
    found %>% strsplit(",") %>% unlist()
  } else {
    found %>% strsplit.select(item, ",")
  }
  
}


#' @rdname trello
#' @export
trello_getboards <- function(username = trello_credentials("member"),
                             key = trello_credentials("key"),
                             token = trello_credentials("token")) {
  set_certe_proxy()
  
  GET_df(paste0("https://api.trello.com/1/members/", username, "/boards?key=", key, "&token=", token))
}

#' @rdname trello
#' @export
trello_getlists <- function(board = trello_credentials("board_default"),
                            key = trello_credentials("key"),
                            token = trello_credentials("token")) {
  set_certe_proxy()
  
  GET_df(paste0("https://api.trello.com/1/boards/", board,
                "/lists?key=", key, "&token=", token))
}

#' @rdname trello
#' @export
trello_getmembers <- function(board = trello_credentials("board_default"),
                              key = trello_credentials("key"),
                              token = trello_credentials("token")) {
  set_certe_proxy()
  
  GET_df(paste0("https://api.trello.com/1/boards/", board,
                "/members?key=", key, "&token=", token))
}

#' @rdname trello
#' @export
trello_getcards <- function(board = trello_credentials("board_default"),
                            key = trello_credentials("key"),
                            token = trello_credentials("token")) {
  set_certe_proxy()
  
  GET_df(paste0("https://api.trello.com/1/boards/", board,
                "/cards?key=", key, "&token=", token))
}

#' @rdname trello
#' @export
trello_getlabels <- function(board = trello_credentials("board_default"),
                             key = trello_credentials("key"),
                             token = trello_credentials("token")) {
  set_certe_proxy()
  
  GET_df(paste0("https://api.trello.com/1/boards/", board,
                "/labels?key=", key, "&token=", token))
}

#' @rdname trello
#' @export
trello_getcustomfields <- function(board = trello_credentials("board_default"),
                                   key = trello_credentials("key"),
                                   token = trello_credentials("token")) {
  set_certe_proxy()
  
  GET_df(paste0("https://api.trello.com/1/boards/", board,
                "/customFields?key=", key, "&token=", token))
}

#' @rdname trello
#' @export
trello_getchecklists <- function(board = trello_credentials("board_default"),
                                 key = trello_credentials("key"),
                                 token = trello_credentials("token")) {
  set_certe_proxy()
  
  GET_df(paste0("https://api.trello.com/1/boards/", board,
                "/checklists?key=", key, "&token=", token))
}

#' @rdname trello
#' @export
trello_getcomments <- function(card_id,
                               key = trello_credentials("key"),
                               token = trello_credentials("token")) {
  set_certe_proxy()
  
  GET_df(paste0("https://api.trello.com/1/cards/", card_id,
                "/actions?filter=commentCard&key=", key, "&token=", token))
}

#' @rdname trello
#' @export
trello_searchcard <- function(x,
                              board = trello_credentials("board_default"),
                              key = trello_credentials("key"),
                              token = trello_credentials("token")) {
  
  cards <- trello_getcards(board = board, key = key, token = token)
  lists <- trello_getlists(board = board, key = key, token = token)
  checklists <- trello_getchecklists(board = board, key = key, token = token)
  
  if (length(cards) == 0) {
    return(character(0))
  }
  
  total <- cards %>% left_join(lists, by = c("idList" = "id"), suffix = c(".card", ".list"))
  if (length(checklists) > 0) {
    total <- total %>%
      left_join(checklists, by = c("id" = "idCard"), suffix = c(".card", ".checklist")) %>%
      mutate(checklistitems = "")
    # checklistitems toevoegen
    for (i in 1:nrow(total)) {
      if (is.list(total[i, 'checkItems'])) {
        total[i, 'checklistitems'] <- concat(total[i, 'checkItems'][[1]]$name, " ")
      }
    }
  } else {
    checklistitems <- ""
  }
  
  total <- total %>%
    transmute(url = shortUrl,
              title = paste0(name.card, ' [', name.list, ']'),
              text = paste(name.card, desc, checklistitems, sep = " "))
  
  if (!is.null(x)) {
    total <- total %>% filter(text %like% x)
  }
  
  cards <- total %>% pull(url)
  names(cards) <- total %>% pull(title)
  
  cards
}

#' @rdname trello
#' @export
trello_openboard <- function(board = trello_credentials("board_default")) {
  browseURL(paste0("https://trello.com/b/", board))
}

#' @rdname trello
#' @export
trello_getcardfromfile <- function() {
  # probeer eerst kaartnummer uit volledige bestandsnaam:
  # /map/#123 Naam.Rmd
  # /#123 map/Naam.Rmd
  if (interactive()) {
    path <- rstudioapi::getSourceEditorContext()$path
  } else {
    # voor markdown
    path <- getwd()
  }
  parts <- unlist(strsplit(path, "[ /]"))
  id <- parts[parts %like% "^#[0-9]+$"][1]
  if (length(id) == 0 | is.na(id) & interactive()) {
    id <- rstudioapi::showPrompt("Kaartnummer", "Geen geldig kaartnummer gevonden. Voer hier een kaartnummer in:")
  }
  id <- gsub("[^0-9]", "", id)
  if (is.null(id) | identical(id, "")) {
    return(NULL)
  }
  id
}

#' @rdname trello
#' @export
trello_opencard <- function() {
  content <- trello_get_card_property(trello_getcardfromfile(), "url")
  browseURL(content)
}

#' @rdname trello
#' @export
trello_get_card_property <- function(card_number,
                                     property, 
                                     board = trello_credentials("board_default"),
                                     key = trello_credentials("key"),
                                     token = trello_credentials("token")) {
  trello_getcards(board, key, token) %>% filter(idShort == card_number) %>% pull(property)
}

#' @rdname trello
#' @export
trello_get_card_id <- function(card_number, 
                               board = trello_credentials("board_default"),
                               key = trello_credentials("key"),
                               token = trello_credentials("token")) {
  trello_getcards(board, key, token) %>% filter(idShort == card_number) %>% pull(id)
}

#' @rdname trello
#' @export
trello_setcomment <- function(card_id,
                              comment,
                              key = trello_credentials("key"),
                              token = trello_credentials("token")) {
  
  request_comments <- POST(url = paste0("https://api.trello.com/1/cards/", card_id, "/actions/comments"),
                           body = list(text = comment,
                                       key = key,
                                       token = token))
  stop_for_status(request_comments, task = paste("add comment to card", card_id))
}

#' @rdname trello
#' @export
trello_setdeadline <- function(card_id, 
                               duedate,
                               duecomplete = FALSE,
                               key = trello_credentials("key"),
                               token = trello_credentials("token")) {
  
  if (!is.null(duedate)) {
    duedate <- paste(as.Date(duedate), "11:00:00") # Trello voegt zelf 6 uur toe...?? Dus dit wordt deze dag 17:00 uur.
  } else {
    duedate <- "null"
  }
  request_card <- PUT(url = paste0("https://api.trello.com/1/cards/", card_id),
                      body = list(due = duedate,
                                  dueComplete = duecomplete,
                                  key = key,
                                  token = token),
                      encode = "json") # dit is nodig voor PUT!
  
  stop_for_status(request_card, task = paste("change deadline of card", card_id))
}

#' @rdname trello
#' @export
trello_addtask <- function(card_id,
                           new_items_vector = NULL,
                           checklist_name = "Taken",
                           board = trello_credentials("board_default"),
                           key = trello_credentials("key"),
                           token = trello_credentials("token")) {
 
  checklist_id <- trello_getchecklists() %>% filter(idCard == card_id)
  # bestaat checklist al?
  if (NROW(checklist_id) == 0 | checklist_id$name[1L] != checklist_name) {
    # checklist maken
    request_checklist <- POST(url = "https://api.trello.com/1/checklists",
                              body = list(idCard = card_id,
                                          name = checklist_name,
                                          pos = "top",
                                          key = key,
                                          token = token))
    checklist_id <- content(request_checklist, "parsed", "application/json")$id
    stop_for_status(request_checklist, task = "add checklist")
  } else {
    checklist_id <- checklist_id$id[1L]
  }
  
  # checklist items toevoegen
  if (all(is.null(new_items_vector)) | length(new_items_vector) == 0) {
    new_items_vector <- ""
  }
  for (i in 1:length(new_items_vector)) {
    new_items_vector[i] <- trimws(new_items_vector[i])
    if (new_items_vector[i] != "") {
      request_checklist_add <- POST(url = paste0("https://api.trello.com/1/checklists/", checklist_id, "/checkItems"),
                                    body = list(name = new_items_vector[i],
                                                pos = "bottom",
                                                key = key,
                                                token = token))
      stop_for_status(request_checklist_add, task = paste("add checklist item", new_items_vector[i]))
    }
  }
}

#' @rdname trello
#' @export
trello_settask_state <- function(card_id,
                                 checkitem_id,
                                 new_value = TRUE,
                                 key = trello_credentials("key"),
                                 token = trello_credentials("token")) {
  
  request_checkitem <- PUT(url = paste0("https://api.trello.com/1/cards/", card_id, "/checkItem/", checkitem_id),
                           body = list(state = ifelse(new_value == TRUE, "complete", "incomplete"),
                                       key = key,
                                       token = token),
                           encode = "json") # dit is nodig voor PUT!
  stop_for_status(request_checkitem, task = paste("change state of checkitem", checkitem_id))
}

#' @rdname trello
#' @export
trello_movecard <- function(card_id, 
                            list_id,
                            key = trello_credentials("key"),
                            token = trello_credentials("token")) {
  
  request_comments <- PUT(url = paste0("https://api.trello.com/1/cards/", card_id),
                          body = list(idList = list_id,
                                      pos = 'top', # altijd naar bovenaan verplaatsen
                                      key = key,
                                      token = token),
                          encode = "json") # dit is nodig voor PUT!
  stop_for_status(request_comments, task = paste("move card", card_id))
}

GET_df <- function(x) {
  result <- x %>% GET()
  stop_for_status(result)
  result %>%
    content(type = "text", encoding = "UTF-8") %>%
    jsonlite::fromJSON(flatten = TRUE)
}