mu-scm: implement store->alist
Get information about the store as an alist. Scm + cc + test + doc.
This commit is contained in:
@ -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())
|
||||||
|
|||||||
@ -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)
|
||||||
|
|||||||
@ -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>)
|
||||||
|
|||||||
@ -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)
|
||||||
|
|||||||
@ -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
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user