From 0ac7d9860bbaafc37607dd9ab013f591df87a9e1 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sun, 22 Nov 2020 09:30:28 -0600 Subject: [PATCH] WIP --- org-ql.el | 39 ++++++++++++++++--------------- tests/test-org-ql.el | 55 +++++++++++++++++++++++--------------------- 2 files changed, 49 insertions(+), 45 deletions(-) diff --git a/org-ql.el b/org-ql.el index 01f538a..bcff9bb 100644 --- a/org-ql.el +++ b/org-ql.el @@ -283,22 +283,21 @@ PREDICATES should be the value of `org-ql-predicates'." PREDICATES should be the value of `org-ql-predicates'." ;; NOTE: I don't how the `list' symbol ends up in the list, but anyway... (let* ((preamble-patterns - (-flatten-n 1 - (-non-nil - (--map (pcase-let* (((map (:preambles preambles) (:fn fn)) (cdr it))) - (--map (pcase-let* ((`(,pattern ,exp) it)) - `(,pattern - (pcase-let* (((map (:regexp regexp) (:case-fold case-fold) (:predicate predicate)) - ,exp)) - (setf org-ql-preamble regexp - preamble-case-fold case-fold) - ;; NOTE: Even when `predicate' is nil, it must be returned in the pcase form. - ;; MAYBE: Rather than returning the "canonical" predicate, allow any predicate form, - ;; which would be more flexible. OTOH it would make writing the tests a bit more work. - (when predicate - ,fn)))) - preambles)) - predicates))))) + (-flatten-n 1 (-non-nil + ;; NOTE: Using -let instead of pcase-let here because I can't make map 2.1 install in the test sandbox. + (--map (-let* (((&plist :preambles :fn) (cdr it))) + (--map (pcase-let* ((`(,pattern ,exp) it)) + `(,pattern + (-let* (((&plist :regexp :case-fold :predicate) ,exp)) + (setf org-ql-preamble regexp + preamble-case-fold case-fold) + ;; NOTE: Even when `predicate' is nil, it must be returned in the pcase form. + ;; MAYBE: Rather than returning the "canonical" predicate, allow any predicate form, + ;; which would be more flexible. OTOH it would make writing the tests a bit more work. + (when predicate + ',fn)))) + preambles)) + predicates))))) (fset 'org-ql--query-preamble `(lambda (query) "FIXME" @@ -1101,9 +1100,11 @@ COMPARATOR may be `<', `<=', `>', or `>='." ('> `(>= ,(1+ num) "*")) ('>= `(>= ,num "*")) ((pred integerp) `(repeat ,comparator-or-num ,num "*"))))) - (list :regexp (rx-to-string `(seq bol ,repeat " ") t)))) + (list :regexp (rx-to-string `(seq bol ,repeat " ") t) + :case-fold t))) (`(,predicate-names ,num) - (list :regexp (rx-to-string `(seq bol (repeat ,num "*") " ") t)))) + (list :regexp (rx-to-string `(seq bol (repeat ,num "*") " ") t) + :case-fold t))) ;; NOTE: It might be necessary to take into account `org-odd-levels'; see docstring for ;; `org-outline-level'. :predicate (when-let ((outline-level (org-outline-level))) @@ -1545,7 +1546,7 @@ parseable by `parse-time-string' which may omit the time value." `(closed :from ,from)))) :preambles ((`(,predicate-names . ,_) ;; Predicate still needs testing. - (list :regexp org-closed-time-regexp :predicate predicate))) + (list :regexp org-closed-time-regexp :predicate t))) :predicate (org-ql--predicate-ts :from from :to to :regexp org-closed-time-regexp :match-group 1 :limit (line-end-position 2))) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index d297fc6..816800b 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -50,7 +50,7 @@ Set at runtime by test suite.") ('org-ql 'org-ql) ('org-ql-expect t) ('org-ql--query-preamble 'query-preamble) - ('org-ql--pre-process-query t) + ('org-ql--normalize-query t) (_ nil))) (result (pcase sexp (`(org-ql-expect ,args) @@ -63,7 +63,7 @@ Set at runtime by test suite.") :action (org-ql-test-org-get-heading)))) (`(org-ql . _) (org-ql-test--format-result--ql sexp)) (`(org-ql--query-preamble . _) (org-ql-test--format-result--query-preamble sexp)) - (`(org-ql--pre-process-query . _) (format "'%S" (eval sexp))) + (`(org-ql--normalize-query . _) (format "'%S" (eval sexp))) (_ nil)))) (progn (backward-char 1) @@ -221,59 +221,62 @@ RESULTS should be a list of strings as returned by (describe "(level)" (it "with one level" - (expect (org-ql--pre-process-query '(level "1")) + (expect (org-ql--normalize-query '(level "1")) :to-equal '(level 1))) (it "with two levels" - (expect (org-ql--pre-process-query '(level "1" "2")) + (expect (org-ql--normalize-query '(level "1" "2")) :to-equal '(level 1 2))) (it "with a comparator and a level" - (expect (org-ql--pre-process-query '(level ">" "1")) + (expect (org-ql--normalize-query '(level ">" "1")) :to-equal '(level > 1)))) (describe "(link)" (it "with one argument" - (expect (org-ql--pre-process-query '(link "DESC-OR-TARGET")) + (expect (org-ql--normalize-query '(link "DESC-OR-TARGET")) :to-equal '(link "DESC-OR-TARGET"))) (it "with one argument and :regexp-p" - (expect (org-ql--pre-process-query '(link "DESC-OR-TARGET" :regexp-p t)) + (expect (org-ql--normalize-query '(link "DESC-OR-TARGET" :regexp-p t)) :to-equal '(link "DESC-OR-TARGET" :regexp-p t))) (it "with keyword arguments" - (expect (org-ql--pre-process-query '(link :description "DESCRIPTION" :target "TARGET" - :regexp-p t)) + (expect (org-ql--normalize-query '(link :description "DESCRIPTION" :target "TARGET" + :regexp-p t)) :to-equal '(link :description "DESCRIPTION" :target "TARGET" :regexp-p t)))) - (expect (org-ql--pre-process-query '(and "string1" "string2")) + (expect (org-ql--normalize-query '(and "string1" "string2")) :to-equal '(and (regexp "string1") (regexp "string2"))) - (expect (org-ql--pre-process-query '(or "string1" "string2")) + (expect (org-ql--normalize-query '(or "string1" "string2")) :to-equal '(or (regexp "string1") (regexp "string2"))) - (expect (org-ql--pre-process-query '(and (todo "TODO") - (or "string1" "string2"))) + (expect (org-ql--normalize-query '(and (todo "TODO") + (or "string1" "string2"))) :to-equal '(and (todo "TODO") (or (regexp "string1") (regexp "string2")))) - (expect (org-ql--pre-process-query '(when (todo "TODO") - (or "string1" "string2"))) + (expect (org-ql--normalize-query '(when (todo "TODO") + (or "string1" "string2"))) :to-equal '(when (todo "TODO") (or (regexp "string1") (regexp "string2")))) - (expect (org-ql--pre-process-query '(when "string-cond1" - (or "string1" "string2"))) + (expect (org-ql--normalize-query '(when "string-cond1" + (or "string1" "string2"))) :to-equal '(when (regexp "string-cond1") (or (regexp "string1") (regexp "string2")))) - (expect (org-ql--pre-process-query '(when (and "string-cond1" "string-cond2") - (or "string1" "string2"))) + (expect (org-ql--normalize-query '(when (and "string-cond1" "string-cond2") + (or "string1" "string2"))) :to-equal '(when (and (regexp "string-cond1") (regexp "string-cond2")) (or (regexp "string1") (regexp "string2")))) - (expect (org-ql--pre-process-query '(unless (and "stringcondition1" "stringcond2") - (or "string1" "string2"))) + (expect (org-ql--normalize-query '(unless (and "stringcondition1" "stringcond2") + (or "string1" "string2"))) :to-equal '(unless (and (regexp "stringcondition1") (regexp "stringcond2")) (or (regexp "string1") (regexp "string2")))) - (expect (org-ql--pre-process-query '(or (ts-active :on "2019-01-01") - (ts-a :on "2019-01-01") - (ts-inactive :on "2019-01-01") - (ts-i :on "2019-01-01"))) + (expect (org-ql--normalize-query '(or (ts-active :on "2019-01-01") + (ts-a :on "2019-01-01") + (ts-inactive :on "2019-01-01") + (ts-i :on "2019-01-01"))) :to-equal '(or (ts :type active :on "2019-01-01") (ts :type active :on "2019-01-01") (ts :type inactive :on "2019-01-01") (ts :type inactive :on "2019-01-01")))) - (describe "Query optimizing" + (describe "Query preambles" + ;; (before-all + ;; (org-ql--define-preamble-fn (reverse org-ql-predicates)) + ;; ) ;; TODO: Other predicates. (describe "(level)"