# -------------------------------------------------------------------------------------------------------------------------  #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #           File Name              :  writeDT.r                                                                              #
  #           Last Updated Funclist  :  08 Feb 2015,  5:12 AM (Sunday)                                                         #
  #                                                                                                                            #
  #           Author Name            :  Rick Saporta                                                                           #
  #           Author Email           :  RickSaporta@gmail.com                                                                  #
  #           Author URL             :  www.github.com/rsaporta                                                                #
  #                                                                                                                            #
  #           Packages Called        :  NA                                                                                     #
  #           Packages Used via NS   :  NA                                                                                     #
  #                                                                                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #   writeDT            ( DT, subfolder="", sep=ifelse(tolower(ext) %in% c("csv", ".csv"), ",", "\t"), ext="tsv"              #
  #                        , base.file.name, append=FALSE, quote=TRUE, row.names=FALSE, col.names=TRUE                         #
  #                        , reveal=FALSE, ... )                                                                               #
  #                                                                                                                            #
  #                                                                                                                            #
  #                                                     <END FUNCS>                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  # -------------------------------------------------------------------------------------------------------------------------  #

nm_from_DT.nm <- function(DT.nm, brackets_replace_with="_modified", pipe_replace_with="_modified", showWarnings=TRUE) {
## NOTE, DT.nm is generally
##      DT.nm <- capture.output(substitute(DT))
  if (length(DT.nm) %in% 2:6) {
    tl <- tail(DT.nm, -1)
    if (all(grepl("    ", tl)) && (grepl("]$", tail(tl, 1)) || any(grepl("%>%", tl)))  )
      DT.nm <- c(DT.nm[[1]], ltrim(tl)) %>% pasteC
  }

  pat.brak <- "(\\[.+\\]\\s*)+"
  # pat.brak <- "(\\[.+?\\]\\s*)+"
  if (grepl(pat.brak, DT.nm)) {
    if (is.null(brackets_replace_with))
      verboseMsg(showWarnings, "DT.nm contains brackets ('[ ]') which might make parsing it difficult.\nHINT: to remove them without replacing, set    brackets_replace_with=\"\"'    (not to null)")
    else
      DT.nm %<>% gsub(pat.brak, brackets_replace_with, .)
  }

  pat.pipe <- "\\s*%>%.+"
  # pat.brak <- "(\\[.+?\\]\\s*)+"
  if (grepl(pat.pipe, DT.nm)) {
    if (is.null(pipe_replace_with))
      verboseMsg(showWarnings, "DT.nm contains pipe (%>%) which might make parsing it difficult.\nHINT: to remove them without replacing, set    pipe_replace_with=\"\"'    (not to null)")
    else
      DT.nm %<>% gsub(pat.pipe, pipe_replace_with, .)
  }

  gsub("^(te?mp_)?DT\\.", "", DT.nm)
}

writeDT <- function(DT, subfolder=NULL, sep=sep_from_ext(ext), ext="tsv", base.file.name, append=FALSE, quote=TRUE, fileEncoding="UTF-8"
  , row.names=FALSE, col.names=header, header=TRUE, reveal=FALSE, proppernames=!missing(to), use_ingest=FALSE, brackets_replace_with="_modified", pipe_replace_with="_modified"
  , full_file_path = "will be auto-generated using DT or base.file.name and subfolder"
  , message_on_no_rows=TRUE
  , ..., to=NULL, cc=getRS('cc'), bcc=list(NULL), subject="[no subject]") {
## if 'to' is not NULL, quickEmail will be called 
## 'cc' and 'bcc' are ignored without to being explicit
## use_ingest :: if TRUE, will write to ingestDir instead of outDir

  if (!is.data.table(DT)) {
    if (is.list(DT) && length(DT) == 1 && is.data.table(DT[[1]]))
      DT <- DT[[1]]
    else
      stop("DT is not a data.table")
  }

  ## If there are no rows, let the user know.
  ## Also, cannot check the implicity column types, since there is no data in the data.table
  if (!nrow(DT)) {
    if (message_on_no_rows)
      message("DT has no rows. The column names will be written as a header")
  } else {

      ## Otherwise, if ther eare rows, check if any are int64, and if so, load the library
      if (any(sapply(DT, inherits, "integer64")) && !isPkgLoaded("bit64")) {
        message(" ----- WILL LOAD LIBRARY bit64 ------")
        require(bit64, quietly=TRUE)
      } else {
        ## CHECK TO SEE IF ANY SHOULD BE integer64
        numCols <- nwhich(sapply(DT, is.numeric))
        int64Cols <- DT[, {if (length(.SD)) sapply(.SD, might_be_int64)}, .SDcols=numCols] %>% nwhich
        if (length(int64Cols))
          warning("Some columns might be integer64, in which case they will be written to file incorrectly. Offenders are: ", pasteQand(int64Cols))
      }


  }

  ## auto-generate f.out  
  if (missing(full_file_path)) {
      ## If base.file.name is not given, use the name of the DT
      DT.nm <- capture.output(substitute(DT))
      if (missing(base.file.name))
        # base.file.name <- gsub("^(te?mp_)?DT\\.", "", DT.nm)
        base.file.name <- nm_from_DT.nm(DT.nm)

      ## SANITY CHECK
      pat.file <- "/|(\\.(csv|tsv|txt)$)"
      if (grepl(pat.file, fileEncoding))
        stop("It looks like fileEncoding is a file name.\nHINT: Did you accidentally supply a 'file' argument to writeDT() instead of 'base.file.name'?")
      if (grepl(pat.file, base.file.name))
        stop("base.file.name should be a single word.\nHINT: use 'subfolder' and 'ext' for the other portions")

      ## use ingest.p if flagged 
      func.p <- if (use_ingest) ingest.p else out.p
      ## create file name to write to
      f.out <- func.p(subfolder, base.file.name, ext=ext)
  } else {
    is.char_of_length1(full_file_path, fail=TRUE)
    f.out <- copy(full_file_path)
  }

  if (!file.exists(dirname(f.out)))
    dir.create(dirname(f.out), recursive=TRUE)

  nms.bak <- copy(names(DT))
  if (isTRUE(proppernames)) {
    setnamestopropper(DT)
    on.exit(setnames(DT, nms.bak))
  }

  if (is.null(fileEncoding))
    fileEncoding <- ""
  write.table(x=DT, file=path.expand(f.out), append=append, sep=sep, quote=quote, row.names=row.names, col.names=col.names, fileEncoding=fileEncoding, ...)

  if (reveal)
    reveal(f.out)
  
  assign(".f.out.writeDT", f.out, envir=globalenv())

  ## EMAIL -- wrapped in try()
  try({
    if (!is.null(to)) {
      c(as.list(to), cc=cc, bcc=bcc, subject=subject, files=f.out, info=topropper(base.file.name, underscore=TRUE)) %>%
      do.call(quickEmail, .)
    }
  })

  return(f.out)
}


sep_from_ext <- function(x, default="\\t") {
  if(!is.character(x) || length(x) < 1)
    stop ("x must be a character of length at least 1")

  ext <- tolower(gsub(".*\\.", "", x))
  dict_ext <- c(
                "csv" = ","
              , "tsv" = "\t"
              , "psv" = "|"
              , "ssv" = ""
              )
  ret <- dict_ext[ext]
  ret[is.na(ret)] <- default
  names(ret) <- if(!is.null(names(x))) names(x) else x
  return(ret)
}



writeViaTempFile <- function(x, file, ncolumns=if (is.character(x)) 1 else 5, append=FALSE, sep=" ", N.attempts_if_locked=3, fail.if.could.not.write=TRUE) {
  if (missing(file))
    stop ("file cannot be missing in writeViaTempFile()", call.=FALSE)
  if (!file.exists(dirname(file)))
    stop ("The parent folder of file does not exist.\nHINT: run dir.create(dirname(file))")


  .tmpfile <- tempfile(tmpdir=dirname(file), pattern=timeStamp("_latestBackups_TEMP", seconds=TRUE), fileext=".r")

  if (append && file.exists(file)) {
    file.copy(from=file, to=.tmpfile, copy.date=TRUE, overwrite=TRUE, recursive=FALSE)
  }

  ## WRITE TO TEMP FILE
  write(x=x, file=.tmpfile, append=append, ncolumns=ncolumns, sep=sep)

  ## Create a lock file
  lockFile <- as.path(dirname(file), sprintf(".%s.lock", basename(file)))
  for (i in seq(N.attempts_if_locked)) {
    if (file.exists(lockFile)) {
      message("There is a lock on file '", file, "' -- waiting 3 seconds ", if (i > 1) sprintf(" [attempt #%02i]", i))
      Sys.sleep(2.5)
    }
  }

  ## If lock file persists, Do not copy the file. Fail or throw warning, then return the temp file
  if (file.exists(lockFile)) {
    msg <- paste0("A lock on file '", file, "' persists after ", N.attempts_if_locked, " attempts. Could not write. Output saved to tempfile '", .tmpfile, "'")
    if (fail.if.could.not.write)
      stop("\n", msg, call.=TRUE)
    ## ELSE
    warning(msg, call.=FALSE)
    ret <- .tmpfile
  } else {
    file.create(lockFile)
    file.copy(from=.tmpfile, to=file, overwrite=TRUE, copy.date=TRUE)
    unlink(lockFile)
    ## confirm that file sizes are identical
    if (!identical(fileSize(.tmpfile), fileSize(file))) {
      warning ("temp file copied to '", file, "' but filesizes are not identical. Error may have occurred. Returning temp file, '", .tmpfile, "'")
      ret <- .tmpfile
    } else {
      unlink(.tmpfile)
      ret <- file
    }
  }

  return(ret)
}