diff options
| -rw-r--r-- | bin/cuirass.in | 21 | ||||
| -rw-r--r-- | src/cuirass/database.scm | 32 | ||||
| -rw-r--r-- | tests/database.scm | 18 |
3 files changed, 61 insertions, 10 deletions
diff --git a/bin/cuirass.in b/bin/cuirass.in index dad2239..fb4023c 100644 --- a/bin/cuirass.in +++ b/bin/cuirass.in @@ -118,10 +118,11 @@ if required." (compile (string-append (%package-cachedir) "/" (assq-ref spec #:name))) (with-store store - (let* ((id (db-add-specification db spec)) - (spec* (acons #:id id spec)) - (jobs (evaluate store db spec*))) - (db-add-evaluation db jobs) + (let* ((jobs (evaluate store db spec))) + (for-each (λ (job) + (or (evaluation-exists? db job) + (db-add-evaluation db job))) + jobs) (set-build-options store #:use-substitutes? #f) (build-packages store db jobs)))) jobspecs)) @@ -158,8 +159,10 @@ if required." (set-current-module (make-user-module)) (primitive-load (car specfile)))))) (with-database db - (if one-shot? - (process-specs db specs) - (while #t - (process-specs db specs) - (sleep interval)))))))))) + (for-each (λ (spec) (db-add-specification db spec)) specs) + (let ((specs* (db-get-specifications db))) + (if one-shot? + (process-specs db specs*) + (while #t + (process-specs db specs*) + (sleep interval))))))))))) diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 6c354bb..4405f6e 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -18,6 +18,8 @@ (define-module (cuirass database) #:use-module (cuirass config) + #:use-module (cuirass utils) + #:use-module (ice-9 match) #:use-module (ice-9 rdelim) #:use-module (sqlite3) #:export (;; Procedures. @@ -26,6 +28,8 @@ db-open db-close db-add-specification + db-get-specifications + evaluation-exists? db-add-evaluation db-get-evaluation db-delete-evaluation @@ -115,6 +119,32 @@ INSERT INTO Specifications\ (assq-refs spec '(#:branch #:tag #:commit) "NULL"))) (last-insert-rowid db)) +(define (db-get-specifications db) + (let loop ((rows (sqlite-exec db "SELECT * FROM Specifications;")) + (specs '())) + (match rows + (() specs) + ((#(id name url load-path file proc args branch tag rev) . rest) + (loop rest + (cons `((#:id . ,id) + (#:name . ,name) + (#:url . ,url) + (#:load-path . ,load-path) + (#:file . ,file) + (#:proc . ,(with-input-from-string proc read)) + (#:arguments . ,(with-input-from-string args read)) + (#:branch . ,branch) + (#:tag . ,(if (string=? tag "NULL") #f tag)) + (#: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) "Store a derivation result in database DB and return its ID." (sqlite-exec db "\ @@ -126,7 +156,7 @@ INSERT INTO Evaluations (derivation, job_name, specification)\ (define (db-get-evaluation 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 Evaluations WHERE derivation='~A';" id))) (define (db-delete-evaluation db id) "Delete a job in database DB which corresponds to ID." diff --git a/tests/database.scm b/tests/database.scm index 964cd00..39f9fcc 100644 --- a/tests/database.scm +++ b/tests/database.scm @@ -20,6 +20,18 @@ (use-modules (cuirass database) (srfi srfi-64)) +(define example-spec + '((#:id . 1) + (#:name . "guix") + (#:url . "git://git.savannah.gnu.org/guix.git") + (#:load-path . ".") + (#:file . "/tmp/gnu-system.scm") + (#:proc . hydra-jobs) + (#:arguments (subset . "hello")) + (#:branch . "master") + (#:tag . #f) + (#:commit . #f))) + (define* (make-dummy-job #:optional (name "foo")) `((#:name . ,name) (#:derivation . ,(string-append name ".drv")) @@ -56,6 +68,12 @@ INSERT INTO Evaluations (derivation, job_name, specification)\ VALUES ('drv3', 'job3', 3);") (sqlite-exec (%db) "SELECT * FROM Evaluations;"))) + (test-equal "db-add-specification" + example-spec + (begin + (db-add-specification (%db) example-spec) + (car (db-get-specifications (%db))))) + (test-assert "db-add-evaluation" (let* ((job (make-dummy-job)) (key (assq-ref job #:derivation))) |