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

Add: (--query-sexp-to-string)

Browse source
This commit is contained in:
Adam Porter 2020-11-11 02:30:37 -06:00
parent 07d21e57c0
commit e15cc3eb76
2 changed files with 568 additions and 450 deletions
Download patch file Download diff file Expand all files Collapse all files

71
org-ql.el
View file

@ -1668,6 +1668,8 @@ element should be a regexp string."
;; This section implements parsing of "plain," non-Lisp queries using the `peg'
;; library. NOTE: This needs to appear after the predicates are defined.
;; TODO: Rename "plain" to "string", or something like that.
(require 'peg)
;; Fix compiler warnings probably caused by `peg' not using lexical-binding.
@ -1749,6 +1751,75 @@ Multiple predicates are combined with BOOLEAN."
(org-ql--def-plain-query-fn))
;; And now we go the other direction...
(defun org-ql--query-sexp-to-string (query)
"Return a string query for sexp QUERY.
If QUERY can't be converted to a string, return nil."
;; This started out pretty simple...but at least it's not just one long function, right?
(cl-labels ((complex-p (query)
(or (contains-p 'or query)))
(contains-p (symbol list)
(cl-loop for element in list
thereis (or (eq symbol element)
(and (listp element)
(contains-p symbol element)))))
(format-args
(args) (let (non-paired paired next-keyword)
(cl-loop for arg in args
do (cond (next-keyword (push (cons next-keyword arg) paired)
(setf next-keyword nil))
((keywordp arg) (setf next-keyword (substring (symbol-name arg) 1)))
(t (push arg non-paired))))
(string-join (append (mapcar #'format-atom non-paired)
(nreverse (--map (format "%s=%s" (car it) (cdr it))
paired)))
",")))
(format-atom
(atom) (cl-typecase atom
(string (if (string-match (rx space) atom)
(format "%S" atom)
(format "%s" atom)))
(t (format "%s" atom))))
(format-form
(form) (pcase form
(`(not . (,rest)) (concat "!" (format-form rest)))
(`(priority . ,_) (format-priority form))
;; FIXME: Convert (src) queries to non-sexp form...someday...
(`(src . ,_) (user-error "Converting (src ...) queries to non-sexp form is not implemented"))
(_ (pcase-let* ((`(,pred . ,args) form)
(args-string (pcase args
('() "")
((guard (= 1 (length args))) (format "%s" (car args)))
(_ (format-args args)))))
(format "%s:%s" pred args-string)))))
(format-and
(form) (pcase-let* ((`(and . ,rest) form))
(string-join (mapcar #'format-form rest) " ")))
(format-priority
(form) (pcase-let* ((`(priority . ,rest) form)
(args (pcase rest
(`(,(and comparator (or '< '<= '> '>= '=)) ,letter)
(priority-letters comparator letter))
(_ rest))))
(concat "priority:" (string-join args ","))))
(priority-letters
(comparator letter) (let* ((char (string-to-char (upcase (symbol-name letter))))
(numeric-priorities '(?A ?B ?C))
;; NOTE: The comparator inversion is intentional.
(others (pcase comparator
('< (--select (> it char) numeric-priorities))
('<= (--select (>= it char) numeric-priorities))
('> (--select (< it char) numeric-priorities))
('>= (--select (<= it char) numeric-priorities))
('= (--select (= it char) numeric-priorities)))))
(mapcar #'char-to-string others))))
;; FIXME: Error out for ts structs passed to `ts' predicate (very unlikely to be linked to).
(unless (complex-p query)
(pcase query
(`(and . ,_) (format-and query))
(_ (format-form query))))))
;;;; Footer
(provide 'org-ql)

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

@ -368,6 +368,53 @@ RESULTS should be a list of strings as returned by
(expect (org-ql--plain-query "regexp:\"quoted phrase\" todo:SOMEDAY")
:to-equal '(and (regexp "quoted phrase") (todo "SOMEDAY")))))
(describe "Convert sexp queries to non-sexp queries"
;; FIXME: Test (src) after converting it is implemented.
;; (src :lang "elisp" :regexps ("defun"))
;; MAYBE: Other predicates? Or should these cover the other
;; cases, because the others use the same format?
(it "(heading)"
(expect (org-ql--query-sexp-to-string '(heading "quoted phrase" "word"))
:to-equal "heading:word,\"quoted phrase\""))
(it "(priority)"
(expect (org-ql--query-sexp-to-string '(priority >= B))
:to-equal "priority:A,B")
(expect (org-ql--query-sexp-to-string '(priority > B))
:to-equal "priority:A")
(expect (org-ql--query-sexp-to-string '(priority < B))
:to-equal "priority:C")
(expect (org-ql--query-sexp-to-string '(priority < A))
:to-equal "priority:B,C")
(expect (org-ql--query-sexp-to-string '(priority <= B))
:to-equal "priority:B,C")
(expect (org-ql--query-sexp-to-string '(priority = A))
:to-equal "priority:A"))
(it "(todo)"
(expect (org-ql--query-sexp-to-string '(todo))
:to-equal "todo:")
(expect (org-ql--query-sexp-to-string '(todo "TODO"))
:to-equal "todo:TODO")
(expect (org-ql--query-sexp-to-string '(todo "TODO" "NEXT"))
:to-equal "todo:NEXT,TODO"))
(it "(ts)"
(expect (org-ql--query-sexp-to-string '(ts :from -1 :to 1))
:to-equal "ts:from=-1,to=1")
(expect (org-ql--query-sexp-to-string '(ts :on today))
:to-equal "ts:on=today")
(expect (org-ql--query-sexp-to-string '(ts-active :from "2017-01-01" :to "2018-01-01"))
:to-equal "ts-active:from=2017-01-01,to=2018-01-01"))
(it "(and ...)"
(expect (org-ql--query-sexp-to-string '(and (tags "book" "books") (priority "A")))
:to-equal "tags:books,book priority:A")
(expect (org-ql--query-sexp-to-string '(and (tags "space") (not (regexp "moon"))))
:to-equal "tags:space !regexp:moon"))
(it "(or ...)"
(expect (org-ql--query-sexp-to-string '(or (tags "book" "books") (priority "A")))
:to-equal nil)))
(describe "Query results"
;; TODO: Other predicates.