cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- added clause 'into' in local fediverse query.

This commit is contained in:
cage 2024-06-16 10:41:15 +02:00
parent 824e89883a
commit 720c55e5b3
2 changed files with 42 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src/fediverse-post-local-search.lisp
View File

@ -130,10 +130,22 @@
(strcat "where " (join-with-strings (third a) " ")) (strcat "where " (join-with-strings (third a) " "))
"")))) ""))))
(defrule fedisearch-into (and "into" fedisearch-spaces (+ (not fedisearch-blank)))
(:function (lambda (a)
(third a)))
(:text t))
(defrule fedisearch-query (? (and fedisearch-where-clause (? (and fedisearch-spaces fedisearch-into))))
(:function (lambda (a)
(list (first a) (second (second a))))))
(defun parse-search-statuses (query) (defun parse-search-statuses (query)
(let* ((where-clause (parse 'fedisearch-where-clause query)) (let* ((parsed (parse 'fedisearch-query query))
(sql-query (strcat (format nil (where-clause (first parsed))
"select * from \"~a\" ~a" (destination-folder (second parsed))
+view-search-fediverse-statuses+ (sql-query (strcat (format nil
where-clause)))) "select * from \"~a\" ~@[~a~]"
(db-utils:query-low-level sql-query))) +view-search-fediverse-statuses+
where-clause))))
(values (db-utils:query-low-level sql-query)
destination-folder)))

44
src/program-events.lisp
View File

@ -2038,26 +2038,30 @@
(defmethod process-event ((object fediverse-local-query-event)) (defmethod process-event ((object fediverse-local-query-event))
(with-accessors ((payload payload)) object (with-accessors ((payload payload)) object
(loop for status-results in (fediverse-post-local-search:parse-search-statuses payload) do (multiple-value-bind (statuses destination-folder)
(let* ((status-id (db:row-message-status-id status-results)) (fediverse-post-local-search:parse-search-statuses payload)
(status-row (db:find-status-id status-id))) (let ((folder (or destination-folder
(when (not (db::find-status-id-folder-timeline status-id (query-results-folder-name))))
(query-results-folder-name) (loop for status in statuses do
db:+home-timeline+)) (let* ((status-id (db:row-message-status-id status))
(setf (getf status-row :folder) (status-row (db:find-status-id status-id)))
(query-results-folder-name)) (when (not (db::find-status-id-folder-timeline status-id
(setf (getf status-row :timeline) folder
db:+home-timeline+) db:+home-timeline+))
(multiple-value-bind (query column-values) (setf (getf status-row :folder)
(db-utils:insert-query db:+table-status+ status-row) folder)
(db-utils:query-low-level query column-values))))) (setf (getf status-row :timeline)
(db:renumber-timeline-message-index db:+home-timeline+ db:+home-timeline+)
(query-results-folder-name) (multiple-value-bind (query column-values)
:account-id nil) (db-utils:insert-query db:+table-status+ status-row)
(let ((refresh-event (make-instance 'refresh-thread-windows-event (db-utils:query-low-level query column-values)))))
:new-folder (query-results-folder-name) (db:renumber-timeline-message-index db:+home-timeline+
:new-timeline db:+home-timeline+))) folder
(push-event refresh-event)))) :account-id nil)
(let ((refresh-event (make-instance 'refresh-thread-windows-event
:new-folder folder
:new-timeline db:+home-timeline+)))
(push-event refresh-event))))))
;;;; end events ;;;; end events