grahamc/hydra - Change QGLBQ5IOVSMBQRXXHO4LOJG4A7V3HSUZESCP2N235A7L4VVOBKCQC

Remove hydra-eval-guile-jobs

This hasn't been used in a long time (Guix uses its own CI system), and it probably doesn't work anymore.

(cherry picked from commit 23c9ca3e94669087d463642baea0cf35a0b8d72f)

Created by Eelco Dolstra on February 15, 2020

QGLBQ5IOVSMBQRXXHO4LOJG4A7V3HSUZESCP2N235A7L4VVOBKCQC

Dependencies

In channels

upstream

main

Change contents

Deletion in .gitignore at line 18 [11.1]
B:BD[11.178] → [12.0:34]
```
/src/script/hydra-eval-guile-jobs
```
Deletion in configure.ac at line 55 [15.15951]
∅:D[13.56] → [14.60:61]
B:BD[14.60] → [14.60:61]
B:BD[16.39] → [17.0:75]
```
PKG_CHECK_MODULES([GUILE], [guile-2.0], [HAVE_GUILE=yes], [HAVE_GUILE=no])
```

Deletion in configure.ac at line 56 [15.15951]

B:BD[18.1] → [12.35:147]

if test "x$HAVE_GUILE" = xyes; then
  AC_PATH_PROG([GUILE], [guile])
else
  GUILE="guile"
fi
AC_SUBST([GUILE])

Deletion in configure.ac at line 74 [15.15951]
B:BD[15.16583] → [12.148:183]
```
  src/script/hydra-eval-guile-jobs
```

Replacement in configure.ac at line 78 [15.15951]

B:BD[19.712] → [12.184:272]

AC_CONFIG_COMMANDS([executable-scripts],
  [chmod +x src/script/hydra-eval-guile-jobs])

[19.712]

[6.34]

AC_CONFIG_COMMANDS([executable-scripts], [])

Deletion in release.nix at line 132 [20.1]
B:BD[8.2523] → [8.2523:2576]
```
          guile # optional, for Guile + Guix support
```
Deletion in src/lib/Hydra/Controller/Jobset.pm at line 226 [22.104]
B:BD[21.1668] → [17.360:475]
B:BD[17.475] → [23.11622:11697]
∅:D[24.2367] → [17.543:544]
∅:D[23.11697] → [17.543:544]
B:BD[17.543] → [17.543:544]
```
    # When the expression is in a .scm file, assume it's a Guile + Guix
    # build expression.
    my $exprType =
        $c->stash->{params}->{"nixexprpath"} =~ /.scm$/ ? "guile" : "nix";
```

File deletion: hydra-eval-guile-jobs.in, hydra-eval-guile-jobs

BF:BFD[25.2543] → [12.667:715]

BF:BFD[12.715] → [17.2679:2679]

BFD:BFD[25.2543] → [17.11339:11384]

BF:BFD[17.11384] → [17.2679:2679]

B:BD[17.2679] → [17.2680:2850]

B:BD[17.2850] → [26.0:171]

B:BD[26.171] → [3.0:227]

∅:D[26.171] → [17.3081:3082]

∅:D[3.227] → [17.3081:3082]

B:BD[17.3081] → [17.3081:3082]

B:BD[17.3082] → [3.228:294]

∅:D[3.294] → [17.3125:3183]

∅:D[12.760] → [17.3125:3183]

B:BD[17.3125] → [17.3125:3183]

B:BD[17.3183] → [27.0:66]

B:BD[27.66] → [5.0:36]

∅:D[5.36] → [17.3239:4795]

∅:D[28.60] → [17.3239:4795]

∅:D[27.66] → [17.3239:4795]

B:BD[17.3239] → [17.3239:4795]

B:BD[17.4795] → [4.0:206]

∅:D[4.206] → [17.4871:5298]

B:BD[17.4871] → [17.4871:5298]

B:BD[17.5298] → [29.0:325]

∅:D[29.325] → [17.5335:6153]

B:BD[17.5335] → [17.5335:6153]

∅:D[29.560] → [17.6153:6278]

B:BD[17.6153] → [17.6153:6278]

B:BD[17.6534] → [17.6534:6593]

B:BD[17.6593] → [28.61:260]

B:BD[28.333] → [28.333:530]

∅:D[28.530] → [17.6649:6713]

B:BD[17.6649] → [17.6649:6713]

B:BD[17.6786] → [17.6786:7337]

B:BD[17.7337] → [27.67:123]

∅:D[27.123] → [17.7392:7983]

B:BD[17.7392] → [17.7392:7983]

∅:D[2.382] → [17.7983:8036]

B:BD[17.7983] → [17.7983:8036]

B:BD[17.8036] → [29.561:653]

∅:D[29.653] → [17.8077:8113]

B:BD[17.8077] → [17.8077:8113]

B:BD[17.8113] → [29.654:744]

∅:D[29.744] → [17.8162:11279]

B:BD[17.8162] → [17.8162:11279]

B:BD[17.11279] → [29.745:995]

B:BD[17.7983] → [2.0:382]

B:BD[17.6153] → [29.326:438]

B:BD[29.438] → [7.136:209]

∅:D[7.209] → [29.504:560]

B:BD[29.504] → [29.504:560]

#!/bin/sh
# Aside from this initial boilerplate, this is actually -*- scheme -*- code.
main="(module-ref (resolve-interface '(hydra-eval-guile-jobs)) 'eval-guile-jobs)"
# Keep the host's GUILE_LOAD_PATH unchanged to allow the installed Guix to
# be used.  This moves Guix modules possibly out of control, but solves
# bootstrapping issues.
#
# Use `--fresh-auto-compile' to ignore any available .go, and force
# recompilation.  This is because checkouts in the store has mtime set to
# the epoch, and thus .go files look newer, even though they may not
# correspond.
exec ${GUILE:-@GUILE@} --no-auto-compile --fresh-auto-compile   \
  -l "$0" -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of Hydra.
;;;
;;; Hydra is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Hydra is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Hydra.  If not, see <http://www.gnu.org/licenses/>.
(define-module (hydra-eval-guile-jobs)
  #:use-module (sxml simple)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:export (job-evaluations->xml
            eval-guile-jobs))
(define (guix-variable module name)
  "Dynamically link variable NAME under Guix module MODULE and return it.
Note: this is used instead of `@', because when using `@' in an uncompiled
file, Guile tries to load the module directly as it reads the source, which
fails in our case, leading to the creation of empty (guix ...) modules."
  ;; TODO: fail with an XML error description
  (let ((m (resolve-interface `(guix ,module))))
    (module-ref m name)))
(define (%derivation-system drv)
  ;; XXX: Awful hack to workaround the fact that `derivation-system', which
  ;; is a macro, cannot be referred to dynamically.
  (struct-ref drv 3))
(define strip-store-path
  (let* ((store (or (getenv "NIX_STORE_DIR") "/nix/store"))
         (store-path-rx
          (make-regexp (string-append "^.*" (regexp-quote store)
                                      "/[^-]+-(.+)$"))))
    (lambda (path)
      (or (and=> (regexp-exec store-path-rx path)
                 (lambda (match)
                   (let ((path (match:substring match 1)))
                     path)))
          path))))
(define (derivation-path->name drv)
  "Return the base name of DRV, sans hash and `.drv' extension."
  (let ((d (strip-store-path drv)))
    (if (string-suffix? ".drv" d)
        (string-drop-right d 4)
        d)))
(define (register-gc-root drv roots-dir)
  "Register a permanent garbage collector root under ROOTS-DIR for DRV."
  (let ((root (string-append roots-dir "/" (basename drv))))
    (unless (file-exists? root)
      (symlink drv root))))
(define* (job-evaluations->sxml jobs
                                #:key gc-roots-dir)
  "Return the hydra-eval-jobs SXML form for the result of JOBS, a list of
symbol/thunk pairs."
  `(*TOP*
    (*PI* xml "version='1.0' encoding='utf-8'")
    "\n"
    (jobs "\n"
     ,@(map (match-lambda
             (((? symbol? name) . (? thunk? thunk))
              (let* ((result (save-module-excursion
                              (lambda ()
                                (set-current-module %user-module)
                                (with-output-to-port (%make-void-port "w")
                                  thunk))))
                     (drv    (assoc-ref result 'derivation)))
                (define (opt-attr xml-name name)
                  (match (assoc name result)
                    ((_ . value)
                     `((,xml-name ,value)))
                    (_
                     '())))
                ;; XXX: Add <arg ...> tags?
                `(job (@ (jobName ,name)
                         (drvPath ,drv)
                         ,@(opt-attr 'homepage 'home-page)
                         (license
                          ,(let loop ((license (assoc-ref result 'license)))
                             (match license
                               ((? struct?)
                                (struct-ref license 0))
                               ((l ...)
                                (string-join (map loop l)))
                               (_ ""))))
                         ,@(opt-attr 'description 'description)
                         (maintainers
                          ,(string-join (or (assoc-ref result 'maintainers)
                                            '())
                                        ", "))
                         (maxSilent
                          ,(number->string (or (assoc-ref result
                                                          'max-silent-time)
                                               3600)))
                         (timeout
                          ,(number->string (or (assoc-ref result 'timeout)
                                               72000)))
                         (nixName ,(derivation-path->name drv))
                         (schedulingPriority
                          ,(number->string (or (assoc-ref result
                                                          'scheduling-priority)
                                               10)))
                         (system
                          ,(call-with-input-file drv
                             (compose %derivation-system
                                      (guix-variable 'derivations
                                                     'read-derivation)))))
                      "\n"))))
            jobs))))
(define* (job-evaluations->xml jobs port
                               #:key gc-roots-dir)
  (set-port-encoding! port "UTF-8")
  (sxml->xml (job-evaluations->sxml jobs #:gc-roots-dir gc-roots-dir)
             port))
;;;
;;; Command-line entry point.
;;;
(define (parse-arguments args)
  "Traverse ARGS, a list of command-line arguments compatible with
`hydra-eval-jobs', and return the name of the file that defines the jobs, an
expression that returns the entry point in that file (a unary procedure), the
list of name/value pairs passed to that entry point, as well as a GC root
directory or #f."
  (define (module-directory dir)
    (let ((d (string-append dir "/share/guile/site/2.0")))
      (if (file-exists? d)
          d
          dir)))
  (let loop ((args      args)
             (result    '())
             (file      #f)
             (entry     'hydra-jobs)
             (roots-dir #f))
    (match args
      (()
       (if (not file)
           (error "hydra-eval-guile-jobs: no expression file given")
           (values file entry (reverse result) roots-dir)))
      (("-I" name=dir rest ...)
       (let* ((dir  (match (string-tokenize name=dir
                                            (char-set-complement (char-set
                                                                  #\=)))
                      ((_ dir) dir)
                      ((dir)   dir)))
              (dir* (module-directory dir)))
         (format (current-error-port) "adding `~a' to the load path~%" dir*)
        (set! %load-path (cons dir* %load-path))
        (set! %load-compiled-path (cons dir* %load-compiled-path)))
       (loop rest result file entry roots-dir))
      (("--argstr" name value rest ...)
       (loop rest (alist-cons (string->symbol name) value result)
             file entry roots-dir))
      (("--arg" name expr rest ...)
       (let ((value (eval (call-with-input-string expr read)
                          (current-module))))
         (loop rest (alist-cons (string->symbol name) value result)
               file entry roots-dir)))
      (("--gc-roots-dir" dir rest ...)
       (loop rest result file entry dir))
      (("-j" _ rest ...)                          ; XXX: what's this?
       (loop rest result file entry roots-dir))
      (("--entry" expr rest ...)               ; entry point, like `guile -e'
       (let ((expr (call-with-input-string expr read)))
         (loop rest result file expr roots-dir)))
      ((file rest ...)                    ; source file that defines the jobs
       (loop rest result file entry roots-dir))
      (_
       (error "hydra-eval-guile-jobs: invalid arguments" args)))))
(define %user-module
  ;; Hydra user module.
  ;; TODO: Make it a sandbox.
  (let ((m (make-module)))
    (beautify-user-module! m)
    m))
(define (eval-guile-jobs . args)
  (setlocale LC_ALL "")
  (let-values (((file entry args gc-roots-dir)
                (parse-arguments args)))
    (save-module-excursion
     (lambda ()
       (set-current-module %user-module)
       ;; The standard output must contain only XML.
       (with-output-to-port (%make-void-port "w")
         (lambda ()
           (primitive-load file)))))
    (let* ((entry (eval entry %user-module))
           (store ((guix-variable 'store 'open-connection)))
           (jobs  (entry store args)))
      (unless (string? gc-roots-dir)
        (format (current-error-port)
                "warning: --gc-roots-dir not specified~%"))
      (job-evaluations->xml jobs (current-output-port)
                            #:gc-roots-dir gc-roots-dir))))
                      ;; Resolve Guix modules lazily.
                      ,(map (match-lambda
                             ((name . path)
                              `(output (@ (name ,name) (path ,path)))))
                            ((guix-variable 'derivations
                                            'derivation-path->output-paths)
                              drv))
                (when gc-roots-dir
                  ;; Register DRV as a GC root so that it's not collected by
                  ;; the time 'hydra-queue-runner' attempts to build it.
                  (register-gc-root drv gc-roots-dir))

Replacement in src/script/Makefile.am at line 2 [15.2198648]
B:BD[12.293] → [12.293:324]
B:BD[12.346] → [12.346:373]
```
  $(distributable_scripts)			\
  hydra-eval-guile-jobs.in
```
[12.293]
[30.97]
```
  $(distributable_scripts)
```
Replacement in src/script/Makefile.am at line 19 [15.2198648]
B:BD[12.611] → [12.611:666]
```
  $(distributable_scripts)			\
  hydra-eval-guile-jobs
```
[12.611]
```
  $(distributable_scripts)
```

Replacement in src/script/hydra-eval-jobset at line 267 [32.1319]

B:BD[31.7572] → [31.7572:7859]

    my ($exprType, $value) = @_;
    my $result;
    if ($exprType eq "guile") {
        if ($value eq "true") {
            $result = "#t";
        } else {
            $result = "#f";
        }
        $result = $value;
    } else {
        $result = $value;
    }
    return $result;

[31.7572]

[31.7859]

    my ($value) = @_;
    return $value;

Replacement in src/script/hydra-eval-jobset at line 273 [32.1319]

B:BD[31.7888] → [31.7888:9575]

    my ($exprType, $input) = @_;
    my $result;
    if ($exprType eq "guile") {
        $result = "'((file-name . \"" . ${input}->{storePath} . "\")" .
            (defined $input->{revision} ? "(revision . \"" . $input->{revision} . "\")" : "") .
            (defined $input->{revCount} ? "(revision-count . " . $input->{revCount} . ")" : "") .
            (defined $input->{gitTag} ? "(git-tag . \"" . $input->{gitTag} . "\")" : "") .
            (defined $input->{shortRev} ? "(short-revision . \"" . $input->{shortRev} . "\")" : "") .
            (defined $input->{version} ? "(version . \"" . $input->{version} . "\")" : "") .
            ")";
    } else {
        $result = "{ outPath = builtins.storePath " . $input->{storePath} . "" .
            "; inputType = \"" . $input->{type} . "\"" .
            (defined $input->{uri} ? "; uri = \"" . $input->{uri} . "\"" : "") .
            (defined $input->{revNumber} ? "; rev = " . $input->{revNumber} . "" : "") .
            (defined $input->{revision} ? "; rev = \"" . $input->{revision} . "\"" : "") .
            (defined $input->{revCount} ? "; revCount = " . $input->{revCount} . "" : "") .
            (defined $input->{gitTag} ? "; gitTag = \"" . $input->{gitTag} . "\"" : "") .
            (defined $input->{shortRev} ? "; shortRev = \"" . $input->{shortRev} . "\"" : "") .
            (defined $input->{version} ? "; version = \"" . $input->{version} . "\"" : "") .
            (defined $input->{outputName} ? "; outputName = \"" . $input->{outputName} . "\"" : "") .
            (defined $input->{drvPath} ? "; drvPath = builtins.storePath " . $input->{drvPath} . "" : "") .
            ";}";
    }
    return $result;

[31.7888]

[31.9575]

    my ($input) = @_;
    return
        "{ outPath = builtins.storePath " . $input->{storePath} . "" .
        "; inputType = \"" . $input->{type} . "\"" .
        (defined $input->{uri} ? "; uri = \"" . $input->{uri} . "\"" : "") .
        (defined $input->{revNumber} ? "; rev = " . $input->{revNumber} . "" : "") .
        (defined $input->{revision} ? "; rev = \"" . $input->{revision} . "\"" : "") .
        (defined $input->{revCount} ? "; revCount = " . $input->{revCount} . "" : "") .
        (defined $input->{gitTag} ? "; gitTag = \"" . $input->{gitTag} . "\"" : "") .
        (defined $input->{shortRev} ? "; shortRev = \"" . $input->{shortRev} . "\"" : "") .
        (defined $input->{version} ? "; version = \"" . $input->{version} . "\"" : "") .
        (defined $input->{outputName} ? "; outputName = \"" . $input->{outputName} . "\"" : "") .
        (defined $input->{drvPath} ? "; drvPath = builtins.storePath " . $input->{drvPath} . "" : "") .
        ";}";

Replacement in src/script/hydra-eval-jobset at line 291 [32.1319]
B:BD[31.9598] → [31.9598:9635]
```
    my ($inputInfo, $exprType) = @_;
```
[31.9598]
[31.9635]
```
    my ($inputInfo) = @_;
```

Replacement in src/script/hydra-eval-jobset at line 308 [32.1319]

B:BD[9.1227] → [9.1227:1310]

            push @res, "--arg", $input, booleanToString($exprType, $alt->{value});

[9.1227]

[9.1310]

            push @res, "--arg", $input, booleanToString($alt->{value});

Deletion in src/script/hydra-eval-jobset at line 311 [32.1319]

B:BD[9.1360] → [9.1360:1465]

            die "input type ‘nix’ only supported for Nix-based jobsets\n" unless $exprType eq "nix";

Deletion in src/script/hydra-eval-jobset at line 314 [32.1319]

B:BD[9.1571] → [9.1571:1677]

            die "input type ‘eval’ only supported for Nix-based jobsets\n" unless $exprType eq "nix";

Replacement in src/script/hydra-eval-jobset at line 322 [32.1319]

B:BD[9.1975] → [9.1975:2052]

            push @res, "--arg", $input, buildInputToString($exprType, $alt);

[9.1975]

[9.2052]

            push @res, "--arg", $input, buildInputToString($alt);

Replacement in src/script/hydra-eval-jobset at line 331 [32.1319]

B:BD[31.11074] → [31.11074:11144]

    my ($inputInfo, $exprType, $nixExprInputName, $nixExprPath) = @_;

[31.11074]

[32.1424]

    my ($inputInfo, $nixExprInputName, $nixExprPath) = @_;

Replacement in src/script/hydra-eval-jobset at line 336 [32.1319]

B:BD[31.11509] → [31.11509:11600]

B:BD[31.11600] → [10.100:127]

    my $evaluator = ($exprType eq "guile") ? "hydra-eval-guile-jobs" : "hydra-eval-jobs";
    my @cmd = ($evaluator,

[31.11509]

[10.127]

    my @cmd = ("hydra-eval-jobs",

Replacement in src/script/hydra-eval-jobset at line 340 [32.1319]

B:BD[10.266] → [10.266:319]

               inputsToArgs($inputInfo, $exprType));

[10.266]

[31.11725]

               inputsToArgs($inputInfo));

Replacement in src/script/hydra-eval-jobset at line 353 [32.1319]

B:BD[31.12055] → [31.12055:12146]

    die "$evaluator returned " . ($res & 127 ? "signal $res" : "exit code " . ($res >> 8))

[31.12055]

[31.12146]

    die "hydra-eval-jobs returned " . ($res & 127 ? "signal $res" : "exit code " . ($res >> 8))

Deletion in src/script/hydra-eval-jobset at line 572 [32.1319]
B:BD[33.3692] → [17.11385:11455]
```
    my $exprType = $jobset->nixexprpath =~ /.scm$/ ? "guile" : "nix";
```

Replacement in src/script/hydra-eval-jobset at line 597 [32.1319]

B:BD[34.2206] → [17.11456:11555]

    my @args = ($jobset->nixexprinput, $jobset->nixexprpath, inputsToArgs($inputInfo, $exprType));

[34.2206]

[34.2294]

    my @args = ($jobset->nixexprinput, $jobset->nixexprpath, inputsToArgs($inputInfo));

Replacement in src/script/hydra-eval-jobset at line 612 [32.1319]

∅:D[35.217] → [36.2570:2680]

∅:D[37.534] → [36.2570:2680]

B:BD[38.5549] → [36.2570:2680]

    my ($jobs, $nixExprInput) = evalJobs($inputInfo, $exprType, $jobset->nixexprinput, $jobset->nixexprpath);

[35.217]

[35.218]

    my ($jobs, $nixExprInput) = evalJobs($inputInfo, $jobset->nixexprinput, $jobset->nixexprpath);

Remove hydra-eval-guile-jobs

Dependencies

In channels

Change contents

Deletion in .gitignore at line 18 [11.1]

Deletion in configure.ac at line 55 [15.15951]

Deletion in configure.ac at line 56 [15.15951]

Deletion in configure.ac at line 74 [15.15951]