Loading src/ql-clpi-index.lisp 0 → 100644 +81 −0 Original line number Diff line number Diff line ;;;; Quicklisp CLPI Index ;;;; ;;;; This software is part of QL-CLPI. See README.org for more information. See ;;;; LICENSE for license information. (uiop:define-package #:ql-clpi/ql-clpi-index (:use #:cl) (:import-from #:clpi) (:export #:ql-dual-index #:ql-file-index #:ql-http-index #:ql-index #:ql-index-latest-version-synced #:ql-project-version-aliases)) (in-package #:ql-clpi/ql-clpi-index) ;; * Index (defclass ql-index (clpi:index) ((latest-version-synced :initarg :latest-version-synced :accessor ql-index-latest-version-synced))) (defclass ql-file-index (ql-index clpi:file-index) ()) (defclass ql-http-index (ql-index clpi:http-index) ()) (defclass ql-dual-index (ql-index clpi:dual-index) ()) (defmethod slot-unbound (class (index ql-index) (slot-name (eql 'latest-version-synced))) (clpi:with-open-index-object-stream (s index "ext/ql/latest-version-synced" :if-does-not-exist nil) (setf (ql-index-latest-version-synced index) (when s (clpi:with-clpi-io-syntax () (read s)))))) (defmethod clpi:index-save :after ((index ql-index)) (when (slot-boundp index 'latest-version-synced) (clpi:with-open-index-object-stream (s index "ext/ql/latest-version-synced" :direction :output :if-exists :supersede) (clpi:with-clpi-io-syntax () (write (ql-index-latest-version-synced index) :stream s) (terpri s))))) (defmethod clpi:index-project-class ((index ql-index)) 'ql-project) ;; * Projects (defclass ql-project (clpi:project) ((version-aliases :initarg :version-aliases :accessor ql-project-version-aliases))) (defmethod slot-unbound (class (project ql-project) (slot-name (eql 'version-aliases))) (clpi:with-open-index-object-stream (s (clpi:index project) (clpi:project-object-path project "ext/ql/version-aliases") :if-does-not-exist nil) (setf (ql-project-version-aliases project) (when s (clpi:with-clpi-io-syntax () (read s)))))) (defmethod clpi:project-save :after ((project ql-project)) (when (slot-boundp project 'version-aliases) (clpi:with-open-index-object-stream (s (clpi:index project) (clpi:project-object-path project "ext/ql/version-aliases") :direction :output :if-exists :supersede) (clpi:with-clpi-io-syntax () (write (ql-project-version-aliases project) :stream s) (terpri s))))) src/ql-clpi.lisp +5 −1 Original line number Diff line number Diff line Loading @@ -7,17 +7,21 @@ (:nicknames #:ql-clpi) (:use #:cl #:alexandria #:ql-clpi/ql-clpi-index #:ql-clpi/ql-dist #:ql-clpi/ql-to-clpi) (:import-from #:alexandria) (:import-from #:clpi) (:export #:ql-dist #:ql-dist-to-clpi #:ql-dual-index #:ql-file-index #:ql-http-index #:project-version-aliases)) (in-package #:ql-clpi/ql-clpi) (defun project-version-aliases (project version) "Given a PROJECT and a VERSION, return all aliases of that version string." (let ((alias-alist (clpi:metadata-value project :ql/version-aliases))) (let ((alias-alist (ql-project-version-aliases project))) (assoc-value alias-alist version :test 'equal))) src/ql-to-clpi.lisp +5 −4 Original line number Diff line number Diff line Loading @@ -7,6 +7,7 @@ (:use #:cl #:alexandria #:anaphora #:ql-clpi/ql-clpi-index #:ql-clpi/ql-dist) (:import-from #:clpi) (:import-from #:puri) Loading Loading @@ -100,7 +101,7 @@ :system-file system-file :dependencies (ql-system-dependencies ql-system)))) (clpi:system-add-system-release system system-release) (setf (clpi:metadata-value system :primary-project) (setf (clpi:system-primary-project system) (clpi:project-name project)) (clpi:system-file-add-system-release system-file system-release))) ;; Add the system files to the release. Loading @@ -114,13 +115,13 @@ ;; This release exists already from a previous dist. Add an ;; alias to the project. (push version (assoc-value (clpi:metadata-value project :ql/version-aliases) (assoc-value (ql-project-version-aliases project) (clpi:release-version previous-release) :test 'equal))))) release-map))) (defun ql-dist-to-clpi (ql-dist index &key appendable-p) (let ((*appendable-p* appendable-p) (latest-version-synced (clpi:metadata-value index :ql/latest-version-synced nil)) (latest-version-synced (ql-index-latest-version-synced index)) (versions (ql-dist-versions ql-dist)) (modified-p nil)) (dolist (version versions) Loading @@ -128,5 +129,5 @@ (string<= version latest-version-synced)) (ql-version-to-clpi ql-dist version index) (setf modified-p t) (setf (clpi:metadata-value index :ql/latest-version-synced) version))) (setf (ql-index-latest-version-synced index) version))) modified-p)) Loading
src/ql-clpi-index.lisp 0 → 100644 +81 −0 Original line number Diff line number Diff line ;;;; Quicklisp CLPI Index ;;;; ;;;; This software is part of QL-CLPI. See README.org for more information. See ;;;; LICENSE for license information. (uiop:define-package #:ql-clpi/ql-clpi-index (:use #:cl) (:import-from #:clpi) (:export #:ql-dual-index #:ql-file-index #:ql-http-index #:ql-index #:ql-index-latest-version-synced #:ql-project-version-aliases)) (in-package #:ql-clpi/ql-clpi-index) ;; * Index (defclass ql-index (clpi:index) ((latest-version-synced :initarg :latest-version-synced :accessor ql-index-latest-version-synced))) (defclass ql-file-index (ql-index clpi:file-index) ()) (defclass ql-http-index (ql-index clpi:http-index) ()) (defclass ql-dual-index (ql-index clpi:dual-index) ()) (defmethod slot-unbound (class (index ql-index) (slot-name (eql 'latest-version-synced))) (clpi:with-open-index-object-stream (s index "ext/ql/latest-version-synced" :if-does-not-exist nil) (setf (ql-index-latest-version-synced index) (when s (clpi:with-clpi-io-syntax () (read s)))))) (defmethod clpi:index-save :after ((index ql-index)) (when (slot-boundp index 'latest-version-synced) (clpi:with-open-index-object-stream (s index "ext/ql/latest-version-synced" :direction :output :if-exists :supersede) (clpi:with-clpi-io-syntax () (write (ql-index-latest-version-synced index) :stream s) (terpri s))))) (defmethod clpi:index-project-class ((index ql-index)) 'ql-project) ;; * Projects (defclass ql-project (clpi:project) ((version-aliases :initarg :version-aliases :accessor ql-project-version-aliases))) (defmethod slot-unbound (class (project ql-project) (slot-name (eql 'version-aliases))) (clpi:with-open-index-object-stream (s (clpi:index project) (clpi:project-object-path project "ext/ql/version-aliases") :if-does-not-exist nil) (setf (ql-project-version-aliases project) (when s (clpi:with-clpi-io-syntax () (read s)))))) (defmethod clpi:project-save :after ((project ql-project)) (when (slot-boundp project 'version-aliases) (clpi:with-open-index-object-stream (s (clpi:index project) (clpi:project-object-path project "ext/ql/version-aliases") :direction :output :if-exists :supersede) (clpi:with-clpi-io-syntax () (write (ql-project-version-aliases project) :stream s) (terpri s)))))
src/ql-clpi.lisp +5 −1 Original line number Diff line number Diff line Loading @@ -7,17 +7,21 @@ (:nicknames #:ql-clpi) (:use #:cl #:alexandria #:ql-clpi/ql-clpi-index #:ql-clpi/ql-dist #:ql-clpi/ql-to-clpi) (:import-from #:alexandria) (:import-from #:clpi) (:export #:ql-dist #:ql-dist-to-clpi #:ql-dual-index #:ql-file-index #:ql-http-index #:project-version-aliases)) (in-package #:ql-clpi/ql-clpi) (defun project-version-aliases (project version) "Given a PROJECT and a VERSION, return all aliases of that version string." (let ((alias-alist (clpi:metadata-value project :ql/version-aliases))) (let ((alias-alist (ql-project-version-aliases project))) (assoc-value alias-alist version :test 'equal)))
src/ql-to-clpi.lisp +5 −4 Original line number Diff line number Diff line Loading @@ -7,6 +7,7 @@ (:use #:cl #:alexandria #:anaphora #:ql-clpi/ql-clpi-index #:ql-clpi/ql-dist) (:import-from #:clpi) (:import-from #:puri) Loading Loading @@ -100,7 +101,7 @@ :system-file system-file :dependencies (ql-system-dependencies ql-system)))) (clpi:system-add-system-release system system-release) (setf (clpi:metadata-value system :primary-project) (setf (clpi:system-primary-project system) (clpi:project-name project)) (clpi:system-file-add-system-release system-file system-release))) ;; Add the system files to the release. Loading @@ -114,13 +115,13 @@ ;; This release exists already from a previous dist. Add an ;; alias to the project. (push version (assoc-value (clpi:metadata-value project :ql/version-aliases) (assoc-value (ql-project-version-aliases project) (clpi:release-version previous-release) :test 'equal))))) release-map))) (defun ql-dist-to-clpi (ql-dist index &key appendable-p) (let ((*appendable-p* appendable-p) (latest-version-synced (clpi:metadata-value index :ql/latest-version-synced nil)) (latest-version-synced (ql-index-latest-version-synced index)) (versions (ql-dist-versions ql-dist)) (modified-p nil)) (dolist (version versions) Loading @@ -128,5 +129,5 @@ (string<= version latest-version-synced)) (ql-version-to-clpi ql-dist version index) (setf modified-p t) (setf (clpi:metadata-value index :ql/latest-version-synced) version))) (setf (ql-index-latest-version-synced index) version))) modified-p))