cl-yesql+asdf.lisp

(defclass yesql (source-file) ()
  (:default-initargs :type "sql"))

(defclass compile-yesql-op (compile-op)
  ;; NOTE: asdf:input-files is memoised.
  ;; We could not control return value via special symbols.
  ;; We need another object (i.e. compile-yesql-op) for another return value.
  ((op :accessor op)))

(defmethod input-files ((o compile-yesql-op) (c yesql))
  "Return universal file path."
  (list (make-pathname :name "universal"
                       :type "lisp"
                       :defaults (system-source-directory
                                   (find-system :vernacular)))))

(defmethod output-files ((o compile-op) (c yesql))
  "Generate output fasl pathnames."
  (asdf::lisp-compilation-output-files o c))

(defmethod output-files ((o compile-yesql-op) (c yesql))
  ;; NOTE: Do not CALL-NEXT-METHOD!
  ;; asdf::lisp-compilation-output-files call input-files implicitly!
  (output-files (op o) c))

(defmethod perform :before ((o compile-op) (c yesql))
  ;; Needs to specify system.
  (eval
  `(,(find-symbol* '#:set-package-base '#:overlord)
     ,(make-pathname :directory (list :relative (component-name (component-parent c))))
     ,(primary-system-name c))))

(defmethod perform ((o compile-op) (c yesql))
  (progv (list (find-symbol* '#:*program-preamble* '#:vernacular/specials)
               (find-symbol* '#:*program* '#:vernacular/specials))
    (list nil `(progn ,@(loop :for (op name . rest)
                              :in (cdr (symbol-call '#:vernacular/lang '#:expand-module
                                         (component-pathname c)))
                          :collect `(,op ,(intern (symbol-name name) TODO) ; <--- Specify package to intern the sql functions.
                                         ,@rest))))
    (let (;; Intermediate operation object to control input files.
          ;; SQL file path for generating fasl pathname.
          ;; universal.lisp for compiling.
          (op (make-operation 'compile-yesql-op)))
      (setf (op op) o)
      (asdf::perform-lisp-compilation op c))))

(defmethod perform ((o load-op) (c yesql))
  (asdf::perform-lisp-load-fasl o c))