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

Adapt for updated CLPI spec

parent 250259bf
Loading
Loading
Loading
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)))))
+5 −1
Original line number Diff line number Diff line
@@ -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)))
+5 −4
Original line number Diff line number Diff line
@@ -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))