(in-package #:org.shirakumo.lquery)

(defmacro deflqfun (name args &rest forms)

(assert (symbolp name))

`(defun ,(intern (symbol-name name) :lquery-funcs) ,args ,@forms))

(defmacro define-lquery-function (name (node-name &rest arguments) &body body)

"Defines a new node function. This is the main mechanism by which node manipulations are defined.

(form-fiddle:with-destructured-lambda-form (:docstring doc :declarations decls :forms forms)

`(lambda () ,@body)

(let ((funsymb (gensym "FUN"))

(i (gensym "I")))

`(deflqfun ,name (,node-name ,@arguments)

,@(when doc (list doc))

,@decls

(flet ((,funsymb (,node-name) ,@forms))

(if (arrayp ,node-name)

(loop for ,i from 0 below (length ,node-name)

do (setf (aref ,node-name ,i)

(,funsymb (aref ,node-name ,i)))

finally (return ,node-name))

(,funsymb ,node-name)))))))

(defmacro define-lquery-list-function (name (vector-name &rest arguments) &body body)

"Defines a new function that operates on the current node array instead of individual elements.

(form-fiddle:with-destructured-lambda-form (:docstring doc :declarations decls :forms forms)

`(lambda () ,@body)

`(deflqfun ,name (,vector-name ,@arguments)

,@(when doc (list doc))

,@decls

(let ((,vector-name (ensure-proper-vector ,vector-name)))

,@forms))))

(defmacro define-lquery-subroutine (name (&rest arguments) &body body)

"Defines a shorthand function. The body is a set of lQuery instructions as you'd use in $.

(let ((prev (gensym "PREV")))

(labels ((%$ (forms)

(if (null forms)

prev

(determine-argument (car forms) (%$ (cdr forms))))))

`(deflqfun ,name (,prev ,@arguments)

,(%$ (reverse body))))))

(defmacro define-lquery-macro (name (previous-form &rest arguments) &body body)

"Define a new lquery local macro.

(assert (symbolp name))

(let ((docstring (car body)))

(if (stringp docstring)

(setf body (cdr body))

(setf docstring (format NIL "lQuery node macro ~a" name)))

`(defun ,(intern (symbol-name name) :lquery-macros) (,previous-form ,@arguments)

,docstring

,@body)))

(defmacro $ (&body actions)

#.(format NIL "Performs lQuery operations on the current document.

* T Any other value simply replaces the current list of nodes.")

(%$ (reverse actions)))

(defmacro $1 (&body actions)

"This is the same as $, except it automatically uses NODE at the end and thus only returns the first result, if any."

`($ ,@actions (node)))

(defun %$ (actions)

(if (null actions)

`(make-proper-vector :size 1 :initial-element *lquery-master-document* :fill-pointer T)

(let ((action (car actions))

(rest (cdr actions)))

(determine-argument action (%$ rest)))))

(defgeneric determine-argument (arg nodes)

(:documentation "Determines what to do with a given argument at compile-time (static type)."))

(defmacro define-argument-handler (type (argument-name operator-name) &body body)

"Defines a new argument handler that decides what to do with a certain type of argument at compile-time.

`(defmethod determine-argument ((,argument-name ,type) ,operator-name)

,@body))

(define-argument-handler list (list nodes)

(when list

(etypecase (car list)

(symbol

(let ((nodemacro (find-symbol (symbol-name (car list)) :lquery-macros)))

(if nodemacro

(apply (symbol-function nodemacro) nodes (cdr list))

(let ((nodefunc (find-symbol (symbol-name (car list)) :lquery-funcs)))

(if nodefunc

`(,nodefunc ,nodes ,@(cdr list))

`(,(car list) ,nodes ,@(cdr list))))))))))

(define-argument-handler symbol (symbol nodes)

`(determine-value ,symbol ,nodes))

(define-argument-handler string (string nodes)

`(clss:select ,string ,nodes))

(defgeneric determine-value (symbol nodes)

(:documentation "Determines what to do with a given symbol at run-time (variable type)."))

(defmacro define-value-handler (type (variable-name operator-name) &body body)

"Defines a new symbol handler that decides what to do with a certain type of symbol at run-time (variable type).

`(defmethod determine-value ((,variable-name ,type) ,operator-name)

,@body))

(define-value-handler T (variable nodes)

(declare (ignore nodes))

variable)

(define-value-handler list (list nodes)

(declare (ignore nodes))

(copy-proper-vector list))

(define-value-handler array (array nodes)

(declare (ignore nodes))

(copy-proper-vector array))

(define-value-handler vector (vector nodes)

(declare (ignore nodes))

(if (adjustable-array-p vector)

vector

(copy-proper-vector vector)))

(define-value-handler string (selector nodes)

(clss:select selector nodes))

(define-value-handler plump:node (node nodes)

(declare (ignore nodes))

(make-proper-vector :size 1 :initial-element node :fill-pointer T))

(define-value-handler function (function nodes)

(funcall function nodes))