Add: (effort) predicate

Closes #80.
2021-06-16 20:38:20 -05:00 · 2021-06-16 20:38:20 -05:00 · d8bfa2317a
commit d8bfa2317a
parent 0dc073ffac
4 changed files with 176 additions and 36 deletions
--- a/README.org
+++ b/README.org
@ -206,6 +206,7 @@ Arguments are listed next to predicate names, where applicable.

 +  =category (&optional categories)= :: Return non-nil if current heading is in one or more of ~CATEGORIES~ (a list of strings).
 +  =done= :: Return non-nil if entry's ~TODO~ keyword is in ~org-done-keywords~.
+  =effort (&optional effort-or-comparator effort)= :: Return non-nil if current heading's effort property matches arguments.  The following forms are accepted: ~(effort DURATION)~: Matches if effort is ~DURATION~.  ~(effort DURATION DURATION)~: Matches if effort is between DURATIONs, inclusive.  ~(effort COMPARATOR DURATION)~: Matches if effort compares to ~DURATION~ with ~COMPARATOR~.  ~COMPARATOR~ may be ~<~, ~<=~, ~>~, or ~>=~.  ~DURATION~ should be an Org effort string, like =5= or =0:05=.
 +  =habit= :: Return non-nil if entry is a habit.
 +  =heading (&rest strings)= :: Return non-nil if current entry's heading matches all ~STRINGS~.  Matching is done case-insensitively.
     -  Aliases: =h=.
@ -520,6 +521,7 @@ Simple links may also be written manually in either sexp or non-sexp form, like:

 *Added*
 +  Macro =org-ql-defpred=, used to define search predicates.  (See [[file:examples/defpred.org][tutorial]].)
+  Predicate ~effort~.
 +  Predicate ~heading-regexp~, which matches regular expressions against heading text (alias: ~h*~).

 *Changed*
--- a/org-ql.el
+++ b/org-ql.el
@ -1017,6 +1017,73 @@ predicates."
  ;; NOTE: This was a defsubst before being defined with the macro.  Might be good to make it a defsubst again.
  :body (or (apply #'org-ql--predicate-todo org-done-keywords)))

+(defun org-ql--duration-to-minutes (duration)
+  "Return DURATION string as a number of minutes.
+For compatibility, since Org 9.1 deprecated
+`org-duration-string-to-minutes', replacing it with
+`org-duration-to-minutes', which seems to return floats instead
+of integers."
+  ;; MAYBE: Remove if compatibility with Org 9.0 is dropped.
+  (funcall (if (fboundp 'org-duration-to-minutes)
+               #'org-duration-to-minutes
+             #'org-duration-string-to-minutes)
+           duration))
+
+(org-ql-defpred effort (&optional effort-or-comparator effort)
+  "Return non-nil if current heading's effort property matches arguments.
+The following forms are accepted:
+
+  (effort DURATION): Matches if effort is DURATION.
+  (effort DURATION DURATION): Matches if effort is between DURATIONs, inclusive.
+  (effort COMPARATOR DURATION): Matches if effort compares to DURATION with COMPARATOR.
+
+COMPARATOR may be `<', `<=', `>', or `>='.  DURATION should be an
+Org effort string, like \"5\" or \"0:05\"."
+  :normalizers ((`(,predicate-names . ,args)
+                 ;; Arguments could be given as strings (e.g. from a non-Lisp query).
+                 `(effort ,@(--map (pcase-exhaustive it
+                                     ((or "<" "<=" ">" ">=" "=")
+                                      (intern it))
+                                     ((pred stringp) (org-ql--duration-to-minutes it))
+                                     ((pred numberp) it)
+                                     ((or '< '<= '> '>= '=)
+                                      ;; FIXME: This same treatment probably needs to be done in the (level) predicate's normalizer (which I would have caught had I already written tests for it).
+                                      `',it))
+                                   args))))
+  ;; NOTE: We always test the body, because we must ensure that the
+  ;; ":effort:" string found is actually an entry property.
+  :preambles ((`(,predicate-names ,_comparator-or-num ,_num)
+               ;; Since we can't compare this using regexps, we just check for what looks like a valid effort.
+               ;; FIXME: Are decimal efforts allowed, or only colon-separated HH:MM?
+               (list :regexp (rx-to-string `(seq bol (0+ blank) ":effort:" (1+ blank) (1+ (or digit "." ":"))) t)
+                     :case-fold t :query query))
+              (`(,predicate-names ,num)
+               ;; Testing equality to a certain effort.
+               (let* ((with-colon (org-duration-from-minutes num))
+                      (without-colon (number-to-string num))
+                      (without-colon-and-decimal
+                       (if (string-suffix-p ".0" without-colon)
+                           (replace-regexp-in-string (rx ".0" eos) "" without-colon t t)
+                         "")))
+                 (list :regexp (rx-to-string `(seq bol (0+ blank) ":effort:" (1+ blank)
+                                                   (or ,with-colon ,without-colon ,without-colon-and-decimal) (or blank eol)) t)
+                       :case-fold t :query query))))
+  :body (let ((entry-effort (org-entry-get (point) "effort"))
+              entry-effort-minutes)
+          (when entry-effort
+            (setf entry-effort-minutes (org-ql--duration-to-minutes entry-effort))
+            (pcase effort-or-comparator
+              ('nil
+               ;; Any effort.  (NOTE: This must come before the symbolp clause, because `symbolp' is non-nil for nil!)
+               t)
+              ((pred numberp) (pcase effort
+                                ('nil ;; Equality
+                                 (= effort-or-comparator entry-effort-minutes))
+                                ((pred numberp) ;; Between two levels
+                                 (<= effort-or-comparator entry-effort-minutes effort))))
+              ((pred symbolp) ;; Compare with function
+               (funcall effort-or-comparator entry-effort-minutes effort))))))
+
 (org-ql-defpred habit ()
  "Return non-nil if entry is a habit."
  :preambles ((`(,predicate-names)
--- a/org-ql.info
+++ b/org-ql.info
@ -401,6 +401,14 @@ Arguments are listed next to predicate names, where applicable.
     (a list of strings).
 ‘done’
     Return non-nil if entry’s ‘TODO’ keyword is in ‘org-done-keywords’.
+‘effort (&optional effort-or-comparator effort)’
+     Return non-nil if current heading’s effort property matches
+     arguments.  The following forms are accepted: ‘(effort DURATION)’:
+     Matches if effort is ‘DURATION’.  ‘(effort DURATION DURATION)’:
+     Matches if effort is between DURATIONs, inclusive.  ‘(effort
+     COMPARATOR DURATION)’: Matches if effort compares to ‘DURATION’
+     with ‘COMPARATOR’.  ‘COMPARATOR’ may be ‘<’, ‘<=’, ‘>’, or ‘>=’.
+     ‘DURATION’ should be an Org effort string, like 5 or 0:05.
 ‘habit’
     Return non-nil if entry is a habit.
 ‘heading (&rest strings)’
@ -970,6 +978,7 @@ File: README.info,  Node: 06-pre,  Next: 052,  Up: Changelog
 *Added*
   • Macro org-ql-defpred, used to define search predicates.  (See
     tutorial (examples/defpred.org).)
+   • Predicate ‘effort’.
   • Predicate ‘heading-regexp’, which matches regular expressions
     against heading text (alias: ‘h*’).

@ -1523,42 +1532,42 @@ Node: org-ql-sparse-tree7574
 Node: Queries8374
 Node: Non-sexp query syntax9485
 Node: General predicates11192
-Node: Ancestor/descendant predicates16835
-Node: Date/time predicates17963
-Node: Functions / Macros20618
-Node: Agenda-like views20916
-Node: Listing / acting-on results22321
-Node: Custom predicates27943
-Node: Dynamic block31434
-Node: Links34132
-Node: Tips34819
-Node: Changelog35137
-Node: 06-pre35863
-Node: 05237239
-Node: 05137543
-Node: 0537960
-Node: 04939434
-Node: 04839708
-Node: 04740055
-Node: 04640450
-Node: 04540850
-Node: 04441209
-Node: 04341568
-Node: 04241765
-Node: 04141926
-Node: 0442167
-Node: 03246100
-Node: 03146479
-Node: 0346676
-Node: 02349651
-Node: 02249879
-Node: 02150147
-Node: 0250346
-Node: 0154381
-Node: Notes54482
-Node: Comparison with Org Agenda searches54644
-Node: org-sidebar55516
-Node: License55795
+Node: Ancestor/descendant predicates17413
+Node: Date/time predicates18541
+Node: Functions / Macros21196
+Node: Agenda-like views21494
+Node: Listing / acting-on results22899
+Node: Custom predicates28521
+Node: Dynamic block32012
+Node: Links34710
+Node: Tips35397
+Node: Changelog35715
+Node: 06-pre36441
+Node: 05237848
+Node: 05138152
+Node: 0538569
+Node: 04940043
+Node: 04840317
+Node: 04740664
+Node: 04641059
+Node: 04541459
+Node: 04441818
+Node: 04342177
+Node: 04242374
+Node: 04142535
+Node: 0442776
+Node: 03246709
+Node: 03147088
+Node: 0347285
+Node: 02350260
+Node: 02250488
+Node: 02150756
+Node: 0250955
+Node: 0154990
+Node: Notes55091
+Node: Comparison with Org Agenda searches55253
+Node: org-sidebar56125
+Node: License56404

 End Tag Table

--- a/tests/test-org-ql.el
+++ b/tests/test-org-ql.el
@ -643,6 +643,68 @@ RESULTS should be a list of strings as returned by
      (org-ql-expect ('(done))
        '("Learn universal sign language")))

+    (describe "(effort)"
+      (org-ql-it "with a number"
+        (org-ql-expect ('(effort 5))
+          '("Order a pizza"))
+        (org-ql-expect ('(effort "5"))
+          '("Order a pizza"))
+        (org-ql-expect ('(effort "0:05"))
+          '("Order a pizza"))
+        (org-ql-expect ('(effort 1))
+          nil))
+      (org-ql-it "with two numbers"
+        (org-ql-expect ('(effort 5 6))
+          '("Order a pizza"))
+        (org-ql-expect ('(effort "0:05" "0:05"))
+          '("Order a pizza"))
+        (org-ql-expect ('(effort 4 5))
+          '("Order a pizza"))
+        (org-ql-expect ('(effort 4 6))
+          '("Order a pizza"))
+        (org-ql-expect ('(effort 6 7))
+          nil))
+      (org-ql-it "<"
+        (org-ql-expect ('(effort < 5))
+          nil)
+        (org-ql-expect ('(effort < 6))
+          '("Order a pizza"))
+        (org-ql-expect ('(effort < "0:06"))
+          '("Order a pizza")))
+      (org-ql-it "<="
+        (org-ql-expect ('(effort <= 4))
+          nil)
+        (org-ql-expect ('(effort <= 5))
+          '("Order a pizza"))
+        (org-ql-expect ('(effort <= 6))
+          '("Order a pizza"))
+        (org-ql-expect ('(effort <= "0:06"))
+          '("Order a pizza")))
+      (org-ql-it ">"
+        (org-ql-expect ('(effort > 4))
+          '("Order a pizza" "Shop for groceries"))
+        (org-ql-expect ('(effort > 5))
+          '("Shop for groceries"))
+        (org-ql-expect ('(effort > "0:05"))
+          '("Shop for groceries"))
+        (org-ql-expect ('(effort > 30))
+          nil)
+        (org-ql-expect ('(effort > "0:30"))
+          nil))
+      (org-ql-it ">="
+        (org-ql-expect ('(effort >= 4))
+          '("Order a pizza" "Shop for groceries"))
+        (org-ql-expect ('(effort >= 5))
+          '("Order a pizza"  "Shop for groceries"))
+        (org-ql-expect ('(effort >= "0:05"))
+          '("Order a pizza"  "Shop for groceries"))
+        (org-ql-expect ('(effort >= 30))
+          '("Shop for groceries"))
+        (org-ql-expect ('(effort >= 31))
+          nil)
+        (org-ql-expect ('(effort >= "0:31"))
+          nil)))
+
    (org-ql-it "(habit)"
      (org-ql-expect ('(habit))
        '("Practice leaping tall buildings in a single bound")))