diff --git a/Makefile.am b/Makefile.am index 8073e0a..d5bb509 100644 --- a/Makefile.am +++ b/Makefile.am @@ -117,7 +117,8 @@ dist_sql_DATA = \ src/sql/upgrade-12.sql \ src/sql/upgrade-13.sql \ src/sql/upgrade-14.sql \ - src/sql/upgrade-15.sql + src/sql/upgrade-15.sql \ + src/sql/upgrade-16.sql dist_css_DATA = \ src/static/css/choices.min.css \ diff --git a/doc/cuirass.texi b/doc/cuirass.texi index 41dddc5..4c160c3 100644 --- a/doc/cuirass.texi +++ b/doc/cuirass.texi @@ -239,6 +239,15 @@ the lowest. Build every job for each system in this list. By default only the current system is selected. +@item @code{properties} (default: @code{'()}) +Arbitrary properties written as an association list (or ``alist''), +which can be used to convey additional information about the +specification. + +You can store any information you like in properties, but you must make +sure that this is serializable. For example, the properties alist +cannot contain records. + @end table @end deftp @@ -1417,6 +1426,9 @@ the lowest. The systems for which build jobs must be evaluated, as a comma separated list. +@item properties +Arbitrary properties written as a Scheme association alist. + @end table @section Checkouts diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 5444f5d..af927eb 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -575,7 +575,7 @@ RETURNING (specification, revision);")) (match (expect-one-row (exec-query/bind db "\ INSERT INTO Specifications (name, build, channels, \ -build_outputs, notifications, period, priority, systems, is_active) \ +build_outputs, notifications, period, priority, systems, is_active, properties) \ VALUES (" (specification-name spec) ", " (specification-build spec) ", " @@ -586,7 +586,9 @@ build_outputs, notifications, period, priority, systems, is_active) \ (specification-priority spec) ", " (specification-systems spec) ", " (bool->int - (specification-is-active? spec)) ") + (specification-is-active? spec)) ", " + (object->string + (specification-properties spec)) ") ON CONFLICT(name) DO UPDATE SET build = " (specification-build spec) ", channels = " channels ", @@ -594,7 +596,8 @@ build_outputs = " build-outputs ", notifications = " notifications ", period = " (specification-period spec) ", priority = " (specification-priority spec) ", -systems = " (specification-systems spec) +systems = " (specification-systems spec) ", +properties = " (object->string (specification-properties spec)) "RETURNING name;")) ((name) name) (else #f))))) @@ -629,17 +632,17 @@ DELETE FROM Specifications WHERE name=" name ";"))) ((rows (if name (exec-query/bind db " SELECT name, build, channels, build_outputs, notifications,\ -period, priority, systems, is_active \ +period, priority, systems, is_active, properties \ FROM Specifications WHERE name =" name ";") (exec-query db " SELECT name, build, channels, build_outputs, notifications,\ -period, priority, systems, is_active \ +period, priority, systems, is_active, properties \ FROM Specifications ORDER BY name ASC;"))) (specs '())) (match rows (() (reverse specs)) (((name build channels build-outputs notifications - period priority systems is-active?) + period priority systems is-active? properties-text) . rest) (loop rest (let ((is-active? @@ -663,7 +666,9 @@ FROM Specifications ORDER BY name ASC;"))) (period (string->number period)) (priority (string->number priority)) (systems (with-input-from-string systems read)) - (is-active? is-active?)) + (is-active? is-active?) + (properties (call-with-input-string properties-text + read))) specs))))))))) (define-enumeration evaluation-status diff --git a/src/cuirass/specification.scm b/src/cuirass/specification.scm index 7b237e6..7d6307c 100644 --- a/src/cuirass/specification.scm +++ b/src/cuirass/specification.scm @@ -50,6 +50,7 @@ specification-notifications specification-systems specification-is-active? + specification-properties specification->sexp sexp->specification @@ -166,7 +167,9 @@ (systems specification-systems ;list of strings (default (list (%current-system)))) (is-active? specification-is-active? ;boolean - (default #t))) + (default #t)) + (properties specification-properties + (default '()))) (define (specification->sexp spec) "Return an sexp describing SPEC." diff --git a/src/schema.sql b/src/schema.sql index e98eea3..a5bb461 100644 --- a/src/schema.sql +++ b/src/schema.sql @@ -13,7 +13,8 @@ CREATE TABLE Specifications ( period INTEGER NOT NULL DEFAULT 0, priority INTEGER NOT NULL DEFAULT 0, systems TEXT NOT NULL, - is_active INTEGER NOT NULL DEFAULT 1 + is_active INTEGER NOT NULL DEFAULT 1, + properties TEXT NOT NULL DEFAULT '()' ); CREATE TABLE Evaluations ( diff --git a/src/sql/upgrade-16.sql b/src/sql/upgrade-16.sql new file mode 100644 index 0000000..a9202a5 --- /dev/null +++ b/src/sql/upgrade-16.sql @@ -0,0 +1,5 @@ +BEGIN TRANSACTION; + +ALTER TABLE Specifications ADD COLUMN properties TEXT NOT NULL DEFAULT '()'; + +COMMIT; diff --git a/tests/database.scm b/tests/database.scm index f836d4f..2dcc68f 100644 --- a/tests/database.scm +++ b/tests/database.scm @@ -76,7 +76,8 @@ (list (email (from "from") (to "to") - (server (mailer))))))) + (server (mailer))))) + (properties '((test-spec? . #t))))) (define (make-dummy-instances fakesha1 fakesha2) (list @@ -201,7 +202,9 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0, 0);") (build-outputs (specification-build-outputs spec))) (and (eq? (specification-name spec) 'guix) (equal? (map channel-name channels) '(guix my-channel)) - (equal? (map build-output-job build-outputs) '("job")))))) + (equal? (map build-output-job build-outputs) '("job")) + (equal? (specification-properties spec) + (specification-properties example-spec)))))) (test-equal "db-add-evaluation" '(2 3)