Initial ideas for Federal Register API client

federalregister.R

# https://www.federalregister.gov/developers/api/v1

# NAMESPACE
# importFrom(RJSONIO, fromJSON)
# importFrom(RCurl, curlPerform, basicTextGatherer)
# S3method(print,fedreg_document)
# S3method(print,fedreg_agency)

fr_search <- function(version='v1', ...) {

    baseurl <- paste('https://www.federalregister.gov/api/',version,'/articles.json', sep='')

    h <- basicTextGatherer()
    curlPerform(url = paste(baseurl, args, sep=''),
                followlocation = 1L, ssl.verifypeer = 1L, ssl.verifyhost = 2L, 
                cainfo = system.file("CurlSSL", "cacert.pem", package = "RCurl"),
                writefunction=h$update, ...)
    response <- h$value()
    out <- fromJSON(response)
    class(out) <- 'fedreg_document'
    return(out)
}

fr_get <- function(docnumber, version='v1', ...){

    # combine multiple document numbers
    docnumbers <- paste(docnumber, collapse=',')
    baseurl <- paste('https://www.federalregister.gov/api/',version,'/articles/',docnumbers,'.json', sep='')
    
    args <- NULL
    
    h <- basicTextGatherer()
    curlPerform(url = paste(baseurl, args, sep=''),
                followlocation = 1L, ssl.verifypeer = 1L, ssl.verifyhost = 2L, 
                cainfo = system.file("CurlSSL", "cacert.pem", package = "RCurl"),
                writefunction=h$update, ...)
    response <- h$value()
    out <- fromJSON(response)
    if(length(strsplit(docnumbers,',')[[1]])==1){
        class(out) <- 'fedreg_document'
        out <- list(out)
    } else {
        out <- out[[2]]
        out <- lapply(out, function(x) {
            class(x) <- 'fedreg_document'
            return(x)
        })
    }
    class(out) <- 'fedreg_document'
    return(out)
    
}

fr_agencies <- function(id=NULL, version='v1', ...){
    if(is.null(id))
        baseurl <- paste('https://www.federalregister.gov/api/',version,'/agencies', sep='')
    else
        baseurl <- paste('https://www.federalregister.gov/api/',version,'/agencies/', id, sep='')
    
    args <- NULL
    
    h <- basicTextGatherer()
    curlPerform(url = paste(baseurl, args, sep=''),
                followlocation = 1L, ssl.verifypeer = 1L, ssl.verifyhost = 2L, 
                cainfo = system.file("CurlSSL", "cacert.pem", package = "RCurl"),
                writefunction=h$update, ...)
    response <- h$value()
    out <- fromJSON(response)
    if(length(out)>1){
        out <- lapply(out, function(x) {
            class(x) <- 'fedreg_agency'
            return(x)
        })
    } else
        class(out) <- 'fedreg_agency'
    return(out)
}



pi_current <- function(version='v1', ...){

    baseurl <- paste('https://www.federalregister.gov/api/',version,'/public-inspection-documents/current.json', sep='')
    args <- NULL
    
    h <- basicTextGatherer()
    curlPerform(url = paste(baseurl, args, sep=''),
                followlocation = 1L, ssl.verifypeer = 1L, ssl.verifyhost = 2L, 
                cainfo = system.file("CurlSSL", "cacert.pem", package = "RCurl"),
                writefunction=h$update, ...)
    response <- h$value()
    out <- fromJSON(response)
    out <- out[[2]]
    out <- lapply(out, function(x) {
        class(x) <- 'fedreg_document'
        return(x)
    })
    return(out)
}

pi_search <- function(version='v1', ...) {
    
    # api docs mention separate by-date API, but same as search:
    # conditions[available_on]=date
    
    baseurl <- paste('https://www.federalregister.gov/api/',version,'/public-inspection-documents.json', sep='')
    
    h <- basicTextGatherer()
    curlPerform(url = paste(baseurl, args, sep=''),
                followlocation = 1L, ssl.verifypeer = 1L, ssl.verifyhost = 2L, 
                cainfo = system.file("CurlSSL", "cacert.pem", package = "RCurl"),
                writefunction=h$update, ...)
    response <- h$value()
    out <- fromJSON(response)
    class(out) <- 'fedreg_document'
    return(out)
}


pi_get <- function(docnumber, version='v1', ...){

    # combine multiple document numbers
    docnumbers <- paste(docnumber, collapse=',')
    baseurl <- paste('https://www.federalregister.gov/api/',version,
                     '/public-inspection-documents/',docnumbers,'.json', sep='')
    
    args <- NULL
    
    h <- basicTextGatherer()
    curlPerform(url = paste(baseurl, args, sep=''),
                followlocation = 1L, ssl.verifypeer = 1L, ssl.verifyhost = 2L, 
                cainfo = system.file("CurlSSL", "cacert.pem", package = "RCurl"),
                writefunction=h$update, ...)
    response <- h$value()
    out <- fromJSON(response)
    if(length(strsplit(docnumbers,',')[[1]])==1){
        class(out) <- 'fedreg_document'
        out <- list(out)
    } else {
        out <- out[[2]]
        out <- lapply(out, function(x) {
            class(x) <- 'fedreg_pidocument'
            return(x)
        })
    }
    return(out)
}


print.fedreg_agency <- function(x, ...){
    if(!is.null(x$short_name))
        cat(x$short_name, ': ', sep='')
    cat(x$name, '\n', sep='')
    cat('ID:', x$id)
    if(!is.null(x$parent_id))
        cat(' Parent ID:',x$parent_id, '\n')
    else
        cat('\n')
    cat(strwrap(x$description),'\n')
    cat('URL: ',x$url,'\n')
    cat('URL for recent articles: ', x$recent_articles_url, '\n')
    cat('\n')
    invisible(x)
}

print.fedreg_document <- function(x, ...){
    
    cat(x$type)
    if(!is.null(x$subtype))
        cat(', ', x$subtype)
    if(!is.null(x$toc_doc))
        cat(': ', x$toc_doc, sep='')
    else if(!is.null(x$title))
        cat(': ', x$title, sep='')
    cat('\n')
    cat('FR Document Number:',x$document_number)
    if(!is.null(x$citation))
        cat(' Citation: ', x$citation)
    cat('\n')
    cat('Date:', x$publication_date, '\n')
    if(!is.null(x$page_length))
        cat(x$page_length, 'Pages:', x$start_page, '-', x$end_page, '\n')
    
    cat('Agencies mentioned:\n')
    lapply(x$agencies, function(a) {cat('  ', a$raw_name, '(',a$id,')\n',sep='')})
    
    cat('URLs:\n')
    cat('  Raw text: ', x$raw_text_url, '\n')
    if(!is.null(x$body_html_url))
        cat('  HTML:     ', x$body_html_url, '\n')
    else if(!is.null(x$html_url))
        cat('  HTML:     ', x$html_url, '\n')
    cat('  JSON:     ', x$json_url, '\n')
    cat('\n')
    invisible(x)
}