;;;; -------------------------------------------------------------------------
;;;; Actions

(asdf/package:define-package :asdf/action
  (:recycle :asdf/action :asdf)

  (:use :common-lisp :asdf/compatibility :asdf/utility :asdf/pathname :asdf/os :asdf/lisp-build

   :asdf/upgrade :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation)
  #+gcl<2.7 (:shadowing-import-from :asdf/compatibility #:type-of)

  (:intern #:stamp #:done-p)

  (:export
   #:action
   #:explain #:operation-description
   #:downward-operation #:upward-operation
   #:file-component
   #:source-file #:c-source-file #:java-source-file
   #:static-file #:doc-file #:html-file
   #:operation-error #:error-component #:error-operation
   #:component-depends-on #:component-self-dependencies
   #:input-files #:output-files #:output-file #:operation-done-p
   #:action-status #:action-stamp #:action-done-p
   #:component-operation-time #:mark-operation-done #:compute-action-stamp
   #:perform #:perform-with-restarts #:retry #:accept))
(in-package :asdf/action)

(deftype action () '(cons operation component)) ;; a step to be performed while building the system

;;;; self-description

(defgeneric* operation-description (operation component) ;; ASDF3: rename to action-description
  (:documentation "returns a phrase that describes performing this operation
on this component, e.g. \"loading /a/b/c\".
You can put together sentences using this phrase."))
(defmethod operation-description (operation component)
  (format nil (compatfmt "~@<~A on ~A~@:>")
          (class-of operation) component))

(defgeneric* explain (operation component))
(defmethod explain ((o operation) (c component))
  (asdf-message (compatfmt "~&~@<; ~@;~A~:>~%") (operation-description o c)))


;;;; Error

(define-condition operation-error (error) ;; Bad, backward-compatible name
  ;; We want to rename it to action-error, but that breaks upgrade on SBCL.
  ;; Before to rename it, fix these other culprits, too:
  ;; cffi-tests, clsql-mysql, clsql-uffi, qt, elephant, uffi-tests, sb-grovel
  ((component :reader error-component :initarg :component)
   (operation :reader error-operation :initarg :operation))
  (:report (lambda (c s)
               (format s (compatfmt "~@<~A while invoking ~A on ~A~@:>")
                       (type-of c) (error-operation c) (error-component c)))))


;;;; Dependencies

(defgeneric* component-depends-on (operation component) ;; ASDF3: rename to component-dependencies
  (:documentation
   "Returns a list of dependencies needed by the component to perform
    the operation.  A dependency has one of the following forms:

      (<operation> <component>*), where <operation> is a class
        designator and each <component> is a component
        designator, which means that the component depends on
        <operation> having been performed on each <component>; or

      (FEATURE <feature>), which means that the component depends
        on <feature>'s presence in *FEATURES*.

    Methods specialized on subclasses of existing component types
    should usually append the results of CALL-NEXT-METHOD to the
    list."))
(defgeneric* component-self-dependencies (operation component))

(defmethod component-depends-on ((o operation) (c component))
  (cdr (assoc (type-of o) (component-in-order-to c)))) ; User-specified in-order dependencies

(defmethod component-self-dependencies ((o operation) (c component))
  (loop :for (o-spec . c-spec) :in (component-depends-on o c)
        :unless (eq o-spec 'feature) ;; avoid the FEATURE "feature"
          :when (find c c-spec :key #'(lambda (dep) (resolve-dependency-spec c dep)))
            :collect (cons (find-operation o o-spec) c)))

;;;; upward-operation, downward-operation
;; These together handle actions that propagate along the component hierarchy.
;; Downward operations like load-op or compile-op propagate down the hierarchy:
;; operation on a parent depends-on operation on its children.
(defclass downward-operation (operation) ())
;; Upward operations like prepare-op propagate up the component hierarchy:
;; operation on a child depends-on operation on its parent.
(defclass upward-operation (operation) ())

(defmethod component-depends-on ((o downward-operation) (c parent-component))
  `((,o ,@(component-children c)) ,@(call-next-method)))
;; For backward-compatibility reasons, a system inherits from module and is a child-component
;; so we must guard against this case. ASDF3: remove that.
(defmethod component-depends-on ((o upward-operation) (c child-component))
  `(,@(aif (component-parent c) `((,o ,it))) ,@(call-next-method)))


;;;; Inputs, Outputs, and invisible dependencies
(defgeneric* output-files (operation component))
(defgeneric* input-files (operation component))
(defgeneric* operation-done-p (operation component)
  (:documentation "Returns a boolean, which is NIL if the action is forced to be performed again"))

(defmethod operation-done-p ((o operation) (c component))
  (declare (ignorable o c))
  t)

(defmethod output-files :around (operation component)
  "Translate output files, unless asked not to"
  operation component ;; hush genera, not convinced by declare ignorable(!)
  (values
   (multiple-value-bind (files fixedp) (call-next-method)
     (if fixedp
         files
         (mapcar *output-translation-hook* files)))
   t))