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 | |
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')
-rw-r--r-- | src/cuirass/base.scm | 214 | ||||
-rw-r--r-- | src/cuirass/database.scm | 115 | ||||
-rw-r--r-- | src/cuirass/utils.scm | 1 | ||||
-rw-r--r-- | src/schema.sql | 28 | ||||
-rw-r--r-- | src/sql/upgrade-1.sql | 78 |
5 files changed, 279 insertions, 157 deletions
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm index 9985fd6..82f49a4 100644 --- a/src/cuirass/base.scm +++ b/src/cuirass/base.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org> ;;; ;;; This file is part of Cuirass. ;;; @@ -38,6 +39,7 @@ #:use-module (ice-9 receive) #:use-module (ice-9 atomic) #:use-module (ice-9 ftw) + #:use-module (ice-9 threads) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) @@ -47,7 +49,8 @@ #:use-module (rnrs bytevectors) #:export (;; Procedures. call-with-time-display - fetch-repository + fetch-input + fetch-inputs compile evaluate clear-build-queue @@ -56,9 +59,7 @@ build-packages prepare-git process-specs - set-guix-package-path! ;; Parameters. - %guix-package-path %package-cachedir %use-substitutes? %fallback?)) @@ -139,10 +140,11 @@ values." (lambda (key err) (report-git-error err)))) -(define* (fetch-repository store spec #:key writable-copy?) - "Get the latest version of repository specified in SPEC. Return two -values: the content of the git repository at URL copied into a store -directory and the sha1 of the top level commit in this directory. +(define* (fetch-input store input #:key writable-copy?) ;TODO fix desc + "Get the latest version of repository inputified in INPUT. Return an +association list containing the input name, the content of the git repository +at URL copied into a store directory and the sha1 of the top level commit in +this directory. When WRITABLE-COPY? is true, return a writable copy; otherwise, return a read-only directory." @@ -153,15 +155,15 @@ read-only directory." branch (string-append "origin/" branch))) - (let ((name (assq-ref spec #:name)) - (url (assq-ref spec #:url)) - (branch (and=> (assq-ref spec #:branch) + (let ((name (assq-ref input #:name)) + (url (assq-ref input #:url)) + (branch (and=> (assq-ref input #:branch) (lambda (b) `(branch . ,(add-origin b))))) - (commit (and=> (assq-ref spec #:commit) + (commit (and=> (assq-ref input #:commit) (lambda (c) `(commit . ,c)))) - (tag (and=> (assq-ref spec #:tag) + (tag (and=> (assq-ref input #:tag) (lambda (t) `(tag . ,t))))) (let-values (((directory commit) @@ -171,12 +173,16 @@ read-only directory." ;; TODO: When WRITABLE-COPY? is true, we could directly copy the ;; checkout directly in a writable location instead of copying it to the ;; store first. - (values (if writable-copy? - (make-writable-copy directory - (string-append (%package-cachedir) - "/" (assq-ref spec #:name))) - directory) - commit)))) + (let ((directory (if writable-copy? + (make-writable-copy directory + (string-append + (%package-cachedir) "/" name)) + directory))) + `((#:name . ,name) + (#:directory . ,directory) + (#:commit . ,commit) + (#:load-path . ,(assq-ref input #:load-path)) + (#:no-compile? . ,(assq-ref input #:no-compile?))))))) (define (make-writable-copy source target) "Create TARGET and make it a writable copy of directory SOURCE; delete @@ -242,9 +248,9 @@ fibers." (logior (@ (fibers epoll) EPOLLERR) (@ (fibers epoll) EPOLLHUP))))) -(define (evaluate store db spec source) - "Evaluate and build package derivations defined in SPEC, using the checkout -in SOURCE directory. Return a list of jobs." +(define (evaluate store db spec checkouts commits) + "Evaluate and build package derivations defined in SPEC, using CHECKOUTS. +Return a list of jobs." (define (augment-job job eval-id) (let ((drv (read-derivation-from-file (assq-ref job #:derivation)))) @@ -253,26 +259,10 @@ in SOURCE directory. Return a list of jobs." (#:system . ,(derivation-system drv)) ,@job))) - (define (tokenize str) - (string-tokenize str (char-set-complement (char-set #\:)))) - - (define load-path - (match (assq-ref spec #:load-path) - (#f - "") - ((= tokenize path) - (string-join (map (lambda (entry) - (if (string-prefix? "/" entry) - entry - (string-append source "/" entry))) - path) - ":")))) - (let* ((port (non-blocking-port (open-pipe* OPEN_READ "evaluate" - load-path - (%guix-package-path) - source (object->string spec)))) + (object->string spec) + (object->string checkouts)))) (result (match (read/non-blocking port) ;; If an error occured during evaluation report it, ;; otherwise, suppose that data read from port are @@ -284,11 +274,12 @@ in SOURCE directory. Return a list of jobs." (data data)))) (close-pipe port) (match result - (('evaluation eval jobs) - (let ((eval-id (db-add-evaluation db eval))) - (log-message "created evaluation ~a for ~a, commit ~a" eval-id - (assq-ref eval #:specification) - (assq-ref eval #:revision)) + (('evaluation jobs) + (let* ((spec-name (assq-ref spec #:name)) + (eval-id (db-add-evaluation + db `((#:specification . ,spec-name) + (#:commits . ,commits))))) + (log-message "created evaluation ~a for '~a'" eval-id spec-name) (let ((jobs (map (lambda (job) (augment-job job eval-id)) jobs))) @@ -610,70 +601,83 @@ procedure is meant to be called at startup." (when (or directory file) (set-tls-certificate-locations! directory file))))) +(define (compile? checkout) + (not (assq-ref checkout #:no-compile?))) + +(define (fetch-inputs spec) + "Fetch all inputs of SPEC in parallel." + (let* ((inputs (assq-ref spec #:inputs)) + (thunks + (map + (lambda (input) + (lambda () + (with-store store + (log-message "fetching input '~a' of spec '~a'" + (assq-ref input #:name) + (assq-ref spec #:name)) + (fetch-input store input + #:writable-copy? (compile? input))))) + inputs)) + (results (par-map %non-blocking thunks))) + (map (lambda (checkout) + (log-message "fetched input '~a' of spec '~a' (commit ~s)" + (assq-ref checkout #:name) + (assq-ref spec #:name) + (assq-ref checkout #:commit)) + checkout) + results))) + +(define (compile-checkouts spec checkouts) + "Compile CHECKOUTS in parallel." + (let* ((thunks + (map + (lambda (checkout) + (lambda () + (log-message "compiling input '~a' of spec '~a' (commit ~s)" + (assq-ref checkout #:name) + (assq-ref spec #:name) + (assq-ref checkout #:commit)) + (compile checkout))) + checkouts)) + (results (par-map %non-blocking thunks))) + (map (lambda (checkout) + (log-message "compiled input '~a' of spec '~a' (commit ~s)" + (assq-ref checkout #:name) + (assq-ref spec #:name) + (assq-ref checkout #:commit)) + checkout) + results))) + (define (process-specs db jobspecs) "Evaluate and build JOBSPECS and store results in DB." (define (process spec) - (define compile? - (not (assq-ref spec #:no-compile?))) - (with-store store - (let ((stamp (db-get-stamp db spec)) - (name (assoc-ref spec #:name))) - (log-message "considering spec '~a', URL '~a'" - name (assoc-ref spec #:url)) - (receive (checkout commit) - (non-blocking (fetch-repository store spec - #:writable-copy? compile?)) - (log-message "spec '~a': fetched commit ~s (stamp was ~s)" - name commit stamp) - (when commit - (unless (string=? commit stamp) - ;; Immediately mark COMMIT as being processed so we don't spawn - ;; a concurrent evaluation of that same commit. - (db-add-stamp db spec commit) - - (when compile? - (non-blocking (compile checkout))) - - (spawn-fiber - (lambda () - (guard (c ((evaluation-error? c) - (log-message "failed to evaluate spec '~s'" - (evaluation-error-spec-name c)) - #f)) - (log-message "evaluating '~a' with commit ~s" - name commit) - (with-store store - (with-database db - (let* ((spec* (acons #:current-commit commit spec)) - (jobs (evaluate store db spec* checkout))) - (log-message "building ~a jobs for '~a'" - (length jobs) name) - (build-packages store db jobs))))))) - - ;; 'spawn-fiber' returns zero values but we need one. - *unspecified*)))))) + (let* ((stamp (db-get-stamp db spec)) + (name (assoc-ref spec #:name)) + (checkouts (fetch-inputs spec)) + (commits (map (cut assq-ref <> #:commit) checkouts)) + (commits-str (string-join commits))) + (unless (equal? commits-str stamp) + ;; Immediately mark SPEC's INPUTS as being processed so we don't + ;; spawn a concurrent evaluation of that same commit. + (db-add-stamp db spec commits-str) + (compile-checkouts spec (filter compile? checkouts)) + (spawn-fiber + (lambda () + (guard (c ((evaluation-error? c) + (log-message "failed to evaluate spec '~a'" + (evaluation-error-spec-name c)) + #f)) + (log-message "evaluating spec '~a': stamp ~s different from ~s" + name commits-str stamp) + (with-store store + (with-database db + (let ((jobs (evaluate store db spec checkouts commits))) + (log-message "building ~a jobs for '~a'" + (length jobs) name) + (build-packages store db jobs))))))) + + ;; 'spawn-fiber' returns zero values but we need one. + *unspecified*)))) (for-each process jobspecs)) - - -;;; -;;; Guix package path. -;;; - -(define %guix-package-path - ;; Extension of package modules search path. - (make-parameter "")) - -(define (set-guix-package-path! path) - "Use PATH to find custom packages not defined in (gnu packages ...) -namespace or not already present in current Guile load paths. PATH is -expected to be a colon-separated string of directories." - (define (set-paths! dir) - (%package-module-path (cons dir (%package-module-path))) - (%patch-path (cons dir (%patch-path))) - (set! %load-path (cons dir %load-path)) - (set! %load-compiled-path (cons dir %load-compiled-path))) - - (let ((dirs (parse-path path))) - (for-each set-paths! dirs))) 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)))))) diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm index d219a3e..6629bc1 100644 --- a/src/cuirass/utils.scm +++ b/src/cuirass/utils.scm @@ -39,6 +39,7 @@ call-with-critical-section with-critical-section + %non-blocking non-blocking essential-task bytevector-range)) diff --git a/src/schema.sql b/src/schema.sql index 65aebbd..eb0f7e9 100644 --- a/src/schema.sql +++ b/src/schema.sql @@ -1,30 +1,40 @@ BEGIN TRANSACTION; CREATE TABLE Specifications ( - repo_name TEXT NOT NULL PRIMARY KEY, + name TEXT NOT NULL PRIMARY KEY, + load_path_inputs TEXT NOT NULL, -- list of input names whose load path will be in Guile's %load-path + package_path_inputs TEXT NOT NULL, -- list of input names whose load paths will be in GUIX_PACKAGE_PATH + proc_input TEXT NOT NULL, -- name of the input containing the proc that does the evaluation + proc_file TEXT NOT NULL, -- file containing the procedure that does the evaluation, relative to proc_input + proc TEXT NOT NULL, -- defined in proc_file + proc_args TEXT NOT NULL -- passed to proc +); + +CREATE TABLE Inputs ( + specification TEXT NOT NULL, + name TEXT NOT NULL, url TEXT NOT NULL, load_path TEXT NOT NULL, - file TEXT NOT NULL, - proc TEXT NOT NULL, - arguments TEXT NOT NULL, -- The following columns are optional. branch TEXT, tag TEXT, revision TEXT, - no_compile_p INTEGER + no_compile_p INTEGER, + PRIMARY KEY (specification, name), + FOREIGN KEY (specification) REFERENCES Specifications (name) ); CREATE TABLE Stamps ( specification TEXT NOT NULL PRIMARY KEY, stamp TEXT NOT NULL, - FOREIGN KEY (specification) REFERENCES Specifications (repo_name) + FOREIGN KEY (specification) REFERENCES Specifications (name) ); CREATE TABLE Evaluations ( id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, specification TEXT NOT NULL, - revision TEXT NOT NULL, - FOREIGN KEY (specification) REFERENCES Specifications (repo_name) + commits TEXT NOT NULL, + FOREIGN KEY (specification) REFERENCES Specifications (name) ); CREATE TABLE Derivations ( @@ -63,7 +73,7 @@ CREATE TABLE Builds ( -- Create indexes to speed up common queries, in particular those -- corresponding to /api/latestbuilds and /api/queue HTTP requests. CREATE INDEX Builds_Derivations_index ON Builds(status ASC, timestamp ASC, id, derivation, evaluation, stoptime DESC); -CREATE INDEX Specifications_index ON Specifications(repo_name, branch); +CREATE INDEX Inputs_index ON Inputs(specification, name, branch); CREATE INDEX Derivations_index ON Derivations(derivation, evaluation, job_name, system); COMMIT; diff --git a/src/sql/upgrade-1.sql b/src/sql/upgrade-1.sql new file mode 100644 index 0000000..7874f94 --- /dev/null +++ b/src/sql/upgrade-1.sql @@ -0,0 +1,78 @@ +BEGIN TRANSACTION; + +DROP INDEX Specifications_index; + +ALTER TABLE Specifications RENAME TO tmp_Specifications; +ALTER TABLE Stamps RENAME TO tmp_Stamps; +ALTER TABLE Evaluations RENAME TO tmp_Evaluations; + +CREATE TABLE Specifications ( + name TEXT NOT NULL PRIMARY KEY, + load_path_inputs TEXT NOT NULL, -- list of input names whose load path will be in Guile's %load-path + package_path_inputs TEXT NOT NULL, -- list of input names whose load paths will be in GUIX_PACKAGE_PATH + proc_input TEXT NOT NULL, -- name of the input containing the proc that does the evaluation + proc_file TEXT NOT NULL, -- file containing the procedure that does the evaluation, relative to proc_input + proc TEXT NOT NULL, -- defined in proc_file + proc_args TEXT NOT NULL -- passed to proc +); + +CREATE TABLE Inputs ( + specification TEXT NOT NULL, + name TEXT NOT NULL, + url TEXT NOT NULL, + load_path TEXT NOT NULL, + -- The following columns are optional. + branch TEXT, + tag TEXT, + revision TEXT, + no_compile_p INTEGER, + PRIMARY KEY (specification, name), + FOREIGN KEY (specification) REFERENCES Specifications (name) +); + +CREATE TABLE Stamps ( + specification TEXT NOT NULL PRIMARY KEY, + stamp TEXT NOT NULL, + FOREIGN KEY (specification) REFERENCES Specifications (name) +); + +CREATE TABLE Evaluations ( + id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, + specification TEXT NOT NULL, + commits TEXT NOT NULL, + FOREIGN KEY (specification) REFERENCES Specifications (name) +); + +INSERT INTO Specifications (name, load_path_inputs, package_path_inputs, proc_input, proc_file, proc, proc_args) +SELECT printf('%s-%s', repo_name, branch) AS name, + printf('("%s")', repo_name) AS load_path_inputs, + '()' AS package_path_inputs, + repo_name AS proc_input, + file AS proc_file, + proc, + arguments AS proc_args +FROM tmp_Specifications; + +INSERT INTO Inputs (specification, name, url, load_path, branch, tag, revision, no_compile_p) +SELECT printf('%s-%s', repo_name, branch) AS specification, + repo_name AS name, + url, load_path, branch, tag, revision, no_compile_p +FROM tmp_Specifications; + +INSERT INTO Stamps (specification, stamp) +SELECT Specifications.name AS specification, stamp +FROM tmp_Stamps +LEFT JOIN Specifications ON Specifications.proc_input = tmp_Stamps.specification; + +INSERT INTO Evaluations (id, specification, commits) +SELECT id, Specifications.name AS specification, revision +FROM tmp_Evaluations +LEFT JOIN Specifications ON Specifications.proc_input = tmp_Evaluations.specification; + +CREATE INDEX Inputs_index ON Inputs(specification, name, branch); + +DROP TABLE tmp_Specifications; +DROP TABLE tmp_Stamps; +DROP TABLE tmp_Evaluations; + +COMMIT; |