diff options
author | Clément Lassieur <clement@lassieur.org> | 2018-06-26 11:18:23 +0200 |
---|---|---|
committer | Clément Lassieur <clement@lassieur.org> | 2018-07-16 21:33:14 +0200 |
commit | 7b2f9e0de1ad2d320973b7aea132a8afcad8bece (patch) | |
tree | 6143d4bf334b645001ebde583247125123a8c853 /src/cuirass/database.scm | |
parent | be713f8a30788861806a74865b07403aa6774117 (diff) | |
download | cuirass-7b2f9e0de1ad2d320973b7aea132a8afcad8bece.tar cuirass-7b2f9e0de1ad2d320973b7aea132a8afcad8bece.tar.gz |
Add support for multiple inputs.
* Makefile.am (dist_sql_DATA): Add src/sql/upgrade-1.sql.
* bin/cuirass.in (show-help, %options, main): Remove the LOAD-PATH option that
was used afterwards as %GUIX-PACKAGE-PATH.
* bin/evaluate.in (absolutize, input-checkout, spec-source, spec-load-path,
spec-package-path, format-checkouts): New procedures.
(%not-colon): Remove variable.
(main): Take the load path, package path and PROC from the checkouts that
result from the inputs. Format the checkouts before sending them to the
procedure. Remove the LOAD-PATH argument.
* doc/cuirass.texi (Overview, Database schema): Document the changes.
* examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
hello-subset.scm, random.scm}: Adapt to the new specification format.
* examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
(package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
the new format of its return value.
* examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
Rename the checkout from 'random (which is a specification) to 'cuirass (which
is a checkout resulting from an input).
* src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
to INPUT. Return a checkout object instead of returning two values.
(evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
SOURCE to "evaluate". Remove %GUIX-PACKAGE-PATH. Build the EVAL object
instead of getting it from "evaluate".
(compile?, fetch-inputs, compile-checkouts): New procedures.
(process-specs): Fetch all inputs instead of only fetching one repository.
The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
used as a STAMP.
(%guix-package-path, set-guix-package-path): Remove them.
* src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
(db-add-specification, db-get-specifications): Adapt to the new specification
format. Add/get all inputs as well.
(db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
separated commit hashes.
(db-get-builds): Rename REPO_NAME to NAME.
(db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
(db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
value.
(db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
* src/cuirass/utils.scm (%non-blocking): Export it.
* src/schema.sql (Inputs): New table that refers to the Specifications table.
(Specifications): Move input related fields to the Inputs table. Rename
REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_FILE.
Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
the Inputs table.
(Stamps): Rename REPO_NAME to NAME.
(Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
(Specifications_index): Replace with Inputs_index.
* src/sql/upgrade-1.sql: New file.
* tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
the new specifications format. Rename REVISION to COMMITS.
* tests/http.scm (evaluations-query-result, fill-db): Idem.
Diffstat (limited to 'src/cuirass/database.scm')
-rw-r--r-- | src/cuirass/database.scm | 115 |
1 files changed, 72 insertions, 43 deletions
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 3627d2e..72acb15 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -227,47 +227,76 @@ database object." (vector-ref (car (sqlite-exec db "SELECT last_insert_rowid();")) 0)) +(define (db-add-input db spec-name input) + (sqlite-exec db "\ +INSERT OR IGNORE INTO Inputs (specification, name, url, load_path, branch, \ +tag, revision, no_compile_p) VALUES (" + spec-name ", " + (assq-ref input #:name) ", " + (assq-ref input #:url) ", " + (assq-ref input #:load-path) ", " + (assq-ref input #:branch) ", " + (assq-ref input #:tag) ", " + (assq-ref input #:commit) ", " + (if (assq-ref input #:no-compile?) 1 0) ");") + (last-insert-rowid db)) + (define (db-add-specification db spec) - "Store specification SPEC in database DB and return its ID." + "Store SPEC in database DB. SPEC inputs are stored in the INPUTS table." (sqlite-exec db "\ -INSERT OR IGNORE INTO Specifications (repo_name, url, load_path, file, \ - proc, arguments, branch, tag, revision, no_compile_p) \ +INSERT OR IGNORE INTO Specifications (name, load_path_inputs, \ +package_path_inputs, proc_input, proc_file, proc, proc_args) \ VALUES (" (assq-ref spec #:name) ", " - (assq-ref spec #:url) ", " - (assq-ref spec #:load-path) ", " - (assq-ref spec #:file) ", " + (assq-ref spec #:load-path-inputs) ", " + (assq-ref spec #:package-path-inputs)", " + (assq-ref spec #:proc-input) ", " + (assq-ref spec #:proc-file) ", " (symbol->string (assq-ref spec #:proc)) ", " - (assq-ref spec #:arguments) ", " - (assq-ref spec #:branch) ", " - (assq-ref spec #:tag) ", " - (assq-ref spec #:commit) ", " - (if (assq-ref spec #:no-compile?) 1 0) - ");") - (last-insert-rowid db)) + (assq-ref spec #:proc-args) ");") + (let ((spec-id (last-insert-rowid db))) + (for-each (lambda (input) + (db-add-input db (assq-ref spec #:name) input)) + (assq-ref spec #:inputs)) + spec-id)) + +(define (db-get-inputs db spec-name) + (let loop ((rows (sqlite-exec db "SELECT * FROM Inputs WHERE specification=" + spec-name ";")) + (inputs '())) + (match rows + (() inputs) + ((#(specification name url load-path branch tag revision no-compile-p) + . rest) + (loop rest + (cons `((#:name . ,name) + (#:url . ,url) + (#:load-path . ,load-path) + (#:branch . ,branch) + (#:tag . ,tag) + (#:commit . ,revision) + (#:no-compile? . ,(positive? no-compile-p))) + inputs)))))) (define (db-get-specifications db) (let loop ((rows (sqlite-exec db "SELECT * FROM Specifications;")) (specs '())) (match rows (() specs) - ((#(name url load-path file proc args branch tag rev no-compile?) + ((#(name load-path-inputs package-path-inputs proc-input proc-file proc + proc-args) . rest) (loop rest (cons `((#:name . ,name) - (#:url . ,url) - (#:load-path . ,load-path) - (#:file . ,file) + (#:load-path-inputs . + ,(with-input-from-string load-path-inputs read)) + (#:package-path-inputs . + ,(with-input-from-string package-path-inputs read)) + (#:proc-input . ,proc-input) + (#:proc-file . ,proc-file) (#:proc . ,(with-input-from-string proc read)) - (#:arguments . ,(with-input-from-string args read)) - (#:branch . ,branch) - (#:tag . ,(match tag - ("NULL" #f) - (_ tag))) - (#:commit . ,(match rev - ("NULL" #f) - (_ rev))) - (#:no-compile? . ,(positive? no-compile?))) + (#:proc-args . ,(with-input-from-string proc-args read)) + (#:inputs . ,(db-get-inputs db name))) specs)))))) (define (db-add-derivation db job) @@ -298,9 +327,9 @@ INSERT INTO Derivations (derivation, job_name, system, nix_name, evaluation)\ (define (db-add-evaluation db eval) (sqlite-exec db "\ -INSERT INTO Evaluations (specification, revision) VALUES (" +INSERT INTO Evaluations (specification, commits) VALUES (" (assq-ref eval #:specification) ", " - (assq-ref eval #:revision) ");") + (string-join (assq-ref eval #:commits)) ");") (last-insert-rowid db)) (define-syntax-rule (with-database db body ...) @@ -517,14 +546,14 @@ Assumes that if group id stays the same the group headers stay the same." (stmt-text (format #f "\ SELECT Builds.id, Outputs.name, Outputs.path, Builds.timestamp, Builds.starttime, Builds.stoptime, Builds.log, Builds.status, Builds.derivation,\ Derivations.job_name, Derivations.system, Derivations.nix_name,\ -Specifications.repo_name \ +Specifications.name \ FROM Builds \ INNER JOIN Derivations ON Builds.derivation = Derivations.derivation AND Builds.evaluation = Derivations.evaluation \ INNER JOIN Evaluations ON Derivations.evaluation = Evaluations.id \ -INNER JOIN Specifications ON Evaluations.specification = Specifications.repo_name \ +INNER JOIN Specifications ON Evaluations.specification = Specifications.name \ LEFT JOIN Outputs ON Outputs.build = Builds.id \ WHERE (:id IS NULL OR (:id = Builds.id)) \ -AND (:jobset IS NULL OR (:jobset = Specifications.repo_name)) \ +AND (:jobset IS NULL OR (:jobset = Specifications.name)) \ AND (:job IS NULL OR (:job = Derivations.job_name)) \ AND (:system IS NULL OR (:system = Derivations.system)) \ AND (:status IS NULL OR (:status = 'done' AND Builds.status >= 0) OR (:status = 'pending' AND Builds.status < 0)) \ @@ -570,28 +599,28 @@ SELECT DISTINCT derivation FROM ( (let ((res (sqlite-exec db "SELECT * FROM Stamps WHERE specification=" (assq-ref spec #:name) ";"))) (match res - (() "") - ((#(spec commit)) commit)))) - -(define (db-add-stamp db spec commit) - "Associate stamp COMMIT to specification SPEC in database DB." - (if (string-null? (db-get-stamp db spec)) + (() #f) + ((#(spec stamp)) stamp)))) + +(define (db-add-stamp db spec stamp) + "Associate STAMP to specification SPEC in database DB." + (if (db-get-stamp db spec) + (sqlite-exec db "UPDATE Stamps SET stamp=" stamp + "WHERE specification=" (assq-ref spec #:name) ";") (sqlite-exec db "\ INSERT INTO Stamps (specification, stamp) VALUES (" - (assq-ref spec #:name) ", " commit ");") - (sqlite-exec db "UPDATE Stamps SET stamp=" commit - "WHERE specification=" (assq-ref spec #:name) ";"))) + (assq-ref spec #:name) ", " stamp ");"))) (define (db-get-evaluations db limit) - (let loop ((rows (sqlite-exec db "SELECT id, specification, revision + (let loop ((rows (sqlite-exec db "SELECT id, specification, commits FROM Evaluations ORDER BY id DESC LIMIT " limit ";")) (evaluations '())) (match rows (() (reverse evaluations)) - ((#(id specification revision) + ((#(id specification commits) . rest) (loop rest (cons `((#:id . ,id) (#:specification . ,specification) - (#:revision . ,revision)) + (#:commits . ,(string-tokenize commits))) evaluations)))))) |