Skip to content
Snippets Groups Projects
Commit bf758b88 authored by Eric Timmons's avatar Eric Timmons
Browse files

Adapt for updated CLPI spec

parent 250259bf
No related branches found
No related tags found
No related merge requests found
;;;; 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)))))
......@@ -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)))
......@@ -7,6 +7,7 @@
(:use #:cl
#:alexandria
#:anaphora
#:ql-clpi/ql-clpi-index
#:ql-clpi/ql-dist)
(:import-from #:clpi)
(:import-from #:puri)
......@@ -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.
......@@ -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)
......@@ -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))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment