(module log mzscheme
  
  (require
   ;(lib "class.ss")
   ;(all-except
    (lib "contract.ss")
   ; any)
   ;(lib "etc.ss")
   ;(lib "match.ss")
   ;(lib "lylux.ss"      "lylux")
   ;(lib "snooze.ss"     "snooze")
   ;(all-except
   (all-except
    (lib "list.ss"       "srfi" "1")
    any)
   ; delete!)
   (lib "string.ss"     "srfi" "13")
   (lib "cut.ss"        "srfi" "26")
   (planet "aif.ss" ("schematics" "macro.plt" 1)) 
   (file "parameter.ss")
   (file "base.ss")
   )
  
  (provide
   (all-defined)
   )
  
  ;; parameter current-log-preamble : (-> (list-of any))
  ;;
  ;; Thunk which returns a list of values to be included at the beginning of each log message.
  (define-parameter current-log-preamble
    (lambda () null)
    (lambda (val)
      (if (procedure? val)
          val
          (raise-exn/format exn:fail:unlib
            "Expected (symbol -> (list-of string)), received ~a." val)))

    with-log-preamble)
  
  ;; parameter current-log-pot : (U (parameter output-port) output-port)
  ;;
  ;; A parameter containing an output port or an output port
  ;; to print messages to.
  (define-parameter current-log-port
    current-output-port
    (lambda (val)
      (if (output-port? val)
          val
          (raise-exn/format exn:fail:unlib
            "Expected output-port, received ~a." val)))
    with-log-port)
  
  ;; log-message : any ... -> integer
  ;;
  ;; Prints a message and returns a timestamp as a unique identifier.
  (define log-message
    (lambda args
      (log-generic 'M args)))
  
  ;; log-warning : any ... -> integer
  ;;
  ;; Prints a warning and returns a timestamp as a unique identifier.
  (define log-warning
    (lambda args
      (log-generic 'W args)))
  
  ;; log-error : any ... -> integer
  ;;
  ;; Prints a error and returns a timestamp as a unique identifier.
  (define log-error
    (lambda args
      (log-generic 'E args)))
  
  ;; log-generic : symbol (list-of any) -> integer
  ;;
  ;; Prints a generic message and returns a timestamp as a unique identifier.
  (define/contract log-generic
    (-> symbol? list? any/c)
    (lambda (message-type message-components)
      (let* ([time
              (current-seconds)]
             [items 
              (cons message-type
                    (append ((current-log-preamble)) 
                            message-components))]
             [out (aif log-port parameter? (current-log-port)
                       (log-port)
                       log-port)])
        (display
         (string-join
          (map
           (cut format "~s" <>)
           items)
          ",") 
         out)
        (newline out)
        time)))
  
  )