diff --git a/chatdir.scm b/chatdir.scm index 2784082..6670002 100644 --- a/chatdir.scm +++ b/chatdir.scm @@ -339,6 +339,46 @@ (directory (subpath root channel))) +;; List all messages that have the given xattr set to the given value. +(define (channel-messages-by-xattr root channel xattr value) + (filter + (lambda (message-leaf) + (string=? (get-xattr (subpath root channel message-leaf) + xattr) + value)) + (channel-messages root channel))) + + +;; List all messages from the given sender. +(define (channel-messages-by-sender root channel sender) + (channel-messages-by-xattr root channel "user.chat.sender" sender)) + + +;; List all messages sent at exactly the given date. +(define (channel-messages-by-date root channel date) + (channel-messages-by-xattr root channel "user.chat.date" + (date->string date "~1T~2"))) + + +;; List all messages sent around the given date, ±deviation seconds. +(define (channel-messages-by-date* root channel date deviation) + (channel-messages-by-date-range root channel + (seconds->date (- (date->seconds date) deviation)) + (seconds->date (+ (date->seconds date) deviation)))) + + +;; List all messages sent within the given date range. +(define (channel-messages-by-date-range root channel min-date max-date) + (filter + (lambda (message-leaf) + (let* ([message-path (subpath root channel message-leaf)] + [message-date (string->date (get-xattr message-path "user.chat.date") + "~Y-~m-~dT~H:~M:~S~z")]) + (and (date<=? min-date message-date) + (date<=? message-date max-date)))) + (channel-messages root channel))) + + ;; Initialization for the input loop (define (input-loop-init root-dir callbacks-alist) (let ([join-callback (alist-ref 'join-channel callbacks-alist)]) diff --git a/tests/tests.scm b/tests/tests.scm index cb03089..e77558c 100644 --- a/tests/tests.scm +++ b/tests/tests.scm @@ -71,8 +71,27 @@ (define *msg-date* (current-date)) (define *msg-xattr* '(user.bovo . "muuuu")) (define *msg-name* (message-file-leaf *dir* *room* *msg-date*)) - (channel-message-add! *dir* *room* *msg-text* *msg-sender* *msg-date* `(,*msg-xattr*)) + +(define *msg-sender-2* "bildinto") +(define *msg-text-2* "he? ĉu vi bonsanas?") +(define *msg-date-2* *msg-date*) +(define *msg-name-2* (message-file-leaf *dir* *room* *msg-date-2*)) +(channel-message-add! *dir* *room* *msg-text-2* *msg-sender-2* *msg-date-2*) + +(define *msg-sender-3* *msg-sender*) +(define *msg-text-3* "feliĉan novjaron! =w= :D ^_^") +(define *msg-date-3* (string->date "2023-01-01 00:01:00" "~Y-~m-~d ~H:~M:~S")) +(define *msg-name-3* (message-file-leaf *dir* *room* *msg-date-3*)) +(channel-message-add! *dir* *room* *msg-text-3* *msg-sender-3* *msg-date-3*) + +(define *msg-sender-4* *msg-sender-2*) +(define *msg-text-4* "certainly! :D") +(define *msg-date-4* (string->date "2023-01-02 21:43:09" "~Y-~m-~d ~H:~M:~S")) +(define *msg-name-4* (message-file-leaf *dir* *room* *msg-date-4*)) +(channel-message-add! *dir* *room* *msg-text-4* *msg-sender-4* *msg-date-4*) + + (check (directory-file-get* (subpath *dir* *room*) *msg-name*) => (list *msg-text* @@ -82,12 +101,6 @@ (cons 'user.chat.channel *room*))) -(define *msg-sender-2* "bildinto") -(define *msg-text-2* "he? ĉu vi bonsanas?") -(define *msg-date-2* *msg-date*) -(define *msg-name-2* (message-file-leaf *dir* *room* *msg-date-2*)) - -(channel-message-add! *dir* *room* *msg-text-2* *msg-sender-2* *msg-date-2*) (check (directory-file-get* (subpath *dir* *room*) *msg-name-2*) => (list *msg-text-2* @@ -96,6 +109,35 @@ (cons 'user.chat.channel *room*))) +(check (list (find (lambda (a) (string=? *msg-name* a)) + (channel-messages *dir* *room*)) + (find (lambda (a) (string=? *msg-name-2* a)) + (channel-messages *dir* *room*))) + => + (list *msg-name* *msg-name-2*)) + + +(check (list (<= 2 (length (channel-messages-by-sender *dir* *room* "maya"))) + (find (lambda (a) (string=? *msg-name-3* a)) + (channel-messages-by-sender *dir* *room* "maya"))) + => + (list #t *msg-name-3*)) + + +(check (find (lambda (a) (string=? *msg-name-3* a)) + (channel-messages-by-date *dir* *room* *msg-date-3*)) + => + *msg-name-3*) + + +(check (let ([messages + (channel-messages-by-date-range *dir* *room* *msg-date-3* *msg-date-4*)]) + (list (find (lambda (a) (string=? *msg-name-3* a)) messages) + (find (lambda (a) (string=? *msg-name-4* a)) messages))) + => + (list *msg-name-3* *msg-name-4*)) + + ;; —————————————————————————————————————————————————— ;; Channel creation/management