R/knitr.R

In gmbecker/recordr: Semantic Annotation and Discoverability System for R-Based Artifacts

recplothook = function(x, opts, ...) {
    if(is.null(defaultTDB())) {
        warning("cannot record plot, default db not set. Use defaultTDB() in the first chunk to do this")
    } else if(!is.null(ggplot2::last_plot())){
        
        len = length(histry::histry())
        record(ggplot2::last_plot(), symorpos = len)
    }
    paste0("![", x, "]")

}



.handlerender = function(rfun) {
    if(is.null(rfun))
        ## lifted from knitr:::knit_handlers (knitr:::utils.R) 
        rfun = function(x, ...) {
            res = withVisible(knitr::knit_print(x, ...))
            ## indicate the htmlwidget result with a special class so we can attach
            ## the figure caption to it later in wrap.knit_asis
            if (inherits(x, 'htmlwidget'))
                class(res$value) = c(class(res$value), 'knit_asis_htmlwidget')
            if (res$visible) res$value else invisible(res$value)
        }

    function(x, options) {
        record(x)
        rfun(x, options = options)
    }
}

idPath = function(x) gsub(":", "_", x)

##' @title Knit and record an Rmd, Rnw, etc file
##'
##' @description This function wraps knitr's \code{knit} function in
##' a way that captures and records some or all values generated by code within the report, as well as the report itself. 
##'
##' This means that many records will generally be added to the trackr db for
##' a single call to this function.
##'
##' @param input The input argument exactly as knitr's \code{knit}
##'     function accepts it
##' @param ... Passed directly to \code{knit}
##' @param verbose passed to (multiple) \code{record} calls for report
##'     and its outputs
##' @param tmptdb A TrackrDB in which to temporarily record results
##'     which are printed within the dynamic document. Generally this
##'     should not need to be changed, as it is only used to collect
##'     the records so they can be associated with the result for the
##'     whole document (in the defaultTDB).
##' @param recvars character or NULL. The names of variables generated by the code within \code{input} which should be automatically recorded, or NULL.
##' @param dryrun logical. Should a dryrun be performed?
##'
##' @details When \code{recvars} is NULL, any objects which are
##'     visibly printed within the report are also
##'     recorded. Otherwise, only the values of the listed variables
##'     (after all code has been evaluated) are recorded, regardless
##'     of visibility
##' @note as with all knitr support in the histry and trackr packages,
##'     manually tracing certain functions within the knitr and
##'     evaluate packages will break this function.
##' @import rmarkdown
##' @export
knit_and_record = function(input, ..., verbose = FALSE,
                           tmptdb = TrackrDB(backend= ListBackend(),
                                             img_dir = img_dir(defaultTDB())),
                           recvars = NULL,
                           dryrun = FALSE) {
    oldtdb = defaultTDB()
    on.exit(defaultTDB(oldtdb))
    defaultTDB(tmptdb)
    ## knitrtracer(FALSE) ## probably unnecessary
    evaltracer(FALSE)
    headermat = yaml_front_matter(input)
    if(is.null(recvars) && "recvars" %in% names(headermat) &&
       !identical("all", headermat$recvars))
        recvars = unlist(strsplit(headermat$recvars, " "))
    

    if(is.null(recvars))
        evaltracer(TRUE, record = TRUE)
    else
        evaltracer(TRUE, record = FALSE)
    con = textConnection("tangletxt", "w", local=TRUE)
    on.exit(close(con), add=TRUE)
    
    knitr::knit(input = input, output = con, tangle=TRUE)
    trackr_knit_env$chunks = NULL
    suppressMessages(trace("split_file", where = asNamespace("knitr"),
                           exit = quote(assign('chunks', returnValue(), envir = trackr_knit_env)),
                           print = FALSE))
    on.exit(suppressMessages(untrace("split_file", where = asNamespace("knitr"))), add=TRUE)


    evalenv = new.env()
      
    if("output" %in% names(list(...)))
        odir = dirname(list(...)$output)
    else
        odir = dirname(input) #getwd()

    starttime = Sys.time()
    if(grepl("[Rr][Mm][Dd]$", input))
        resfile = render(input = input,
                         output_format = html_document(self_contained = FALSE,
                                                       mathjax = NULL),
                         run_pandoc = TRUE, envir = evalenv, ...)
    else if (grepl("[Rr][Nn][Ww]$", input)) {
        resfile = render(input = input,  output_format = "pdf_document",
                         run_pandoc=TRUE, envir = evalenv, ...)
    }
    
    endtime = Sys.time()

   
    
    filenamestub = gsub("(.*)\\.R..$", "\\1", basename(input))
    figpath = file.path(odir, paste0(filenamestub, "_files"))
    figs = character()

    if(file.exists(file.path(odir, "figure"))) {
        dir.create(file.path(figpath, "figure-html"))
        file.copy(list.files(file.path(odir, "figure"), full.names=TRUE),
                  file.path(figpath, "figure-html"))
    }
    if(file.exists(figpath))
        figs = list.files(figpath, recursive=TRUE)

    figsfull = file.path(figpath, figs)

   
   
    if(length(figs) > 0 && grepl("html", resfile, ignore.case=TRUE)) {
        alllines = readLines(resfile)
        figs = figs[sapply(basename(figs), function(x) any(grepl(x, alllines)))]
        ## ## these are integers. ugh. thisisfine.jpg
        ## figmtimes = sapply(figsfull, function(x) file.info(x)$mtime)
        ## figs = figs[figmtimes > starttime & figmtimes <= endtime]
    }

    figmd5 = character()
    if(length(figs) > 0) {
        figs = normalizePath(figs) ## md5sum fails on relative paths...
        figmd5 = tools::md5sum(figs)
    }

    uniqueid = gen_hash_id(c(readLines(resfile), figmd5))
        
    
  
    chunks = unlist(lapply( trackr_knit_env$chunks, function(x) x$input))
    trackr_knit_env$chunks = NULL

    evaltracer(FALSE)
    evaltracer(TRUE)

    if(!is.null(recvars)) {
        lapply(recvars, function(nm) { record(get(nm, envir = evalenv),
                                              code = histropts()$knitrHistory,
                                              symorpos = nm)})
    } #otherwise recording has already happened.
    
    ## turn on the real backend and clean up the onexit stuff
    defaultTDB(oldtdb)
    suppressMessages(untrace("split_file", where = asNamespace("knitr")))
    close(con) #from on.exit(close(con)) when grabbing tangle text
    on.exit(NULL)

    rmdfs = RmdFeatureSet(rmdfile = input, objtdb = tmptdb,
                          uniqueid = uniqueid,
                          outputfile = resfile, chunks = chunks,
                          figurefiles = figs)
    imgpat = paste0("(", paste(idPath(rmdfs@outputids), collapse="|"), ")")
    imgfiles = list.files(img_dir(tmptdb), pattern = imgpat, full.names = TRUE)
 #   stopifnot(length(imgfiles) == 3 * length(rmdfs@outputids))
    file.copy(imgfiles, file.path(img_dir(oldtdb), basename(imgfiles)))
    objfsets = lapply(docs(trackr_backend(tmptdb)), function(x) {
        fs = listRecToFeatureSet(x)
        fs@generatedin = uniqueID(rmdfs)
        fs@regdate = rmdfs@regdate
        fs@extramdata = c(fs@extramdata, .cleanHeader(headermat))
        ret = fs
        fs})
    res1 = record(rmdfs, code =NULL, verbose = verbose, dryrun = dryrun)
    reslots = lapply(objfsets, function(x) record(x, code = objCode(x),
                                                  symorpos = length(code),
                                                  verbose = verbose,
                                                  dryrun = dryrun))
    if(dryrun) 
        c(list(res1), reslots)
    else 
        oldtdb
}