scm: add support for labels + tests

Add procedures 'label' (for a message) and all-labels (for a store).

scm/mu-scm-store.cc

@@ -178,6 +178,25 @@ subr_cc_store_mfind(SCM store_scm, SCM query_scm, SCM related_scm, SCM skip_dups
 	err.throw_scm();
 }
 
+static SCM
+subr_cc_store_all_labels(SCM store_scm) try {
+
+	constexpr auto func{"cc-store-all-labels"};
+	const auto& store{to_store(store_scm, func, 1)};
+
+	const auto label_map{store.label_map()};
+
+	SCM labels{SCM_EOL};
+	for (const auto& [label, _n]: label_map)
+		labels = scm_append_x(
+			scm_list_2(labels,
+				   scm_list_1(to_scm<std::string>(label))));
+	return labels;
+
+} catch (const ScmError& err) {
+	err.throw_scm();
+}
+
 
 static void
 init_subrs()
@@ -192,7 +211,8 @@ init_subrs()
 			   reinterpret_cast<scm_t_subr>(subr_cc_store_cfind));
 	scm_c_define_gsubr("cc-store-alist", 1/*req*/, 0/*opt*/, 0/*rst*/,
 			   reinterpret_cast<scm_t_subr>(subr_cc_store_alist));
-
+	scm_c_define_gsubr("cc-store-all-labels", 1/*req*/, 0/*opt*/, 0/*rst*/,
+			   reinterpret_cast<scm_t_subr>(subr_cc_store_all_labels));
 #pragma GCC diagnostic pop
 }
 

scm/mu-scm-test.scm

@@ -120,6 +120,16 @@
 
     (test-end "test-message-parts")))
 
+(define (test-message-labels)
+  (test-begin "test-message-labels")
+  (let* ((perfmsgs (mfind "label:performance")))
+    (test-equal 4 (length perfmsgs))
+    (for-each (lambda (msg)
+		(test-equal 1 (length (labels msg)))
+		(test-equal "performance" (car (labels msg))))
+	      perfmsgs))
+    (test-end "test-message-labels"))
+
 (define (test-message-new)
   (test-begin "test-message-new")
   (let ((msg (make-message (format #f "~a/testdir2/Foo/cur/mail5" (getenv "MU_TESTDATADIR"))))
@@ -187,6 +197,7 @@
       (test-message-full)
       (test-message-more)
       (test-message-parts)
+      (test-message-labels)
       (test-message-new)
       (test-options)
       (test-helpers)

scm/mu-scm.cc

@@ -193,6 +193,20 @@ test_scm_script()
 		g_assert_true(res);
 	}
 
+	// add some label for testing
+	{
+		auto res = store->run_query("optimization");
+		const Labels::DeltaLabelVec labels{*Labels::parse_delta_label("+performance")};
+		assert_valid_result(res);
+		g_assert_cmpuint(res->size(), ==, 4);
+		for (auto& it: *res) {
+			auto msg{it.message()};
+			g_assert_true(!!msg);
+			const auto updateres{store->update_labels(*msg, labels)};
+			assert_valid_result(updateres);
+		}
+	}
+
 	Mu::Options opts{};
 	opts.scm.script_path = join_paths(MU_SCM_SRCDIR, "mu-scm-test.scm");
 

scm/mu-scm.scm

@@ -44,6 +44,7 @@
 	    path
 	    priority
 	    subject
+	    labels
 
 	    references
 	    thread-id
@@ -89,6 +90,7 @@
 	    mfind
 	    mcount
 	    cfind
+	    all-labels
 	    store->alist
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -350,6 +352,10 @@ fake-message-id (see impls) are filtered out. If there are no references, return
 #f."
   (assoc-ref (message->alist message) 'references))
 
+(define-method (labels (message <message>))
+  "Get the list of labels for MESSAGE or #f if not available."
+  (assoc-ref (message->alist message) 'labels))
+
 (define-method (thread-id (message <message>))
   "Get the oldest (first) reference for MESSAGE, or message-id if there are none.
 If neither are available, return #f.
@@ -370,7 +376,7 @@ This is method is useful to determine the thread a message is in."
   (assoc-ref (message->alist message) 'flags))
 
 (define-method (flag? (message <message>) flag)
-  "Does MESSAGE have FLAG?"
+  "Does MESSAGE have some FLAG?"
   (let ((flgs (flags message)))
     (if flgs
 	(if (member flag flgs) #t #f)
@@ -561,6 +567,12 @@ The pattern is mandatory; the other (keyword) arguments are optional.
     #:max-results max. number of matches. Default: false (unlimited))."
   (cc-store-cfind (cc-store store) pattern personal? after max-results))
 
+(define* (all-labels
+	  #:key
+	  (store %default-store))
+  "Get the list of all labels in the store."
+  (cc-store-all-labels (cc-store store)))
+
 ;;; Misc
 
 ;; Get an alist with the general options this instance of \"mu\" started with.

scm/mu-scm.texi

@@ -364,6 +364,11 @@ Example:
      (root-maildir . "/home/user/Maildir") (schema-version . 500))
 @end lisp
 
+@deffn {Scheme Procedure} all-labels
+@end deffn
+Get the list of all labels present in the store, or @code{#f} if there are none.
+Not to be confused with @code{labels} procedure for a @code{message} object.
+
 @node Message
 @section Message
 
@@ -695,6 +700,17 @@ For example:
 => 2815
 @end lisp
 
+@deffn {Scheme Procedure} labels message
+@end deffn
+Get the list of labels for this message, or @code{#f} if there are none.
+Not to be confused with the @code{all-labels} procedure for a Store.
+
+For example:
+@lisp
+(labels msg)
+=> ("foo" "bar")
+@end lisp
+
 @deffn {Scheme Procedure} language message
 @end deffn
 Get the ISO-639-1 language code for message's primary language or @code{#f} if not
@@ -771,6 +787,7 @@ For example:
 => "gnu-emacs-sources.gnu.org"
 @end lisp
 
+
 @c @deffn {Scheme Procedure} sexp message
 @c @end deffn
 @c Get the message's s-expression.