Loading cli/commands/clpi/release.lisp +7 −122 Original line number Diff line number Diff line Loading @@ -5,16 +5,10 @@ (uiop:define-package #:clpm-cli/commands/clpi/release (:use #:cl #:alexandria #:clpm-cli/common-args #:clpm-cli/commands/clpi/common #:clpm-cli/interface-defs #:clpm/context #:clpm/groveler #:clpm/requirement #:clpm/source #:clpm/utils #:do-urlencode) #:clpm) (:import-from #:adopt) (:import-from #:jsown) (:import-from #:uiop Loading Loading @@ -46,129 +40,20 @@ with an HTTP client to submit the data to a CLPI server.") (defparameter *clpi-release-ui* (adopt:make-interface :name "clpm clpi systems" :summary "Print systems forms for CLPI" :name "clpm clpi release" :summary "Print a json description of the release for a CLPI server" :usage "clpi systems [options]" :help *help-string* :contents (list *group-common* *option-asds* *option-deps-from-lockfile*))) (defun sort-dependencies (deps) (labels ((find-system-name (dep) (if (listp dep) (ecase (first dep) (:version (second dep)) (:feature (find-system-name (third dep))) (:require (second dep))) dep))) (sort (copy-list (remove-duplicates deps :test #'equal)) #'string< :key #'find-system-name))) (defun asdf-feature-expression-to-jsown (f) (if (listp f) (ecase (first f) ((:and :or) (jsown:new-js ("type" (string-downcase (symbol-name (first f)))) ("features" (mapcar #'asdf-feature-expression-to-jsown (rest f))))) (:not (jsown:new-js ("type" "not") ("feature" (asdf-feature-expression-to-jsown (second f)))))) (string-downcase (symbol-name f)))) (defgeneric asdf-complex-dep-to-jsown (type args)) (defmethod asdf-complex-dep-to-jsown ((type (eql :feature)) args) (jsown:new-js ("type" "feature") ("featureExpression" (asdf-feature-expression-to-jsown (first args))) ("dependency" (second args)))) (defmethod asdf-complex-dep-to-jsown ((type (eql :require)) args) (jsown:new-js ("type" "require") ("name" (first args)))) (defmethod asdf-complex-dep-to-jsown ((type (eql :version)) args) (jsown:new-js ("type" "version") ("name" (first args)) ("version" (second args)))) (defun asdf-dep-to-jsown (dep) (if (stringp dep) dep (asdf-complex-dep-to-jsown (first dep) (rest dep)))) (define-cli-command (("clpi" "release") *clpi-release-ui*) (arguments options) (destructuring-bind (project-name project-version release-url) arguments (let ((asds (gethash :asds options)) (*active-groveler* (make-groveler)) (deps-from-lockfile-p (gethash :deps-from-lockfile options)) (context) system-objs) (when deps-from-lockfile-p (setf context (load-anonymous-context-from-pathname (merge-pathnames "clpmfile.lock")))) (uiop:with-safe-io-syntax () (let ((*print-case* :downcase)) (dolist (asd asds) (let ((absolute-asd-pathname (merge-pathnames asd))) ;; Load the asd into the groveler (handler-bind ((groveler-dependency-missing (lambda (c) (when context (let* ((missing-system-spec (groveler-dependency-missing-system c)) (missing-req (convert-asd-system-spec-to-req missing-system-spec)) (missing-system-name (requirement-name missing-req)) (matching-sr (find missing-system-name (context-system-releases context) :test #'equal :key (compose #'system-name #'system-release-system)))) (when (and matching-sr (system-release-satisfies-version-spec-p matching-sr (requirement-version-spec missing-req))) (groveler-add-asd-and-retry (system-release-absolute-asd-pathname matching-sr)))))))) (active-groveler-load-asd absolute-asd-pathname)) (dolist (system-name (active-groveler-systems-in-file absolute-asd-pathname)) (destructuring-bind (&key depends-on version defsystem-depends-on loaded-systems license description &allow-other-keys) (active-groveler-system-deps system-name) (let ((all-deps (append depends-on defsystem-depends-on loaded-systems)) (system-obj (jsown:new-js ("name" system-name) ("systemFile" asd)))) (when version (jsown:extend-js system-obj ("version" version))) (when description (jsown:extend-js system-obj ("description" description))) (when license (jsown:extend-js system-obj ("license" (uiop:with-safe-io-syntax () (write-to-string license))))) (when all-deps (jsown:extend-js system-obj ("dependencies" (mapcar #'asdf-dep-to-jsown all-deps)))) (push system-obj system-objs)))))))) (write-string (jsown:to-json (jsown:new-js ("projectName" project-name) ("version" project-version) ("url" release-url) ("archiveType" "tar.gz") ("systems" system-objs)))) (deps-from-lockfile-p (gethash :deps-from-lockfile options))) (write-string (jsown:to-json (clpm:make-release-jsown project-name project-version release-url asds :clpmfile (when deps-from-lockfile-p (merge-pathnames "clpmfile"))))) (terpri *standard-output*))) t) clpm/clpi.lisp 0 → 100644 +129 −0 Original line number Diff line number Diff line ;;;; CLPI Server Integration - EXPERIMENTAL ;;;; ;;;; This software is part of CLPM. See README.org for more information. See ;;;; LICENSE for license information. (uiop:define-package #:clpm/clpi (:use #:cl #:alexandria #:clpm/context #:clpm/groveler #:clpm/requirement #:clpm/source) (:import-from #:jsown) (:export #:make-release-jsown)) (in-package #:clpm/clpi) (defun sort-dependencies (deps) (labels ((find-system-name (dep) (if (listp dep) (ecase (first dep) (:version (second dep)) (:feature (find-system-name (third dep))) (:require (second dep))) dep))) (sort (copy-list (remove-duplicates deps :test #'equal)) #'string< :key #'find-system-name))) (defun asdf-feature-expression-to-jsown (f) (if (listp f) (ecase (first f) ((:and :or) (jsown:new-js ("type" (string-downcase (symbol-name (first f)))) ("features" (mapcar #'asdf-feature-expression-to-jsown (rest f))))) (:not (jsown:new-js ("type" "not") ("feature" (asdf-feature-expression-to-jsown (second f)))))) (string-downcase (symbol-name f)))) (defgeneric asdf-complex-dep-to-jsown (type args)) (defmethod asdf-complex-dep-to-jsown ((type (eql :feature)) args) (jsown:new-js ("type" "feature") ("featureExpression" (asdf-feature-expression-to-jsown (first args))) ("dependency" (second args)))) (defmethod asdf-complex-dep-to-jsown ((type (eql :require)) args) (jsown:new-js ("type" "require") ("name" (first args)))) (defmethod asdf-complex-dep-to-jsown ((type (eql :version)) args) (jsown:new-js ("type" "version") ("name" (first args)) ("version" (second args)))) (defun asdf-dep-to-jsown (dep) (if (stringp dep) dep (asdf-complex-dep-to-jsown (first dep) (rest dep)))) (defun make-release-jsown (project-name project-version release-url asds &key clpmfile) (let ((*active-groveler* (make-groveler)) system-objs) (labels ((load-into-groveler (absolute-asd-pathname clpmfile) (handler-bind ((groveler-dependency-missing (lambda (c) (when clpmfile (let* ((missing-system-spec (groveler-dependency-missing-system c)) (missing-req (convert-asd-system-spec-to-req missing-system-spec)) (missing-system-name (requirement-name missing-req)) (matching-sr (find missing-system-name (context-system-releases clpmfile) :test #'equal :key (compose #'system-name #'system-release-system)))) (when (and matching-sr (system-release-satisfies-version-spec-p matching-sr (requirement-version-spec missing-req))) (groveler-add-asd-and-retry (system-release-absolute-asd-pathname matching-sr)))))))) (active-groveler-load-asd absolute-asd-pathname))) (process-asd (asd clpmfile) (let ((absolute-asd-pathname (merge-pathnames asd))) ;; Load the asd into the groveler (load-into-groveler absolute-asd-pathname clpmfile) (dolist (system-name (active-groveler-systems-in-file absolute-asd-pathname)) (destructuring-bind (&key depends-on version defsystem-depends-on loaded-systems license description &allow-other-keys) (active-groveler-system-deps system-name) (let ((all-deps (append depends-on defsystem-depends-on loaded-systems)) (system-obj (jsown:new-js ("name" system-name) ("systemFile" asd)))) (when version (jsown:extend-js system-obj ("version" version))) (when description (jsown:extend-js system-obj ("description" description))) (when license (jsown:extend-js system-obj ("license" (uiop:with-safe-io-syntax () (write-to-string license))))) (when all-deps (jsown:extend-js system-obj ("dependencies" (mapcar #'asdf-dep-to-jsown all-deps)))) (push system-obj system-objs))))))) (if clpmfile (with-context (clpmfile) (dolist (asd asds) (process-asd asd clpmfile))) (dolist (asd asds) (process-asd asd clpmfile))) (jsown:new-js ("projectName" project-name) ("version" project-version) ("url" release-url) ("archiveType" "tar.gz") ("systems" system-objs))))) clpm/clpm.lisp +3 −0 Original line number Diff line number Diff line Loading @@ -8,6 +8,7 @@ (:use #:cl #:clpm/bundle #:clpm/client #:clpm/clpi #:clpm/config #:clpm/context-diff #:clpm/context-queries Loading @@ -26,6 +27,8 @@ #:bundle-update) ;; From client (:export #:client-asd-pathname) ;; From clpi (:export #:make-release-jsown) ;; From config (:export #:config-value) ;; From context-queries Loading Loading
cli/commands/clpi/release.lisp +7 −122 Original line number Diff line number Diff line Loading @@ -5,16 +5,10 @@ (uiop:define-package #:clpm-cli/commands/clpi/release (:use #:cl #:alexandria #:clpm-cli/common-args #:clpm-cli/commands/clpi/common #:clpm-cli/interface-defs #:clpm/context #:clpm/groveler #:clpm/requirement #:clpm/source #:clpm/utils #:do-urlencode) #:clpm) (:import-from #:adopt) (:import-from #:jsown) (:import-from #:uiop Loading Loading @@ -46,129 +40,20 @@ with an HTTP client to submit the data to a CLPI server.") (defparameter *clpi-release-ui* (adopt:make-interface :name "clpm clpi systems" :summary "Print systems forms for CLPI" :name "clpm clpi release" :summary "Print a json description of the release for a CLPI server" :usage "clpi systems [options]" :help *help-string* :contents (list *group-common* *option-asds* *option-deps-from-lockfile*))) (defun sort-dependencies (deps) (labels ((find-system-name (dep) (if (listp dep) (ecase (first dep) (:version (second dep)) (:feature (find-system-name (third dep))) (:require (second dep))) dep))) (sort (copy-list (remove-duplicates deps :test #'equal)) #'string< :key #'find-system-name))) (defun asdf-feature-expression-to-jsown (f) (if (listp f) (ecase (first f) ((:and :or) (jsown:new-js ("type" (string-downcase (symbol-name (first f)))) ("features" (mapcar #'asdf-feature-expression-to-jsown (rest f))))) (:not (jsown:new-js ("type" "not") ("feature" (asdf-feature-expression-to-jsown (second f)))))) (string-downcase (symbol-name f)))) (defgeneric asdf-complex-dep-to-jsown (type args)) (defmethod asdf-complex-dep-to-jsown ((type (eql :feature)) args) (jsown:new-js ("type" "feature") ("featureExpression" (asdf-feature-expression-to-jsown (first args))) ("dependency" (second args)))) (defmethod asdf-complex-dep-to-jsown ((type (eql :require)) args) (jsown:new-js ("type" "require") ("name" (first args)))) (defmethod asdf-complex-dep-to-jsown ((type (eql :version)) args) (jsown:new-js ("type" "version") ("name" (first args)) ("version" (second args)))) (defun asdf-dep-to-jsown (dep) (if (stringp dep) dep (asdf-complex-dep-to-jsown (first dep) (rest dep)))) (define-cli-command (("clpi" "release") *clpi-release-ui*) (arguments options) (destructuring-bind (project-name project-version release-url) arguments (let ((asds (gethash :asds options)) (*active-groveler* (make-groveler)) (deps-from-lockfile-p (gethash :deps-from-lockfile options)) (context) system-objs) (when deps-from-lockfile-p (setf context (load-anonymous-context-from-pathname (merge-pathnames "clpmfile.lock")))) (uiop:with-safe-io-syntax () (let ((*print-case* :downcase)) (dolist (asd asds) (let ((absolute-asd-pathname (merge-pathnames asd))) ;; Load the asd into the groveler (handler-bind ((groveler-dependency-missing (lambda (c) (when context (let* ((missing-system-spec (groveler-dependency-missing-system c)) (missing-req (convert-asd-system-spec-to-req missing-system-spec)) (missing-system-name (requirement-name missing-req)) (matching-sr (find missing-system-name (context-system-releases context) :test #'equal :key (compose #'system-name #'system-release-system)))) (when (and matching-sr (system-release-satisfies-version-spec-p matching-sr (requirement-version-spec missing-req))) (groveler-add-asd-and-retry (system-release-absolute-asd-pathname matching-sr)))))))) (active-groveler-load-asd absolute-asd-pathname)) (dolist (system-name (active-groveler-systems-in-file absolute-asd-pathname)) (destructuring-bind (&key depends-on version defsystem-depends-on loaded-systems license description &allow-other-keys) (active-groveler-system-deps system-name) (let ((all-deps (append depends-on defsystem-depends-on loaded-systems)) (system-obj (jsown:new-js ("name" system-name) ("systemFile" asd)))) (when version (jsown:extend-js system-obj ("version" version))) (when description (jsown:extend-js system-obj ("description" description))) (when license (jsown:extend-js system-obj ("license" (uiop:with-safe-io-syntax () (write-to-string license))))) (when all-deps (jsown:extend-js system-obj ("dependencies" (mapcar #'asdf-dep-to-jsown all-deps)))) (push system-obj system-objs)))))))) (write-string (jsown:to-json (jsown:new-js ("projectName" project-name) ("version" project-version) ("url" release-url) ("archiveType" "tar.gz") ("systems" system-objs)))) (deps-from-lockfile-p (gethash :deps-from-lockfile options))) (write-string (jsown:to-json (clpm:make-release-jsown project-name project-version release-url asds :clpmfile (when deps-from-lockfile-p (merge-pathnames "clpmfile"))))) (terpri *standard-output*))) t)
clpm/clpi.lisp 0 → 100644 +129 −0 Original line number Diff line number Diff line ;;;; CLPI Server Integration - EXPERIMENTAL ;;;; ;;;; This software is part of CLPM. See README.org for more information. See ;;;; LICENSE for license information. (uiop:define-package #:clpm/clpi (:use #:cl #:alexandria #:clpm/context #:clpm/groveler #:clpm/requirement #:clpm/source) (:import-from #:jsown) (:export #:make-release-jsown)) (in-package #:clpm/clpi) (defun sort-dependencies (deps) (labels ((find-system-name (dep) (if (listp dep) (ecase (first dep) (:version (second dep)) (:feature (find-system-name (third dep))) (:require (second dep))) dep))) (sort (copy-list (remove-duplicates deps :test #'equal)) #'string< :key #'find-system-name))) (defun asdf-feature-expression-to-jsown (f) (if (listp f) (ecase (first f) ((:and :or) (jsown:new-js ("type" (string-downcase (symbol-name (first f)))) ("features" (mapcar #'asdf-feature-expression-to-jsown (rest f))))) (:not (jsown:new-js ("type" "not") ("feature" (asdf-feature-expression-to-jsown (second f)))))) (string-downcase (symbol-name f)))) (defgeneric asdf-complex-dep-to-jsown (type args)) (defmethod asdf-complex-dep-to-jsown ((type (eql :feature)) args) (jsown:new-js ("type" "feature") ("featureExpression" (asdf-feature-expression-to-jsown (first args))) ("dependency" (second args)))) (defmethod asdf-complex-dep-to-jsown ((type (eql :require)) args) (jsown:new-js ("type" "require") ("name" (first args)))) (defmethod asdf-complex-dep-to-jsown ((type (eql :version)) args) (jsown:new-js ("type" "version") ("name" (first args)) ("version" (second args)))) (defun asdf-dep-to-jsown (dep) (if (stringp dep) dep (asdf-complex-dep-to-jsown (first dep) (rest dep)))) (defun make-release-jsown (project-name project-version release-url asds &key clpmfile) (let ((*active-groveler* (make-groveler)) system-objs) (labels ((load-into-groveler (absolute-asd-pathname clpmfile) (handler-bind ((groveler-dependency-missing (lambda (c) (when clpmfile (let* ((missing-system-spec (groveler-dependency-missing-system c)) (missing-req (convert-asd-system-spec-to-req missing-system-spec)) (missing-system-name (requirement-name missing-req)) (matching-sr (find missing-system-name (context-system-releases clpmfile) :test #'equal :key (compose #'system-name #'system-release-system)))) (when (and matching-sr (system-release-satisfies-version-spec-p matching-sr (requirement-version-spec missing-req))) (groveler-add-asd-and-retry (system-release-absolute-asd-pathname matching-sr)))))))) (active-groveler-load-asd absolute-asd-pathname))) (process-asd (asd clpmfile) (let ((absolute-asd-pathname (merge-pathnames asd))) ;; Load the asd into the groveler (load-into-groveler absolute-asd-pathname clpmfile) (dolist (system-name (active-groveler-systems-in-file absolute-asd-pathname)) (destructuring-bind (&key depends-on version defsystem-depends-on loaded-systems license description &allow-other-keys) (active-groveler-system-deps system-name) (let ((all-deps (append depends-on defsystem-depends-on loaded-systems)) (system-obj (jsown:new-js ("name" system-name) ("systemFile" asd)))) (when version (jsown:extend-js system-obj ("version" version))) (when description (jsown:extend-js system-obj ("description" description))) (when license (jsown:extend-js system-obj ("license" (uiop:with-safe-io-syntax () (write-to-string license))))) (when all-deps (jsown:extend-js system-obj ("dependencies" (mapcar #'asdf-dep-to-jsown all-deps)))) (push system-obj system-objs))))))) (if clpmfile (with-context (clpmfile) (dolist (asd asds) (process-asd asd clpmfile))) (dolist (asd asds) (process-asd asd clpmfile))) (jsown:new-js ("projectName" project-name) ("version" project-version) ("url" release-url) ("archiveType" "tar.gz") ("systems" system-objs)))))
clpm/clpm.lisp +3 −0 Original line number Diff line number Diff line Loading @@ -8,6 +8,7 @@ (:use #:cl #:clpm/bundle #:clpm/client #:clpm/clpi #:clpm/config #:clpm/context-diff #:clpm/context-queries Loading @@ -26,6 +27,8 @@ #:bundle-update) ;; From client (:export #:client-asd-pathname) ;; From clpi (:export #:make-release-jsown) ;; From config (:export #:config-value) ;; From context-queries Loading