summaryrefslogtreecommitdiff
path: root/rt-liberation.el
diff options
context:
space:
mode:
authorYoni Rabkin <yoni@rabkins.net>2021-03-05 12:40:50 -0500
committerYoni Rabkin <yoni@rabkins.net>2021-03-05 12:40:50 -0500
commitabf4625d1785638d0ce6940818bb4fab3a82fcc3 (patch)
tree96e1c67e65e3cbca496a23482c66b8fb759fedab /rt-liberation.el
parent000c356e588789e75bd065308db6b1656e26fe08 (diff)
* rt-liberation-compiler.el: split out compiler code
Diffstat (limited to 'rt-liberation.el')
-rw-r--r--rt-liberation.el136
1 files changed, 1 insertions, 135 deletions
diff --git a/rt-liberation.el b/rt-liberation.el
index 04d9965..268b745 100644
--- a/rt-liberation.el
+++ b/rt-liberation.el
@@ -43,6 +43,7 @@
(require 'cl-lib)
(require 'rt-liberation-rest)
+(require 'rt-liberation-compiler)
(declare-function rt-liber-get-ancillary-text "rt-liberation-storage.el")
(declare-function rt-liber-ticket-marked-p "rt-liberation-multi.el")
@@ -77,39 +78,12 @@
'font-lock-comment-face)))
"Expressions to font-lock for RT ticket viewer.")
-(defvar rt-liber-created-string "Created"
- "String representation of \"created\" query tag.")
-
(defvar rt-liber-resolved-string "Resolved"
"String representation of \"resolved\" query tag.")
(defvar rt-liber-base-url ""
"Base url for ticket display.")
-(defvar rt-liber-lastupdated-string "LastUpdated"
- "String representation of \"lastupdated\" query tag.")
-
-(defvar rt-liber-resolved-string "Resolved"
- "String representation of \"resolved\" query tag.")
-
-(defvar rt-liber-content-string "Content LIKE"
- "String representation of \"content\" query tag.")
-
-(defvar rt-liber-subject-string "Subject LIKE"
- "String representation of \"subject\" query tag.")
-
-(defvar rt-liber-email-address-string "Requestor.EmailAddress LIKE"
- "String representation of \"Requestor.EmailAddress\" query tag.")
-
-(defvar rt-liber-content-not-string "Content NOT LIKE"
- "String representation of \"content\" query tag.")
-
-(defvar rt-liber-subject-not-string "Subject NOT LIKE"
- "String representation of \"subject\" query tag.")
-
-(defvar rt-liber-email-address-not-string "Requestor.EmailAddress NOT LIKE"
- "String representation of \"Requestor.EmailAddress\" query tag.")
-
(defvar rt-liber-content-regexp "^Content:.*$"
"Regular expression for section headers.")
@@ -267,114 +241,6 @@ This variable is made buffer local for the ticket history")
;;; --------------------------------------------------------
-;;; TicketSQL compiler
-;;; --------------------------------------------------------
-(eval-and-compile ;; for use in macro `rt-liber-compile-query'
- (defun rt-liber-bool-p (sym)
- "Return t if SYM is a boolean operator, otherwise nil."
- (member sym '(and or)))
- (defun rt-liber-attrib-p (sym)
- "Return t if SYM is a ticket attribute, otherwise nil."
- (member sym '(id owner status subject content queue lastupdatedby
- email-address)))
- (defun rt-liber-time-p (sym)
- "Return t if SYM is a temporal attribute, otherwise nil."
- (member sym '(created lastupdated resolved)))
- (defun rt-liber-negation-p (sym)
- (member sym '(not)))
-
- (defun rt-liber-reduce (op seq)
- "Reduce-OP with SEQ to a string of \"s0 op s1 op s2..\"."
- (if seq
- (cl-reduce
- #'(lambda (a b)
- (format "%s %s %s" a op b))
- seq)
- ""))
-
- (defun rt-liber-make-interval (pred before after)
- "Return a formatted TicketSQL interval.
-PRED temporal attribute predicate.
-BEFORE date before predicate.
-AFTER date after predicate."
- (when (string= before "") (setq before nil))
- (when (string= after "") (setq after nil))
- (concat
- (if before (format "%s < '%s'" pred before) "")
- (if (and before after) (format " AND ") "")
- (if after (format "%s > '%s'" pred after) ""))))
-
-(defmacro rt-liber-compile-query (query &optional n)
- "Compile sexp-based QUERY into TicketSQL."
- (cond ((null query) `"")
- ((stringp query) `,query)
- ((rt-liber-bool-p query) `,(upcase (format "%s" query)))
- ;; attribute (positive)
- ((and (rt-liber-attrib-p query)
- (not n))
- `,(cond ((equal query 'content) rt-liber-content-string)
- ((equal query 'subject) rt-liber-subject-string)
- ((equal query 'email-address) rt-liber-email-address-string)
- (t (capitalize (format "%s =" query)))))
- ;; attribute (negation)
- ((and (rt-liber-attrib-p query)
- n)
- `,(cond ((equal query 'content) rt-liber-content-not-string)
- ((equal query 'subject) rt-liber-subject-not-string)
- ((equal query 'email-address) rt-liber-email-address-not-string)
- (t (capitalize (format "%s !=" query)))))
- ;; time
- ((rt-liber-time-p query)
- `,(cond ((equal query 'created) rt-liber-created-string)
- ((equal query 'lastupdated) rt-liber-lastupdated-string)
- ((equal query 'resolved) rt-liber-resolved-string)))
- ((and (listp query)
- (rt-liber-time-p (car query)))
- `(rt-liber-make-interval
- (rt-liber-compile-query ,(car query))
- (rt-liber-compile-query ,(cadr query))
- (rt-liber-compile-query ,(caddr query))))
- ;; function (known at compile time?)
- ((and query
- (listp query)
- (not (rt-liber-bool-p (car query)))
- (not (rt-liber-negation-p (car query)))
- (functionp (car query)))
- `(format "%s" ,query))
- ;; negation attribute pairs
- ((and (listp query)
- (rt-liber-negation-p (car query))
- (rt-liber-attrib-p (caadr query)))
- `(format "%s '%s'"
- (rt-liber-compile-query ,(caadr query) t) ; negate
- (rt-liber-compile-query ,(cadadr query))))
- ;; attribute pairs
- ((and (listp query)
- (rt-liber-attrib-p (car query)))
- `(format "%s '%s'"
- (rt-liber-compile-query ,(car query))
- (rt-liber-compile-query ,(cadr query))))
- ;; splice boolean operators
- ((and (listp query)
- (rt-liber-bool-p (car query)))
- `(rt-liber-reduce (rt-liber-compile-query ,(car query))
- (rt-liber-compile-query ,(cdr query))))
- ;; compound statements
- ((and (listp query)
- (not (cdr query)))
- `(list (rt-liber-compile-query ,(car query))))
- ((listp query)
- `(append
- (list (rt-liber-compile-query ,(car query)))
- (rt-liber-compile-query ,(cdr query))))
- ;; free variable
- ((and query
- (symbolp query))
- `(format "%s" ,query))
- (t (error "cannot compile query %s" query))))
-
-
-;;; --------------------------------------------------------
;;; Parse Answer
;;; --------------------------------------------------------
(defun rt-liber-parse-answer (answer-string parser-f)