mu-scm: implement store->alist

Get information about the store as an alist.

Scm + cc + test + doc.
This commit is contained in:
Dirk-Jan C. Binnema
2025-07-09 21:50:31 +03:00
parent 8d46f80bb9
commit 6d72aa5c7f
5 changed files with 100 additions and 15 deletions

View File

@ -38,6 +38,57 @@ to_store(SCM scm, const char *func, int pos)
return *reinterpret_cast<Store*>(scm_foreign_object_ref(scm, 0)); return *reinterpret_cast<Store*>(scm_foreign_object_ref(scm, 0));
} }
static SCM
subr_cc_store_alist(SCM store_scm) try {
constexpr auto func{"cc-store-alist"};
SCM alist{SCM_EOL};
const auto& conf{to_store(store_scm, func, 1).config()};
using MuConfig = Mu::Config;
using Type = MuConfig::Type;
for (const auto& prop: Mu::Config::properties) {
// don't expose internal values & values that may change during
// runtime
if (any_of(prop.flags &
(MuConfig::Flags::Internal | MuConfig::Flags::Runtime)))
continue;
const auto str{conf.get_str(prop)};
if (str.empty())
continue;
const auto name{make_symbol(prop.name)};
const auto val = std::invoke([&]() {
switch (prop.type) {
case Type::Number:
return to_scm(MuConfig::decode<Type::Number>(str));
case Type::Boolean:
return to_scm(MuConfig::decode<Type::Boolean>(str));
case Type::Timestamp:
return to_scm(MuConfig::decode<Type::Timestamp>(str));
case Type::Path:
return to_scm(MuConfig::decode<Type::Path>(str));
case Type::String:
return to_scm(MuConfig::decode<Type::String>(str));
case Type::StringList:
return to_scm(MuConfig::decode<Type::StringList>(str));
default:
throw ScmError{ScmError::Id::WrongType, func, 1, store_scm, "store"};
}
});
alist = scm_acons(name, val, alist);
}
return scm_reverse_x(alist, SCM_EOL);
} catch (const ScmError& err) {
err.throw_scm();
}
static SCM static SCM
subr_cc_store_mcount(SCM store_scm) try { subr_cc_store_mcount(SCM store_scm) try {
return to_scm(to_store(store_scm, "cc-store-mcount", 1).size()); return to_scm(to_store(store_scm, "cc-store-mcount", 1).size());
@ -139,6 +190,9 @@ init_subrs()
reinterpret_cast<scm_t_subr>(subr_cc_store_mcount)); reinterpret_cast<scm_t_subr>(subr_cc_store_mcount));
scm_c_define_gsubr("cc-store-cfind", 5/*req*/, 0/*opt*/, 0/*rst*/, scm_c_define_gsubr("cc-store-cfind", 5/*req*/, 0/*opt*/, 0/*rst*/,
reinterpret_cast<scm_t_subr>(subr_cc_store_cfind)); 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));
#pragma GCC diagnostic pop #pragma GCC diagnostic pop
} }
@ -167,8 +221,8 @@ Mu::Scm::init_store(const Store& store)
SCM SCM
Mu::Scm::to_scm(const Contact& contact) Mu::Scm::to_scm(const Contact& contact)
{ {
static SCM email{scm_from_utf8_symbol("email")}; static SCM email{make_symbol("email")};
static SCM name{scm_from_utf8_symbol("name")}; static SCM name{make_symbol("name")};
SCM alist = scm_acons(email, to_scm(contact.email), SCM_EOL); SCM alist = scm_acons(email, to_scm(contact.email), SCM_EOL);
if (!contact.name.empty()) if (!contact.name.empty())

View File

@ -3,14 +3,18 @@
(use-modules (mu) (srfi srfi-64) (use-modules (mu) (srfi srfi-64)
(ice-9 textual-ports)) (ice-9 textual-ports))
(define (test-basic) (define (test-store)
(test-begin "test-basic") (test-begin "test-store")
(test-equal "mcount" 19 (mcount)) (test-equal "mcount" 19 (mcount))
(test-equal "cfind" 29 (length (cfind ""))) (test-equal "cfind" 29 (length (cfind "")))
(test-equal "mfind" 19 (length (mfind ""))) (test-equal "mfind" 19 (length (mfind "")))
(test-end "test-basic")) (let ((info (store->alist)))
(test-equal 50000 (assoc-ref info 'batch-size))
(test-equal 100000000 (assoc-ref info 'max-message-size)))
(test-end "test-store"))
(define (test-basic-mfind) (define (test-basic-mfind)
@ -33,10 +37,8 @@
(let ((recip (car (to msg)))) (let ((recip (car (to msg))))
(test-equal "Bilbo Baggins" (assoc-ref recip 'name)) (test-equal "Bilbo Baggins" (assoc-ref recip 'name))
(test-equal "bilbo@anotherexample.com" (assoc-ref recip 'email))) (test-equal "bilbo@anotherexample.com" (assoc-ref recip 'email)))
;; no date ;; no date
(test-assert (not (date msg))) (test-assert (not (date msg)))
;; flags ;; flags
(test-equal '(unread) (flags msg)) (test-equal '(unread) (flags msg))
(test-assert (unread? msg)) (test-assert (unread? msg))
@ -171,7 +173,7 @@
(test-with-runner runner (test-with-runner runner
(test-begin "mu-scm-tests") (test-begin "mu-scm-tests")
(test-basic) (test-store)
(test-basic-mfind) (test-basic-mfind)
(test-mfind) (test-mfind)
(test-message-full) (test-message-full)

View File

@ -221,6 +221,13 @@ namespace Mu::Scm {
return scm_from_utf8_stringn(val.data(), val.size()); return scm_from_utf8_stringn(val.data(), val.size());
else if constexpr (is_char_array_v<Type>|| std::is_same_v<Type, const char*>) else if constexpr (is_char_array_v<Type>|| std::is_same_v<Type, const char*>)
return scm_from_utf8_string(val); return scm_from_utf8_string(val);
else if constexpr (std::is_same_v<Type, std::vector<std::string>>) {
SCM lst{SCM_EOL};
for (const auto& s: val)
lst = scm_append_x(scm_list_2(lst,
scm_list_1(to_scm(s))));
return lst;
}
else if constexpr (std::is_same_v<Type, bool>) else if constexpr (std::is_same_v<Type, bool>)
return scm_from_bool(val); return scm_from_bool(val);
else if constexpr (std::is_same_v<Type, size_t>) else if constexpr (std::is_same_v<Type, size_t>)

View File

@ -87,6 +87,7 @@
mfind mfind
mcount mcount
cfind cfind
store->alist
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Other ;; Other
@ -453,7 +454,8 @@ This is a list of <mime-part> objects."
;; the 'store-object' is a foreign object wrapping a const Store*. ;; the 'store-object' is a foreign object wrapping a const Store*.
(define-class <store> () (define-class <store> ()
(store-object #:init-keyword #:store-object #:getter store-object)) (store-object #:init-keyword #:store-object #:getter store-object)
(alist #:init-value #f))
;; not exported ;; not exported
(define-method (make-store store-object) (define-method (make-store store-object)
@ -464,6 +466,14 @@ This is a list of <mime-part> objects."
;; %default-store-object is defined in mu-scm-store.cc ;; %default-store-object is defined in mu-scm-store.cc
(make-store %default-store-object)) (make-store %default-store-object))
(define* (store->alist #:key (store %default-store))
"Get an alist-representation for some store.
Keyword arguments:
#:store %default-store. Leave at default."
(when (not (slot-ref store 'alist))
(slot-set! store 'alist (cc-store-alist (store-object store))))
(slot-ref store 'alist))
(define* (mfind query (define* (mfind query
#:key #:key
(store %default-store) (store %default-store)
@ -472,7 +482,7 @@ This is a list of <mime-part> objects."
(sort-field 'date) (sort-field 'date)
(reverse? #f) (reverse? #f)
(max-results #f)) (max-results #f))
"Find messages matching some query. "Find messages matching some query.
The query is mandatory, the other (keyword) arguments are optional. The query is mandatory, the other (keyword) arguments are optional.
(mfind QUERY (mfind QUERY
@ -482,10 +492,10 @@ The query is mandatory, the other (keyword) arguments are optional.
#:sort-field? field to sort by, a symbol. Default: date #:sort-field? field to sort by, a symbol. Default: date
#:reverse? sort in descending order (z-a) #:reverse? sort in descending order (z-a)
#:max-results max. number of matches. Default: false (unlimited))." #:max-results max. number of matches. Default: false (unlimited))."
(map (lambda (plist) (map (lambda (plist)
(make <message> #:plist plist)) (make <message> #:plist plist))
(cc-store-mfind (store-object store) query (cc-store-mfind (store-object store) query
related? skip-dups? sort-field reverse? max-results))) related? skip-dups? sort-field reverse? max-results)))
(define* (mcount (define* (mcount
#:key #:key

View File

@ -260,7 +260,7 @@ few key concepts, represented in some GOOP objects and other data-structures:
@end itemize @end itemize
@menu @menu
* Store:: the database of all information * Store:: where message information lives
* Message:: inspecting individual messages * Message:: inspecting individual messages
* Miscellaneous:: other functions * Miscellaneous:: other functions
* Helpers:: some helper functions * Helpers:: some helper functions
@ -352,6 +352,18 @@ Example usage:
=> 140728 => 140728
@end lisp @end lisp
@deffn {Scheme Procedure} store->alist
@end deffn
Retrieve an association list (``alist'') with information about the store.
Example:
@lisp
(store->alist)
=> ((batch-size . 50000) (created . 1741180008) (max-message-size . 100000000)
(personal-addresses "djcb@@example.com" "msx@@example.com")
(root-maildir . "/home/user/Maildir") (schema-version . 500))
@end lisp
@node Message @node Message
@section Message @section Message