From ab3d1178b9ccf1bca4e157c6d88e97299a19648a Mon Sep 17 00:00:00 2001
From: Adam Porter <adam@alphapapa.net>
Date: Sun, 18 Aug 2019 21:28:06 -0500
Subject: [PATCH] Add: Call some ts-type predicates with a number/auto

---
 README.org                | 26 ++++++++++------
 examples.org              | 33 +++++++++-----------
 examples/org-bills-due.el |  2 +-
 org-ql.el                 | 64 +++++++++++++++++++++++++++++++++++++++
 tests/test-org-ql.el      | 41 +++++++++++++++++++++++++
 5 files changed, 136 insertions(+), 30 deletions(-)

diff --git a/README.org b/README.org
index dcb0b4a..9431fd7 100644
--- a/README.org
+++ b/README.org
@@ -44,16 +44,16 @@ More examples are available in [[examples.org]].
     :action '(org-toggle-tag "Emacs" 'on))
 
   ;; Return a list of bills coming due, searching all Org Agenda files,
-  ;; sorted by deadline.  Deadlines are compared with
-  ;; `org-deadline-warning-days', which is implied by the plain `<=' in
-  ;; the `deadline' predicate.  `org-ql-query' works like `org-ql-select'
-  ;; but offers arguments named like SQL queries.
+  ;; sorted by deadline.  The `auto' argument to `deadline' means to match
+  ;; entries whose deadlines fall within `org-deadline-warning-days'.
+  ;; `org-ql-query' works like `org-ql-select' but offers arguments named
+  ;; like SQL queries.
   (org-ql-query
     :select #'org-get-heading
     :from (org-agenda-files)
     :where '(and (not (done))
                  (tags "bills")
-                 (deadline <=))
+                 (deadline auto))
     :order-by 'deadline)
   ;;=> ("TODO Electric bill" "TODO Water bill")
 
@@ -205,17 +205,23 @@ Arguments are listed next to predicate names, where applicable.
 
 All of these selectors take optional keyword arguments ~:from~, ~:to:~, and ~:on~.  If ~:from~, return non-nil if entry has a timestamp on or after ~:from~.  If ~:to~, return non-nil if entry has a timestamp on or before ~:to~.  If ~:on~, return non-nil if entry has a timestamp on date ~:on~.  Argument values should be either ~ts~ structs, or strings parseable by ~parse-time-string~ which may omit the time value.
 
-+  ~clocked~ :: Return non-nil if current entry was clocked in given period.  If no arguments are specified, return non-nil if entry was clocked at any time.  Note: Clock entries are expected to be clocked out.  Currently clocked entries (i.e. with unclosed timestamp ranges) are ignored.
-+  ~closed~ :: Return non-nil if current entry was closed in given period.  If no arguments are specified, return non-nil if entry was closed at any time.
-+  ~deadline~ :: Return non-nil if current entry has deadline in given period.  If no arguments are specified, return non-nil if entry has any deadline.
-+  ~planning~ :: Return non-nil if current entry has planning timestamp in given period (i.e. its deadline, scheduled, or closed timestamp).  If no arguments are specified, return non-nil if entry is scheduled at any time.
-+  ~scheduled~ :: Return non-nil if current entry is scheduled in given period.  If no arguments are specified, return non-nil if entry is scheduled at any time.
 +  ~ts~ :: Return non-nil if current entry has a timestamp in given period.  If no arguments are specified, return non-nil if entry has any timestamp.
 +  ~ts-active~ :: Like ~ts~, but only matches active timestamps.
 +  ~ts-a~ :: Like ~ts~, but only matches active timestamps.
 +  ~ts-inactive~ :: Like ~ts~, but only matches inactive timestamps.
 +  ~ts-i~ :: Like ~ts~, but only matches inactive timestamps.
 
+The following selectors can also take a single argument, a number, which looks backward or forward a number of days.  The number can also be negative to invert the direction.
+
+*Backward-looking:*
++  ~clocked~ :: Return non-nil if current entry was clocked in given period.  If no arguments are specified, return non-nil if entry was clocked at any time.  Note: Clock entries are expected to be clocked out.  Currently clocked entries (i.e. with unclosed timestamp ranges) are ignored.
++  ~closed~ :: Return non-nil if current entry was closed in given period.  If no arguments are specified, return non-nil if entry was closed at any time.
+
+*Forward-looking:*
++  ~deadline~ :: Return non-nil if current entry has deadline in given period.  If argument is =auto=, return non-nil if entry has deadline within =org-deadline-warning-days=.  If no arguments are specified, return non-nil if entry has any deadline.
++  ~planning~ :: Return non-nil if current entry has planning timestamp in given period (i.e. its deadline, scheduled, or closed timestamp).  If no arguments are specified, return non-nil if entry is scheduled at any time.
++  ~scheduled~ :: Return non-nil if current entry is scheduled in given period.  If no arguments are specified, return non-nil if entry is scheduled at any time.
+
 ** Functions / Macros
 :PROPERTIES:
 :TOC:      ignore-children
diff --git a/examples.org b/examples.org
index 759ea3e..b90c9da 100644
--- a/examples.org
+++ b/examples.org
@@ -11,7 +11,7 @@
 * Show entries with recent timestamps
 
 #+BEGIN_SRC elisp
-  (cl-defun org-ql-agenda-recent-items (days &optional (type 'ts))
+  (cl-defun org-ql-view-recent-items (days &optional (type 'ts))
     "Show items from previous DAYS days with timestamps of TYPE.
   TYPE may be `ts', `ts-active', `ts-inactive', `clocked',
   `closed', `deadline', `planning', or `scheduled'."
@@ -19,28 +19,23 @@
                        (->> '(ts ts-active ts-inactive clocked closed deadline planning scheduled)
                             (completing-read "Timestamp type: ")
                             intern)))
-    (let ((from (->> (ts-now)
-                     (ts-adjust 'day (* -1 days))
-                     (ts-apply :hour 0 :minute 0 :second 0)
-                     ;; Formatting isn't required, but it looks better in the header than a struct.
-                     ts-format)))
-      (org-ql-search (org-agenda-files)
-        `(,type :from ,from :to ,(ts-format (ts-now)))
-        :title "Recent items"
-        :sort '(date priority todo)
-        :groups '((:todo "DONE")
-                  (:category "log" :tag "log")
-                  (:auto-parent t)
-                  (:auto-todo t)))))
+    (org-ql-search (org-agenda-files)
+      `(,type ,days)
+      :title "Recent items"
+      :sort '(date priority todo)
+      :groups '((:todo "DONE")
+                (:name "Log" :category "log" :tag "log")
+                (:auto-parent t)
+                (:auto-todo t))))
 
   ;; Show entries with any timestamp from last 7 days:
-  (org-ql-agenda-recent-items 7)
+  (org-ql-view-recent-items 7)
 
-  ;; Show entries clocked in last 7 days:
-  (org-ql-agenda-recent-items 30 'clocked)
+  ;; Show entries clocked in last 30 days:
+  (org-ql-view-recent-items 30 'clocked)
 
-  ;; Show entries closed in last 7 days:
-  (org-ql-agenda-recent-items 30 'closed)
+  ;; Show entries closed in last 30 days:
+  (org-ql-view-recent-items 30 'closed)
 #+END_SRC
 
 * Stuck projects block agenda
diff --git a/examples/org-bills-due.el b/examples/org-bills-due.el
index 5c7261c..c544734 100644
--- a/examples/org-bills-due.el
+++ b/examples/org-bills-due.el
@@ -35,7 +35,7 @@
 
 (-if-let* ((header "Bills due within 3 days")
            (items (org-ql "~/org/main.org"
-                    (and (deadline <= (+ 3 today))
+                    (and (deadline 3)
                          (tags "bills"))
                     :action (org-get-heading 'no-tags 'no-todo)))
            (string (concat "<ul>"
diff --git a/org-ql.el b/org-ql.el
index 0535bb0..a8da355 100644
--- a/org-ql.el
+++ b/org-ql.el
@@ -267,6 +267,10 @@ NARROW corresponds to the `org-ql-select' argument NARROW."
 Replaces bare strings with (regexp) selectors, and appropriate
 `ts'-related selectors."
   ;; This is unsophisticated, but it works.
+  ;; TODO: Maybe query pre-processing should be done in one place,
+  ;; rather than here and in --query-predicate.
+  ;; NOTE: Don't be scared by the `pcase' patterns!  They make this
+  ;; all very easy once you grok the backquoting and unquoting.
   (cl-labels ((rec (element)
                    (pcase element
                      (`(or . ,clauses) `(or ,@(mapcar #'rec clauses)))
@@ -283,6 +287,38 @@ Replaces bare strings with (regexp) selectors, and appropriate
                      (`(children) '(children (lambda () t)))
                      (`(descendants ,query) `(descendants ',query))
                      (`(descendants) '(descendants (lambda () t)))
+                     ;; Timestamp-based predicates.  I think this is the way that makes the most sense:
+                     ;; set the limit to N days in the future, adjusted to 23:59:59 (since Org doesn't
+                     ;; support timestamps down to the second, anyway, there should be no need to adjust
+                     ;; it forward to 00:00:00 of the next day).  That way, e.g. if it's Monday at 3 PM,
+                     ;; and N is 1, rather than showing items up to 3 PM Tuesday, it will show items any
+                     ;; time on Tuesday.  If this isn't desired, the user can pass a specific timestamp.
+                     (`(,(and pred (or 'clocked 'closed))
+                        ,(and num-days (pred numberp)))
+                      ;; (clocked) and (closed) implicitly look into the past.
+                      (let ((from (->> (ts-now)
+                                       (ts-adjust 'day (* -1 num-days))
+                                       (ts-apply :hour 0 :minute 0 :second 0))))
+                        `(,pred :from ,from)))
+                     (`(deadline auto)
+                      ;; Use `org-deadline-warning-days' as the :to arg.
+                      (let ((to (->> (ts-now)
+                                     (ts-adjust 'day org-deadline-warning-days)
+                                     (ts-apply :hour 23 :minute 59 :second 59))))
+                        `(deadline-warning :to ,to)))
+                     (`(,(and pred (or 'deadline 'scheduled 'planning))
+                        ,(and num-days (pred numberp)))
+                      (let ((to (->> (ts-now)
+                                     (ts-adjust 'day num-days)
+                                     (ts-apply :hour 23 :minute 59 :second 59))))
+                        `(,pred :to ,to)))
+                     (`(,(and pred (or 'deadline 'scheduled 'planning))
+                        ,(and type (or :from :to :on))
+                        ,(and num-days (pred numberp)))
+                      (let ((target (->> (ts-now)
+                                         (ts-adjust 'day num-days)
+                                         (ts-apply :hour 23 :minute 59 :second 59))))
+                        `(,pred ,type ,target)))
                      (`(,(or 'ts-active 'ts-a) . ,rest) `(ts :type active ,@rest))
                      (`(,(or 'ts-inactive 'ts-i) . ,rest) `(ts :type inactive ,@rest))
                      (_ element))))
@@ -783,6 +819,14 @@ comparator, PRIORITY should be a priority string."
 ;; TODO: Remove the _on vars from these arg lists.  I think they're not
 ;; necessary, or shouldn't be, since --pre-process-query should handle them.
 
+;; NOTE: These docstrings apply to the functions defined by `org-ql--defpref',
+;; not necessarily to the way users are expected to call them in queries.  The
+;; queries are pre-processed by `org-ql--pre-process-query' to handle
+;; arguments which are constant during a query's execution.
+
+;; TODO: Update the macro to define a user-facing docstring so I don't
+;; have to manually update the documentation.
+
 (org-ql--defpred clocked (&key from to _on)
   ;; The underscore before `on' prevents "unused lexical variable"
   ;; warnings, because we pre-process that argument in a macro before
@@ -840,6 +884,26 @@ FROM, TO, and ON should be either `ts' structs, or strings
 parseable by `parse-time-string' which may omit the time value."
   (org-ql--predicate-ts :from from :to to :regexp org-deadline-time-regexp :match-group 1))
 
+(org-ql--defpred deadline-warning (&key from to)
+  "Internal selector used to handle `org-deadline-warning-days' and deadlines with warning periods."
+  (save-excursion
+    (forward-line 1)
+    (when (re-search-forward org-deadline-time-regexp (line-end-position) t)
+      (-let* ((context (org-element-context))
+              ;; Since we need to handle warning periods, we parse the
+              ;; Org timestamp as an org-element rather than as a string.
+              ((_planning (_closed _nil _deadline element . _rest)) context)
+              ((_timestamp (&keys :warning-value :warning-unit)) element)
+              (ts (ts-parse-org-element element))
+              (ts (pcase warning-unit
+                    ('nil ts)
+                    ((and unit (or 'year 'month 'day))
+                     (->> ts (ts-adjust unit (* -1 warning-value))))
+                    ('week (->> ts (ts-adjust 'day (* -7 warning-value)))))))
+        (cond ((and from to) (ts-in from to ts))
+              (from (ts<= from ts))
+              (to (ts<= ts to)))))))
+
 (org-ql--defpred planning (&key from to _on)
   ;; The underscore before `on' prevents "unused lexical variable"
   ;; warnings, because we pre-process that argument in a macro before
diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el
index 21113b6..e92d4a3 100644
--- a/tests/test-org-ql.el
+++ b/tests/test-org-ql.el
@@ -110,6 +110,15 @@ RESULTS should be a list of strings as returned by
              :action (org-ql-test-org-get-heading))
            :to-equal ,results))
 
+(defmacro org-ql-then (&rest body)
+  "Wrap BODY, setting `ts-now' to return timestamp at 2017-07-05 12:00:00."
+  ;; The same time used in `org-super-agenda--test-date', which is where the test data comes from.
+  (declare (indent defun))
+  `(cl-letf (((symbol-function 'ts-now)
+              (lambda ()
+                (make-ts :year 2017 :month 7 :day 5 :hour 12 :minute 0 :second 0))))
+     ,@body))
+
 ;;;; Tests
 
 (describe "org-ql"
@@ -250,6 +259,11 @@ RESULTS should be a list of strings as returned by
         (org-ql-expect ((clocked))
           '("Learn universal sign language")))
 
+      (org-ql-it "with a number"
+        (org-ql-then
+          (org-ql-expect ((clocked 10))
+            '("Learn universal sign language"))))
+
       (org-ql-it ":from a timestamp"
         (org-ql-expect ((clocked :from "2017-07-05"))
           '("Learn universal sign language"))
@@ -282,6 +296,11 @@ RESULTS should be a list of strings as returned by
         (org-ql-expect ((closed))
           '("Learn universal sign language")))
 
+      (org-ql-it "with a number"
+        (org-ql-then
+          (org-ql-expect ((closed 10))
+            '("Learn universal sign language"))))
+
       (org-ql-it ":on"
         (org-ql-expect ((closed :on "2017-07-05"))
           '("Learn universal sign language"))
@@ -310,9 +329,20 @@ RESULTS should be a list of strings as returned by
         (org-ql-expect ((deadline))
           '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")))
 
+      (org-ql-it "auto"
+        (org-ql-then
+          (org-ql-expect ((deadline auto))
+            '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs"))))
+
+      (org-ql-it "with a number"
+        (org-ql-then
+          (org-ql-expect ((deadline 2))
+            '("Take over the world" "/r/emacs"))))
+
       (org-ql-it ":on"
         (org-ql-expect ((deadline :on "2017-07-05"))
           '("/r/emacs"))
+
         (org-ql-expect ((deadline :on "2019-06-09"))
           nil))
 
@@ -348,6 +378,11 @@ RESULTS should be a list of strings as returned by
         (org-ql-expect ((planning))
           '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")))
 
+      (org-ql-it "with a number"
+        (org-ql-then
+          (org-ql-expect ((planning 2))
+            '("Take over the world" "Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Learn universal sign language" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))))
+
       (org-ql-it ":on"
         (org-ql-expect ((planning :on "2017-07-05"))
           '("Practice leaping tall buildings in a single bound" "Learn universal sign language" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))
@@ -412,6 +447,12 @@ RESULTS should be a list of strings as returned by
         (org-ql-expect ((scheduled))
           '("Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp")))
 
+      (org-ql-it "with a number"
+        (org-ql-then
+          ;; Using -1 is the easiest way to exclude some results but not all for testing this.
+          (org-ql-expect ((scheduled -1))
+            '("Skype with president of Antarctica"))))
+
       (org-ql-it ":on"
         (org-ql-expect ((scheduled :on "2017-07-05"))
           '("Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp"))