#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FILE.plt - file, path, and atomic file operation utilities 
;;
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; temp.ss - provides the facility to manage temp-files (both output & input)
;; yc 2/13/2009 - first version
(require "depend.ss"
         "path.ss"
         )

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; generic functions

;; make-temp-path
;; generates a completely random temp path...
(define (make-temp-path (base (temp-path)))
  (build-path base (format "~a.~a.~a.~a" 
                           (uuid->string (make-uuid))
                           (current-seconds)
                           (current-milliseconds)
                           (symbol->string (gensym)))))


;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; source/c
;; what are acceptable sources
(define source/c 
  (or/c false/c path-string? bytes? input-port? string? (-> output-port? any)))

;; make-source-filler
;; provides a procedure to bind the source and pump it into the output-port
;; convert the data source type into the appropriate call to pump into out.
(define (make-source-filler source)
  (lambda (out)
        (cond ((and (path-string? source)
                    (file-exists? source))
               (call-with-input-file source (curryr copy-port out)))
              ((input-port? source)
               (copy-port source out))
              ((bytes? source)
               (write-bytes source out))
              ((string? source)
               (write-string source out))
              ((procedure? source)
               (source out))
              ((not source) (void))
              (else
               (error 'build-temporary-file "unsupported source: ~a" source)))))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; output-temp-file
;; the output-port version of temp-file

;; output-temp-file-onclose/c
;; contract for the onclose function - it must take in a path-string and return a thunk.
(define temp-file-onclose/c (-> path-string? thunk?))

;; default-onclose
;; this is the default output-temp-file-onclose/c
(define (default-onclose path) void)

;; build-output-temp-file
;; make an output-port that represents a temporary output file.
(define (build-output-temp-file path onclose)
  (let ((out (open-output-file path)))
    (make-output-port path 
                      always-evt
                      (make-default-write out)
                      (make-default-close-output-port out (onclose path)))))

;; open-output-temp-file
;; returns an output-port that reprsents the underlying temp-file
(define (open-output-temp-file #:base (dir (temp-path))
                               #:close (onclose default-onclose))
  (build-output-temp-file (make-temp-path dir) onclose))

;; make-temp-file
;; the difference here is that we return a path instead of output-port.
(define (make-temp-file #:source (source #f)
                        #:base (dir (temp-path))) 
  (call-with-output-port (open-output-temp-file #:base dir)
                         (lambda (out)
                           ((make-source-filler source) out)
                           (object-name out))))


;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; input-temp-file
;; the input-port version of the temp-file - useful when other programs
;; generates the temporary file that you would be interested to consume
;; (the main pattern being that other temp-file is used to convert the source
;; data)

;; input-temp-file
;; a structure to represent the temp-file's input-port
(define-struct input-temp-file (inner path)
  #:property prop:input-port 0)

;; build-intpu-temp-file
;; creates the input-temp-file based on the path.
(define (build-input-temp-file path onclose)
  (let ((in (open-input-file path)))
    (make-input-temp-file 
     (make-input-port path
                      (make-default-read in)
                      (make-default-peek in)
                      (make-default-close-input-port in (onclose path)))
     path)))

(define (default-input-temp-file-onclose path)
  (lambda () 
    (delete-file path)))

;; open-input-temp-file
;; return the input-temp-file in an input-port
(define (open-input-temp-file #:source (source #f)
                              #:base (dir (temp-path))
                              #:close (onclose default-input-temp-file-onclose))
  (build-input-temp-file (make-temp-file #:source source #:base dir) onclose))

;; call-with-input-temp-file
(define (call-with-input-temp-file proc 
                                   #:source (source #f)
                                   #:base (dir (temp-path))
                                   #:close
                                   (onclose default-input-temp-file-onclose))
  (call-with-input-port (open-input-temp-file #:source source
                                              #:base dir
                                              #:close onclose)
                        proc))

;; temp-file-length - used to determine the actual length of the temp-file...
(define (temp-file-length t)
  (with-handlers ((exn? (lambda (e) 0)))
    (file-size (input-temp-file-path t))))
;; add temp-file-length into the input-port-length-registry
(input-port-length-registry-set! input-temp-file? temp-file-length)

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CONTRACT
(provide/contract 
 (make-temp-path (->* () 
                      (path-string?)
                      path-string?))
 (open-output-temp-file (->* () 
                             (#:base path-string?
                                     #:close temp-file-onclose/c)
                             output-port?))
 (make-temp-file (->* () 
                      (#:source source/c
                                #:base path-string?)
                      path-string?))
 (open-input-temp-file (->* ()
                            (#:source source/c
                                      #:base path-string?
                                      #:close temp-file-onclose/c)
                            input-temp-file?))
 (call-with-input-temp-file (->* ((-> input-port? any))
                                 (#:source source/c
                                           #:base path-string?
                                           #:close temp-file-onclose/c)
                                 any))
 
 (input-temp-file? (-> any/c any)) 
 (input-temp-file-path (-> input-temp-file? path-string?))
 )