cuirass: Use database to store specifications.

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

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

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