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.

2 files changed, 88 insertions, 37 deletions

diff --git a/bin/cuirass.in b/bin/cuirass.in
index b7c9144..11eb975 100644
--- a/bin/cuirass.in
+++ b/bin/cuirass.in
@@ -9,6 +9,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
 ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;;
 ;;; This file is part of Cuirass.
 ;;;
@@ -42,7 +43,6 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
       --one-shot            Evaluate and build jobs only once
       --cache-directory=DIR Use DIR for storing repository data
       --fallback            Fall back to building when the substituter fails.
-  -L  --load-path=DIR       Prepend DIR to Guix package module search path.
   -S  --specifications=SPECFILE
                             Add specifications from SPECFILE to database.
   -D  --database=DB         Use DB to store build results.
@@ -59,7 +59,6 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
 (define %options
   '((one-shot                         (value #f))
     (cache-directory                  (value #t))
-    (load-path      (single-char #\L) (value #t))
     (specifications (single-char #\S) (value #t))
     (database       (single-char #\D) (value #t))
     (port           (single-char #\p) (value #t))
@@ -88,8 +87,6 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
          (%package-database (option-ref opts 'database (%package-database)))
          (%package-cachedir
           (option-ref opts 'cache-directory (%package-cachedir)))
-         (%guix-package-path
-          (option-ref opts 'load-path (%guix-package-path)))
          (%use-substitutes? (option-ref opts 'use-substitutes #f))
          (%fallback? (option-ref opts 'fallback #f)))
       (cond
diff --git a/bin/evaluate.in b/bin/evaluate.in
index 86d0e83..3f08b92 100644
--- a/bin/evaluate.in
+++ b/bin/evaluate.in
@@ -27,32 +27,96 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
 
 ;; Note: Do not use any Guix modules (see below).
 (use-modules (ice-9 match)
-             (ice-9 pretty-print))
+             (ice-9 pretty-print)
+             (srfi srfi-1)
+             (srfi srfi-26))
 
 (define (ref module name)
   "Dynamically link variable NAME under MODULE and return it."
   (let ((m (resolve-interface module)))
     (module-ref m name)))
 
-(define %not-colon
-  (char-set-complement (char-set #\:)))
+(define (absolutize directory load-path)
+  (if (string-prefix? "/" load-path)
+      load-path
+      (string-append directory "/" load-path)))
+
+(define (input-checkout checkouts input-name)
+  "Find in CHECKOUTS the CHECKOUT corresponding to INPUT-NAME, and return it."
+  (find (lambda (checkout)
+          (string=? (assq-ref checkout #:name)
+                    input-name))
+        checkouts))
+
+(define (spec-source spec checkouts)
+  "Find in CHECKOUTS the directory where the #:PROC-INPUT repository of SPEC
+has been checked out, and return it."
+  (let* ((input-name (assq-ref spec #:proc-input))
+         (checkout (input-checkout checkouts input-name)))
+    (assq-ref checkout #:directory)))
+
+(define (spec-load-path spec checkouts)
+  "Find in CHECKOUTS the load paths of each SPEC's #:LOAD-PATH-INPUTS and
+return them as a list."
+  (map (lambda (input-name)
+         (let* ((checkout (input-checkout checkouts input-name))
+                (directory (assq-ref checkout #:directory))
+                (load-path (assq-ref checkout #:load-path)))
+           (absolutize directory load-path)))
+       (assq-ref spec #:load-path-inputs)))
+
+(define (spec-package-path spec checkouts)
+  "Find in CHECKOUTS the package paths of each SPEC's #:PACKAGE-PATH-INPUTS
+and return them as a colon separated string."
+  (let* ((input-names (assq-ref spec #:package-path-inputs))
+         (checkouts (map (cut input-checkout checkouts <>) input-names)))
+    (string-join
+     (map
+      (lambda (checkout)
+        (let ((directory (assq-ref checkout #:directory))
+              (load-path (assq-ref checkout #:load-path)))
+          (absolutize directory load-path)))
+      checkouts)
+     ":")))
+
+(define (format-checkouts checkouts)
+  "Format checkouts the way Hydra does: #:NAME becomes the key as a symbol,
+#:DIRECTORY becomes FILE-NAME and #:COMMIT becomes REVISION.  The other
+entries are added because they could be useful during the evaluation."
+  (map
+   (lambda (checkout)
+     (let loop ((in checkout)
+                (out '())
+                (name #f))
+       (match in
+         (()
+          (cons name out))
+         (((#:name . val) . rest)
+          (loop rest out (string->symbol val)))
+         (((#:directory . val) . rest)
+          (loop rest (cons `(file-name . ,val) out) name))
+         (((#:commit . val) . rest)
+          (loop rest (cons `(revision . ,val) out) name))
+         (((keyword . val) . rest)
+          (loop rest (cons `(,(keyword->symbol keyword) . ,val) out) name)))))
+   checkouts))
 
 (define* (main #:optional (args (command-line)))
   (match args
-    ((command load-path guix-package-path source specstr)
+    ((command spec-str checkouts-str)
      ;; Load FILE, a Scheme file that defines Hydra jobs.
      ;;
-     ;; Until FILE is loaded, we must *not* load any Guix module because
-     ;; SOURCE may be providing its own, which could differ from ours--this is
-     ;; the case when SOURCE is a Guix checkout.  The 'ref' procedure helps us
-     ;; achieve this.
-     (let ((%user-module (make-fresh-user-module))
-           (spec         (with-input-from-string specstr read))
-           (stdout       (current-output-port))
-           (stderr       (current-error-port))
-           (load-path    (string-tokenize load-path %not-colon)))
-       (unless (string-null? guix-package-path)
-         (setenv "GUIX_PACKAGE_PATH" guix-package-path))
+     ;; Until FILE is loaded, we must *not* load any Guix module because the
+     ;; user may be providing its own with #:LOAD-PATH-INPUTS, which could
+     ;; differ from ours.  The 'ref' procedure helps us achieve this.
+     (let* ((%user-module (make-fresh-user-module))
+            (spec (with-input-from-string spec-str read))
+            (checkouts (with-input-from-string checkouts-str read))
+            (source (spec-source spec checkouts))
+            (file (assq-ref spec #:proc-file))
+            (stdout (current-output-port))
+            (stderr (current-error-port)))
+       (setenv "GUIX_PACKAGE_PATH" (spec-package-path spec checkouts))
 
        ;; Since we have relative file name canonicalization by default, better
        ;; change to SOURCE to make sure things like 'include' with relative
@@ -60,13 +124,13 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
        (chdir source)
 
        ;; Change '%load-path' once and for all.  We need it to be effective
-       ;; both when we load SPEC's #:file and when we later call the thunks.
-       (set! %load-path (append load-path %load-path))
+       ;; both when we load FILE and when we later call the thunks.
+       (set! %load-path (append (spec-load-path spec checkouts) %load-path))
 
        (save-module-excursion
         (lambda ()
           (set-current-module %user-module)
-          (primitive-load (assq-ref spec #:file))))
+          (primitive-load file)))
 
        ;; From there on we can access Guix modules.
 
@@ -93,22 +157,12 @@ building things during evaluation~%")
                           (apply real-build-things store args))))
 
          ;; Call the entry point of FILE and print the resulting job sexp.
-         ;; Among the arguments, always pass 'file-name' and 'revision' like
-         ;; Hydra does.
-         (let* ((proc-name (assq-ref spec #:proc))
-                (proc    (module-ref %user-module proc-name))
-                (commit  (assq-ref spec #:current-commit))
-                (name    (assq-ref spec #:name))
-                (args    `((guix
-                            (revision . ,commit)
-                            (file-name . ,source))
-                           ,@(or (assq-ref spec #:arguments) '())))
-                (thunks  (proc store args))
-                (eval    `((#:specification . ,name)
-                           (#:revision . ,commit))))
+         (let* ((proc (module-ref %user-module (assq-ref spec #:proc)))
+                (args `(,@(format-checkouts checkouts)
+                        ,@(or (assq-ref spec #:proc-args) '())))
+                (thunks (proc store args)))
            (pretty-print
-            `(evaluation ,eval
-                         ,(map (lambda (thunk) (thunk))
+            `(evaluation ,(map (lambda (thunk) (thunk))
                                thunks))
             stdout)))))
     ((command _ ...)