summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMathieu Lirzin <mthl@gnu.org>2016-07-26 16:53:57 +0200
committerMathieu Lirzin <mthl@gnu.org>2016-07-27 14:17:09 +0200
commitd493a58823aed8c556bf795d02207e57718b96c9 (patch)
tree1fbb66eda8315b3d7cfa5074049779c02462c920
parent0225d696424b0826af210fdeef770a2310252c64 (diff)
downloadcuirass-d493a58823aed8c556bf795d02207e57718b96c9.tar
cuirass-d493a58823aed8c556bf795d02207e57718b96c9.tar.gz
schema: Separate "Derivations" from "Evaluations".
* src/schema.sql (Derivations): New table. (Evaluations): Remove 'derivation' and 'job_name' columns. Add 'id' column. * src/cuirass/database.scm (db-add-evaluation): Adapt. (db-get-derivation, db-add-derivation): New procedures. (evaluation-exists?, db-get-evaluation): Delete. * bin/evaluate.in (main): Adapt. * tests/database.scm ("sqlite-exec"): Likewise. ("db-add-derivation", "db-get-derivation"): New tests. ("db-add-evaluation", "db-get-evaluation"): Delete.
-rw-r--r--bin/evaluate.in14
-rw-r--r--src/cuirass/database.scm26
-rw-r--r--src/schema.sql11
-rw-r--r--tests/database.scm23
4 files changed, 38 insertions, 36 deletions
diff --git a/bin/evaluate.in b/bin/evaluate.in
index 878732f..6c5a53f 100644
--- a/bin/evaluate.in
+++ b/bin/evaluate.in
@@ -57,17 +57,17 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(exit 1)))
(parameterize ((%package-database database))
;; Call the entry point of FILE and print the resulting job sexp.
- (let* ((proc (module-ref %user-module 'hydra-jobs))
- (thunks (proc store (assq-ref spec #:arguments)))
- (db (db-open))
- (spec-id (assq-ref spec #:id)))
+ (let* ((proc (module-ref %user-module 'hydra-jobs))
+ (thunks (proc store (assq-ref spec #:arguments)))
+ (db (db-open))
+ (spec-id (assq-ref spec #:id))
+ (eval-id (db-add-evaluation db spec-id)))
(pretty-print
(map (λ (thunk)
(let* ((job (call-with-time-display thunk))
;; Keep track of SPEC id in the returned jobs.
- (job* (acons #:spec-id spec-id job)))
- (or (evaluation-exists? db job*)
- (db-add-evaluation db job*))
+ (job* (acons #:eval-id eval-id job)))
+ (db-add-derivation db job*)
job*))
thunks)
stdout)
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 13362a5..a314704 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -31,9 +31,9 @@
db-get-specifications
db-add-stamp
db-get-stamp
- evaluation-exists?
db-add-evaluation
- db-get-evaluation
+ db-add-derivation
+ db-get-derivation
db-add-build
read-sql-file
read-quoted-string
@@ -142,25 +142,23 @@ INSERT INTO Specifications\
(#:commit . ,(if (string=? rev "NULL") #f rev)))
specs))))))
-(define (evaluation-exists? db job)
- "Check if JOB is already added to DB."
- (let ((primary-key (assq-ref job #:derivation)))
- (not (null? (sqlite-exec db "\
-SELECT * FROM Evaluations WHERE derivation='~A';"
- primary-key)))))
-
-(define (db-add-evaluation db job)
+(define (db-add-derivation db job)
"Store a derivation result in database DB and return its ID."
(sqlite-exec db "\
-INSERT INTO Evaluations (derivation, job_name, specification)\
+INSERT INTO Derivations (derivation, job_name, evaluation)\
VALUES ('~A', '~A', '~A');"
(assq-ref job #:derivation)
(assq-ref job #:job-name)
- (assq-ref job #:spec-id)))
+ (assq-ref job #:eval-id)))
-(define (db-get-evaluation db id)
+(define (db-get-derivation db id)
"Retrieve a job in database DB which corresponds to ID."
- (car (sqlite-exec db "SELECT * FROM Evaluations WHERE derivation='~A';" id)))
+ (car (sqlite-exec db "SELECT * FROM Derivations WHERE derivation='~A';" id)))
+
+(define (db-add-evaluation db spec-id)
+ (sqlite-exec db "INSERT INTO Evaluations (specification) VALUES ('~A');"
+ spec-id)
+ (last-insert-rowid db))
(define-syntax-rule (with-database db body ...)
"Run BODY with a connection to the database which is bound to DB in BODY."
diff --git a/src/schema.sql b/src/schema.sql
index d5c1f00..248f9d2 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -21,12 +21,19 @@ CREATE TABLE Stamps (
);
CREATE TABLE Evaluations (
- derivation TEXT NOT NULL PRIMARY KEY,
- job_name TEXT NOT NULL,
+ id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
specification INTEGER NOT NULL,
FOREIGN KEY (specification) REFERENCES Specifications (id)
);
+CREATE TABLE Derivations (
+ derivation TEXT NOT NULL,
+ evaluation INTEGER NOT NULL,
+ job_name TEXT NOT NULL,
+ PRIMARY KEY (derivation, evaluation),
+ FOREIGN KEY (evaluation) REFERENCES Evaluations (id)
+);
+
CREATE TABLE Builds (
id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
derivation TEXT NOT NULL,
diff --git a/tests/database.scm b/tests/database.scm
index 29a1e50..7fa9f1b 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -57,15 +57,12 @@
(test-assert "sqlite-exec"
(begin
- (sqlite-exec (%db) "\
-INSERT INTO Evaluations (derivation, job_name, specification)\
- VALUES ('drv1', 'job1', 1);")
- (sqlite-exec (%db) "\
-INSERT INTO Evaluations (derivation, job_name, specification)\
- VALUES ('drv2', 'job2', 2);")
- (sqlite-exec (%db) "\
-INSERT INTO Evaluations (derivation, job_name, specification)\
- VALUES ('drv3', 'job3', 3);")
+ (sqlite-exec (%db)
+ "INSERT INTO Evaluations (specification) VALUES (1);")
+ (sqlite-exec (%db)
+ "INSERT INTO Evaluations (specification) VALUES (2);")
+ (sqlite-exec (%db)
+ "INSERT INTO Evaluations (specification) VALUES (3);")
(sqlite-exec (%db) "SELECT * FROM Evaluations;")))
(test-equal "db-add-specification"
@@ -74,14 +71,14 @@ INSERT INTO Evaluations (derivation, job_name, specification)\
(db-add-specification (%db) example-spec)
(car (db-get-specifications (%db)))))
- (test-assert "db-add-evaluation"
+ (test-assert "db-add-derivation"
(let* ((job (make-dummy-job))
(key (assq-ref job #:derivation)))
- (db-add-evaluation (%db) job)
+ (db-add-derivation (%db) job)
(%id key)))
- (test-assert "db-get-evaluation"
- (db-get-evaluation (%db) (%id)))
+ (test-assert "db-get-derivation"
+ (db-get-derivation (%db) (%id)))
(test-assert "db-close"
(db-close (%db))))