Replace my simple logging implementation with log4cl

6 files changed, 24 insertions, 105 deletions

diff --git a/src/bot/impl.lisp b/src/bot/impl.lisp
index 85f4496..652e2f7 100644
--- a/src/bot/impl.lisp
+++ b/src/bot/impl.lisp
@@ -1,10 +1,11 @@
 ;; SPDX-License-Identifier: EUPL-1.2
 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
 (defpackage :ukkoclot/bot/impl
-  (:use :c2cl :iterate :ukkoclot/config :ukkoclot/log)
+  (:use :c2cl :iterate :ukkoclot/config)
   (:import-from :anaphora :aand :acond :it)
   (:import-from :cl+ssl)
   (:import-from :dex)
+  (:import-from :log)
   (:import-from :ukkoclot/strings :lisp->snake-case)
   (:local-nicknames
    (:jzon :com.inuoe.jzon))
@@ -17,7 +18,7 @@
 (defgeneric parse-value (type json)
   (:documentation "Parse value of TYPE from the parsed JSON")
   (:method (type json)
-    (log-error "I don't know how to parse simple type ~A!" type)
+    (log:error "I don't know how to parse simple type ~A!" type)
     (error "I don't know how to parse simple type ~A!" type))
   (:method ((type (eql 'boolean)) json)
     (check-type json boolean)
@@ -100,9 +101,9 @@
         ((gethash "ok" hash) (parse-value type (gethash "result" hash)))
         ((aand (gethash "parameters" hash)
                (gethash "retry_after" it))
-         (log-info "Should sleep for ~A seconds" it)
+         (log:info "Should sleep for ~A seconds" it)
          (sleep it)
-         (log-info "Good morning!")
+         (log:info "Good morning!")
          (do-call% bot method uri type args-encoded))
         (t (error "TG error ~A: ~A ~:A"
                   (gethash "error_code" hash)
@@ -112,5 +113,5 @@
 (defun do-call (bot method path type args)
   (let ((uri (concatenate 'string (bot-base-uri bot) path))
         (args-encoded (fixup-args args)))
-    (log-debug "~A .../~A ~S" method path args-encoded)
+    (log:debug "~A .../~A ~S" method path args-encoded)
     (do-call% bot method uri type args-encoded)))
diff --git a/src/config.lisp b/src/config.lisp
index 86a0f33..17c5c73 100644
--- a/src/config.lisp
+++ b/src/config.lisp
@@ -1,7 +1,7 @@
 ;; SPDX-License-Identifier: EUPL-1.2
 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
 (defpackage :ukkoclot/config
-  (:use :c2cl :ukkoclot/hash-tables :ukkoclot/log)
+  (:use :c2cl :ukkoclot/hash-tables)
   (:export
    :config-load :config-merge
    :config-p
diff --git a/src/db.lisp b/src/db.lisp
index 9b646d2..5d08e6a 100644
--- a/src/db.lisp
+++ b/src/db.lisp
@@ -1,7 +1,8 @@
 ;; SPDX-License-Identifier: EUPL-1.2
 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
 (defpackage :ukkoclot/db
-  (:use :c2cl :sqlite :ukkoclot/log)
+  (:use :c2cl :sqlite)
+  (:import-from :log)
   (:export :get-inline-bot-type :set-inline-bot-type :with-db))
 (in-package :ukkoclot/db)
 
@@ -39,24 +40,24 @@
     (unless current-ver
       (setf current-ver 0))
     (cond
-      ((= current-ver +target-version+) (log-info "Database is up to date"))
+      ((= current-ver +target-version+) (log:info "Database is up to date"))
 
       ((> current-ver +target-version+)
-       (log-error "Database has a higher version than supported?")
+       (log:error "Database has a higher version than supported?")
        (error "Corrupted Database"))
 
       (t
-       (log-info "Updating database from version ~A to ~A" current-ver +target-version+)
+       (log:info "Updating database from version ~A to ~A" current-ver +target-version+)
        (loop while (< current-ver +target-version+)
              do (with-transaction db
-                  (log-info "Updating database step from ~A" current-ver)
+                  (log:info "Updating database step from ~A" current-ver)
                   (incf current-ver)
                   (upgrade-step db current-ver)
                   (execute-non-query
                    db
                    "INSERT OR REPLACE INTO version(id, version) VALUES (0, ?)"
                    current-ver)))
-       (log-info "Database updating complete :)")))))
+       (log:info "Database updating complete :)")))))
 
 (defun upgrade-step (db new-version)
   (case new-version
diff --git a/src/inline-bots.lisp b/src/inline-bots.lisp
index 3ed85e9..3c6b7c4 100644
--- a/src/inline-bots.lisp
+++ b/src/inline-bots.lisp
@@ -1,7 +1,8 @@
 ;; SPDX-License-Identifier: EUPL-1.2
 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
 (defpackage :ukkoclot/inline-bots
-  (:use :c2cl :ukkoclot/bot :ukkoclot/config :ukkoclot/log :ukkoclot/tg-types)
+  (:use :c2cl :ukkoclot/bot :ukkoclot/config :ukkoclot/tg-types)
+  (:import-from :log)
   (:local-nicknames (:db :ukkoclot/db))
   (:export :blacklist-inline-bot :on-inline-bot :whitelist-inline-bot))
 (in-package :ukkoclot/inline-bots)
@@ -17,7 +18,7 @@
     (if (eq ty :whitelisted)
         t
         (progn
-          (log-info "Deleting an unallowed inline bot message from ~A ~A"
+          (log:info "Deleting an unallowed inline bot message from ~A ~A"
                     (user-username via)
                     (user-id via))
           (try-delete-message bot msg)
diff --git a/src/log.lisp b/src/log.lisp
deleted file mode 100644
index e6e8661..0000000
--- a/src/log.lisp
+++ /dev/null
@@ -1,85 +0,0 @@
-;; SPDX-License-Identifier: EUPL-1.2
-;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
-(defpackage :ukkoclot/log
-  (:use :c2cl)
-  (:export :*output* :deflevel :log-error :log-warn :log-info :log-debug))
-(in-package :ukkoclot/log)
-
-(defparameter *output* *error-output*)
-
-(defvar *max-name-length* 8)
-(defvar *max-level-length* 4)
-
-(defvar *levels* nil)
-
-(defun get-levels ()
-  (unless *levels*
-    (setf *levels* (make-hash-table :test #'eq)))
-  *levels*)
-
-(defun register-level (level value)
-  (setf (gethash level (get-levels)) value)
-  (let ((l (length (symbol-name level))))
-    (when (> l *max-level-length*)
-      (setf *max-level-length* l))))
-
-(defun level-value (level)
-  (let ((value (gethash level (get-levels))))
-    (if value
-        value
-        (progn
-          (format *output* "UKKOLOG INTERNAL WARN: UNKNOWN LEVEL ~A" level)
-          1000))))
-
-(defun level< (lhs rhs)
-  (< (level-value lhs) (level-value rhs)))
-
-(defstruct (logger (:constructor make-logger%))
-  (name (error "No value given for NAME") :type keyword :read-only t)
-  (min-level :debug :type keyword))     ;TODO: Make this :info and make it configurable
-
-(defun make-logger (name)
-  (let ((l (length (symbol-name name))))
-    (when (> l *max-name-length*)
-      (setf *max-name-length* l)))
-  (make-logger% :name name))
-
-(defvar *package-loggers* nil)
-
-(defun get-package-loggers ()
-  (unless *package-loggers*
-    (setf *package-loggers* (make-hash-table :test #'eq)))
-  *package-loggers*)
-
-(defun get-package-logger (package)
-  (let* ((name (package-name package))
-         (name-sym (intern name :keyword))
-         (loggers (get-package-loggers))
-         (logger (gethash name-sym loggers)))
-    (unless logger
-      (setf logger (make-logger name-sym))
-      (setf (gethash name-sym loggers) logger))
-    logger))
-
-(defun perform-log (package level fmt-str &rest args)
-  (let ((logger (get-package-logger package)))
-    (unless (level< level (logger-min-level logger))
-      (apply #'format *output*
-             (concatenate 'string "~&~v@A: ~v@A: " fmt-str "~%")
-             *max-name-length* (logger-name logger)
-             *max-level-length* level
-             args))))
-
-(defmacro p (level fmt-str &rest args)
-  `(perform-log ,*package* ,level ,fmt-str ,@args))
-
-(defmacro deflevel (name value)
-  `(progn
-     (register-level ,name ,value)
-     (defmacro ,(intern (concatenate 'string "LOG-" (symbol-name name))) (fmt-str &rest args)
-       `(p ,,name ,fmt-str ,@args))))
-
-(deflevel :error 700)
-(deflevel :warn 600)
-(deflevel :info 500)
-(deflevel :debug 400)
diff --git a/src/main.lisp b/src/main.lisp
index f31cd7c..f90bfb3 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -2,8 +2,9 @@
 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
 (defpackage :ukkoclot/main
   (:nicknames :ukkoclot)
-  (:use :c2cl :ukkoclot/bot :ukkoclot/config :ukkoclot/inline-bots :ukkoclot/log :ukkoclot/tg-types)
+  (:use :c2cl :ukkoclot/bot :ukkoclot/config :ukkoclot/inline-bots :ukkoclot/tg-types)
   (:import-from :anaphora :acond :awhen :it)
+  (:import-from :log)
   (:import-from :ukkoclot/bot :make-bot :bot-power-on :fixup-value)
   (:import-from :ukkoclot/db :with-db)
   (:import-from :ukkoclot/strings :escape-xml :is-tg-whitespace-str :starts-with :starts-with-ignore-case)
@@ -24,12 +25,12 @@
   (unwind-protect
        (let ((config (config-load #P"config.default.lisp")))
          (config-merge config #P"config.lisp")
-         (log-info "Starting up ~A" (config-bot-name config))
+         (log:info "Starting up ~A" (config-bot-name config))
          (with-db (db (config-db-path config))
            (let ((bot (make-bot config db)))
              ;; TODO: Catch fatal errors & report them
              (wrapped-main bot config))))
-    (log-info "We're done!")))
+    (log:info "We're done!")))
 
 (defun wrapped-main (bot config)
   (when *in-prod*
@@ -81,7 +82,7 @@
                                   :callback-query-id (callback-query-id cb)
                                   :text "OK"))
           (t
-           (log-info "Unrecognised callback query data: ~A" data)
+           (log:info "Unrecognised callback query data: ~A" data)
            (answer-callback-query bot
                                   :callback-query-id (callback-query-id cb)
                                   :text "Unallowed callback query, don't press the button again"
@@ -215,7 +216,7 @@
 
 (defun on-text-command (bot msg text cmd)
   (let ((simple-cmd (simplify-cmd bot cmd)))
-    (log-debug "text-command: ~A AKA ~A" cmd simple-cmd)
+    (log:debug "text-command: ~A AKA ~A" cmd simple-cmd)
     ;; TODO: Replace this cond with a nicer dispatch.  Something like string-case?
     (acond
       ((equal simple-cmd "chatid")
@@ -246,7 +247,7 @@ Send time: ..."))
           )))
 
 (defun report-error (bot evt err)
-  (log-error "While handling ~A: ~A" evt err)
+  (log:error "While handling ~A: ~A" evt err)
   (let ((msg (format nil "<code>~A</code> while handling ~&<pre>~A</pre>"
                      (escape-xml (format nil "~A" err))
                      (escape-xml (format nil "~A" evt)))))