;;; logger.scm - Simple structured logging for CHICKEN Scheme
;;;
;;; Copyright (c) 2026, Rolando Abarca
;;; BSD 3-Clause License - see LICENSE file

(module logger
  (logger/level
   logger/output
   logger/format
   logger/module-levels
   logger/set-module-level!
   logger/disable-module!
   logger/log
   logger/d
   logger/i
   logger/w
   logger/e
   logger/install)

  (import scheme
          chicken.base
          chicken.string
          chicken.port
          chicken.time
          chicken.time.posix
          (only srfi-1 filter)
          medea)

  ;; Parameters
  (define logger/level  (make-parameter 'debug))
  (define logger/output (make-parameter ##sys#standard-output))
  (define logger/format (make-parameter 'text))
  (define logger/module-levels (make-parameter '()))  ;; alist of (module-name . level)

  ;; Set log level for a specific module
  (define (logger/set-module-level! module-name level)
    (let ((current (logger/module-levels)))
      (logger/module-levels
       (cons (cons module-name level)
             (alist-delete module-name current eq?)))))

  ;; Disable logging for a specific module
  (define (logger/disable-module! module-name)
    (logger/set-module-level! module-name 'none))

  ;; Helper to delete from alist
  (define (alist-delete key alist eq-fn)
    (filter (lambda (pair) (not (eq-fn (car pair) key))) alist))

  ;; Level priority (higher = more important, 'none = disabled)
  (define (level->priority level)
    (case level
      ((debug) 0)
      ((info)  1)
      ((warn)  2)
      ((error) 3)
      ((none)  999)  ;; effectively disables logging
      (else    0)))

  (define (level->string level)
    (case level
      ((debug) "DEBUG")
      ((info)  "INFO")
      ((warn)  "WARN")
      ((error) "ERROR")
      (else    "UNKNOWN")))

  ;; ISO timestamp
  (define (current-iso-timestamp)
    (let ((now (seconds->utc-time)))
      (time->string now "%Y-%m-%dT%H:%M:%SZ")))

  ;; Get effective log level for a module (module-specific or global fallback)
  (define (effective-level-for module-name)
    (let ((module-entry (assq module-name (logger/module-levels))))
      (if module-entry
          (cdr module-entry)
          (logger/level))))

  ;; Core logging function
  (define (logger/log module-name level msg . rest)
    (when (>= (level->priority level) (level->priority (effective-level-for module-name)))
      (let* ((full-msg (apply conc msg rest))
             (ts (current-seconds))
             (now (seconds->utc-time ts))
             (str-now (time->string now "%Y-%m-%dT%H:%M:%SZ"))
             (mod-str (symbol->string module-name)))
        (with-output-to-port (logger/output)
          (lambda ()
            (case (logger/format)
              ((json)
               (write-json `((ts . ,ts)
                             (level . ,(symbol->string level))
                             (module . ,mod-str)
                             (message . ,full-msg)))
               (newline))
              (else
               (print str-now " [" (level->string level) "] [" mod-str "] " full-msg)))
            (flush-output))))))

  ;; Convenience functions (global module)
  (define (logger/d msg . rest) (apply logger/log 'GLOBAL 'debug msg rest))
  (define (logger/i msg . rest) (apply logger/log 'GLOBAL 'info msg rest))
  (define (logger/w msg . rest) (apply logger/log 'GLOBAL 'warn msg rest))
  (define (logger/e msg . rest) (apply logger/log 'GLOBAL 'error msg rest))

  ;; Install macro - generates module-local logging functions
  (define-syntax logger/install
    (er-macro-transformer
     (lambda (x r c)
       (let ((module-name (cadr x)))
         `(,(r 'begin)
           (,(r 'define) (d msg . rest) (apply logger/log ',module-name 'debug msg rest))
           (,(r 'define) (i msg . rest) (apply logger/log ',module-name 'info msg rest))
           (,(r 'define) (w msg . rest) (apply logger/log ',module-name 'warn msg rest))
           (,(r 'define) (e msg . rest) (apply logger/log ',module-name 'error msg rest)))))))
)