Commit 509fc33c authored by Eric Timmons's avatar Eric Timmons
Browse files

Add a basic clpm client

parent 3ff8039c
Loading
Loading
Loading
Loading

clpm-asdf.asd

0 → 100644
+18 −0
Original line number Original line Diff line number Diff line
;;;; CLPM ASDF Extensions System Definition
;;;;
;;;; This software is part of CLPM. See README.org for more information. See
;;;; LICENSE for license information.

#-:asdf3.1
(error "Requires ASDF >=3.1")

(defsystem #:clpm-asdf
  :version "0.0.1"
  :description "ASDF Extensions for CLPM"
  :license "BSD-2-Clause"
  :pathname "src/clpm-asdf/"
  :class :package-inferred-system
  :depends-on (#:clpm-asdf/clpm-asdf)
  ;; :components
  ;; ((:file "clpm-client"))
  )

clpm-client.asd

0 → 100644
+15 −0
Original line number Original line Diff line number Diff line
;;;; CLPM Client System Definition
;;;;
;;;; This software is part of CLPM. See README.org for more information. See
;;;; LICENSE for license information.

#-:asdf3.1
(error "Requires ASDF >=3.1")

(defsystem #:clpm-client
  :version "0.0.1"
  :description "A client for CLPM"
  :license "BSD-2-Clause"
  :pathname "src/clpm-client/"
  :class :package-inferred-system
  :depends-on (#:clpm-client/clpm-client))
+12 −0
Original line number Original line Diff line number Diff line
;;;; ASDF extensions for CLPM
;;;;
;;;; This software is part of CLPM. See README.org for more information. See
;;;; LICENSE for license information.

(uiop:define-package #:clpm-asdf/clpm-asdf
    (:nicknames #:clpm-asdf)
  (:use #:cl
        #:clpm-asdf/concatenate-package-inferred-system-source-op)
  (:reexport #:clpm-asdf/concatenate-package-inferred-system-source-op))

(in-package #:clpm-asdf/clpm-asdf)
+59 −0
Original line number Original line Diff line number Diff line
;;;; Support for concatenating source files for a package inferred system
;;;;
;;;; This software is part of CLPM. See README.org for more information. See
;;;; LICENSE for license information.

(uiop:define-package #:clpm-asdf/concatenate-package-inferred-system-source-op
    (:use #:cl
          #:asdf)
  (:export #:concatenate-package-inferred-system-source-op))

(in-package #:clpm-asdf/concatenate-package-inferred-system-source-op)

(defclass concatenate-package-inferred-system-source-op
    (asdf/concatenate-source::basic-concatenate-source-op
     non-propagating-operation)
  ()
  (:documentation
   "An operation that concatenates all source files for a package inferred
system."))

(defun chase-parent (c)
  (if (component-parent c)
      (chase-parent (component-parent c))
      c))

(defmethod asdf:input-files ((operation concatenate-package-inferred-system-source-op) (s system))
  (check-type s package-inferred-system)
  ;; Only work on the primary system directly.
  (assert (equal (primary-system-name s) (component-name s)))
  (loop :with encoding = (or (component-encoding s) *default-encoding*)
        :with other-encodings = '()
        :with around-compile = (asdf::around-compile-hook s)
        :with other-around-compile = '()
        :with primary-system-name = (primary-system-name s)
        :for c :in (required-components  ;; see note about similar call to required-components
                    s :goal-operation 'load-op ;;  in bundle.lisp
                      :keep-operation 'asdf::basic-compile-op
                      :other-systems t)
        :append
        (when (and (typep c 'cl-source-file)
                   (equal (primary-system-name (chase-parent c)) primary-system-name))
          (let ((e (component-encoding c)))
            (unless (equal e encoding)
              (let ((a (assoc e other-encodings)))
                (if a (push (component-find-path c) (cdr a))
                    (push (list a (component-find-path c)) other-encodings)))))
          (unless (equal around-compile (asdf::around-compile-hook c))
            (push (component-find-path c) other-around-compile))
          (input-files (make-operation 'compile-op) c)) :into inputs
        :finally
           (when other-encodings
             (warn "~S uses encoding ~A but has sources that use these encodings:~{ ~A~}"
                   operation encoding
                   (mapcar #'(lambda (x) (cons (car x) (list (reverse (cdr x)))))
                           other-encodings)))
           (when other-around-compile
             (warn "~S uses around-compile hook ~A but has sources that use these hooks: ~A"
                   operation around-compile other-around-compile))
           (return inputs)))
+129 −0
Original line number Original line Diff line number Diff line
;;;; ASDF Integration with CLPM client
;;;;
;;;; This software is part of CLPM. See README.org for more information. See
;;;; LICENSE for license information.

(uiop:define-package #:clpm-client/asdf
    (:use #:cl
          #:clpm-client/cleanup
          #:clpm-client/clpm)
  (:import-from #:asdf
                #:*system-definition-search-functions*)
  (:export #:*clpm-system-not-found-behavior*
           #:activate-clpm
           #:clpm-active-p
           #:clpm-install-system
           #:clpm-missing-system
           #:clpm-system-search
           #:deactivate-clpm))

(in-package #:clpm-client/asdf)

(defvar *clpm-system-not-found-behavior* :error
  "The behavior if CLPM is asked to find a system that is not installed. One of:

+ :ERROR :: Signal a CLPM-MISSING-SYSTEM condition with the INSTALL-SYSTEM
restart available.

+ :INSTALL :: Just install the system without prompting.

+ NIL :: Do nothing.")

(defun clpm-install-system (system-name)
  "Install a system using CLPM (see: *CLPM-EXECUTABLE*). Returns T iff the
system was successfully installed."
  (multiple-value-bind (output error-output exit-code)
      (run-clpm (list "install" "-s" system-name)
                :ignore-error-status t
                :input nil
                :output '(:string :stripped t)
                :error-output '(:string :stripped t))
    (declare (ignore output error-output))
    (= exit-code 0)))

(define-condition clpm-missing-system (error)
  ((system-name
    :initarg :system-name))
  (:report (lambda (c s)
             (format s "CLPM unable to find system locally: ~A"
                     (slot-value c 'system-name))))
  (:documentation "A condition signaled when CLPM is unable to find a system
locally."))

(defun clpm-system-search (system-name)
  "A search function for ASDF's *SYSTEM-DEFINITION-SEARCH-FUNCTIONS* list.

Given a system name, it tries to find it using the CLPM executable (see:
*CLPM-EXECUTABLE*). If the system cannot be found, it either does nothing,
signals a condition, and/or installs the system with CLPM-INSTALL-SYSTEM (see:
*CLPM-SYSTEM-NOT-FOUND-BEHAVIOR*)."
  (unless (string-equal "asdf" system-name)
    (multiple-value-bind (output error-output exit-code)
        (run-clpm (list "find" "-VV" system-name)
                  :ignore-error-status t
                  :input nil
                  :output '(:string :stripped t)
                  :error-output '(:string :stripped t))
      (declare (ignore error-output))
      (if (= 0 exit-code)
          (pathname output)
          (ecase *clpm-system-not-found-behavior*
            (:install
             (when (clpm-install-system system-name)
               (clpm-system-search system-name)))
            (:error
             (restart-case
                 ;; The progn is necessary here to prevent RESTART-CASE from
                 ;; using WITH-CONDITION-RESTARTS to associate the restarts with
                 ;; only this condition. This becomes an issue for
                 ;; :DEFSYSTEM-DEPENDS-ON, becuase this error will be signaled
                 ;; in the middle of an ASDF DEFINE-OP and ASDF will catch it,
                 ;; wrap it, and signal a new condition. If
                 ;; WITH-CONDITION-RESTARTS is used in the expansion of this
                 ;; macro, then these restarts won't be available in the
                 ;; interactive debugger in this case.
                 (progn
                   (error 'clpm-missing-system :system-name system-name))
               (install-system ()
                 :report "Attempt to install the system"
                 (let ((*clpm-system-not-found-behavior* nil))
                   (when (clpm-install-system system-name)
                     (clpm-system-search system-name))))
               (continue ()
                 :report "Return control to ASDF"
                 nil)))
            ((nil)
             nil))))))

(defun clpm-active-p ()
  "Returns T iff 'CLPM-SYSTEM-SEARCH is registered with ASDF's search functions."
  (member 'clpm-system-search *system-definition-search-functions*))

(defun activate-clpm (&key force
                        (order :last))
  "Add 'CLPM-SYSTEM-SEARCH to ASDF's system definition search functions list.

Does nothing if CLPM-ACTIVE-P returns T and :FORCE is NIL.

:ORDER can be one of:

+ :LAST :: (default) The clpm search function is added to the end of ASDF's
 search functions.

+ :FIRST :: The CLPM search function is added to the front of ASDF's search functions."
  (when (or force
            (not (clpm-active-p)))
    (ecase order
      (:last
       (setf *system-definition-search-functions*
             (append *system-definition-search-functions* (list 'clpm-system-search))))
      (:first
       (push 'clpm-system-search *system-definition-search-functions*)))))

(defun deactivate-clpm ()
  "Removes ~clpm-system-search~ from ASDF's search functions."
  (setf *system-definition-search-functions*
        (remove 'clpm-system-search *system-definition-search-functions*)))

;; Unregister CLPM from ASDF on CLPM cleanup.
(register-clpm-cleanup-hook 'deactivate-clpm)
Loading