jiri/org-ql
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

WIP

Browse source
This commit is contained in:
Adam Porter 2020-11-22 09:30:28 -06:00
parent 7b3f5618a2
commit 0ac7d9860b
2 changed files with 49 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

19
org-ql.el
View file

@ -283,20 +283,19 @@ PREDICATES should be the value of `org-ql-predicates'."
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... ;; NOTE: I don't how the `list' symbol ends up in the list, but anyway...
(let* ((preamble-patterns (let* ((preamble-patterns
(-flatten-n 1 (-flatten-n 1 (-non-nil
(-non-nil ;; NOTE: Using -let instead of pcase-let here because I can't make map 2.1 install in the test sandbox.
(--map (pcase-let* (((map (:preambles preambles) (:fn fn)) (cdr it))) (--map (-let* (((&plist :preambles :fn) (cdr it)))
(--map (pcase-let* ((`(,pattern ,exp) it)) (--map (pcase-let* ((`(,pattern ,exp) it))
`(,pattern `(,pattern
(pcase-let* (((map (:regexp regexp) (:case-fold case-fold) (:predicate predicate)) (-let* (((&plist :regexp :case-fold :predicate) ,exp))
,exp))
(setf org-ql-preamble regexp (setf org-ql-preamble regexp
preamble-case-fold case-fold) preamble-case-fold case-fold)
;; NOTE: Even when `predicate' is nil, it must be returned in the pcase form. ;; 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, ;; 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. ;; which would be more flexible. OTOH it would make writing the tests a bit more work.
(when predicate (when predicate
,fn)))) ',fn))))
preambles)) preambles))
predicates))))) predicates)))))
(fset 'org-ql--query-preamble (fset 'org-ql--query-preamble
@ -1101,9 +1100,11 @@ COMPARATOR may be `<', `<=', `>', or `>='."
('> `(>= ,(1+ num) "*")) ('> `(>= ,(1+ num) "*"))
('>= `(>= ,num "*")) ('>= `(>= ,num "*"))
((pred integerp) `(repeat ,comparator-or-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) (`(,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 ;; NOTE: It might be necessary to take into account `org-odd-levels'; see docstring for
;; `org-outline-level'. ;; `org-outline-level'.
:predicate (when-let ((outline-level (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)))) `(closed :from ,from))))
:preambles ((`(,predicate-names . ,_) :preambles ((`(,predicate-names . ,_)
;; Predicate still needs testing. ;; Predicate still needs testing.
(list :regexp org-closed-time-regexp :predicate predicate))) (list :regexp org-closed-time-regexp :predicate t)))
:predicate :predicate
(org-ql--predicate-ts :from from :to to :regexp org-closed-time-regexp :match-group 1 (org-ql--predicate-ts :from from :to to :regexp org-closed-time-regexp :match-group 1
:limit (line-end-position 2))) :limit (line-end-position 2)))

37
tests/test-org-ql.el
View file

@ -50,7 +50,7 @@ Set at runtime by test suite.")
('org-ql 'org-ql) ('org-ql 'org-ql)
('org-ql-expect t) ('org-ql-expect t)
('org-ql--query-preamble 'query-preamble) ('org-ql--query-preamble 'query-preamble)
('org-ql--pre-process-query t) ('org-ql--normalize-query t)
(_ nil))) (_ nil)))
(result (pcase sexp (result (pcase sexp
(`(org-ql-expect ,args) (`(org-ql-expect ,args)
@ -63,7 +63,7 @@ Set at runtime by test suite.")
:action (org-ql-test-org-get-heading)))) :action (org-ql-test-org-get-heading))))
(`(org-ql . _) (org-ql-test--format-result--ql sexp)) (`(org-ql . _) (org-ql-test--format-result--ql sexp))
(`(org-ql--query-preamble . _) (org-ql-test--format-result--query-preamble 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)))) (_ nil))))
(progn (progn
(backward-char 1) (backward-char 1)
@ -221,49 +221,49 @@ RESULTS should be a list of strings as returned by
(describe "(level)" (describe "(level)"
(it "with one level" (it "with one level"
(expect (org-ql--pre-process-query '(level "1")) (expect (org-ql--normalize-query '(level "1"))
:to-equal '(level 1))) :to-equal '(level 1)))
(it "with two levels" (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))) :to-equal '(level 1 2)))
(it "with a comparator and a level" (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)))) :to-equal '(level > 1))))
(describe "(link)" (describe "(link)"
(it "with one argument" (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"))) :to-equal '(link "DESC-OR-TARGET")))
(it "with one argument and :regexp-p" (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))) :to-equal '(link "DESC-OR-TARGET" :regexp-p t)))
(it "with keyword arguments" (it "with keyword arguments"
(expect (org-ql--pre-process-query '(link :description "DESCRIPTION" :target "TARGET" (expect (org-ql--normalize-query '(link :description "DESCRIPTION" :target "TARGET"
:regexp-p t)) :regexp-p t))
:to-equal '(link :description "DESCRIPTION" :target "TARGET" :to-equal '(link :description "DESCRIPTION" :target "TARGET"
:regexp-p t)))) :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"))) :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"))) :to-equal '(or (regexp "string1") (regexp "string2")))
(expect (org-ql--pre-process-query '(and (todo "TODO") (expect (org-ql--normalize-query '(and (todo "TODO")
(or "string1" "string2"))) (or "string1" "string2")))
:to-equal '(and (todo "TODO") (or (regexp "string1") (regexp "string2")))) :to-equal '(and (todo "TODO") (or (regexp "string1") (regexp "string2"))))
(expect (org-ql--pre-process-query '(when (todo "TODO") (expect (org-ql--normalize-query '(when (todo "TODO")
(or "string1" "string2"))) (or "string1" "string2")))
:to-equal '(when (todo "TODO") (or (regexp "string1") (regexp "string2")))) :to-equal '(when (todo "TODO") (or (regexp "string1") (regexp "string2"))))
(expect (org-ql--pre-process-query '(when "string-cond1" (expect (org-ql--normalize-query '(when "string-cond1"
(or "string1" "string2"))) (or "string1" "string2")))
:to-equal '(when (regexp "string-cond1") (or (regexp "string1") (regexp "string2")))) :to-equal '(when (regexp "string-cond1") (or (regexp "string1") (regexp "string2"))))
(expect (org-ql--pre-process-query '(when (and "string-cond1" "string-cond2") (expect (org-ql--normalize-query '(when (and "string-cond1" "string-cond2")
(or "string1" "string2"))) (or "string1" "string2")))
:to-equal '(when (and (regexp "string-cond1") (regexp "string-cond2")) (or (regexp "string1") (regexp "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") (expect (org-ql--normalize-query '(unless (and "stringcondition1" "stringcond2")
(or "string1" "string2"))) (or "string1" "string2")))
:to-equal '(unless (and (regexp "stringcondition1") (regexp "stringcond2")) (or (regexp "string1") (regexp "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") (expect (org-ql--normalize-query '(or (ts-active :on "2019-01-01")
(ts-a :on "2019-01-01") (ts-a :on "2019-01-01")
(ts-inactive :on "2019-01-01") (ts-inactive :on "2019-01-01")
(ts-i :on "2019-01-01"))) (ts-i :on "2019-01-01")))
@ -272,8 +272,11 @@ RESULTS should be a list of strings as returned by
(ts :type inactive :on "2019-01-01") (ts :type inactive :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. ;; TODO: Other predicates.
(describe "(level)" (describe "(level)"