WIP: Long shot

WIP: Restore original test and use ts-apply
The previous change passes, so this should, too. But I don't see how ts.el could be causing a void-variable error in an org-ql macro expansion, so maybe these are separate problems...
2021-07-05 03:11:33 -05:00 · 2021-07-05 02:50:00 -05:00 · 2021-07-05 02:46:34 -05:00 · 2021-07-05 02:41:15 -05:00 · 2021-07-05 02:39:44 -05:00 · 2021-07-05 02:29:45 -05:00
3 changed files with 110 additions and 35 deletions
--- a/org-ql.el
+++ b/org-ql.el
@ -1148,9 +1148,9 @@ It would be expanded to:
 Expands into a form that processes arguments to timestamp-related
 predicates and evaluates BODY, which is expected to evaluate to a
 timestamp-related query predicate form.  It expects the variable
-`rest' to be bound to a list of the predicate's arguments.  In
+`argh' to be bound to a list of the predicate's arguments.  In
 BODY, these variables are bound to normalized values, when
-applicable: `from', `to', `on', `type'.  If `rest' includes a
+applicable: `from', `to', `on', `type'.  If `argh' includes a
 `:with-time' argument, it is automatically added to BODY's
 result form."
  ;; Several attempts to use `cl-macrolet' and `cl-symbol-macrolet' failed, so I resorted
@ -1162,13 +1162,16 @@ result form."
  ;; do with the version of map.el being used (although it happens locally even in
  ;; a clean sandbox, which should produce the same result as on CI).  Maybe the
  ;; real fix would be to make makem.sh support dependency versions...
-  `(-let (((&keys :from :to :on :type) rest)
-          (result))
+  `(let ((from (plist-get argh :from))
+         (to (plist-get argh :to))
+         (on (plist-get argh :on))
+         (type (plist-get argh :type))
+         (result))
     (ignore type) ;; Only (ts) uses it.
-     (pcase rest
+     (pcase argh
       (`(,(and num (pred numberp)) . ,rest*)
        (setf on num
-              rest rest*)))
+              argh rest*)))
     (when on
       (setq from on
             to on))
@ -1207,9 +1210,9 @@ result form."
     (setf result (progn ,@body))
     ;; Add :with-time to the result when necessary, but only when it's not already present.
     ;; (This is messy, but we do this to make predicate definition and normalization easier.)
-     (when (and (plist-member rest :with-time)
+     (when (and (plist-member argh :with-time)
                (not (memq :with-time result)))
-       (setf result (append result (list :with-time (plist-get rest :with-time)))))
+       (setf result (append result (list :with-time (plist-get argh :with-time)))))
     ;; Remove certain keyword arguments whose value is nil.  This is
     ;; a little bit ugly, but it allows us to normalize queries more
     ;; easily, without leaving useless arguments in the result.
@ -1949,10 +1952,10 @@ ignored."
  :normalizers ((`(,predicate-names ,(and num-days (pred numberp)))
                 ;; (clocked) and (closed) implicitly look into the past.
                 (let* ((from-day (* -1 num-days))
-                        (rest (list :from from-day)))
+                        (argh (list :from from-day)))
                   (org-ql--normalize-from-to-on
                     `(clocked :from ,from))))
-                (`(,predicate-names . ,rest)
+                (`(,predicate-names . ,argh)
                 (org-ql--normalize-from-to-on
                   `(clocked :from ,from :to ,to))))
  :preambles ((`(,predicate-names ,(pred numberp))
@ -1969,10 +1972,10 @@ Without arguments, return non-nil if entry is closed."
  :normalizers ((`(,predicate-names ,(and num-days (pred numberp)))
                 ;; (clocked) and (closed) implicitly look into the past.
                 (let* ((from-day (* -1 num-days))
-                        (rest (list :from from-day)))
+                        (argh (list :from from-day)))
                   (org-ql--normalize-from-to-on
                     `(closed :from ,from))))
-                (`(,predicate-names . ,rest)
+                (`(,predicate-names . ,argh)
                 (org-ql--normalize-from-to-on
                   `(closed :from ,from :to ,to))))
  :preambles ((`(,predicate-names . ,_)
@ -1987,23 +1990,23 @@ Without arguments, return non-nil if entry is closed."
 If argument is `auto', return non-nil if entry has deadline
 within `org-deadline-warning-days'.  Without arguments, return
 non-nil if entry has a deadline."
-  :normalizers ((`(,predicate-names auto . ,rest)
+  :normalizers ((`(,predicate-names auto . ,argh)
                 ;; Use `org-deadline-warning-days' as the :to arg.
                 (let ((ts (->> (ts-now)
                             (ts-adjust 'day org-deadline-warning-days)
                             (ts-apply :hour 23 :minute 59 :second 59))))
-                   `(deadline-warning :to ,ts ,@rest)))
-                (`(,predicate-names . ,(and rest (guard (numberp (car rest)))))
+                   `(deadline-warning :to ,ts ,@argh)))
+                (`(,predicate-names . ,(and argh (guard (numberp (car argh)))))
                 (org-ql--normalize-from-to-on
                   `(deadline :to ,to)))
-                (`(,predicate-names . ,rest)
+                (`(,predicate-names . ,argh)
                 (org-ql--normalize-from-to-on
                   `(deadline :from ,from :to ,to))))
  ;; NOTE: Does this normalizer cause the preamble to not be used?
  ;; (Adding one to the deadline-warning definition to be sure.)
-  :preambles ((`(,predicate-names . ,rest)
+  :preambles ((`(,predicate-names . ,argh)
               (list :query query
-                     :regexp (pcase-exhaustive (org-ql--plist-get* rest :with-time)
+                     :regexp (pcase-exhaustive (org-ql--plist-get* argh :with-time)
                               ((or 't "t") org-ql-regexp-deadline-with-time)
                               ((or 'nil "nil") org-ql-regexp-deadline-without-time)
                               ('not-found org-ql-regexp-deadline)))))
@ -2044,15 +2047,15 @@ non-nil if entry has a deadline."
 (org-ql-defpred planning (&key from to _on regexp _with-time)
  "Return non-nil if current entry has planning timestamp in given period.
 Without arguments, return non-nil if entry has any planning timestamp."
-  :normalizers ((`(,predicate-names . ,(and rest (guard (numberp (car rest)))))
+  :normalizers ((`(,predicate-names . ,(and argh (guard (numberp (car argh)))))
                 (org-ql--normalize-from-to-on
                   `(planning :to ,to)))
-                (`(,predicate-names . ,rest)
+                (`(,predicate-names . ,argh)
                 (org-ql--normalize-from-to-on
                   `(planning :from ,from :to ,to))))
-  :preambles ((`(,predicate-names . ,rest)
+  :preambles ((`(,predicate-names . ,argh)
               (list :query query
-                     :regexp (pcase-exhaustive (org-ql--plist-get* rest :with-time)
+                     :regexp (pcase-exhaustive (org-ql--plist-get* argh :with-time)
                               ((or 't "t") org-ql-regexp-planning-with-time)
                               ((or 'nil "nil") org-ql-regexp-planning-without-time)
                               ('not-found org-ql-regexp-planning)))))
@ -2065,12 +2068,12 @@ Without arguments, return non-nil if entry has any planning timestamp."
 (org-ql-defpred scheduled (&key from to _on regexp _with-time)
  "Return non-nil if current entry is scheduled in given period.
 Without arguments, return non-nil if entry is scheduled."
-  :normalizers ((`(,predicate-names . ,rest)
+  :normalizers ((`(,predicate-names . ,argh)
                 (org-ql--normalize-from-to-on
                   `(scheduled :from ,from :to ,to))))
-  :preambles ((`(,predicate-names . ,rest)
+  :preambles ((`(,predicate-names . ,argh)
               (list :query query
-                     :regexp (pcase-exhaustive (org-ql--plist-get* rest :with-time)
+                     :regexp (pcase-exhaustive (org-ql--plist-get* argh :with-time)
                               ((or 't "t") org-ql-regexp-scheduled-with-time)
                               ((or 'nil "nil") org-ql-regexp-scheduled-without-time)
                               ('not-found org-ql-regexp-scheduled)))))
@ -2096,32 +2099,32 @@ of REGEXP's group that matches the Org timestamp (i.e. excluding
 any planning prefix); it defaults to 0 (i.e. the whole regexp)."
  ;; MAYBE: Define active/inactive ones separately?
  :normalizers
-  ((`(,(or 'ts-active 'ts-a) . ,rest) `(ts :type active ,@rest))
-   (`(,(or 'ts-inactive 'ts-i) . ,rest) `(ts :type inactive ,@rest))
-   (`(,predicate-names . ,(and rest (guard (numberp (car rest)))))
+  ((`(,(or 'ts-active 'ts-a) . ,argh) `(ts :type active ,@argh))
+   (`(,(or 'ts-inactive 'ts-i) . ,argh) `(ts :type inactive ,@argh))
+   (`(,predicate-names . ,(and argh (guard (numberp (car argh)))))
    (org-ql--normalize-from-to-on
      `(ts :type ,type :to ,to)))
-   (`(,predicate-names . ,rest)
+   (`(,predicate-names . ,argh)
    (org-ql--normalize-from-to-on
      `(ts :type ,type :from ,from :to ,to))))

  :preambles
-  ((`(,predicate-names . ,rest)
-    (list :regexp (pcase (plist-get rest :type)
-                    ((or 'nil 'both) (pcase-exhaustive (org-ql--plist-get* rest :with-time)
+  ((`(,predicate-names . ,argh)
+    (list :regexp (pcase (plist-get argh :type)
+                    ((or 'nil 'both) (pcase-exhaustive (org-ql--plist-get* argh :with-time)
                                       ((or 't "t") org-ql-regexp-ts-both-with-time)
                                       ((or 'nil "nil") org-ql-regexp-ts-both-without-time)
                                       ('not-found org-ql-regexp-ts-both)))
-                    ('active (pcase-exhaustive (org-ql--plist-get* rest :with-time)
+                    ('active (pcase-exhaustive (org-ql--plist-get* argh :with-time)
                               ((or 't "t") org-ql-regexp-ts-active-with-time)
                               ((or 'nil "nil") org-ql-regexp-ts-active-without-time)
                               ('not-found org-ql-regexp-ts-active)))
-                    ('inactive (pcase-exhaustive (org-ql--plist-get* rest :with-time)
+                    ('inactive (pcase-exhaustive (org-ql--plist-get* argh :with-time)
                                 ((or 't "t") org-ql-regexp-ts-inactive-with-time)
                                 ((or 'nil "nil") org-ql-regexp-ts-inactive-without-time)
                                 ('not-found org-ql-regexp-ts-inactive))))
          ;; Predicate needs testing only when args are present.
-          :query (-let (((&keys :from :to :on) rest))
+          :query (-let (((&keys :from :to :on) argh))
                   ;; TODO: This used to be (when (or from to on) query), but
                   ;; that doesn't seem right, so I changed it to this if, and the
                   ;; tests pass either way.  Might deserve a little scrutiny.
--- a/tests/test-org-ql-ert.el
+++ b/tests/test-org-ql-ert.el
@ -0,0 +1,55 @@
+;;; test-org-ql-ert.el ---                           -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021  Adam Porter
+
+;; Author: Adam Porter <adam@alphapapa.net>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'ert)
+
+(require 'org-ql)
+
+;;;; Variables
+
+
+;;;; Customization
+
+
+;;;; Commands
+
+
+;;;; Functions
+
+(ert-deftest org-ql--normalize-query ()
+  (should (equal (org-ql--normalize-query '(ts-active :on "2019-01-01"))
+                 `(ts :type active
+                      :from ,(ts-apply :hour 0 :minute 0 :second 0 (ts-parse "2019-01-01"))
+                      :to ,(ts-apply :hour 23 :minute 59 :second 59 (ts-parse "2019-01-01"))))))
+
+
+;;;; Footer
+
+(provide 'test-org-ql-ert)
+
+;;; test-org-ql-ert.el ends here
--- a/tests/test-org-ql.el
+++ b/tests/test-org-ql.el
@ -511,6 +511,23 @@ with keyword arg NOW in PLIST."
    ;;                        (ts :type inactive
    ;;                            :from ,(make-ts :unix 1546322400.0)
    ;;                            :to ,(make-ts :unix 1546408799.0))))
+
+    (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
+                               :from ,(ts-apply :hour 0 :minute 0 :second 0 (ts-parse "2019-01-01"))
+                               :to ,(ts-apply :hour 23 :minute 59 :second 59 (ts-parse "2019-01-01")))
+                           (ts :type active
+                               :from ,(ts-apply :hour 0 :minute 0 :second 0 (ts-parse "2019-01-01"))
+                               :to ,(ts-apply :hour 23 :minute 59 :second 59 (ts-parse "2019-01-01")))
+                           (ts :type inactive
+                               :from ,(ts-apply :hour 0 :minute 0 :second 0 (ts-parse "2019-01-01"))
+                               :to ,(ts-apply :hour 23 :minute 59 :second 59 (ts-parse "2019-01-01")))
+                           (ts :type inactive
+                               :from ,(ts-apply :hour 0 :minute 0 :second 0 (ts-parse "2019-01-01"))
+                               :to ,(ts-apply :hour 23 :minute 59 :second 59 (ts-parse "2019-01-01")))))
    )

  (describe "Query preambles"
Author	SHA1	Message	Date
Adam Porter	85540f5231	WIP: Long shot	2021-07-05 03:11:33 -05:00
Adam Porter	51bd90bb03	WIP: Restore original test and use ts-apply The previous change passes, so this should, too. But I don't see how ts.el could be causing a void-variable error in an org-ql macro expansion, so maybe these are separate problems...	2021-07-05 02:50:00 -05:00
Adam Porter	92cf211b02	WIP: Try copying passing test from ERT file Is this related to ts.el? But how could that explain a void-variable error?	2021-07-05 02:46:34 -05:00
Adam Porter	2b4e6f09ca	Revert "WIP: Disable Buttercup test file" This reverts commit `24993c9a25`.	2021-07-05 02:41:15 -05:00
Adam Porter	b7c0edfc71	WIP: Don't use -let? Grasping at straws here...	2021-07-05 02:39:44 -05:00
Adam Porter	3d6747f427	WIP: Parse string into ts Rather than using a Unix timestamp, which makes a different ts depending on the system timezone, due to an issue in ts.el (which I hope to fix soon).	2021-07-05 02:29:45 -05:00
Adam Porter	5924b37cb7	WIP: Try to make ERT print whole struct This probably won't work, but I don't know what else to do...	2021-07-05 02:24:57 -05:00
Adam Porter	24993c9a25	WIP: Disable Buttercup test file makem.sh loads all test files when testing (i.e. it loads the Buttercup test file even when running only ERT tests). In case Buttercup is somehow related, let's disable its tests...	2021-07-05 02:22:19 -05:00
Adam Porter	0b288f01de	WIP: Add ERT test Maybe this will work, or unmask the error from Buttercup?	2021-07-05 02:22:19 -05:00
Adam Porter	e66af03aee	WIP	2021-07-05 01:43:51 -05:00