diff options
| -rw-r--r-- | bin/evaluate.in | 14 | ||||
| -rw-r--r-- | src/cuirass/database.scm | 26 | ||||
| -rw-r--r-- | src/schema.sql | 11 | ||||
| -rw-r--r-- | tests/database.scm | 23 |
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)))) |