Commit bf758b88 authored by Eric Timmons's avatar Eric Timmons
Browse files

Adapt for updated CLPI spec

parent 250259bf
;;;; 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))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment