#lang scheme/base
(require (planet bzlib/base)
         "base.ss")

;; the thing about log is that it actually writes out the data.
;; what do we want to write?
;; the only thing that's fixed about the log is the timestamp - it goes by current-seconds
;; and then it can receive the rest
(define (log-event out sec args)
  (display (format "~s\n" (cons sec args)) out)
  (flush-output out))

(define (log-trace out sec args)
  (display (format "~a\n" (car args)) out)
  (flush-output out)) 

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; log-dispatcher
(define (log-dispatcher (args (thread-receive)))
  (if (not (car args))
      (apply log-event (cdr args))
      (apply log-trace (cdr args)))
  (log-dispatcher))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the struct that holds the log.  it acts as a procedure as well as an
;; output port at once.
(define-struct *log (path out thread)
  #:property prop:output-port 1
  #:property prop:procedure
  (lambda ($struct #:trace? (trace? #f) . args)
    (thread-cast* (*log-thread $struct) trace? (*log-out $struct) (current-seconds) args)))

;; each log should be a singleton... so it serialize the access to the log
;; at the same time allow for asynchronous log writing...
;; make-log should registry the log to the object (unless it is #f or a port).
(define log-registry (make-immutable-hash-registry))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ctor
(define (make-log (log-path #f))
  (let ((out (cond ((output-port? log-path) log-path)
                   ((or (string? log-path) (path? log-path))
                    (open-output-file log-path #:exists 'append))
                   (else
                    (case log-path
                      ((cout) (current-output-port))
                      ((cerr) (current-error-port))
                      (else
                       (open-output-bytes)))))))
    (make-*log log-path out (thread log-dispatcher)))) 

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; there will be a default log
(define current-log (make-parameter (make-log 'cerr)))

;; trace will automatically be pushed toward current log???
;; hmm...

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; log-trace!
;; this uses log as a port for the trace calls.  it by passes the log-event
;; function...
;; log trace is serialized... hmm...
(define (log-trace! s (log (current-log)))
  (log #:trace? #t s)) 

(define (log-value? v)
  (or (eq? v #f)
      (member 'cout 'cerr)
      (output-port? v)
      (path-string? v)))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CONTRACT
(provide/contract
 (rename *log? log? (-> any/c boolean?))
 (make-log (->* (log-value?) () *log?))
 (current-log (parameter/c *log?))
 (log-trace! (->* (string?) (*log?) any))
 )