#' Clone an existing directory
#'
#' Clone an existing directory to a new location.
#' This is typically performed inside \code{\link{saveObject}} after detecting duplicated objects,
#' see \code{?\link{createDedupSession}} for an example use case.
#'
#' @param src String containing the path to the source directory, typically generated by a prior \code{\link{saveObject}} call.
#' @param dest String containing the path to the destination directory, typically the \code{path} in a subsequent \code{\link{saveObject}} call. 
#' @param action String specifying the action to use when cloning files from \code{src} to \code{dest}.
#' \itemize{
#' \item \code{"copy"}: copy all files within \code{src} to their corresponding locations in \code{dest}.
#' \item \code{"link"}: create a hard link from each file in \code{src} to its corresponding location in \code{dest}.
#' If this fails, we silently fall back to a copy.
#' \item \code{"symlink"}: create a symbolic link from each file in \code{src} to its corresponding location in \code{dest}.
#' Each symbolic link contains the absolute path in the corresponding file in its original directory,
#' which is useful when the contents of \code{dest} might be moved (but the original directory will not).
#' \item \code{"relsymlink"}: create a symbolic link from each file in \code{src} to its corresponding location in \code{dest}.
#' Each symbolic link contains the minimal relative path to the corresponding file in the original directory,
#' which is useful when both \code{src} and \code{dest} are moved together, e.g., as they are part of the same parent object like a SummarizedExperiment.
#' }
#' 
#' @return A new directory is created at \code{dest} with the contents of \code{src}, either copied or linked.
#' \code{NULL} is invisibly returned.
#' 
#' @author Aaron Lun
#'
#' @examples
#' tmp <- tempfile()
#' dir.create(tmp)
#' 
#' src <- file.path(tmp, "A")
#' dir.create(src)
#' write(file=file.path(src, "foobar"), LETTERS)
#' 
#' dest <- file.path(tmp, "B")
#' cloneDirectory(src, dest)
#' list.files(dest, recursive=TRUE)
#'
#' @seealso
#' \code{\link{cloneFile}}, to clone individual files.
#' 
#' @export
#' @importFrom utils head tail
cloneDirectory <- function(src, dest, action=c("link", "copy", "symlink", "relsymlink")) {
    action <- match.arg(action)
    dir.create(dest)
    manifest <- list.files(src, recursive=TRUE)

    if (action == "relsymlink") {
        base2base <- relative_path_to_src(src, dest)
        pwd <- getwd()

        for (y in manifest) {
            ydir <- dirname(y)
            ybase <- basename(y)
            ywd <- file.path(dest, ydir)
            dir.create(ywd, recursive=TRUE, showWarnings=FALSE)

            ycounter <- 0L
            while (ydir != ".") {
                ydir <- dirname(ydir)
                ycounter <- ycounter + 1L
            }
            ycomponents <- c(rep("..", ycounter), base2base, y)
            ytarget <- do.call(file.path, as.list(ycomponents))

            (function() { # wrapping this in a function so that the on.exit is called in a timely manner.
                on.exit(setwd(pwd))
                setwd(ywd)
                if (!file.symlink(ytarget, ybase)) {
                    stop("failed to link '", y, "' from '", src, "' to '", dest, "'")
                }
            })()
        }

    } else if (action == "link") {
        for (y in manifest) {
            to <- file.path(dest, y)
            dir.create(dirname(to), recursive=TRUE, showWarnings=FALSE)
            from <- file.path(src, y)
            from <- resolve_symlinks(from) # Resolving any symlinks so that we hard link to the original file.
            if (!suppressWarnings(file.link(from, to)) && !file.copy(from, to)) {
                stop("failed to copy or link '", y, "' from '", src, "' to '", dest, "'")
            }
        }

    } else if (action == "copy") {
        for (y in manifest) {
            to <- file.path(dest, y)
            dir.create(dirname(to), recursive=TRUE, showWarnings=FALSE)
            from <- file.path(src, y)
            if (!file.copy(from, to)) { # file.copy() follows symbolic links, so no need for special treatment here.
                stop("failed to copy '", y, "' from '", src, "' to '", dest, "'")
            }
        }

    } else if (action == "symlink") {
        for (y in manifest) {
            to <- file.path(dest, y)
            dir.create(dirname(to), recursive=TRUE, showWarnings=FALSE)
            from <- absolutizePath(file.path(src, y))
            if (!file.symlink(from, to)) {
                stop("failed to symlink '", y, "' from '", src, "' to '", dest, "'")
            }
        }
    }
}

relative_path_to_src <- function(src, dest) {
    src <- normalizePath(src, mustWork=TRUE)
    src.comp <- decompose_path(src)$components
    src.len <- length(src.comp)

    dest <- normalizePath(dest, mustWork=TRUE)
    dest.comp <- decompose_path(dest)$components
    dest.len <- length(dest.comp)

    counter <- 0L
    for (i in seq_len(min(src.len, dest.len))) {
        if (src.comp[i] != dest.comp[i]) {
            counter <- i - 1L
            break
        }
    }

    components <- c(rep("..", dest.len - counter), src.comp[(counter+1):src.len])
    do.call(file.path, as.list(components))
}

decompose_path <- function(path) {
    output <- character()
    repeat {
        base <- basename(path)
        dpath <- dirname(path)
        if (dpath == path && dpath != ".") {
            return(list(relative=FALSE, root=dpath, components=output))
        }
        output <- c(base, output)
        if (dpath == ".") {
            return(list(relative=TRUE, root=NULL, components=output))
        }
        path <- dpath
    }
}

resolve_symlinks <- function(from) {
    while (1) {
        ll <- Sys.readlink(from)
        if (ll == "") {
            break
        }

        decomposed <- decompose_path(ll)
        if (decomposed$relative) {
            from <- file.path(dirname(from), ll)
        } else {
            from <- ll
        }
    }

    from
}
