guix/guix-cuirass
2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git synced 2023-12-14 06:03:04 +01:00
Code Issues Releases Wiki Activity

schema: Separate "Derivations" from "Evaluations".

Browse source 
* 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.
This commit is contained in:
Mathieu Lirzin 2016-07-26 16:53:57 +02:00
parent 0225d69642
commit d493a58823
No known key found for this signature in database
GPG key ID: 0ADEE10094604D37
4 changed files with 38 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
bin/evaluate.in
View file

@ -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)

26
src/cuirass/database.scm
View file

@ -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."

11
src/schema.sql
View file

@ -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,

23
tests/database.scm
View file

@ -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))))