R/cllovers.r

In colourlovers: R Client for the COLOURlovers API

#' Retrieve a user (lover)
#' 
#' Retrieve a lover (user) or set of lovers from the COLOURlovers API.
#' 
#' Retrieve details about a COLOURlovers user or users.
#' 
#' Specifying named arguments to \code{...} allows the user to request a
#' specific response, as follows:
#' 
#' \itemize{
#'   \item \code{orderCol}: A character string containing a sort criterion. One of
#'         \dQuote{dateCreated}, \dQuote{score}, \dQuote{name}, \dQuote{numVotes},
#'         \dQuote{numViews}.
#'   \item \code{sortBy}: A character string containing either \dQuote{ASC} (for
#'         ascending by the \code{orderCol} criterion, the default) or \dQuote{DSC}
#'         (for descending).
#'   \item \code{numResults}: A numeric value indicating the number of results to
#'         return, with a maximum of 100. Default is 20.
#'   \item \code{resultOffset}: A numeric value indicating the page of results to
#'         return, with page size specified in the \code{numResults} argument.
#' }
#' 
#' @param set Optionally, a subset of COLOURlovers palettes. Allowed values are
#'   \dQuote{new} and \dQuote{top}.
#' @param ... A named list of parameters passed to the API request. Allowed
#'   parameters are \code{orderCol}, \code{sortBy}, \code{numResults}, and
#'   \code{resultOffset}. Specifying \code{orderCol} overrules any argument to
#'   \code{set}. See details.
#' @param fmt A format for the API response, one of \dQuote{xml} (the default)
#'   or \dQuote{json}. This has essentially no effect on function behavior.
#' 
#' @return A list of class \dQuote{cllover}, including details about one or
#'   more users. This should be the same regardless of the value of \code{fmt}.
#' 
#' @export
#' 
#' @aliases cllover cllovers print.cllover print.cllovers
#' 
#' @author Thomas J. Leeper
#' @references \url{http://www.colourlovers.com/api/#lovers}
#' 
#' @examples \dontrun{
#' # Retrieve top users
#' cllovers(set = 'top', fmt = 'json')
#' 
#' # Retrieve a single user
#' cllover('COLOURlovers', fmt = 'json')
#' }
cllovers <- function(set = NULL, ..., fmt = 'xml') {
    # request multiple lovers
    if (!is.null(set)) {
        set <- match.arg(set, c('new', 'top'))
    }
    
    query <- list(...)
    query <- query[!sapply(query, is.null)]
    allowed <- c('orderCol', 'sortBy', 'numResults', 'resultOffset')
    query[which(!names(query) %in% allowed)] <- NULL
    n <- names(query)
    
    if ('orderCol' %in% n) {
        ord <- c('dateCreated', 'score', 'name', 'numVotes', 'numViews')
        if (!query$orderCol %in% ord) {
            query$orderCol <- NULL
            warning("orderCol not recognized")
        }
    }
    if ('sortBy' %in% n) {
        if (!query$sortBy %in% c('ASC', 'DSC')) {
            query$sortBy <- NULL
            warning("sortBy not recognized")
        }
    }
    if ('numResults' %in% n) {
        if (query$numResults > 100 | query$numResults < 1)
            query$numResults <- 20
    }
    if ('resultOffset' %in% n) {
        if (query$resultOffset < 1)
            query$resultOffset <- 1
    }            
    
    out <- clquery('lovers', set, query = query, fmt = fmt)
    names(out) <- rep('lover', length(out))
    class(out) <- c('cllovers', class(out))
    
    for (i in 1:length(out)) {
        class(out[[i]]) <- c('cllover', class(out))
    }
    
    return(out)
}

#' @rdname cllovers
#' @param user The COLOURlovers username for a specific user.
#' @param comments A boolean indicating whether to include the last ten
#'   comments for the user. Default is \code{FALSE}.
#' @export
cllover <- function(user, comments = FALSE, fmt = 'xml') {
    # request a single lover/user
    out <- list(lover = clquery('lover', user, 
                                query = list(comments = as.numeric(comments)), 
                                fmt = fmt)[[1]])[[1]]
    class(out) <- c('cllover', class(out))
    return(out)
}

#' @export
print.cllover <- function(x, ...) {
    cat('Lover username:     ', x$userName[[1]], '\n')
    cat('Registered:         ', x$dateRegistered, '\n')
    cat('Last active:        ', x$dateLastActive, '\n')
    cat('Rating:             ', x$rating, '\n')
    cat('Location:           ', x$location[[1]], '\n')
    cat('Colors:             ', x$numColors, '\n')
    cat('Palettes:           ', x$numPalettes, '\n')
    cat('Patterns:           ', x$numPatterns, '\n')
    cat('Comments made:      ', x$numCommentsMade, '\n')
    cat('Lovers:             ', x$numLovers, '\n')
    cat('Comments on profile:', x$numCommentsOnProfile, '\n')
    cat('URL:                ', x$url[[1]], '\n')
    cat('API URL:            ', x$apiUrl[[1]], '\n')
    cat('\n')
    invisible(x)
}

#' @export
print.cllovers <- function(x, ...) sapply(x, print)