#' Split list, apply function, and return results in a list.
#'
#' For each element of a list, apply function, keeping results as a list.
#'
#' \code{llply} is equivalent to \code{\link{lapply}} except that it will
#' preserve labels and can display a progress bar.
#'
#' @template ply
#' @template l-
#' @template -l
#' @export
#' @examples
#' llply(llply(mtcars, round), table)
#' llply(baseball, summary)
#' # Examples from ?lapply
#' x <- list(a = 1:10, beta = exp(-3:3), logic = c(TRUE,FALSE,FALSE,TRUE))
#'
#' llply(x, mean)
#' llply(x, quantile, probs = 1:3/4)
llply <- function(.data, .fun = NULL, ..., .progress = "none", .inform = FALSE,
                  .parallel = FALSE, .paropts = NULL) {
  if (is.null(.fun)) return(as.list(.data))
  if (is.character(.fun) || is.list(.fun)) .fun <- each(.fun)
  if (!is.function(.fun)) stop(".fun is not a function.")

  if (!inherits(.data, "split")) {
    pieces <- as.list(.data)

    # This special case can be done much faster with lapply, so do it.
    fast_path <- .progress == "none" && !.inform && !.parallel
    if (fast_path) {
      return(structure(lapply(pieces, .fun, ...), dim = dim(pieces)))
    }

  } else {
    pieces <- .data
  }

  n <- length(pieces)
  if (n == 0) return(list())


  if (.parallel && .progress != "none") {
    message("Progress disabled when using parallel plyr")
    .progress <- "none"
  }

  result <- vector("list", n)
  for (i in 1:n) {
     result[i] <- .fun(pieces[[i]])
  } 

  result
#  progress <- create_progress_bar(.progress)
#  progress$init(n)
#  on.exit(progress$term())

#  result <- vector("list", n)
#  do.ply <- function(i) {
#    print("PIECES")
#    piece <- pieces[[i]]
#    print("PIECE")
#    print(piece)
    # Display informative error messages, if desired
#    if (.inform) {
#      res <- try(.fun(piece, ...))
#      if (inherits(res, "try-error")) {
#        piece <- paste(capture.output(print(piece)), collapse = "\n")
#        stop("with piece ", i, ": \n", piece, call. = FALSE)
#      }
#    } else {
#      print("DOING ELSE")
#      res <- .fun(piece, ...)
#    }
#    progress$step()
#    res
#  }
#  if (.parallel) {
#    setup_parallel()

#    i <- seq_len(n)
#    fe_call <- as.call(c(list(quote(foreach::foreach), i = i), .paropts))
#    fe <- eval(fe_call)
#
#    result <- foreach::`%dopar%`(fe, do.ply(i))
#  } else {
#    
#    print("PIECES")
#    print(pieces)
#    print("PIECES DATA")
#    print(pieces[[1]])
#    print("FUNCTION DATA")
#    print(.fun)
#    print("FUNCTION APPLIED TO FIRST VALUE")
#    print(.fun(pieces[[1]]))
#    print("CURRENT RESULT")
#    print(result)
#    print("READY TO START LOOP")
#    for (i in 0:n-1) {
       #print("RESULT I BEFORE ASSIGNMENT")
       #print(result[i+1])
       #print("DOPLY I")
       #piece <- pieces[[i+1]]
       #print("FUNCTION")
       #print(.fun(piece, ...))
       #result[i+1] <- .fun(piece, ...)
       #print("ATTEMPTING ASSIGNMENT")
       #result[[i+1]] = ""
       #print("ABLE TO ASSIGN TO EMPTY STRING")
       #print(result[[i+1]])
       #print("HERE IS THE ENTIRE RESULT")
       #print(result)
       #print("NOW ATTEMPTING SECOND ASSIGNMENT")
       #result[[i+1]] = .fun(pieces[[i+1]])
       #print("DONE ASSIGNMENT")
       #print(do.ply(i+1))
       #result[i] <- do.ply(i+1)
       #print("RESULT I")
       #print(result[i])
       #print("RESULT I AFTER ASSIGNMENT")
       #print(result[i])
    #print("DOING LOOP APPLY IN LLPLY")
    #result <- .C("loop_apply", n=n, f=do.ply)   #loop_apply(n, do.ply)
    #print("RESULT IN ELSE")
    #print(result)
    #print("NAMES IN ELSE")
    #print(names(result))
    #print("DONE LOOP APPLY IN LLPLY")
  #}
  #}
  #attributes(result)[c("split_type", "split_labels")] <-
  #  attributes(pieces)[c("split_type", "split_labels")]
  #print("PIECES AFTER ELSE")
  #print(pieces) 
  #print("RESULT AFTER ELSE")
  #print(result)
  #print("NAMES RESULT AFTER ELSE")
  #print(names(result))
  #print("NAMES PIECES AFTER ELSE")
  #print(names(pieces))
  #names(result) <- names(pieces)
  #print("FINAL RESULTS")
  #print(result)
  # Only set dimension if not null, otherwise names are removed
  #if (!is.null(dim(pieces))) {
  #  dim(result) <- dim(pieces)
  #}

  #result
}
