#lang scheme/base

(require srfi/19)

(define-values
  (*debug* *info* *warning* *error*) (apply values (build-list 4 (λ (i) i))))

(define port (make-parameter (current-error-port)))

(define level (make-parameter *info*))

(define (setup file #:level (new-level #f) #:port (new-port #f))
  (if new-port
      (port new-port)
      (port (open-output-file #:exists 'append file)))
  (when new-level
    (level new-level))
  (log (date->string (current-date))))
  

(define names
  (list->vector
   '(debug info warning error)))

(define (log fmt #:level [other-level *info*] . args)
  (when (>= other-level (level))
    (parameterize
        ([current-output-port (port)])
      (display (vector-ref names other-level))
      (display ": ")
      (display (if fmt (apply format fmt args) (car args)))
      (display "\n")
      (flush-output))))

(define info log)

(define (error fmt . args)
  (apply log fmt #:level *error* args))

(define (warning fmt . args)
  (apply log fmt #:level *warning* args))

(define (debug fmt . args)
  (apply log fmt #:level *debug* args))

(provide log port level setup)
(provide *debug* *info* *warning* *error*)
(provide  debug   info   warning   error)