Commit 322a3a25 authored by Eric Timmons's avatar Eric Timmons

Update spec to remove `index` object

Replace it with append friendly project-index and system-index
parent dd5c165b
#+TITLE: CLPI Specification v0.4
#+AUTHOR: clpm-devel@common-lisp.net
#+AUTHOR: Eric Timmons
#+EMAIL: clpm-devel@common-lisp.net
This document provides the specification of version 0.4 of the Common Lisp
Project Index.
......@@ -40,43 +41,51 @@ the secondary.
+ =clpi-version= :: Required. A string naming the version of the CLPI
specification used by this index. Must be ="0.4"= for this version of the
spec.
+ =project-index-object-version= :: An integer or NIL/missing whose purpose is
further described in [[*Project index]].
+ =system-index-object-version= :: An integer or NIL/missing whose purpose is
further described in [[*System index]].
* Index
* Project index
The object =index= must exist. This object is a lightweight summary of all
projects, systems, and releases contained within the index. It contains a
single plist with the keys:
The object =project-index= or =project-index-PROJECT-INDEX-OBJECT-VERSION=
must exist, where =PROJECT-INDEX-OBJECT-VERSION= is defined in the [[*Index
metadata]]. If the project index object version is NIL/not provided, only the
former must exist, otherwise the latter must exist.
+ =:projects= :: A list of project information, described in [[*Project index]].
+ =:systems= :: A list of system information, described in [[*System index]].
Each form in this object is a list where the first element is a project name
(string). The rest is a list of strings naming versions of releases of this
project.
It is allowed for a project to be named with no releases.
It is allowed for a project to appear multiple times in this object. If it
does, all the releases should be combined after reading.
As this object is typically fetched from the primary by the secondaries on a
regular basis, other keys (including in sub plists) are allowed, but
discouraged in order to keep the size to a minimum.
If =PROJECT-INDEX-OBJECT-VERSION= is non-NIL, this file must only be appended
to.
** Project index
* System index
This list contains all projects defined within the index as well as each
project's releases. Each element in the project index must be of the form
=(project-name . project-plist)= where =project-name= is a string naming the
project and =project-plist= is a plist containing the following keys:
The object =system-index= or =system-index-SYSTEM-INDEX-OBJECT-VERSION=
must exist, where =SYSTEM-INDEX-OBJECT-VERSION= is defined in the [[*Index
metadata]]. If the system index object version is NIL/not provided, only the
former must exist, otherwise the latter must exist.
+ =:releases= :: A list of strings providing the versions of each release of
the project.
Each form in this object is a list where the first element is a system name
(string). The rest is a list of lists describing releases of this
system. Each element is a list with one or two member. The first member is a
[[*Project release description]]. The second element is the ASD version of
the system (if one is defined). If the second element is missing, it is
assumed the ASD version of the system is =NIL=.
** System index
It is allowed for a system to be named with no releases.
This list contains the names of all systems defined within the index as well
as which project releases provide them. Every element in the system index
must be of the form =(system-name . system-plist)=, where =system-name= is a
string containing the name of the system and =system-plist= is a list
containing the following keys:
It is allowed for a system to appear multiple times in this object. If it
does, all the releases should be combined after reading.
= =:releases= :: A list of releases of the system. Each element is a list
with one or two members. The first member is a [[*Project release description]].
The second element is the ASD version of the system (if one is defined). If
the second element is missing, it is assumed the ASD version of the system
is =NIL=.
If =SYSTEM-INDEX-OBJECT-VERSION= is non-NIL, this file must only be appended
to.
* Project metadata
......
......@@ -15,6 +15,8 @@
#:index-plist
#:index-project
#:index-project-class
#:index-project-index-object-path
#:index-project-index-object-version
#:index-project-missing
#:index-project-missing-index
#:index-project-missing-project-name
......@@ -25,6 +27,8 @@
#:index-system
#:index-system-class
#:index-system-file-class
#:index-system-index-object-path
#:index-system-index-object-version
#:index-system-missing
#:index-system-missing-index
#:index-system-missing-system-name
......@@ -73,7 +77,7 @@
slots. This is not called as part of INITIALIZE-INSTANCE in order to allow work
to be defered until first access instead of instantiation."))
(defgeneric index-initialize-internal (index &key projects systems &allow-other-keys)
(defgeneric index-initialize-internal (index projects systems)
(:documentation
"Performs initialization of the index using the data read from the index
object."))
......@@ -98,6 +102,14 @@ signaled."))
(:documentation
"Return the class used to instantiate projects for INDEX."))
(defgeneric index-project-index-object-path (index)
(:documentation
"Return the path of the INDEX's project-index object."))
(defgeneric index-project-index-object-version (index)
(:documentation
"Return the version of the INDEX's project-index object."))
(defgeneric index-project-names (index)
(:documentation
"Return a list of the names of projects in INDEX."))
......@@ -130,6 +142,14 @@ signaled."))
(:documentation
"Return the class used to instantiate system files for INDEX."))
(defgeneric index-system-index-object-path (index)
(:documentation
"Return the path of the INDEX's system-index object."))
(defgeneric index-system-index-object-version (index)
(:documentation
"Return the version of the INDEX's system-index object."))
(defgeneric index-system-names (index)
(:documentation
"Return a list of the names of systems in INDEX."))
......
......@@ -6,6 +6,7 @@
(uiop:define-package #:clpi/index
(:use #:cl
#:alexandria
#:anaphora
#:clpi/defs
#:clpi/object-store-dual
#:clpi/project
......@@ -27,10 +28,28 @@
:accessor index-version
:documentation
"The version of the CLPI spec to which this index adhears.")
(project-index-object-version
:accessor index-project-index-object-version
:documentation
"The version of the project-index object.")
(system-index-object-version
:accessor index-system-index-object-version
:documentation
"The version of the system-index object.")
(system-ht
:accessor index-system-ht
:documentation
"Maps system names to system instances."))
"Maps system names to system instances.")
(new-projects
:initform nil
:accessor index-new-projects
:documentation
"A list of new projects added to the index.")
(new-systems
:initform nil
:accessor index-new-systems
:documentation
"A list of new systems added to the index."))
(:documentation
"The base class for an index. Contains a mapping from project (system) names
to projects (systems). Each map slot starts as unbound, when first accessed, the
......@@ -44,7 +63,9 @@ project-index and system-index files are read to instantiate the objects."))
(gethash (project-name project) (index-project-ht index))
(when (and exists-p (not (eql project existing-project)))
(error "Project already exists!"))
(setf (gethash (project-name project) (index-project-ht index)) project))
(unless exists-p
(push project (index-new-projects index))
(setf (gethash (project-name project) (index-project-ht index)) project)))
index)
(defmethod index-add-system ((index index) system)
......@@ -52,41 +73,70 @@ project-index and system-index files are read to instantiate the objects."))
(gethash (system-name system) (index-system-ht index))
(when (and exists-p (not (eql system existing-system)))
(error "System already exists!"))
(setf (gethash (system-name system) (index-system-ht index)) system))
(unless exists-p
(push system (index-new-systems index))
(setf (gethash (system-name system) (index-system-ht index)) system)))
index)
(defmethod index-project-index-object-path ((index index))
(let ((version (index-project-index-object-version index)))
(if version
(uiop:strcat "project-index-" (write-to-string version))
"project-index")))
(defmethod index-system-index-object-path ((index index))
(let ((version (index-system-index-object-version index)))
(if version
(uiop:strcat "system-index-" (write-to-string version))
"system-index")))
(defmethod index-initialize ((index index))
(let (contents)
(let ((projects (make-hash-table :test 'equal))
(systems (make-hash-table :test 'equal)))
(with-open-object-stream (s (index-object-store index) "clpi-version" :if-does-not-exist nil)
(if s
(with-clpi-io-syntax ()
(setf (index-version index) (read s)))
(setf (index-version index) "0.4")))
(with-open-object-stream (s (index-object-store index) "index" :if-does-not-exist nil)
(with-open-object-stream (s (index-object-store index) "project-index-object-version"
:if-does-not-exist nil)
(setf (index-project-index-object-version index) (when s (with-clpi-io-syntax () (read s)))))
(with-open-object-stream (s (index-object-store index) "system-index-object-version"
:if-does-not-exist nil)
(setf (index-system-index-object-version index) (when s (with-clpi-io-syntax () (read s)))))
(with-open-object-stream (s (index-object-store index) (index-project-index-object-path index)
:if-does-not-exist nil)
(when s
(with-clpi-io-syntax ()
(setf contents (read s)))))
(apply #'index-initialize-internal index contents)))
(with-stream-forms (f s)
(destructuring-bind (project-name &rest versions)
f
(setf (gethash project-name projects) (append versions (gethash project-name projects)))))))
(with-open-object-stream (s (index-object-store index) (index-system-index-object-path index)
:if-does-not-exist nil)
(when s
(with-stream-forms (f s)
(destructuring-bind (system-name &rest versions)
f
(setf (gethash system-name systems) (append versions (gethash system-name systems)))))))
(index-initialize-internal index projects systems)))
(defmethod index-initialize-internal ((index index) &key projects systems &allow-other-keys)
(defmethod index-initialize-internal ((index index) projects systems)
(let ((project-ht (make-hash-table :test 'equal))
(system-ht (make-hash-table :test 'equal)))
(dolist (project-description projects)
(destructuring-bind (name &rest plist)
project-description
(setf (gethash name project-ht)
(apply #'make-instance (index-project-class index)
:index index
:name name
plist))))
(dolist (system-description systems)
(destructuring-bind (name &rest plist)
system-description
(setf (gethash name system-ht)
(apply #'make-instance (index-system-class index)
:index index
:name name
plist))))
(maphash (lambda (project-name project-versions)
(setf (gethash project-name project-ht)
(make-instance (index-project-class index)
:index index
:name project-name
:releases project-versions)))
projects)
(maphash (lambda (system-name system-versions)
(setf (gethash system-name system-ht)
(make-instance (index-system-class index)
:index index
:name system-name
:releases system-versions)))
systems)
(setf (slot-value index 'project-ht) project-ht
(slot-value index 'system-ht) system-ht)))
......@@ -116,28 +166,118 @@ project-index and system-index files are read to instantiate the objects."))
(hash-table-values (index-project-ht index)))
(defmethod index-save ((index index))
(dolist (p (index-projects index))
(project-save p))
(dolist (s (index-systems index))
(system-save s))
(with-open-object-stream (s (index-object-store index) "clpi-version"
:direction :output
:if-exists :supersede)
(with-clpi-io-syntax ()
(write "0.4" :stream s)
(terpri s)))
(let ((plist (index-plist index)))
(with-open-object-stream (s (index-object-store index) "index"
(let ((project-added-release-versions-ht (make-hash-table))
(project-removed-release-versions-ht (make-hash-table))
project-index-object-version-bumped
(system-added-release-versions-ht (make-hash-table))
(system-removed-release-versions-ht (make-hash-table))
system-index-object-version-bumped)
(dolist (p (index-projects index))
;; First, figure out the added and removed project releases.
(awhen (project-added-release-versions p)
(setf (gethash p project-added-release-versions-ht) it))
(awhen (project-removed-release-versions p)
(setf (gethash p project-removed-release-versions-ht) it))
;; Then write to disk.
(project-save p))
(dolist (s (index-systems index))
;; First, figure out the added and removed system releases.
(awhen (system-added-system-release-descriptions s)
(setf (gethash s system-added-release-versions-ht) it))
(awhen (system-removed-system-release-descriptions s)
(setf (gethash s system-removed-release-versions-ht) it))
;; Then write to disk.
(system-save s))
(with-open-object-stream (s (index-object-store index) "clpi-version"
:direction :output
:if-exists :supersede)
(with-clpi-io-syntax ()
(pprint plist s)))))
(write "0.4" :stream s)
(terpri s)))
;; Determine if the project-index version needs to be updated.
(when (and (index-project-index-object-version index)
(not (zerop (hash-table-count project-removed-release-versions-ht))))
(incf (index-project-index-object-version index))
(setf project-index-object-version-bumped t))
;; Determine if the project-index version needs to be updated.
(when (and (index-system-index-object-version index)
(not (zerop (hash-table-count system-removed-release-versions-ht))))
(incf (index-system-index-object-version index))
(setf system-index-object-version-bumped t))
;; Write the project-index. If we bumped the version or the version is NIL,
;; we need to write the whole file.
(if (or (null (index-project-index-object-version index))
project-index-object-version-bumped)
(with-open-object-stream (s (index-object-store index) (index-project-index-object-path index)
:direction :output
:if-exists :supersede)
(dolist (p (index-projects index))
(with-clpi-io-syntax ()
(write (list* (project-name p) (project-versions p)) :stream s)
(terpri s))))
(with-open-object-stream (s (index-object-store index) (index-project-index-object-path index)
:direction :output
:if-exists :append)
(dolist (p (index-new-projects index))
(with-clpi-io-syntax ()
(write (list* (project-name p) (project-versions p)) :stream s)
(terpri s))
(remhash p project-added-release-versions-ht))
(maphash (lambda (project added-versions)
(with-clpi-io-syntax ()
(write (list* (project-name project) added-versions) :stream s)
(terpri s)))
project-added-release-versions-ht)))
(setf (index-new-projects index) nil)
(awhen (index-project-index-object-version index)
(with-open-object-stream (s (index-object-store index) "project-index-object-version"
:direction :output
:if-exists :supersede)
(write it :stream s)))
;; Write the system-index. If we bumped the version or the version is NIL,
;; we need to write the whole file.
(if (or (null (index-system-index-object-version index))
system-index-object-version-bumped)
(with-open-object-stream (s (index-object-store index) (index-system-index-object-path index)
:direction :output
:if-exists :supersede)
(dolist (system (index-systems index))
(with-clpi-io-syntax ()
(write (list* (system-name system) (system-system-release-descriptions system)) :stream s)
(terpri s))))
(with-open-object-stream (s (index-object-store index) (index-system-index-object-path index)
:direction :output
:if-exists :append)
(dolist (system (index-new-systems index))
(with-clpi-io-syntax ()
(write (list* (system-name system) (system-system-release-descriptions system)) :stream s)
(terpri s))
(remhash system system-added-release-versions-ht))
(maphash (lambda (system added-versions)
(with-clpi-io-syntax ()
(write (list* (system-name system) added-versions) :stream s)
(terpri s)))
system-added-release-versions-ht)))
(setf (index-new-systems index) nil)
(awhen (index-system-index-object-version index)
(with-open-object-stream (s (index-object-store index) "system-index-object-version"
:direction :output
:if-exists :supersede)
(write it :stream s))))
(values))
(defmethod index-sync ((index index))
(let ((object-store (index-object-store index)))
(when (typep object-store 'dual-object-store)
(dual-object-store-update-object object-store "clpi-version")
(dual-object-store-update-object object-store "index")
(dual-object-store-update-object object-store "project-index-object-version")
(dual-object-store-update-object object-store "system-index-object-version")
(dual-object-store-update-object object-store (index-project-index-object-path index))
(dual-object-store-update-object object-store (index-system-index-object-path index))
(dolist (p (index-projects index))
(dual-object-store-update-object object-store (project-object-path p "repo"))
(dual-object-store-update-object object-store (project-object-path p "authors"))
......
......@@ -37,7 +37,9 @@ store, the secondary is updated from the primary and then the secondary is read.
(defun path-appendable-p (path)
(let ((file-namestring (file-namestring path)))
(starts-with-subseq "releases-" file-namestring)))
(or (starts-with-subseq "releases-" file-namestring)
(starts-with-subseq "project-index-" file-namestring)
(starts-with-subseq "system-index-" file-namestring))))
(defun dual-object-store-update-object (object-store path)
(let* ((primary (dual-object-store-primary object-store))
......
......@@ -7,6 +7,7 @@
(:use #:cl)
(:export #:project
#:project-add-release
#:project-added-release-versions
#:project-changes-appendable-p
#:project-commit-new-releases-to-stream!
#:project-dirty-p
......@@ -25,6 +26,7 @@
#:project-release-class
#:project-releases
#:project-releases-path
#:project-removed-release-versions
#:project-repo
#:project-save
#:project-version-scheme
......@@ -58,6 +60,11 @@
(:documentation
"Add a new release to PROJECT."))
(defgeneric project-added-release-versions (project)
(:documentation
"Returns a list of strings naming new versions of the PROJECT added since it
was last saved."))
(defgeneric project-changes-appendable-p (project)
(:documentation
"Returns a boolean indicating if the changes made to the project can be
......@@ -112,6 +119,11 @@ NIL."))
(:documentation
"Returns the path to the PROJECT's releases object in its index."))
(defgeneric project-removed-release-versions (project)
(:documentation
"Returns a list of strings naming versions of the PROJECT removed since it
was last saved."))
(defgeneric project-repo (project)
(:documentation
"Returns the source repository for PROJECT."))
......
......@@ -85,6 +85,14 @@ instantiated."))
(push (cons :add-release new-release) (project-release-deltas project))
project)
(defmethod project-added-release-versions ((project project))
(mapcar (compose #'release-version #'cdr)
(remove-if-not (lambda (x) (eql (car x) :add-release)) (project-release-deltas project))))
(defmethod project-removed-release-versions ((project project))
;; We don't allow removing releases yet.
nil)
(defmethod project-changes-appendable-p ((project project))
(every (lambda (x)
(eql (car x) :add-release))
......@@ -148,11 +156,10 @@ instantiated."))
(mapcar (curry #'project-release project) (project-versions project)))
(defmethod project-releases-path ((project project))
(let ((releases-object-version (project-releases-object-version project))
(project-name (project-name project)))
(let ((releases-object-version (project-releases-object-version project)))
(if releases-object-version
(uiop:strcat "projects/" project-name "/releases-" (write-to-string releases-object-version))
(uiop:strcat "projects/" project-name "/releases"))))
(project-object-path project (uiop:strcat "releases-" (write-to-string releases-object-version)))
(project-object-path project (uiop:strcat "releases")))))
(defmethod project-save ((project project))
(when (project-dirty-p project)
......
......@@ -7,6 +7,7 @@
(:use #:cl)
(:export #:system
#:system-add-system-release
#:system-added-system-release-descriptions
#:system-index-plist
#:system-name
#:system-no-such-version
......@@ -15,7 +16,9 @@
#:system-object-path
#:system-primary-project
#:system-save
#:system-system-release-descriptions
#:system-releases
#:system-removed-system-release-descriptions
#:system-version-release-names
#:system-version-releases
#:system-versions))
......@@ -38,6 +41,11 @@
(:documentation
"Add a new system release to SYSTEM."))
(defgeneric system-added-system-release-descriptions (system)
(:documentation
"Returns a list of system release descriptions naming new versions of the
SYSTEM added since it was last saved."))
(defgeneric system-index-plist (system)
(:documentation
"Return a plist for describing the SYSTEM in an index."))
......@@ -60,10 +68,19 @@ If ERROR is non-NIL (default), a PROJECT-MISSING-VERSION condition is signaled
if a release object cannot be instantiated due to missing information in the
index. Otherwise, then such releases are silently dropped."))
(defgeneric system-removed-system-release-descriptions (system)
(:documentation
"Returns a list of system release descriptions naming versions of the SYSTEM
removed since it was last saved."))
(defgeneric system-save (system)
(:documentation
"Save the SYSTEM's data to objects in the index."))
(defgeneric system-system-release-descriptions (system)
(:documentation
"Returns a list describing all the system releases of SYSTEM."))
(defgeneric system-version-release-names (system version &optional error)
(:documentation
"Return a list of release names that provide VERSION of SYSTEM. A release
......
......@@ -33,7 +33,10 @@ contained in that release.")
:reader system-version-release-ht
:documentation
"Maps system versions to a list of releases (as two element lists) that
provide that version.")))
provide that version.")
(system-release-deltas
:initform nil
:accessor system-system-release-deltas)))
(defmethod initialize-instance :after ((system system) &key releases &allow-other-keys)
(let ((release-version-ht (make-hash-table :test 'equal))
......@@ -64,9 +67,28 @@ provide that version.")))
(system-release-version new-system-release))
(setf (gethash (system-release-version new-system-release)
(system-version-release-ht system))
release-spec))
release-spec)
(push (cons :add (if (system-release-version new-system-release)
(list release-spec (system-release-version new-system-release))
(list release-spec)))
(system-system-release-deltas system)))
system)
(defmethod system-added-system-release-descriptions ((system system))
(mapcar #'cdr
(remove-if-not (lambda (x) (eql (car x) :add)) (system-system-release-deltas system))))
(defmethod system-removed-system-release-descriptions ((system system))
;; We don't support removing system releases yet.
nil)
(defmethod system-system-release-descriptions ((system system))
(let (out)
(maphash (lambda (k v)
(push (if v (list k v) (list k)) out))
(system-release-version-ht system))
out))
(defmethod system-index-plist ((system system))
(let ((out nil)
system-release-versions)
......@@ -97,7 +119,8 @@ provide that version.")))
:if-exists :supersede)
(with-clpi-io-syntax ()
(write (system-primary-project system) :stream s)
(terpri s)))))
(terpri s))))
(setf (system-system-release-deltas system) nil))
(defmethod system-version-release-names ((system system) version &optional (error t))
(multiple-value-bind (names exists-p) (gethash version (system-version-release-ht system))
......
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