From 3962af025690b793117bccc93bcb9bab48ddd530 Mon Sep 17 00:00:00 2001 From: cage Date: Sat, 23 Jan 2021 15:40:51 +0100 Subject: [PATCH] - changed db-nil-p this function was transforming "no" and even 0.0 (floating point number) to nil. That behaivour was incorrect for numbers and probably not desiderable for the string no (in fact poll with "No" option was not rendered beacause of this fact). Removed conversion for non- integer numbers and prevented conversion from some kind of non empty string (like "nil" or "no") via a key argument. --- src/db-utils.lisp | 31 +++++++++++++++++-------------- src/db.lisp | 29 ++++++++++++++++++----------- src/message-rendering-utils.lisp | 4 ++-- src/thread-window.lisp | 2 +- 4 files changed, 38 insertions(+), 28 deletions(-) diff --git a/src/db-utils.lisp b/src/db-utils.lisp index ab431f1..c23b9a3 100644 --- a/src/db-utils.lisp +++ b/src/db-utils.lisp @@ -168,7 +168,7 @@ (from ,table) (where ,clause)))))) -(defgeneric db-nil-p (a) +(defgeneric db-nil-p (a &key &allow-other-keys) (:documentation "Non nil if the column can be considered a null value in lisp example: @@ -180,27 +180,30 @@ example: \"null\" -> T ")) -(defmethod db-nil-p ((a null)) +(defmethod db-nil-p ((a null) &key &allow-other-keys) t) -(defmethod db-nil-p ((a symbol)) +(defmethod db-nil-p ((a symbol) &key &allow-other-keys) (eq a :nil)) -(defmethod db-nil-p ((a string)) - (or (string-empty-p a) - (string-equal a "false") - (string-equal a "null") - (string-equal a "nil") - (string-equal a "no") - (string-equal a "0"))) +(defmethod db-nil-p ((a string) &key (only-empty-or-0-are-null nil) &allow-other-keys) + (if only-empty-or-0-are-null + (or (string-empty-p a) + (string-equal a "0")) + (or (string-empty-p a) + (string-equal a "false") + (string-equal a "null") + (string-equal a "nil") + (string-equal a "no") + (string-equal a "0")))) -(defmethod db-nil-p ((a number)) - (num:epsilon= a 0.0)) +(defmethod db-nil-p ((a integer) &key &allow-other-keys) + (= a 0)) (defun db-not-nil-p (a) (not (db-nil-p a))) -(defun db-getf (row indicator &optional (default nil)) +(defun db-getf (row indicator &key (default nil) (only-empty-or-0-are-null nil)) "Try to find a value in a `row' (modeled as a plist), return `default' if indicator has a value of nil in row and signal a `conditions:column-not-found' if `indicator' does not exists in @@ -209,7 +212,7 @@ example: (cond ((eq res :not-found) (error 'conditions:column-not-found :column indicator :row row)) - ((db-nil-p res) + ((db-nil-p res :only-empty-or-0-are-null only-empty-or-0-are-null) default) (t res)))) diff --git a/src/db.lisp b/src/db.lisp index 22ae04a..eb358c5 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -686,7 +686,8 @@ (account-known-p db-account-row)) (and account-known-p (db-getf db-account-row - :ignoredp nil)))) + :ignoredp + :default nil)))) (defun user-ignored-p (account-id) "Returns non nil if this account must be ignored" @@ -1697,12 +1698,18 @@ returns an alist of (local-username . acct)." (cons (msg-utils:add-mention-prefix local-name) (msg-utils:add-mention-prefix username)))))) -(defmacro gen-access-message-row (name column) +(defmacro gen-access-message-row (name column + &key + (default nil) + (only-empty-or-0-are-null nil)) "Convenience macro to generate function to access a value of a table row." `(defun ,(misc:format-fn-symbol t "row-~a" name) (row) (and row - (db-getf row ,column)))) + (db-getf row + ,column + :default ,default + :only-empty-or-0-are-null ,only-empty-or-0-are-null)))) (gen-access-message-row id :id) @@ -1750,9 +1757,9 @@ row." (gen-access-message-row poll-multiple-vote-p :multiple) -(gen-access-message-row title :title) +(gen-access-message-row title :title :only-empty-or-0-are-null t) -(gen-access-message-row subtitle :subtitle) +(gen-access-message-row subtitle :subtitle :only-empty-or-0-are-null t) (gen-access-message-row url :url) @@ -1783,7 +1790,7 @@ row." (gen-access-message-row seenp :seenp) (defun row-votes-count (row) - (and row (db-getf row :votes-count 0))) + (and row (db-getf row :votes-count :default 0))) (defun row-message-reply-to-id (row) (and row @@ -2879,11 +2886,11 @@ than `days-in-the-past' days (default: `(swconf:config-purge-cache-days-offset)' (defun row-unseen-count (row) (and row - (db-getf row :unseen-count 0))) + (db-getf row :unseen-count :default 0))) (defun row-seen-count (row) (and row - (db-getf row :seen-count 0))) + (db-getf row :seen-count :default 0))) (defun gemini-all-subscriptions () (when-let* ((query (select (:gemini-subscription.* @@ -2942,13 +2949,13 @@ than `days-in-the-past' days (default: `(swconf:config-purge-cache-days-offset)' (gen-access-message-row gemlog-url :gemlog-url) -(gen-access-message-row gemlog-title :gemlog-title) +(gen-access-message-row gemlog-title :gemlog-title :only-empty-or-0-are-null t) -(gen-access-message-row gemlog-subtitle :gemlog-subtitle) +(gen-access-message-row gemlog-subtitle :gemlog-subtitle :only-empty-or-0-are-null t) (gen-access-message-row post-date :post-date) -(gen-access-message-row post-title :post-title) +(gen-access-message-row post-title :post-title :only-empty-or-0-are-null t) (gen-access-message-row post-link :post-link) diff --git a/src/message-rendering-utils.lisp b/src/message-rendering-utils.lisp index f667c7e..2d91592 100644 --- a/src/message-rendering-utils.lisp +++ b/src/message-rendering-utils.lisp @@ -187,12 +187,12 @@ (loop for attachment in all-attachments do (let ((type (db-utils:db-getf attachment :type - (_ "unknown")))) + :default (_ "unknown")))) (format stream (_"type: ~a~%metadata~%~a~%address: ~a~2%") (attachment-type->description type) (attachment-type->metadata type attachment) - (db-utils:db-getf attachment :url (_ "unknown"))))))) + (db-utils:db-getf attachment :url :default (_ "unknown"))))))) text)) (defgeneric message-original->text-body (object &key &allow-other-keys)) diff --git a/src/thread-window.lisp b/src/thread-window.lisp index 3c8ec13..1cdc86b 100644 --- a/src/thread-window.lisp +++ b/src/thread-window.lisp @@ -797,7 +797,7 @@ db:renumber-timeline-message-index." (timeline-folder timeline-folder)) object (when-let* ((selected-row (selected-row object)) (fields (fields selected-row)) - (original (db-utils:db-getf fields :content "")) + (original (db-utils:db-getf fields :content :default "")) (status-id (db:row-message-status-id fields)) (header (message-original->text-header fields))) (let* ((body (db:row-message-rendered-text fields))