From ec7de1aa1ad2bc14b3b1572ea4cc5024a6c662ae Mon Sep 17 00:00:00 2001 From: Uko Kokņevičs Date: Sat, 18 Oct 2025 03:06:09 +0300 Subject: Add ocicl lint --- .ocicl-lint.conf | 4 ++++ .pre-commit-config.yaml | 8 ++++++++ REUSE.toml | 2 +- config.default.lisp | 1 + src/db.lisp | 13 +++++++------ src/inline-bots.lisp | 12 ++++++------ src/main.lisp | 21 +++++++++++---------- src/strings.lisp | 3 +-- src/tg.lisp | 6 +++--- src/tg/message-entity.lisp | 6 +++--- src/tg/message.lisp | 2 +- src/tg/method-macros.lisp | 10 +++++++--- src/tg/type-macros.lisp | 13 ++++++++----- src/tg/update.lisp | 2 +- ukkoclot.asd | 3 +-- 15 files changed, 63 insertions(+), 43 deletions(-) create mode 100644 .ocicl-lint.conf diff --git a/.ocicl-lint.conf b/.ocicl-lint.conf new file mode 100644 index 0000000..c161d92 --- /dev/null +++ b/.ocicl-lint.conf @@ -0,0 +1,4 @@ +# minus-one: I don't like 1- +# missing-docistring: I'm lazy +suppress-rules = minus-one, missing-docstring +suggest-libraries = alexandria, uiop, serapeum diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index ea14b31..f30fd61 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -1,6 +1,14 @@ # See https://pre-commit.com for more information # See https://pre-commit.com/hooks.html for more hooks repos: +- repo: local + hooks: + - id: ocicl-lint + name: ocicl-lint + language: system + entry: ocicl lint + pass_filenames: true + files: \.(lisp|asd)$ - repo: https://github.com/fsfe/reuse-tool rev: v6.1.2 hooks: diff --git a/REUSE.toml b/REUSE.toml index f87ab00..58ef515 100644 --- a/REUSE.toml +++ b/REUSE.toml @@ -3,7 +3,7 @@ version = 1 [[annotations]] label = "Miscellaneous little shits I put under CC0" - path = [".gitignore", ".pre-commit-config.yaml", "config.default.lisp"] + path = [".gitignore", ".ocicl-lint.conf", ".pre-commit-config.yaml", "config.default.lisp"] SPDX-License-Identifier = "CC0-1.0" SPDX-FileCopyrightText = " 2025 Uko Kokņevičs " diff --git a/config.default.lisp b/config.default.lisp index ac519ae..4162c9a 100644 --- a/config.default.lisp +++ b/config.default.lisp @@ -1,3 +1,4 @@ +;; lint:suppress in-package spdx-license-identifier ;; Copy this file to config.lisp and modify it there (:bot-name "Ukko's Clot" :bot-token "123456789:ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghi" diff --git a/src/db.lisp b/src/db.lisp index 5d08e6a..8fab0db 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -6,7 +6,7 @@ (:export :get-inline-bot-type :set-inline-bot-type :with-db)) (in-package :ukkoclot/db) -(defparameter +target-version+ 1 +(defconstant +target-version+ 1 "Intended DB version") (defmacro with-db ((name path) &body body) @@ -20,7 +20,10 @@ (integer->inline-bot-type type-int)))) (defun set-inline-bot-type (db id type) - (execute-non-query db "INSERT OR REPLACE INTO inline_bots (id, type) VALUES (?, ?)" id (inline-bot-type->integer type))) + (execute-non-query db + "INSERT OR REPLACE INTO inline_bots (id, type) VALUES (?, ?)" + id + (inline-bot-type->integer type))) (defun inline-bot-type->integer (type) (case type @@ -66,8 +69,7 @@ (execute-non-query db " CREATE TABLE inline_bots_enum ( id INTEGER PRIMARY KEY, - value TEXT UNIQUE -)") + value TEXT UNIQUE)") (execute-non-query db " INSERT INTO inline_bots_enum(id, value) VALUES (?, 'blacklisted'), (?, 'whitelisted')" @@ -78,6 +80,5 @@ VALUES (?, 'blacklisted'), (?, 'whitelisted')" (execute-non-query db " CREATE TABLE inline_bots ( id INTEGER PRIMARY KEY, - type INTEGER REFERENCES inline_bots_enum(id) -)")) + type INTEGER REFERENCES inline_bots_enum(id))")) (t (error "Unreachable upgrade step reached ~A" new-version)))) diff --git a/src/inline-bots.lisp b/src/inline-bots.lisp index caf210a..94ed478 100644 --- a/src/inline-bots.lisp +++ b/src/inline-bots.lisp @@ -17,14 +17,13 @@ (defun on-inline-bot (bot msg via) (let ((ty (db:get-inline-bot-type (bot-db bot) (user-id via)))) - (if (eq ty :whitelisted) - t - (progn + (or (eql ty :whitelisted) + (prog1 nil (log:info "Deleting an unallowed inline bot message from ~A ~A" (user-username via) (user-id via)) (try-delete-message bot msg) - (unless (eq ty :blacklisted) + (unless (eql ty :blacklisted) ;; Not explicitly blacklisted, notify dev group (let ((whitelist (make-inline-keyboard-button :text "Whitelist" :callback-data (format nil "bwl:~A" (user-id via)))) @@ -38,5 +37,6 @@ :parse-mode html :reply-markup (make-inline-keyboard-markup :inline-keyboard - (make-array '(1 2) :initial-contents (list (list whitelist blacklist))))))) - nil)))) + (make-array '(1 2) + :initial-contents + (list (list whitelist blacklist))))))))))) diff --git a/src/main.lisp b/src/main.lisp index 2e01411..ba3e343 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -9,7 +9,8 @@ (:import-from :ukkoclot/db :with-db) (:import-from :ukkoclot/serializing :fixup-value) (:import-from :ukkoclot/state :make-bot :bot-config :bot-power-on) - (:import-from :ukkoclot/strings :escape-xml :is-tg-whitespace :is-tg-whitespace-str :starts-with :starts-with-ignore-case) + (:import-from :ukkoclot/strings + :escape-xml :is-tg-whitespace :is-tg-whitespace-str :starts-with :starts-with-ignore-case) (:local-nicknames (:jzon :com.inuoe.jzon)) (:export :main)) @@ -26,7 +27,9 @@ (defun start-swank (port) (log:info "Starting a SWANK server on port ~A..." port) (swank:create-server :port port :dont-close t) - (log:info "SWANK started. You can connect to it by forwarding ports via SSH: `ssh -L~A:127.0.0.1:~A username@server.com'" port port) + (log:info + "SWANK started. You can connect to it by forwarding ports via SSH: `ssh -L~A:127.0.0.1:~A username@server.com'" + port port) (log:info "And then afterwards M-x slime-connect giving localhost and ~A" port)) (defun stop-swank (port) @@ -214,9 +217,10 @@ (reply-message bot msg "OwO")) ((string-equal text "waow") - (reply-message bot - (or (message-reply-to-message msg) msg) - "BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED")) + (reply-message + bot + (or (message-reply-to-message msg) msg) + "BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED")) ((string-equal text "what") (reply-message bot msg @@ -232,8 +236,7 @@ (write-string "GIR" s)) (if (char= (elt text 3) #\t) (write-char #\l s) - (write-char #\L s))))) - ))) + (write-char #\L s)))))))) (defun simplify-cmd (bot cmd) (let ((at-idx (position #\@ cmd))) @@ -273,9 +276,7 @@ Send time: ...")) (message-from msg) (= (user-id (message-from msg)) (config-owner (bot-config bot)))) (setf (bot-power-on bot) nil) - (reply-message bot msg "Initialising shutdown..." :allow-sending-without-reply t)) - - ))) + (reply-message bot msg "Initialising shutdown..." :allow-sending-without-reply t))))) (defun report-error (bot evt err) (log:error "While handling ~A: ~A" evt err) diff --git a/src/strings.lisp b/src/strings.lisp index 635762c..f08010e 100644 --- a/src/strings.lisp +++ b/src/strings.lisp @@ -42,8 +42,7 @@ (string= gc "Zl") ; Separator, line (string= gc "Zp") ; Separator, paragraph (string= gc "Cc") ; Other, control - (= (char-code ch) #x2800) ; BRAILLE PATTERN BLANK - ))) + (= (char-code ch) #x2800)))) ; BRAILLE PATTERN BLANK (defun is-tg-whitespace-str (str) (iter (for ch in-string str) diff --git a/src/tg.lisp b/src/tg.lisp index 1ee7da0..05b6e90 100644 --- a/src/tg.lisp +++ b/src/tg.lisp @@ -1,7 +1,7 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (uiop:define-package :ukkoclot/tg - (:use) + (:use :c2cl) (:use-reexport :ukkoclot/tg/animation :ukkoclot/tg/answer-callback-query @@ -45,5 +45,5 @@ :ukkoclot/tg/suggested-post-price :ukkoclot/tg/update :ukkoclot/tg/user - :ukkoclot/tg/web-app-info - )) + :ukkoclot/tg/web-app-info)) +(in-package :ukkoclot/tg) diff --git a/src/tg/message-entity.lisp b/src/tg/message-entity.lisp index 3413763..c7e6ba1 100644 --- a/src/tg/message-entity.lisp +++ b/src/tg/message-entity.lisp @@ -37,7 +37,7 @@ (defun message-entity-extract (entity text) (with-slots (length offset) entity - (if (= length 0) + (if (zerop length) "" (let* ((start (iterate (with curr-idx16 = 0) @@ -46,7 +46,7 @@ (when (or (= curr-idx16 offset) (> (+ curr-idx16 curr-width) offset)) (return curr-idx32)) - (setq curr-idx16 (+ curr-idx16 curr-width)) + (incf curr-idx16 curr-width) (finally (return (length text))))) (end (iterate (with curr-len16 = 0) @@ -54,6 +54,6 @@ (for curr-width = (utf16-width ch)) (when (>= curr-len16 length) (return curr-idx32)) - (setq curr-len16 (+ curr-len16 curr-width)) + (incf curr-len16 curr-width) (finally (return (length text)))))) (subseq text start end))))) diff --git a/src/tg/message.lisp b/src/tg/message.lisp index 4707c57..e7043bc 100644 --- a/src/tg/message.lisp +++ b/src/tg/message.lisp @@ -160,7 +160,7 @@ ;; (video-chat-participants-invited (or video-chat-participants-invited null) nil) ;; (web-app-data (or web-app-data null) nil) ;; (reply-markup (or inline-keyboard-markup null) nil) - ) + ) ; lint:suppress closing-parens-same-line whitespace-before-close-paren (defun message-id (msg) (message-message-id msg)) diff --git a/src/tg/method-macros.lisp b/src/tg/method-macros.lisp index 3599328..e614db9 100644 --- a/src/tg/method-macros.lisp +++ b/src/tg/method-macros.lisp @@ -2,6 +2,7 @@ ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/tg/method-macros (:use :c2cl :iterate) + (:import-from :serapeum :take) (:import-from :ukkoclot/state :bot) (:import-from :ukkoclot/strings :ends-with :lisp->camel-case) (:import-from :ukkoclot/transport :do-call) @@ -13,7 +14,10 @@ (defparameter +unique+ (gensym)) - (defun make-param (name type &optional (default +unique+) &key (skip-if-default (not (eq default +unique+)))) + ;; TODO: Fix optional-and-key ! + (defun make-param (name type ; lint:suppress avoid-optional-and-key + &optional (default +unique+) + &key (skip-if-default (not (eq default +unique+)))) (let ((default (if (eq default +unique+) `(error ,(format nil "No value given for ~A" name)) default))) @@ -29,7 +33,7 @@ (defun path-from-name (name) (let ((str (lisp->camel-case (symbol-name name)))) (if (ends-with str "%") - (subseq str 0 (- (length str) 1)) + (take (- (length str) 1) str) str))) (defun emit-append-to-args (param args) @@ -46,7 +50,7 @@ (let ((revparams (reverse params)) (args (gensym "ARGS")) (bot (gensym "BOT"))) - `(defun ,name (,bot &key ,@(iter (for param in params) + `(defun ,name (,bot &key ,@(iter (for param in params) ; lint:suppress lambda-list-invalid (collect (emit-defun-arg param)))) (let (,args) ,@(iter (for param in revparams) diff --git a/src/tg/type-macros.lisp b/src/tg/type-macros.lisp index 552c908..b9d649c 100644 --- a/src/tg/type-macros.lisp +++ b/src/tg/type-macros.lisp @@ -15,7 +15,10 @@ (defparameter +unique+ (gensym)) - (defun make-field (name type &optional (default +unique+) &key (skip-if-default (not (eq default +unique+)))) + ;; TODO: Fix optional-and-key ! + (defun make-field (name type ; lint:suppress avoid-optional-and-key + &optional (default +unique+) + &key (skip-if-default (not (eq default +unique+)))) (let ((default (if (eq default +unique+) `(error ,(format nil "No value given for ~A" name)) default))) @@ -70,7 +73,7 @@ ,@(emit-collect-nondefault-fields name fields obj (lambda (field value) - `(setf ,result (cons ,(emit-coerced-field field value) ,result)))) + `(push ,(emit-coerced-field field value) ,result))) ,result)))) (defun emit-let-gethash (field source) @@ -81,8 +84,8 @@ (let ((type-sym (gensym "TYPE-SYM")) (source (gensym "SOURCE"))) `(defmethod parse-value ((,type-sym (eql ',name)) ,source) - (let ,(iter (for field in fields) - (collect (emit-let-gethash field source))) + (let (,@(iter (for field in fields) + (collect (emit-let-gethash field source)))) (,(type-constructor name) ,@(iter (for field in fields) (appending (emit-constructor-args field)))))))) @@ -92,7 +95,7 @@ (stream (gensym "STREAM")) (depth (gensym "DEPTH")) (pprint-args (gensym "PPRINT-ARGS"))) - `(defun ,printer-name (,obj ,stream ,depth) + `(defun ,printer-name (,obj ,stream ,depth) ; lint:suppress lambda-list-invalid (declare (ignore ,depth)) (let (,pprint-args) ,@(emit-collect-nondefault-fields diff --git a/src/tg/update.lisp b/src/tg/update.lisp index 1c4ae46..90535ed 100644 --- a/src/tg/update.lisp +++ b/src/tg/update.lisp @@ -49,4 +49,4 @@ ;; (chat-join-request (or chat-join-request null) nil) ;; (chat-boost (or chat-boost-updated null) nil) ;; (removed-chat-boost (or chat-boost-removed) nil) - ) + ) ; lint:suppress closing-parens-same-line whitespace-before-close-paren diff --git a/ukkoclot.asd b/ukkoclot.asd index 9a9a85c..d03f1ce 100644 --- a/ukkoclot.asd +++ b/ukkoclot.asd @@ -11,9 +11,8 @@ :description "ukkoclot: Ukko's shitty telegram bot" :long-description #.(uiop:read-file-string (uiop:subpathname *load-pathname* "README.md")) :pathname "src" - :depends-on (:ukkoclot/main) + :depends-on (:ukkoclot/main)) ;; TODO: :in-order-to ((test-op (test-op ukkoclot-test))) - ) (register-system-packages :closer-mop '(:c2cl)) (register-system-packages :dexador '(:dex)) -- cgit v1.2.3