Change: Move some timestamp-predicate arg processing
Those pcase clauses looked nice and clean, but putting the logic in the macrolet lets us use number arguments to the keywords, which is useful. Eventually I may want to unify this, or put it in the defpred macro.
This commit is contained in:
Adam Porter
parent
8d34bc13bd
commit
f8f18716ae
1 changed files with 48 additions and 49 deletions
97
org-ql.el
97
org-ql.el
|
|
@ -312,43 +312,6 @@ Replaces bare strings with (regexp) selectors, and appropriate
|
||||||
(ts-adjust 'day num-days)
|
(ts-adjust 'day num-days)
|
||||||
(ts-apply :hour 23 :minute 59 :second 59))))
|
(ts-apply :hour 23 :minute 59 :second 59))))
|
||||||
`(,pred :to ,to)))
|
`(,pred :to ,to)))
|
||||||
(`(,(and pred (or 'deadline 'scheduled 'planning))
|
|
||||||
,(and direction (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 ,direction ,target)))
|
|
||||||
(`(,(and pred (or 'ts 'ts-a 'ts-i 'ts-active 'ts-inactive))
|
|
||||||
,(and direction (or :from :to))
|
|
||||||
,(and num-days (pred numberp)))
|
|
||||||
(-let* ((type (pcase-exhaustive pred
|
|
||||||
((or 'ts-i 'ts-inactive) 'inactive)
|
|
||||||
((or 'ts-a 'ts-active) 'active)
|
|
||||||
('ts 'both)))
|
|
||||||
((hour minute second) (pcase-exhaustive direction
|
|
||||||
(:from '(0 0 0))
|
|
||||||
(:to '(23 59 59))))
|
|
||||||
(ts (->> (ts-now)
|
|
||||||
(ts-adjust 'day num-days)
|
|
||||||
(ts-apply :hour hour :minute minute :second second))))
|
|
||||||
`(ts :type ,type ,direction ,ts)))
|
|
||||||
(`(,(and pred (or 'ts 'ts-a 'ts-i 'ts-active 'ts-inactive))
|
|
||||||
:on
|
|
||||||
,(and num-days (pred numberp)))
|
|
||||||
;; This rule is only for :on, because we must provide both :from and :to
|
|
||||||
;; timestamps to the (ts) selector for the --query-predicate function.
|
|
||||||
(-let* ((type (pcase-exhaustive pred
|
|
||||||
((or 'ts-i 'ts-inactive) 'inactive)
|
|
||||||
((or 'ts-a 'ts-active) 'active)
|
|
||||||
('ts 'both)))
|
|
||||||
(from (->> (ts-now)
|
|
||||||
(ts-adjust 'day num-days)
|
|
||||||
(ts-apply :hour 0 :minute 0 :second 0)))
|
|
||||||
(to (->> (ts-now)
|
|
||||||
(ts-adjust 'day num-days)
|
|
||||||
(ts-apply :hour 23 :minute 59 :second 59))))
|
|
||||||
`(ts :type ,type :from ,from :to ,to)))
|
|
||||||
(`(,(or 'ts-active 'ts-a) . ,rest) `(ts :type active ,@rest))
|
(`(,(or 'ts-active 'ts-a) . ,rest) `(ts :type active ,@rest))
|
||||||
(`(,(or 'ts-inactive 'ts-i) . ,rest) `(ts :type inactive ,@rest))
|
(`(,(or 'ts-inactive 'ts-i) . ,rest) `(ts :type inactive ,@rest))
|
||||||
;; Any other form: passed through unchanged.
|
;; Any other form: passed through unchanged.
|
||||||
|
|
@ -372,12 +335,18 @@ Replaces bare strings with (regexp) selectors, and appropriate
|
||||||
(setq from on
|
(setq from on
|
||||||
to on))
|
to on))
|
||||||
(when from
|
(when from
|
||||||
(setq from (cl-typecase from
|
(setq from (cl-etypecase from
|
||||||
(string (ts-parse-fill 'begin from))
|
(string (ts-parse-fill 'begin from))
|
||||||
|
(number (->> (ts-now)
|
||||||
|
(ts-adjust 'day from)
|
||||||
|
(ts-apply :hour 0 :minute 0 :second 0)))
|
||||||
(ts from))))
|
(ts from))))
|
||||||
(when to
|
(when to
|
||||||
(setq to (cl-typecase to
|
(setq to (cl-etypecase to
|
||||||
(string (ts-parse-fill 'end to))
|
(string (ts-parse-fill 'end to))
|
||||||
|
(number (->> (ts-now)
|
||||||
|
(ts-adjust 'day to)
|
||||||
|
(ts-apply :hour 23 :minute 59 :second 59)))
|
||||||
(ts to))))
|
(ts to))))
|
||||||
;; NOTE: The macro must expand to the actual `org-ql--predicate-clocked'
|
;; NOTE: The macro must expand to the actual `org-ql--predicate-clocked'
|
||||||
;; function, not another `clocked'.
|
;; function, not another `clocked'.
|
||||||
|
|
@ -387,12 +356,18 @@ Replaces bare strings with (regexp) selectors, and appropriate
|
||||||
(setq from on
|
(setq from on
|
||||||
to on))
|
to on))
|
||||||
(when from
|
(when from
|
||||||
(setq from (cl-typecase from
|
(setq from (cl-etypecase from
|
||||||
(string (ts-parse-fill 'begin from))
|
(string (ts-parse-fill 'begin from))
|
||||||
|
(number (->> (ts-now)
|
||||||
|
(ts-adjust 'day from)
|
||||||
|
(ts-apply :hour 0 :minute 0 :second 0)))
|
||||||
(ts from))))
|
(ts from))))
|
||||||
(when to
|
(when to
|
||||||
(setq to (cl-typecase to
|
(setq to (cl-etypecase to
|
||||||
(string (ts-parse-fill 'end to))
|
(string (ts-parse-fill 'end to))
|
||||||
|
(number (->> (ts-now)
|
||||||
|
(ts-adjust 'day to)
|
||||||
|
(ts-apply :hour 23 :minute 59 :second 59)))
|
||||||
(ts to))))
|
(ts to))))
|
||||||
;; NOTE: The macro must expand to the actual `org-ql--predicate-closed'
|
;; NOTE: The macro must expand to the actual `org-ql--predicate-closed'
|
||||||
;; function, not another `closed'.
|
;; function, not another `closed'.
|
||||||
|
|
@ -402,12 +377,18 @@ Replaces bare strings with (regexp) selectors, and appropriate
|
||||||
(setq from on
|
(setq from on
|
||||||
to on))
|
to on))
|
||||||
(when from
|
(when from
|
||||||
(setq from (cl-typecase from
|
(setq from (cl-etypecase from
|
||||||
(string (ts-parse-fill 'begin from))
|
(string (ts-parse-fill 'begin from))
|
||||||
|
(number (->> (ts-now)
|
||||||
|
(ts-adjust 'day from)
|
||||||
|
(ts-apply :hour 0 :minute 0 :second 0)))
|
||||||
(ts from))))
|
(ts from))))
|
||||||
(when to
|
(when to
|
||||||
(setq to (cl-typecase to
|
(setq to (cl-etypecase to
|
||||||
(string (ts-parse-fill 'end to))
|
(string (ts-parse-fill 'end to))
|
||||||
|
(number (->> (ts-now)
|
||||||
|
(ts-adjust 'day to)
|
||||||
|
(ts-apply :hour 23 :minute 59 :second 59)))
|
||||||
(ts to))))
|
(ts to))))
|
||||||
;; NOTE: The macro must expand to the actual `org-ql--predicate-deadline'
|
;; NOTE: The macro must expand to the actual `org-ql--predicate-deadline'
|
||||||
;; function, not another `deadline'.
|
;; function, not another `deadline'.
|
||||||
|
|
@ -417,12 +398,18 @@ Replaces bare strings with (regexp) selectors, and appropriate
|
||||||
(setq from on
|
(setq from on
|
||||||
to on))
|
to on))
|
||||||
(when from
|
(when from
|
||||||
(setq from (cl-typecase from
|
(setq from (cl-etypecase from
|
||||||
(string (ts-parse-fill 'begin from))
|
(string (ts-parse-fill 'begin from))
|
||||||
|
(number (->> (ts-now)
|
||||||
|
(ts-adjust 'day from)
|
||||||
|
(ts-apply :hour 0 :minute 0 :second 0)))
|
||||||
(ts from))))
|
(ts from))))
|
||||||
(when to
|
(when to
|
||||||
(setq to (cl-typecase to
|
(setq to (cl-etypecase to
|
||||||
(string (ts-parse-fill 'end to))
|
(string (ts-parse-fill 'end to))
|
||||||
|
(number (->> (ts-now)
|
||||||
|
(ts-adjust 'day to)
|
||||||
|
(ts-apply :hour 23 :minute 59 :second 59)))
|
||||||
(ts to))))
|
(ts to))))
|
||||||
;; NOTE: The macro must expand to the actual `org-ql--predicate-planning'
|
;; NOTE: The macro must expand to the actual `org-ql--predicate-planning'
|
||||||
;; function, not another `planning'.
|
;; function, not another `planning'.
|
||||||
|
|
@ -432,12 +419,18 @@ Replaces bare strings with (regexp) selectors, and appropriate
|
||||||
(setq from on
|
(setq from on
|
||||||
to on))
|
to on))
|
||||||
(when from
|
(when from
|
||||||
(setq from (cl-typecase from
|
(setq from (cl-etypecase from
|
||||||
(string (ts-parse-fill 'begin from))
|
(string (ts-parse-fill 'begin from))
|
||||||
|
(number (->> (ts-now)
|
||||||
|
(ts-adjust 'day from)
|
||||||
|
(ts-apply :hour 0 :minute 0 :second 0)))
|
||||||
(ts from))))
|
(ts from))))
|
||||||
(when to
|
(when to
|
||||||
(setq to (cl-typecase to
|
(setq to (cl-etypecase to
|
||||||
(string (ts-parse-fill 'end to))
|
(string (ts-parse-fill 'end to))
|
||||||
|
(number (->> (ts-now)
|
||||||
|
(ts-adjust 'day to)
|
||||||
|
(ts-apply :hour 23 :minute 59 :second 59)))
|
||||||
(ts to))))
|
(ts to))))
|
||||||
;; NOTE: The macro must expand to the actual `org-ql--predicate-scheduled'
|
;; NOTE: The macro must expand to the actual `org-ql--predicate-scheduled'
|
||||||
;; function, not another `scheduled'.
|
;; function, not another `scheduled'.
|
||||||
|
|
@ -447,12 +440,18 @@ Replaces bare strings with (regexp) selectors, and appropriate
|
||||||
(setq from on
|
(setq from on
|
||||||
to on))
|
to on))
|
||||||
(when from
|
(when from
|
||||||
(setq from (cl-typecase from
|
(setq from (cl-etypecase from
|
||||||
(string (ts-parse-fill 'begin from))
|
(string (ts-parse-fill 'begin from))
|
||||||
|
(number (->> (ts-now)
|
||||||
|
(ts-adjust 'day from)
|
||||||
|
(ts-apply :hour 0 :minute 0 :second 0)))
|
||||||
(ts from))))
|
(ts from))))
|
||||||
(when to
|
(when to
|
||||||
(setq to (cl-typecase to
|
(setq to (cl-etypecase to
|
||||||
(string (ts-parse-fill 'end to))
|
(string (ts-parse-fill 'end to))
|
||||||
|
(number (->> (ts-now)
|
||||||
|
(ts-adjust 'day to)
|
||||||
|
(ts-apply :hour 23 :minute 59 :second 59)))
|
||||||
(ts to))))
|
(ts to))))
|
||||||
;; NOTE: The macro must expand to the actual `org-ql--predicate-ts'
|
;; NOTE: The macro must expand to the actual `org-ql--predicate-ts'
|
||||||
;; function, not another `ts'.
|
;; function, not another `ts'.
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue