grahamc/hydra - Change Q6VFUIC6XO46PDXITZ72E7V4ATKA2PWO7USK37NTCO2LBKNGCFYAC

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.

Created by Eelco Dolstra on February 15, 2020

Q6VFUIC6XO46PDXITZ72E7V4ATKA2PWO7USK37NTCO2LBKNGCFYAC

Dependencies

In channels

main

upstream

Change contents

Deletion in .gitignore at line 18 [10.1]
B:BD[10.178] → [11.0:34]
```
/src/script/hydra-eval-guile-jobs
```
Deletion in configure.ac at line 55 [14.15951]
∅:D[12.56] → [13.60:61]
B:BD[13.60] → [13.60:61]
B:BD[15.39] → [16.0:75]
```
PKG_CHECK_MODULES([GUILE], [guile-2.0], [HAVE_GUILE=yes], [HAVE_GUILE=no])
```

Deletion in configure.ac at line 56 [14.15951]

B:BD[17.1] → [11.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 [14.15951]
B:BD[14.16583] → [11.148:183]
```
  src/script/hydra-eval-guile-jobs
```

Replacement in configure.ac at line 78 [14.15951]

B:BD[18.712] → [11.184:272]

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

[18.712]

[6.34]

AC_CONFIG_COMMANDS([executable-scripts], [])

Deletion in flake.nix at line 109 [20.1]

B:BD[19.3972] → [19.3972:4029]

              guile # optional, for Guile + Guix support

Insertion in flake.nix at line 110 [20.1]
[9.555]
[19.4062]
```
              boehmgc
```

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

BF:BFD[21.2543] → [11.667:715]

BF:BFD[11.715] → [16.2679:2679]

BFD:BFD[21.2543] → [16.11339:11384]

BF:BFD[16.11384] → [16.2679:2679]

B:BD[16.2679] → [16.2680:2850]

B:BD[16.2850] → [22.0:171]

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

∅:D[22.171] → [16.3081:3082]

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

B:BD[16.3081] → [16.3081:3082]

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

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

∅:D[11.760] → [16.3125:3183]

B:BD[16.3125] → [16.3125:3183]

B:BD[16.3183] → [23.0:66]

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

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

∅:D[24.60] → [16.3239:4795]

∅:D[23.66] → [16.3239:4795]

B:BD[16.3239] → [16.3239:4795]

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

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

B:BD[16.4871] → [16.4871:5298]

B:BD[16.5298] → [25.0:325]

∅:D[25.325] → [16.5335:6153]

B:BD[16.5335] → [16.5335:6153]

∅:D[25.560] → [16.6153:6278]

B:BD[16.6153] → [16.6153:6278]

B:BD[16.6534] → [16.6534:6593]

B:BD[16.6593] → [24.61:260]

B:BD[24.333] → [24.333:530]

∅:D[24.530] → [16.6649:6713]

B:BD[16.6649] → [16.6649:6713]

B:BD[16.6786] → [16.6786:7337]

B:BD[16.7337] → [23.67:123]

∅:D[23.123] → [16.7392:7983]

B:BD[16.7392] → [16.7392:7983]

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

B:BD[16.7983] → [16.7983:8036]

B:BD[16.8036] → [25.561:653]

∅:D[25.653] → [16.8077:8113]

B:BD[16.8077] → [16.8077:8113]

B:BD[16.8113] → [25.654:744]

∅:D[25.744] → [16.8162:11279]

B:BD[16.8162] → [16.8162:11279]

B:BD[16.11279] → [25.745:995]

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

B:BD[16.6153] → [25.326:438]

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

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

B:BD[25.504] → [25.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 [14.2198648]
B:BD[11.293] → [11.293:324]
B:BD[11.346] → [11.346:373]
```
  $(distributable_scripts)			\
  hydra-eval-guile-jobs.in
```
[11.293]
[26.97]
```
  $(distributable_scripts)
```
Replacement in src/script/Makefile.am at line 19 [14.2198648]
B:BD[11.611] → [11.611:666]
```
  $(distributable_scripts)			\
  hydra-eval-guile-jobs
```
[11.611]
```
  $(distributable_scripts)
```

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

B:BD[27.7572] → [27.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;

[27.7572]

[27.7859]

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

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

B:BD[27.7888] → [27.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;

[27.7888]

[27.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 [28.1319]
B:BD[27.9598] → [27.9598:9635]
```
    my ($inputInfo, $exprType) = @_;
```
[27.9598]
[27.9635]
```
    my ($inputInfo) = @_;
```

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

B:BD[29.1227] → [29.1227:1310]

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

[29.1227]

[29.1310]

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

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

B:BD[29.1360] → [29.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 [28.1319]

B:BD[29.1571] → [29.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 [28.1319]

B:BD[29.1975] → [29.1975:2052]

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

[29.1975]

[29.2052]

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

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

B:BD[27.11074] → [30.0:81]

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

[27.11074]

[30.81]

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

Deletion in src/script/hydra-eval-jobset at line 343 [28.1319]
∅:D[30.434] → [27.11508:11509]
B:BD[27.11508] → [27.11508:11509]
B:BD[27.11509] → [30.435:529]
```
        my $evaluator = ($exprType eq "guile") ? "hydra-eval-guile-jobs" : "hydra-eval-jobs";
```
Replacement in src/script/hydra-eval-jobset at line 344 [28.1319]
B:BD[27.11600] → [30.530:558]
```
        @cmd = ($evaluator,
```
[27.11600]
[30.558]
```
        @cmd = ("hydra-eval-jobs",
```

Replacement in src/script/hydra-eval-jobset at line 348 [28.1319]

B:BD[30.708] → [30.708:762]

                inputsToArgs($inputInfo, $exprType));

[30.708]

[30.762]

                inputsToArgs($inputInfo));

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

Replacement in src/script/hydra-eval-jobset at line 616 [28.1319]

B:BD[32.2206] → [16.11456:11555]

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

[32.2206]

[32.2294]

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

Replacement in src/script/hydra-eval-jobset at line 631 [28.1319]

B:BD[33.217] → [8.855:959]

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

[33.217]

[33.218]

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

Remove hydra-eval-guile-jobs

Dependencies

In channels

Change contents

Deletion in .gitignore at line 18 [10.1]

Deletion in configure.ac at line 55 [14.15951]

Deletion in configure.ac at line 56 [14.15951]

Deletion in configure.ac at line 74 [14.15951]

Replacement in configure.ac at line 78 [14.15951]

Deletion in flake.nix at line 109 [20.1]

Insertion in flake.nix at line 110 [20.1]

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

Replacement in src/script/Makefile.am at line 2 [14.2198648]

Replacement in src/script/Makefile.am at line 19 [14.2198648]