utils-unpack.R

#' Unpack user objects
#'
#' @param response_user Basically `response$user`
#'
#' @return A `tibble` with tidy user data.
#'   `name` is renamed to `user_name` due to duplication with e.g. list names,
#'   and `slug` is renamed to `user_slug` for the same reason.
#' @keywords internal
#' @noRd
#' @importFrom rlang has_name is_empty
#' @importFrom dplyr rename mutate_if
unpack_user <- function(response_user) {
  if (!inherits(response_user, what = "data.frame")) {
    stop("User object must be data.frame like")
  }

  if (is_empty(response_user)) {
    return(tibble())
  }

  # Flatten the tbl
  response_user <- cbind(response_user[names(response_user) != "ids"], response_user$ids)

  #  Extract avatars because they're doubly nested but only one value
  if (has_name(response_user, "images")) {
    response_user$avatar <- response_user$images$avatar$full
    response_user <- response_user[names(response_user) != "images"]
  }

  # Private users don't have a "name" field
  if (has_name(response_user, "name")) {
    response_user <- response_user |>
      rename(user_name = "name")
  }

  response_user |>
    rename(user_slug = "slug") |>
    mutate_if(is.factor, as.character) |>
    fix_tibble_response()
}

#' Unpack a standard show media object
#' This should work regardless of the value of `extended` to be sufficiently robust
#' @keywords internal
#' @noRd
#' @importFrom rlang has_name
#' @importFrom purrr modify_if
#' @importFrom purrr modify_in
#' @importFrom dplyr select
#' @importFrom dplyr bind_cols
unpack_show <- function(show) {
  if (!inherits(show, "data.frame")) {
    stop("show should inherit from data.frame, but is class ", class(show))
  }

  # Convert, just in case
  show <- as_tibble(show)

  # Flatten "airs" (not present in minimal output)
  if (has_name(show, "airs")) {
    show <- modify_in(
      show, "airs",
      ~ modify_if(.x, is.null, ~ return(NA_character_))
    )
    show$airs <- as_tibble(show$airs)

    names(show$airs) <- paste0("airs_", names(show$airs))

    show <- show |>
      select(-"airs") |>
      cbind(show$airs) |>
      as_tibble()
    # Note: Use cbind() over dplyr::bind_cols(): The latter complains about columns
    # that are data.frames. cbind() might be ever so slightly slower, but less picky.
  }

  show <- show |>
    select(-"ids") |>
    bind_cols(fix_ids(show$ids)) |>
    as_tibble() |>
    fix_datetime()

  show
}

#' Unpack movie object
#' @keywords internal
#' @importFrom dplyr bind_cols
#' @importFrom dplyr select
#' @importFrom rlang has_name
#' @noRd
unpack_movie <- function(response) {
  if (!has_name(response, "movie")) {
    return(response)
  }

  bind_cols(
    response |> select(-"movie"),
    response$movie |> select(-"ids"),
    response$movie$ids |> fix_ids()
  ) |>
    fix_tibble_response()
}

#' Crew subsections
#' Unpacks production, art, crew, costume & make-up, directing,
#' writing, sound, and camera
#' @keywords internal
#' @noRd
#' @importFrom purrr map_df
#' @importFrom rlang has_name
#' @importFrom dplyr bind_cols
#' @importFrom dplyr mutate
#' @importFrom dplyr select
#' @source <https://trakt.docs.apiary.io/#reference/people/shows> for crew sections
unpack_crew_sections <- function(crew, type) {
  if (type == "shows") {
    map_df(trakt_people_crew_sections, function(section) {
      if (has_name(crew, section)) {
        crew[[section]] <- crew[[section]]$show |>
          unpack_show() |>
          bind_cols(
            crew[[section]] |>
              select(-"show")
          ) |>
          as_tibble() |>
          mutate(crew_type = section)
      }

      crew[[section]]
    })
  } else if (type == "movies") {
    map_df(trakt_people_crew_sections, function(section) {
      if (has_name(crew, section)) {
        crew[[section]] <- crew[[section]] |>
          unpack_movie() |>
          as_tibble() |>
          mutate(crew_type = section)
      }

      crew[[section]]
    })
  }
}

#' Unpack people in media_people functions
#'
#' @keywords internal
#' @noRd
#' @importFrom purrr map_df
#' @importFrom rlang has_name is_empty
#' @importFrom dplyr bind_cols
#' @importFrom dplyr mutate select
unpack_people <- function(response) {
  if (is_empty(response)) {
    return(tibble())
  }

  # Flatten the data.frame
  if (has_name(response, "cast") && !is_empty(response$cast)) {
    response$cast$person[["images"]] <- NULL

    response$cast$person <- response$cast$person |>
      select(-"ids") |>
      cbind(fix_ids(response$cast$person$ids)) |>
      fix_datetime() |>
      as_tibble()

    response$cast <- response$cast |>
      select(-"person") |>
      cbind(response$cast$person) |>
      as_tibble()
  }

  if (has_name(response, "crew") && !is_empty(response$crew)) {
    response$crew <- map_df(trakt_people_crew_sections, function(section) {
      response$crew[[section]]$person[["images"]] <- NULL

      if (!has_name(response$crew, section) | is_empty(response$crew[[section]])) {
        return(tibble())
      }

      response$crew[[section]]$person <- response$crew[[section]]$person |>
        select(-"ids") |>
        cbind(fix_ids(response$crew[[section]]$person$ids))

      response$crew[[section]] <- response$crew[[section]] |>
        select(-"person") |>
        cbind(response$crew[[section]]$person) |>
        mutate(crew_type = section) |>
        as_tibble() |>
        fix_datetime()
    })
  }

  if (has_name(response, "guest_stars") && !is_empty(response$guest_stars)) {
    response$guest_stars$person[["images"]] <- NULL

    response$guest_stars$person <- response$guest_stars$person |>
      select(-"ids") |>
      cbind(fix_ids(response$guest_stars$person$ids)) |>
      fix_datetime() |>
      as_tibble()

    response$guest_stars <- response$guest_stars |>
      select(-"person") |>
      cbind(response$guest_stars$person) |>
      as_tibble()
  }

  response
}

#' Unpack lists in list methods
#'
#' @param response As returned by [trakt_get].
#'
#' @keywords internal
#' @noRd
#' @return A [tibble()][tibble::tibble-package].
#' @importFrom rlang is_empty
#' @importFrom dplyr bind_cols select
#' @importFrom purrr pluck
unpack_lists <- function(response) {
  if (is_empty(response)) {
    return(tibble())
  }

  response |>
    select(-any_of(c("ids", "user"))) |>
    bind_cols(
      pluck(response, "ids") |> fix_ids(),
      pluck(response, "user") |> unpack_user()
    ) |>
    fix_tibble_response()
}

#' Unpack comments in comment methods
#'
#' @param response As returned by [trakt_get].
#'
#' @keywords internal
#' @noRd
#' @return A [tibble()][tibble::tibble-package].
#' @importFrom rlang is_empty
#' @importFrom dplyr bind_cols
#' @importFrom purrr pluck discard
unpack_comments <- function(response) {
  if (is_empty(response)) {
    return(tibble())
  }

  response |>
    discard(is.list) |>
    as_tibble() |>
    bind_cols(
      pluck(response, "user") |>
        as_tibble() |>
        unpack_user()
    ) |>
    mutate(user_rating = as.integer(.data[["user_rating"]])) |>
    fix_tibble_response()
}

#' Unpack comments in comment methods
#'
#' @param response As returned by [trakt_get].
#'
#' @keywords internal
#' @noRd
#' @return A [tibble()][tibble::tibble-package].
#' @importFrom rlang is_empty
#' @importFrom dplyr bind_cols filter select pull
#' @importFrom purrr pluck map_df
unpack_comments_multitype <- function(response) {
  if (is_empty(response)) {
    return(tibble())
  }

  # What types are present in the list
  list_types <- unique(response$type)

  # Get the list "base" without media items
  # in this case only a type column
  list_base <- response |> select("type")

  # Row-bind the list base to the unpacked media items
  map_df(list_types, ~ {
    bind_cols(
      list_base |>
        filter(type == .x),
      response |>
        filter(type == .x) |>
        pull("comment") |>
        unpack_comments(),
      flatten_media_object(response, .x)
    )
  }) |>
    fix_tibble_response()
}

#' Generalized unpacker
#'
#' @param x A response object
#' @param type One of "movie", "show", "season", "episode", "person"
#'
#' @return A flat `tibble()`
#' @keywords internal
#' @noRd
#' @importFrom dplyr filter select bind_cols vars rename_at rename_all ends_with
#' @importFrom stringr str_c str_remove str_replace
#' @importFrom purrr pluck
flatten_media_object <- function(x, type) {
  x <- x |>
    as_tibble() |>
    filter(type == !!type)

  if (nrow(x) == 0) {
    return(tibble())
  }

  if (type == "show") {
    res <- pluck(x, "show") |>
      unpack_show()
  } else if (type == "movie") {
    res <- bind_cols(
      pluck(x, "movie") |> select(-"ids"),
      pluck(x, "movie", "ids") |> fix_ids()
    )
  } else if (type == "season") {
    res <- bind_cols(
      pluck(x, "show") |>
        unpack_show(),
      pluck(x, "season") |>
        select(-"ids") |>
        rename_all(~ paste0("season_", .x)),
      pluck(x, "season", "ids") |>
        fix_ids() |>
        rename_all(~ paste0("season_", .x))
    )
  } else if (type == "episode") {
    res <- bind_cols(
      pluck(x, "show") |> unpack_show(),
      pluck(x, "episode") |>
        select(-"ids") |>
        rename_all(~ paste0("episode_", .x)),
      pluck(x, "episode", "ids") |>
        fix_ids() |>
        rename_all(~ paste0("episode_", .x))
    )
  } else if (type == "person") {
    res <- bind_cols(
      pluck(x, "person") |> select(-"ids"),
      pluck(x, "person", "ids") |> fix_ids()
    )
  } else if (type == "list") {
    res <- bind_cols(
      pluck(x, "list") |> select(-"ids"),
      pluck(x, "list", "ids") |> fix_ids()
    )
  }

  res |>
    fix_datetime() |>
    filter(!is.na(.data[["trakt"]])) |>
    as_tibble()
}

#' Generalized unpacker for single items in _summary functions
#'
#' @param x A response object
#' @param type One of "movie", "show", "season", "episode", "person"
#'
#' @return A flat `tibble()`
#' @keywords internal
#' @noRd
#' @importFrom dplyr filter select bind_cols vars rename_at rename_all ends_with matches
#' @importFrom stringr str_c str_remove str_replace
#' @importFrom purrr modify_if modify_at discard pluck list_merge set_names
flatten_single_media_object <- function(response, type) {
  if (is_empty(response)) {
    return(tibble())
  }

  if (type %in% c("movie", "movies")) {
    if (has_name(response, "movie")) {
      response <- pluck(response, "movie")
    }

    res <- response |>
      modify_if(is.null, ~NA_character_) |>
      discard(is.list) |>
      list_merge(
        !!!(pluck(response, "ids") |> fix_ids())
      ) |>
      modify_if(~ length(.x) > 1, list)
  }

  if (type %in% c("show", "shows")) {
    if (has_name(response, "show")) {
      response <- pluck(response, "show")
    }

    res <- response |>
      modify_if(is.null, ~NA_character_) |>
      discard(is.list) |>
      modify_if(~ length(.x) > 1, list)

    if (has_name(response, "airs")) {
      airs <- response |>
        pluck("airs", .default = NULL) |>
        set_names(~ paste0("airs_", .x))

      res <- list_merge(res, !!!airs)
    }

    res <- res |> list_merge(
      !!!(pluck(response, "ids") |> fix_ids())
    )
  }

  if (type %in% c("episode", "episodes")) {
    res <- response |>
      pluck("episode") |>
      modify_if(is.null, ~NA_character_) |>
      discard(is.list) |>
      modify_if(~ length(.x) > 1, list) |>
      list_merge(
        !!!(pluck(response, "episode", "ids") |> fix_ids())
      ) |>
      as_tibble() |>
      rename(episode = "number") |>
      rename_at(vars(-"season", -"episode"), ~ paste0("episode_", .x))

    res <- bind_cols(
      flatten_single_media_object(response[["show"]], "show"),
      res
    )
  }

  if (type %in% c("season", "seasons")) {
    res <- response |>
      pluck("season") |>
      modify_if(is.null, ~NA_character_) |>
      discard(is.list) |>
      modify_if(~ length(.x) > 1, list) |>
      list_merge(
        !!!(pluck(response, "season", "ids") |> fix_ids())
      ) |>
      as_tibble() |>
      rename(season = "number") |>
      rename_at(vars(-"season"), ~ paste0("season_", .x))

    res <- bind_cols(
      flatten_single_media_object(response[["show"]], "show"),
      res
    )
  }


  # Take possible list-columns (genres etc.) and make them lists if not already
  # Required to be able to bind_row() them to other results where the column
  # might not be a list already
  res |>
    modify_at(
      grepl("^genres$|^available_translations$|^languages$", names(res)),
      ~ {
        if (!is.list(.x)) list(.x) else .x
      }
    ) |>
    fix_tibble_response()
}