#' Flatten (Nested) Lists or Environments.
#'
#' Flatten \code{lists} or \code{environments} according to specifications
#' made via arg \code{start.after} and/or arg \code{stop.at}. When keeping 
#' the defaults, the function will traverse arg \code{src} (if \code{src} is 
#' an \code{environment}, it is coerced to a \code{list} 
#' via \code{\link{envirToList}} first) to retrieve the values at the 
#' respective bottom layers/bottom elements. These values are arranged in a 
#' named \code{list} where the respective names can be interpreted as the
#' the paths to the retrieved values. See examples.   
#'
#' @param src A named (arbitrary deeply nested) \code{list} or an 
#' \code{environment} that should be flattened.
#' @param start.after An \code{integer} specifying the layer after which to 
#' start the flattening. \code{NULL} means to start at the very top. See
#' examples.
#' @param stop.at An \code{integer} specifying the layer at which to stop
#' the flattening. \code{NULL} means there is no stop criterion.
#' @param delim.path A \code{character} (length: 1) specifying how the names of 
#' the resulting flattened list should be pasted.
#' @param .do.debug If \code{TRUE}, print information that might be helpful
#' for debugging.
#' @param ... Further args.
#' @return A named \code{list} that features the desired degree of flattening.
#' @callGraphPrimitives
#' @author Janko Thyson \email{janko.thyson.rstuff@@googlemail.com}
#' @seealso \code{\link{envirToList}}
#' @example inst/examples/flatten.R
flatten <- function(
    src, 
    start.after=NULL, 
    stop.at=NULL, 
    .delim.path="/",
    .delim.index="-",
    do.index=FALSE,
    do.original=TRUE,
    do.warn=TRUE,
    .do.debug=FALSE,
    ...
){
    #---------------------------------------------------------------------------
    # VALIDATE
    #---------------------------------------------------------------------------
    
    if(!is.list(src) & !is.environment(src)){
        stop("Arg 'src' must be a 'list' or an 'environment'.")
    }
    if(!is.null(start.after) & !is.null(stop.at)){
        if(start.after == 1& stop.at == 1){
            msg <- c(
                "Invalid specification:",
                paste("* start.after: ", start.after, sep=""),
                paste("* stop.at:     ", stop.at, sep="")
            )
            stop(cat(msg, sep="\n"))
        }
    }
    # /VALIDATE ----------
    
    #---------------------------------------------------------------------------
    # INNER FUNCTIONS
    #---------------------------------------------------------------------------
    
    .startAfterInner <- function(
        envir,
        nms,
        out.1,
        do.reset=FALSE,
        ...
    ){
        .do.debug <- envir$.do.debug
        idx.diff <- diff(c(envir$start.after, length(envir$counter)))
        if(.do.debug){
            cat(c("", "+++", ""), sep="\n")
            #                print("+++")
            cat("names:", sep="\n")
            print(names(out.1))
            cat("envir$counter:", sep="\n")
            print(envir$counter)
            cat("idx.diff:", sep="\n")
            print(idx.diff)            
        }
        # UPDATE IF DEGREE OF NESTEDNESS EXCEEDS START CRITERION
        if(idx.diff > 0){
            idx.cutoff      <- (
                length(envir$counter)-idx.diff+1):length(envir$counter
            ) 
            idx.left        <- envir$counter[-idx.cutoff]
            nms.1           <- nms[idx.cutoff]
            names(out.1)    <- paste(nms.1, collapse="/") 
            # UPDATE SRC
            idx.append <- sapply(envir$history, function(x.hist){
                all(idx.left == x.hist)        
            })
            if(.do.debug){
                cat("idx.cutoff:", sep="\n")
                print(idx.cutoff)
                cat("idx.left:", sep="\n")
                print(idx.left)
                cat("idx.append:", sep="\n")
                print(idx.append)
                cat("names remaining:", sep="\n")
                print(names(out.1))
            }
            if(any(idx.append)){                                          
                envir$src[[idx.left]] <- append(envir$src[[idx.left]], 
                    values=out.1)                    
            } else {
                envir$src[[idx.left]] <- out.1
                # UPDATE HISTORY
                envir$history <- c(envir$history, list(idx.left))
            }
            envir$out <- envir$src
            # /             
        } 
        if(idx.diff < 0){
            envir$out <- envir$src
        }
        # /
        # RESET
        if(do.reset){
            envir$nms       <- envir$nms[-length(envir$nms)]
            envir$counter   <- envir$counter[-length(envir$counter)]
        }
        # /
        return(TRUE)
    }
    
    .updateOutInner <- function(
        envir,
        out.1,
        do.reset=FALSE,
        ...
    ){
        .do.debug <- envir$.do.debug
        # UPDATE OUT
        out.0           <- get("out", envir = envir)
        out             <- c(out.0, out.1)
        envir$out       <- out
        # /
        # RESET
        if(do.reset){
            envir$nms       <- envir$nms[-length(envir$nms)]
            envir$counter   <- envir$counter[-length(envir$counter)]
        }
        # /
        return(TRUE)
    }
    
    .flattenInner <- function(
        src, 
        envir, 
        ...
    ){
        .do.debug <- envir$.do.debug
        if( (class(src)=="list" & length(src) != 0) |
            (class(src) == "environment" & length(src) != 0)
            ){
            if(class(src) == "environment"){
                src <- as.list(src)
            }
            # UPDATE
            envir$counter.history <- c(envir$counter.history, list(envir$counter))
            # EXIT IF DEGREE EXCEEDS CUTOFF
            if(!is.null(envir$stop.at)){
                if(length(envir$counter) > envir$stop.at){ 
                    # THIS
                    nms         <- get("nms", envir=envir)
                    path.nms    <- paste(envir$nms, collapse=envir$.delim.path)
                    if(.do.debug){
                        cat("names:", sep="\n")
                        print(path.nms)
                    }
                    out.1           <- list(src)
                    names(out.1)    <- path.nms
                    # /
                    # DECISION ON FLATTENING
                    if(!is.null(envir$start.after)){
                        .startAfterInner(envir=envir, nms=nms, out.1=out.1, 
                            do.reset=TRUE)
                        return(NULL)
                        #                    }
                        # /
                    } else {
                        .updateOutInner(envir=envir, out.1=out.1, do.reset=TRUE)
                        return(NULL)
                    }
                }
            }
            # /
            # LOOP OVER ELEMENTS
            for(i in seq(along=src)){                
                # UPDATE COUNTER
                envir$counter <- c(envir$counter, i)
                # UPDATE NAMES
#                assign("nms", c(get("nms", envir=envir), names(src[i])), envir=envir)
                envir$nms   <- c(get("nms", envir=envir), names(src[i]))
                path.nms    <- paste(envir$nms, collapse=envir$.delim.path)
                # UPDATE INDEX
                idx.append <- !(path.nms %in% names(envir$index))            
                index.1 <- list(data.frame(
                    name=path.nms,
                    index=paste(envir$counter, collapse=envir$.delim.index),
                    is.top=length(envir$counter) == 1,
                    is.bottom=FALSE,
                    degree=length(envir$counter),
                    duplicate=!idx.append,
                    class=class(src[[i]]),
                    type=typeof(src[[i]]),
                    length=length(src[[i]]),
                    dim={
                        if(is.null(dim(src[[i]]))){
                            NA
                        } else {
                            paste(dim(src[[i]]), collapse=" ")
                        }
                    },
                    stringsAsFactors=FALSE
                ))
#                index.1$is.bottom   <- rslt
                names(index.1)      <- path.nms 
                envir$index         <- c(envir$index, index.1)
                # /
                # RECURSIVE FLATTENING
                rslt <- .flattenInner(src[[i]], envir) # call  recursively
                envir$index[[length(envir$index)]]$is.bottom <- rslt
                # RESET COUNTER
                if(i == length(src)){
                    envir$nms       <- envir$nms[-length(envir$nms)]
                    envir$counter   <- envir$counter[-length(envir$counter)]
                }
                # /
#                return(FALSE)
            }
            # /
            return(TRUE)
        } else {
            # THIS
            nms         <- get("nms", envir=envir)
            path.nms    <- paste(envir$nms, collapse=envir$.delim.path)
            if(.do.debug){
                cat("names:", sep="\n")
                print(path.nms)
            }
            out.1           <- list(src)
            names(out.1)    <- path.nms
            # /
            # DECISION ON FLATTENING
            if(!is.null(envir$start.after)){
                .startAfterInner(envir=envir, nms=nms, out.1=out.1)
            } else {
                .updateOutInner(envir=envir, out.1=out.1)
            }
            # /
            if(.do.debug){
                cat("out.1:", sep="\n")
                print(out.1)
            }
            # UPDATE INDEX
            idx.append <- !(path.nms %in% names(envir$index))
            if(idx.append){
                index.1 <- list(data.frame(
                    name=path.nms,
                    index=paste(envir$counter, collapse=envir$.delim.index),
                    is.top=FALSE,
                    is.bottom=TRUE,
                    degree=length(envir$counter),
                    class=class(src[[i]]),
                    type=typeof(src[[i]]),
                    length=length(src[[i]]),
                    dim={
                        if(is.null(dim(src[[i]]))){
                            NA
                        } else {
                            paste(dim(src[[i]]), collapse=" ")
                        }
                    },
                    stringsAsFactors=FALSE
                ))
                names(index.1) <- path.nms 
                envir$index <- c(envir$index, index.1)
            }
            # /
            # RESET
            envir$nms       <- envir$nms[-length(envir$nms)]
            envir$counter   <- envir$counter[-length(envir$counter)]
            # /
            return(TRUE)
        }
#        return(TRUE)
    }
    
    # /INNER FUNCTIONS ----------
    
    #---------------------------------------------------------------------------
    # ACTUAL PROCESSING
    #---------------------------------------------------------------------------
    
    # COERCE TO LIST
    if(class(src) == "environment"){
        src <- envirToList(src=src)
    }
    # /
    # PRESERVE ORIGINAL (just in case)
    src.0               <- src
    out                 <- list()
    # ENVIR
    envir               <- new.env()
    envir$.do.debug     <- .do.debug
    envir$counter       <- NULL
    envir$counter.history <- NULL
    envir$.delim.index   <- .delim.index
    envir$.delim.path    <- .delim.path
    envir$do.warn       <- do.warn
    envir$history       <- NULL
    envir$index         <- NULL
    envir$nms           <- NULL
    envir$out           <- list()
    envir$src           <- src
    envir$start.after   <- start.after
    stop.at.0           <- stop.at
    if(!is.null(stop.at)){
        stop.at.0 <- stop.at
        if(stop.at == 1){
            # OUT VALUE
            out <- envir$out
            out <- list(
                original=NULL,
                flat=src,
                index=list(raw=NULL, table=NULL),
                degree={
                    c(
                        if(is.null(start.after)){
                                0
                            } else {
                                start.after
                            },
                        if(is.null(stop.at.0)){
                                0
                            } else {
                                stop.at.0
                            }
                    )
                }
            )
            # /
            if(do.original){
                out$original <- src
            }
            # /
            # CLASS
            class(out) <- c("FlatList", class(out))
            return(out)
        } else {
            stop.at <- stop.at - 1
        }
    }
    envir$stop.at       <- stop.at
    # /
    # APPLY INNER
    .flattenInner(src, envir)
    
    # WARNINGS
    if(envir$do.warn){
        max.length <- max(sapply(envir$counter.history, length))
#        if(!envir$do.block.warning){
        if(!is.null(start.after)){            
            if(start.after > max.length){                        
                warning(paste("Argument 'start.after=", start.after, 
                    "' exceeds maximum degree of sublayer nestedness (=", 
                    max.length, ").", sep=""))
            }
        }
        if(!is.null(stop.at)){
            if(stop.at.0 > max.length){
                warning(paste("Argument 'stop.at=", stop.at.0, 
                    "' exceeds maximum degree of sublayer nestedness (=", 
                    max.length, ").", sep=""))    
            }
        }
    }
    # /
    
    # OUT VALUE
    out <- envir$out
    out <- list(
        original=NULL,
        flat=out,
        index=list(raw=NULL, table=NULL),
        degree={
            c(
                if(is.null(start.after)){
                0
                } else {
                    start.after
                },
                if(is.null(stop.at.0)){
                    0
                } else {
                    stop.at.0
                }
            )
        }
    )
    # /
    # PROCESS OUT
    if(do.index){
        index.raw   <- envir$index
        index.table <- do.call("rbind", index.raw)
        rownames(index.table) <- NULL
        out$index$raw <- index.raw
        out$index$table <- index.table
    }
    if(do.original){
        out$original <- src
    }
    # /
    # CLASS
    class(out) <- c("FlatList", class(out))
    # /

    # /ACTUAL PROCESSING ----------
   
    return(out)    
}