[PATCH RFC 0/4] Getting rid of input labels?

[PATCH RFC 0/4] Getting rid of input labels?

[Ludovic Courtès]

Hello Guix!

Here’s a proposal for a soft revolution: getting rid of input labels
in package definitions.  Instead of writing:

    (native-inputs
     `(("autoconf" ,autoconf)
       ("automake" ,automake)
       ("pkg-config" ,pkg-config)
       ("guile" ,guile-3.0)))
    
one can write:

    (native-inputs (list autoconf automake pkg-config guile-3.0))

With this patch set, this is just syntactic sugar: ‘package-inputs’
and friends still return a list of tuples.  (These patches are
against ‘core-updates’ but that works equally well on ‘master’,
without a world rebuild.)

My understanding of the code is that this change adds no overhead
for packages written in the old style, and negligible overhead for
packages written in the new style (calling ‘package-name’
instead of referring to a literal string for the label.)  I haven’t
tried to measure it though as it would require a massive conversion
to the new style to be really measurable.

I don’t think I need to expound on the benefits.  :-)

There are issues and open questions:

  • This hides labels, but they’re still visible as soon as one
    fiddles with ‘package-inputs’ & co.  So this lowers the barrier
    to entry, but the difficulty of dealing with input tuples
    does not disappear entirely.

  • Both styles would be supported for a long time so contributors
    would still have to know about input tuples anyway.

  • There are packages that use custom labels as some sort of an
    abstraction.  For instance, the “kernel-headers” label is
    associated either with ‘linux-libre-headers’ or with
    ‘hurd-headers’.  In this case, the simplified style would
    use the package name as the label, which isn’t appropriate,
    or at least would require adjustments in packages that
    rely on this.

  • There are packages with same-named but different inputs,
    and they rely on having a different input label.

  • Some packages rely on labels that differ from the package
    name (this is what the ‘guix lint -c input-labels’ patch
    detects).  For instance, commencement.scm has things like:

      `(("guile" ,%bootstrap-guile))

    Automatic labeling would convert it to:

      `(("guile-bootstrap" ,%bootstrap-guile))

    Not necessarily a problem: we can keep the old style for these.
    Common Lisp packages typically lack the “cl-” prefix in
    input labels but most likely they don’t actually refer to
    those labels, so we should be fine.

  • Packages such as ‘tzdata’ use labels to refer to non-package
    inputs.  These cannot be converted to the automatic labeling
    style, or not without extra changes.

  • Currently, something like:

      (inputs (list glib))

    is converted to:

      (inputs `(("glib" ,glib)))

    Should it, instead, be converted to:

     (inputs `(("glib" ,glib)
               ("glib:bin" ,glib "bin")))

    ?  This would make the concise style strictly less
    expressive, but maybe good enough?

Ludovic Courtès (4):
  records: Support field sanitizers.
  DRAFT packages: Allow inputs to be plain package lists.
  DRAFT gnu: Change inputs of core packages to plain lists.
  DRAFT lint: Add 'input-labels' checker.

 gnu/packages/base.scm  | 30 +++++++--------
 gnu/packages/guile.scm | 87 ++++++++++--------------------------------
 gnu/packages/mes.scm   | 23 ++++-------
 guix/lint.scm          | 35 +++++++++++++++++
 guix/packages.scm      | 35 +++++++++++++++--
 guix/records.scm       | 65 ++++++++++++++++++++++++-------
 tests/records.scm      | 38 ++++++++++++++++++
 7 files changed, 198 insertions(+), 115 deletions(-)

-- 
2.31.1

[PATCH RFC 1/4] records: Support field sanitizers.

[Ludovic Courtès]

* guix/records.scm (make-syntactic-constructor): Add #:sanitizers.
[field-sanitizer]: New procedure.
[wrap-field-value]: Honor F's sanitizer.
(define-record-type*)[field-sanitizer]: New procedure.
Pass #:sanitizer to 'make-syntactic-constructor'.
* tests/records.scm ("define-record-type* & sanitize")
("define-record-type* & sanitize & thunked"): New tests.
---
 guix/records.scm  | 65 +++++++++++++++++++++++++++++++++++++----------
 tests/records.scm | 38 +++++++++++++++++++++++++++
 2 files changed, 89 insertions(+), 14 deletions(-)

diff --git a/guix/records.scm b/guix/records.scm
index 3d54a51956..ed94c83dac 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -120,7 +120,8 @@ context of the definition of a thunked field."
     "Make the syntactic constructor NAME for TYPE, that calls CTOR, and
 expects all of EXPECTED fields to be initialized.  DEFAULTS is the list of
 FIELD/DEFAULT-VALUE tuples, THUNKED is the list of identifiers of thunked
-fields, and DELAYED is the list of identifiers of delayed fields.
+fields, DELAYED is the list of identifiers of delayed fields, and SANITIZERS
+is the list of FIELD/SANITIZER tuples.
 
 ABI-COOKIE is the cookie (an integer) against which to check the run-time ABI
 of TYPE matches the expansion-time ABI."
@@ -130,6 +131,7 @@ of TYPE matches the expansion-time ABI."
         #:this-identifier this-identifier
         #:delayed delayed
         #:innate innate
+        #:sanitizers sanitizers
         #:defaults defaults)
      (define-syntax name
        (lambda (s)
@@ -169,19 +171,30 @@ of TYPE matches the expansion-time ABI."
          (define (innate-field? f)
            (memq (syntax->datum f) 'innate))
 
+         (define field-sanitizer
+           (let ((lst (map (match-lambda
+                             ((f p)
+                              (list (syntax->datum f) p)))
+                           #'sanitizers)))
+             (lambda (f)
+               (or (and=> (assoc-ref lst (syntax->datum f)) car)
+                   #'(lambda (x) x)))))
+
          (define (wrap-field-value f value)
-           (cond ((thunked-field? f)
-                  #`(lambda (x)
-                      (syntax-parameterize ((#,this-identifier
-                                             (lambda (s)
-                                               (syntax-case s ()
-                                                 (id
-                                                  (identifier? #'id)
-                                                  #'x)))))
-                        #,value)))
-                 ((delayed-field? f)
-                  #`(delay #,value))
-                 (else value)))
+           (let* ((sanitizer (field-sanitizer f))
+                  (value     #`(#,sanitizer #,value)))
+             (cond ((thunked-field? f)
+                    #`(lambda (x)
+                        (syntax-parameterize ((#,this-identifier
+                                               (lambda (s)
+                                                 (syntax-case s ()
+                                                   (id
+                                                    (identifier? #'id)
+                                                    #'x)))))
+                          #,value)))
+                   ((delayed-field? f)
+                    #`(delay #,value))
+                   (else value))))
 
          (define default-values
            ;; List of symbol/value tuples.
@@ -291,6 +304,19 @@ can access the record it belongs to via the 'this-thing' identifier.
 A field can also be marked as \"delayed\" instead of \"thunked\", in which
 case its value is effectively wrapped in a (delay …) form.
 
+A field can also have an associated \"sanitizer\", which is a procedure that
+takes a user-supplied field value and returns a \"sanitized\" value for the
+field:
+
+  (define-record-type* <thing> thing make-thing
+    thing?
+    this-thing
+    (name  thing-name
+           (sanitize (lambda (value)
+                       (cond ((string? value) value)
+                             ((symbol? value) (symbol->string value))
+                             (else (throw 'bad! value)))))))
+
 It is possible to copy an object 'x' created with 'thing' like this:
 
   (thing (inherit x) (name \"bar\"))
@@ -307,6 +333,14 @@ inherited."
          (field-default-value #'(field properties ...)))
         (_ #f)))
 
+    (define (field-sanitizer s)
+      (syntax-case s (sanitize)
+        ((field (sanitize proc) _ ...)
+         (list #'field #'proc))
+        ((field _ properties ...)
+         (field-sanitizer #'(field properties ...)))
+        (_ #f)))
+
     (define-field-property-predicate delayed-field? delayed)
     (define-field-property-predicate thunked-field? thunked)
     (define-field-property-predicate innate-field? innate)
@@ -376,6 +410,8 @@ inherited."
               (innate     (filter-map innate-field? field-spec))
               (defaults   (filter-map field-default-value
                                       #'((field properties ...) ...)))
+              (sanitizers (filter-map field-sanitizer
+                                        #'((field properties ...) ...)))
               (cookie     (compute-abi-cookie field-spec)))
          (with-syntax (((field-spec* ...)
                         (map field-spec->srfi-9 field-spec))
@@ -421,6 +457,7 @@ of a record instantiation"
                                            #:this-identifier #'this-identifier
                                            #:delayed #,delayed
                                            #:innate #,innate
+                                           #:sanitizers #,sanitizers
                                            #:defaults #,defaults)))))
       ((_ type syntactic-ctor ctor pred
           (field get properties ...) ...)
diff --git a/tests/records.scm b/tests/records.scm
index 706bb3dbfd..d014e7a995 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -283,6 +283,44 @@
              (equal? (foo-bar y) 1))              ;promise was already forced
            (eq? (foo-baz y) 'b)))))
 
+(test-assert "define-record-type* & sanitize"
+  (begin
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (bar foo-bar
+           (default "bar")
+           (sanitize (lambda (x) (string-append x "!")))))
+
+    (let* ((p (foo))
+           (q (foo (inherit p)))
+           (r (foo (inherit p) (bar "baz")))
+           (s (foo (bar "baz"))))
+      (and (string=? (foo-bar p) "bar!")
+           (equal? q p)
+           (string=? (foo-bar r) "baz!")
+           (equal? s r)))))
+
+(test-assert "define-record-type* & sanitize & thunked"
+  (let ((sanitized 0))
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (bar foo-bar
+           (default "bar")
+           (sanitize (lambda (x)
+                       (set! sanitized (+ 1 sanitized))
+                       (string-append x "!")))))
+
+    (let ((p (foo)))
+      (and (string=? (foo-bar p) "bar!")
+           (string=? (foo-bar p) "bar!")          ;twice
+           (= sanitized 1)             ;sanitizer was called at init time only
+           (let ((q (foo (bar "baz"))))
+             (and (string=? (foo-bar q) "baz!")
+                  (string=? (foo-bar q) "baz!")   ;twice
+                  (= sanitized 2)
+                  (let ((r (foo (inherit q))))
+                    (and (string=? (foo-bar r) "baz!")
+                         (= sanitized 2)))))))))  ;no re-sanitization
 (test-assert "define-record-type* & wrong field specifier"
   (let ((exp '(begin
                 (define-record-type* <foo> foo make-foo
-- 
2.31.1

[PATCH RFC 2/4] DRAFT packages: Allow inputs to be plain package lists.

[Ludovic Courtès]

DRAFT: Is it a good idea?  If it is, add tests and doc.

* guix/packages.scm (add-input-label, sanitize-inputs): New procedures.
(<package>)[inputs, propagated-inputs, native-inputs]: Add 'sanitize' property.
---
 guix/packages.scm | 35 ++++++++++++++++++++++++++++++++---
 1 file changed, 32 insertions(+), 3 deletions(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index ba19174646..fc3290b8e8 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -366,6 +366,32 @@ name of its URI."
   ;; <https://lists.gnu.org/archive/html/guix-devel/2017-03/msg00790.html>.
   (fold delete %supported-systems '("mips64el-linux")))
 
+(define (add-input-label input)
+  "Add an input label to INPUT."
+  (match input
+    ((? package? package)
+     (list (package-name package) package))
+    (((? package? package) output)                ;XXX: ugly?
+     (list (package-name package) package output))
+    ((? gexp-input?)       ;XXX: misplaced because 'native?' field is ignored?
+     (let ((obj    (gexp-input-thing input))
+           (output (gexp-input-output input)))
+       `(,(if (package? obj)
+              (package-name obj)
+              "_")
+         ,obj
+         ,@(if (string=? output "out") '() (list output)))))
+    (x
+     `("_" ,x))))
+
+(define-inlinable (sanitize-inputs inputs)
+  "Sanitize INPUTS by turning it into a list of name/package tuples if it's
+not already the case."
+  (cond ((null? inputs) inputs)
+        ((and (pair? (car inputs))
+              (string? (caar inputs)))
+         inputs)
+        (else (map add-input-label inputs))))
 
 ;; A package.
 (define-record-type* <package>
@@ -380,11 +406,14 @@ name of its URI."
              (default '()) (thunked))
 
   (inputs package-inputs                  ; input packages or derivations
-          (default '()) (thunked))
+          (default '()) (thunked)
+          (sanitize sanitize-inputs))
   (propagated-inputs package-propagated-inputs    ; same, but propagated
-                     (default '()) (thunked))
+                     (default '()) (thunked)
+                     (sanitize sanitize-inputs))
   (native-inputs package-native-inputs    ; native input packages/derivations
-                 (default '()) (thunked))
+                 (default '()) (thunked)
+                 (sanitize sanitize-inputs))
 
   (outputs package-outputs                ; list of strings
            (default '("out")))
-- 
2.31.1

[PATCH RFC 3/4] DRAFT gnu: Change inputs of core packages to plain lists.

[Ludovic Courtès]

This is transparent: the resulting derivations are unchanged.

* gnu/packages/base.scm (grep, sed, tar, patch, diffutils)
(coreutils, gnu-make, make-glibc-utf8-locales): Change input fields to
plain package lists.
* gnu/packages/guile.scm (guile-1.8, guile-json-1, guile-json-3)
(guile-gdbm-ffi, guile-sqlite3, guile-bytestructures)
(guile-git, guile-zlib, guile-lzlib, guile-zstd): Likewise.
* gnu/packages/mes.scm (nyacc-0.86, nyacc-0.99)
(nyacc, nyacc-1.00.2, mes-0.19, mes): Likewise.
---
 gnu/packages/base.scm  | 30 +++++++--------
 gnu/packages/guile.scm | 87 ++++++++++--------------------------------
 gnu/packages/mes.scm   | 23 ++++-------
 3 files changed, 42 insertions(+), 98 deletions(-)

diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm
index 33c4952415..6656742c06 100644
--- a/gnu/packages/base.scm
+++ b/gnu/packages/base.scm
@@ -109,8 +109,8 @@ command-line arguments, multiple languages, and so on.")
               "0gipv6bzkm1aihj0ncqpyh164xrzgcxcv9r1kwzyk2g1mzl1azk6"))
             (patches (search-patches "grep-timing-sensitive-test.patch"))))
    (build-system gnu-build-system)
-   (native-inputs `(("perl" ,perl)))             ;some of the tests require it
-   (inputs `(("pcre" ,pcre)))
+   (native-inputs (list perl))                   ;some of the tests require it
+   (inputs (list pcre))
    (arguments
     `(#:phases
       (modify-phases %standard-phases
@@ -161,8 +161,7 @@ including, for example, recursive directory searching.")
             (modules '((guix build utils)))))
    (build-system gnu-build-system)
    (synopsis "Stream editor")
-   (native-inputs
-    `(("perl" ,perl)))                            ;for tests
+   (native-inputs (list perl))                    ;for tests
    (description
     "Sed is a non-interactive, text stream editor.  It receives a text
 input from a file or from standard input and it then applies a series of text
@@ -215,7 +214,7 @@ implementation offers several extensions over the standard utility.")
    ;; When cross-compiling, the 'set-shell-file-name' phase needs to be able
    ;; to refer to the target Bash.
    (inputs (if (%current-target-system)
-               `(("bash" ,bash))
+               (list bash)
                '()))
 
    (synopsis "Managing tar archives")
@@ -248,7 +247,7 @@ standard utility.")
     (if (%current-target-system)
         `(#:configure-flags '("gl_cv_func_working_mktime=yes"))
         '()))
-   (native-inputs `(("ed" ,ed)))
+   (native-inputs (list ed))
    (synopsis "Apply differences to originals, with optional backups")
    (description
     "Patch is a program that applies changes to files based on differences
@@ -271,7 +270,7 @@ differences.")
              (base32
               "09isrg0isjinv8c535nxsi1s86wfdfzml80dbw41dj9x3hiad9xk"))))
    (build-system gnu-build-system)
-   (native-inputs `(("perl" ,perl)))
+   (native-inputs (list perl))
    (synopsis "Comparing and merging files")
    (description
     "GNU Diffutils is a package containing tools for finding the
@@ -330,16 +329,16 @@ used to apply commands with arbitrarily long arguments.")
               "1yjcrh5hw70c0yn8zw55pd6j51dj90anpq8mmg649ps9g3gdhn24"))
             (patches (search-patches "coreutils-ls.patch"))))
    (build-system gnu-build-system)
-   (inputs `(("acl"  ,acl)                        ; TODO: add SELinux
-             ("attr" ,attr)                       ;for xattrs in ls, mv, etc
-             ("gmp"  ,gmp)                        ;bignums in 'expr', yay!
+   (inputs `(,acl                                 ;TODO: add SELinux
+             ,attr                                ;for xattrs in ls, mv, etc
+             ,gmp                                 ;bignums in 'expr', yay!
 
              ;; Do not use libcap when cross-compiling since it's not quite
              ;; cross-compilable; and use it only for supported systems.
              ,@(if (and (not (%current-target-system))
                         (member (%current-system)
                                 (package-supported-systems libcap)))
-                   `(("libcap" ,libcap)) ;capability support in 'ls', etc.
+                   `(,libcap)                ;capability support in 'ls', etc.
                    '())))
    (native-inputs
     ;; Perl is needed to run tests in native builds, and to run the bundled
@@ -348,7 +347,7 @@ used to apply commands with arbitrarily long arguments.")
     ;; for help2man.
     (if (%current-target-system)
         '()
-        `(("perl" ,perl))))
+        (list perl)))
    (outputs '("out" "debug"))
    (arguments
     `(#:parallel-build? #f            ; help2man may be called too early
@@ -443,8 +442,8 @@ standard.")
               "06cfqzpqsvdnsxbysl5p2fgdgxgl9y4p7scpnrfa8z2zgkjdspz0"))
             (patches (search-patches "make-impure-dirs.patch"))))
    (build-system gnu-build-system)
-   (native-inputs `(("pkg-config" ,pkg-config)))  ; to detect Guile
-   (inputs `(("guile" ,guile-3.0)))
+   (native-inputs (list pkg-config))              ;to detect Guile
+   (inputs (list guile-3.0))
    (outputs '("out" "debug"))
    (arguments
     `(,@(if (hurd-target?)
@@ -1147,8 +1146,7 @@ to the @code{share/locale} sub-directory of this package.")
                                                          locale ".UTF-8")))
                                ',locales)
                      #t))))
-    (native-inputs `(("glibc" ,glibc)
-                     ("gzip" ,gzip)))
+    (native-inputs (list glibc gzip))
     (synopsis (if default-locales?
                   (P_ "Small sample of UTF-8 locales")
                   (P_ "Customized sample of UTF-8 locales")))
diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm
index a3876a2591..fb566fe690 100644
--- a/gnu/packages/guile.scm
+++ b/gnu/packages/guile.scm
@@ -112,13 +112,11 @@
                       `(("self" ,this-package))
                       '()))
 
-   (inputs `(("gawk" ,gawk)
-             ("readline" ,readline)))
+   (inputs (list gawk readline))
 
    ;; Since `guile-1.8.pc' has "Libs: ... -lgmp -lltdl", these must be
    ;; propagated.
-   (propagated-inputs `(("gmp" ,gmp)
-                        ("libltdl" ,libltdl)))
+   (propagated-inputs (list gmp libltdl))
 
    (native-search-paths
     (list (search-path-specification
@@ -570,9 +568,8 @@ GNU@tie{}Guile.  Use the @code{(ice-9 readline)} module and call its
     (build-system gnu-build-system)
     (arguments
      `(#:make-flags '("GUILE_AUTO_COMPILE=0")))   ;to prevent guild warnings
-    (native-inputs `(("pkg-config" ,pkg-config)
-                     ("guile" ,guile-2.2)))
-    (inputs `(("guile" ,guile-2.2)))
+    (native-inputs (list pkg-config guile-2.2))
+    (inputs (list guile-2.2))
     (synopsis "JSON module for Guile")
     (description
      "Guile-JSON supports parsing and building JSON documents according to the
@@ -610,9 +607,8 @@ specification.  These are the main features:
               (sha256
                (base32
                 "0nj0684qgh6ppkbdyxqfyjwsv2qbyairxpi8fzrhsi3xnc7jn4im"))))
-    (native-inputs `(("pkg-config" ,pkg-config)
-                     ("guile" ,guile-3.0)))
-    (inputs `(("guile" ,guile-3.0)))))
+    (native-inputs (list pkg-config guile-3.0))
+    (inputs (list guile-3.0))))
 
 (define-public guile3.0-json
   (deprecated-package "guile3.0-json" guile-json-3))
@@ -671,10 +667,8 @@ specification.  These are the main features:
                          (format #f "(dynamic-link \"~a/lib/libgdbm.so\")"
                                  (assoc-ref inputs "gdbm"))))
                       #t)))))
-    (native-inputs
-     `(("guile" ,guile-3.0)))
-    (inputs
-     `(("gdbm" ,gdbm)))
+    (native-inputs (list guile-3.0))
+    (inputs (list gdbm))
     (home-page "https://github.com/ijp/guile-gdbm")
     (synopsis "Guile bindings to the GDBM library via Guile's FFI")
     (description
@@ -705,14 +699,8 @@ Guile's foreign function interface.")
                 "1nryy9j3bk34i0alkmc9bmqsm0ayz92k1cdf752mvhyjjn8nr928"))
               (file-name (string-append name "-" version "-checkout"))))
     (build-system gnu-build-system)
-    (native-inputs
-     `(("autoconf" ,autoconf)
-       ("automake" ,automake)
-       ("guile" ,guile-3.0)
-       ("pkg-config" ,pkg-config)))
-    (inputs
-     `(("guile" ,guile-3.0)
-       ("sqlite" ,sqlite)))
+    (native-inputs (list autoconf automake guile-3.0 pkg-config))
+    (inputs (list guile-3.0 sqlite))
     (synopsis "Access SQLite databases from Guile")
     (description
      "This package provides Guile bindings to the SQLite database system.")
@@ -752,13 +740,8 @@ Guile's foreign function interface.")
                              (doc (string-append out "/share/doc/" package)))
                         (install-file "README.md" doc)
                         #t))))))
-    (native-inputs
-     `(("autoconf" ,autoconf)
-       ("automake" ,automake)
-       ("pkg-config" ,pkg-config)
-       ("guile" ,guile-3.0)))
-    (inputs
-     `(("guile" ,guile-3.0)))
+    (native-inputs (list autoconf automake pkg-config guile-3.0))
+    (inputs (list guile-3.0))
     (synopsis "Structured access to bytevector contents for Guile")
     (description
      "Guile bytestructures offers a system imitating the type system
@@ -795,17 +778,11 @@ type system, elevating types to first-class status.")
     (arguments
      `(#:make-flags '("GUILE_AUTO_COMPILE=0")))     ; to prevent guild warnings
     (native-inputs
-     `(("pkg-config" ,pkg-config)
-       ("autoconf" ,autoconf)
-       ("automake" ,automake)
-       ("texinfo" ,texinfo)
-       ("guile" ,guile-3.0)
-       ("guile-bytestructures" ,guile-bytestructures)))
+     (list pkg-config autoconf automake texinfo guile-3.0 guile-bytestructures))
     (inputs
-     `(("guile" ,guile-3.0)
-       ("libgit2" ,libgit2)))
+     (list guile-3.0 libgit2))
     (propagated-inputs
-     `(("guile-bytestructures" ,guile-bytestructures)))
+     (list guile-bytestructures))
     (synopsis "Guile bindings for libgit2")
     (description
      "This package provides Guile bindings to libgit2, a library to
@@ -842,16 +819,8 @@ manipulate repositories of the Git version control system.")
     (arguments
      '(#:make-flags
        '("GUILE_AUTO_COMPILE=0"))) ;to prevent guild warnings
-    (native-inputs
-     `(("autoconf" ,autoconf)
-       ("automake" ,automake)
-       ("pkg-config" ,pkg-config)
-       ,@(if (%current-target-system)
-             `(("guile" ,guile-3.0))   ;for 'guild compile' and 'guile-3.0.pc'
-             '())))
-    (inputs
-     `(("guile" ,guile-3.0)
-       ("zlib" ,zlib)))
+    (native-inputs (list autoconf automake pkg-config guile-3.0))
+    (inputs (list guile-3.0 zlib))
     (synopsis "Guile bindings to zlib")
     (description
      "This package provides Guile bindings for zlib, a lossless
@@ -881,16 +850,8 @@ Guile's foreign function interface.")
     (arguments
      '(#:make-flags
        '("GUILE_AUTO_COMPILE=0"))) ;to prevent guild warnings
-    (native-inputs
-     `(("autoconf" ,autoconf)
-       ("automake" ,automake)
-       ("pkg-config" ,pkg-config)
-       ,@(if (%current-target-system)
-             `(("guile" ,guile-3.0))   ;for 'guild compile' and 'guile-3.0.pc'
-             '())))
-    (inputs
-     `(("guile" ,guile-3.0)
-       ("lzlib" ,lzlib)))
+    (native-inputs (list autoconf automake pkg-config guile-3.0))
+    (inputs (list guile-3.0 lzlib))
     (synopsis "Guile bindings to lzlib")
     (description
      "This package provides Guile bindings for lzlib, a C library for
@@ -916,14 +877,8 @@ pure Scheme by using Guile's foreign function interface.")
                (base32
                 "1c8l7829b5yx8wdc0mrhzjfwb6h9hb7cd8dfxcr71a7vlsi86310"))))
     (build-system gnu-build-system)
-    (native-inputs
-     `(("autoconf" ,autoconf)
-       ("automake" ,automake)
-       ("pkg-config" ,pkg-config)
-       ("guile" ,guile-3.0)))
-    (inputs
-     `(("zstd" ,zstd "lib")
-       ("guile" ,guile-3.0)))
+    (native-inputs (list autoconf automake pkg-config guile-3.0))
+    (inputs (list `(,zstd "lib") guile-3.0))
     (synopsis "GNU Guile bindings to the zstd compression library")
     (description
      "This package provides a GNU Guile interface to the zstd (``zstandard'')
diff --git a/gnu/packages/mes.scm b/gnu/packages/mes.scm
index 750ec2e67a..b074b37289 100644
--- a/gnu/packages/mes.scm
+++ b/gnu/packages/mes.scm
@@ -55,8 +55,7 @@
                (base32
                 "0lkd9lyspvhxlfs0496gsllwinh62jk9wij6gpadvx9gwz6yavd9"))))
     (build-system gnu-build-system)
-    (native-inputs
-     `(("guile" ,guile-2.2)))
+    (native-inputs (list guile-2.2))
     (synopsis "LALR(1) Parser Generator in Guile")
     (description
      "NYACC is an LALR(1) parser generator implemented in Guile.
@@ -91,10 +90,8 @@ extensive examples, including parsers for the Javascript and C99 languages.")
                     (("^DOCDIR =.*")
                      "DOCDIR = @prefix@/share/doc/$(PACKAGE_TARNAME)\n"))
                   #t))))
-    (native-inputs
-     `(("pkg-config" ,pkg-config)))
-    (inputs
-     `(("guile" ,guile-2.2)))))
+    (native-inputs (list pkg-config))
+    (inputs (list guile-2.2))))
 
 (define-public nyacc
   (package
@@ -115,8 +112,7 @@ extensive examples, including parsers for the Javascript and C99 languages.")
                      "GUILE_GLOBAL_SITE=\
 $prefix/share/guile/site/$GUILE_EFFECTIVE_VERSION\n"))
                   #t))))
-    (inputs
-     `(("guile" ,guile-3.0)))))
+    (inputs (list guile-3.0))))
 
 (define-public nyacc-1.00.2
   (package
@@ -144,8 +140,7 @@ $prefix/share/guile/site/$GUILE_EFFECTIVE_VERSION\n"))
               (sha256
                (base32
                 "065ksalfllbdrzl12dz9d9dcxrv97wqxblslngsc6kajvnvlyvpk"))))
-    (inputs
-     `(("guile" ,guile-2.2)))))
+    (inputs (list guile-2.2))))
 
 (define-public mes-0.19
   ;; Mes used for bootstrap.
@@ -161,9 +156,7 @@ $prefix/share/guile/site/$GUILE_EFFECTIVE_VERSION\n"))
                 "15h4yhaywdc0djpjlin2jz1kzahpqxfki0r0aav1qm9nxxmnp1l0"))))
     (build-system gnu-build-system)
     (supported-systems '("i686-linux" "x86_64-linux"))
-    (propagated-inputs
-     `(("mescc-tools" ,mescc-tools-0.5.2)
-       ("nyacc" ,nyacc-0.86)))
+    (propagated-inputs (list mescc-tools-0.5.2 nyacc-0.86))
     (native-inputs
      `(("guile" ,guile-2.2)
        ,@(let ((target-system (or (%current-target-system)
@@ -204,9 +197,7 @@ Guile.")
                (base32
                 "0mnryfkl0dwbr5gxp16j5s95gw7z1vm1fqa1pxabp0aiar1hw53s"))))
     (supported-systems '("armhf-linux" "i686-linux" "x86_64-linux"))
-    (propagated-inputs
-     `(("mescc-tools" ,mescc-tools)
-       ("nyacc" ,nyacc-1.00.2)))
+    (propagated-inputs (list mescc-tools nyacc-1.00.2))
     (native-search-paths
      (list (search-path-specification
             (variable "C_INCLUDE_PATH")
-- 
2.31.1

[PATCH RFC 4/4] DRAFT lint: Add 'input-labels' checker.

[Ludovic Courtès]

DRAFT: Good idea? If yes, add tests and doc.

* guix/lint.scm (check-input-labels): New procedure.
(%local-checkers): Add 'input-labels' checker.
---
 guix/lint.scm | 35 +++++++++++++++++++++++++++++++++++
 1 file changed, 35 insertions(+)

diff --git a/guix/lint.scm b/guix/lint.scm
index 1bebfe03d3..95f82dba60 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -383,6 +383,37 @@ of a package, and INPUT-NAMES, a list of package specifications such as
          (package-input-intersection (package-direct-inputs package)
                                      input-names))))
 
+(define (check-input-labels package)
+  "Emit a warning for labels that differ from the corresponding package name."
+  (define (check input-kind package-inputs)
+    (define (warning label name)
+      (make-warning package
+                    (G_ "label '~a' does not match package name '~a'")
+                    (list label name)
+                    #:field input-kind))
+
+    (append-map (match-lambda
+                  (((? string? label) (? package? dependency))
+                   (if (string=? label (package-name dependency))
+                       '()
+                       (list (warning label (package-name dependency)))))
+                  (((? string? label) (? package? dependency) output)
+                   (let ((expected (string-append (package-name dependency)
+                                                  ":" output)))
+                     (if (string=? label expected)
+                         '()
+                         (list (warning label expected)))))
+                  (_
+                   '()))
+                (package-inputs package)))
+
+  (append-map (match-lambda
+                ((kind proc)
+                 (check kind proc)))
+              `((native-inputs ,package-native-inputs)
+                (inputs ,package-inputs)
+                (propagated-inputs ,package-propagated-inputs))))
+
 (define (package-name-regexp package)
   "Return a regexp that matches PACKAGE's name as a word at the beginning of a
 line."
@@ -1493,6 +1524,10 @@ them for PACKAGE."
      (name        'inputs-should-not-be-input)
      (description "Identify inputs that shouldn't be inputs at all")
      (check       check-inputs-should-not-be-an-input-at-all))
+   (lint-checker
+     (name        'input-labels)
+     (description "Identify input labels that do not match package names")
+     (check       check-input-labels))
    (lint-checker
      (name        'license)
      ;; TRANSLATORS: <license> is the name of a data type and must not be
-- 
2.31.1

Re: [PATCH RFC 0/4] Getting rid of input labels?

[Vincent Legoll]

Hello,

On Thu, May 20, 2021 at 5:03 PM Ludovic Courtès <ludo@gnu.org> wrote:
> Instead of writing:
>
>     (native-inputs
>      `(("autoconf" ,autoconf)
>        ("automake" ,automake)
>        ("pkg-config" ,pkg-config)
>        ("guile" ,guile-3.0)))
>
> one can write:
>
>     (native-inputs (list autoconf automake pkg-config guile-3.0))

What about

>     (native-inputs
>      `(,autoconf
>        ("truc" ,muche)
>        "pkg-config"
>     ))

i.e. allowing package objects, tuples and names, and it would DTRT ?

Wouldn't something like that be possible ?

-- 
Vincent Legoll

Re: [PATCH RFC 0/4] Getting rid of input labels?

[Ludovic Courtès]

Hi Vincent,

Vincent Legoll <vincent.legoll@gmail.com> skribis:

> What about
>
>>     (native-inputs
>>      `(,autoconf
>>        ("truc" ,muche)
>>        "pkg-config"
>>     ))
>
> i.e. allowing package objects, tuples and names, and it would DTRT ?
>
> Wouldn't something like that be possible ?

It would be possible, but I’d rather not allow for mixing styles.  Not
allowing mixing style means it’s easier to check for correctness, and
the “auto labeling” code has fewer checks to make.

Ludo’.

Re: [PATCH RFC 0/4] Getting rid of input labels?

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 872 bytes --]

Ludovic Courtès schreef op do 20-05-2021 om 16:58 [+0200]:
> Hello Guix!
> 
> Here’s a proposal for a soft revolution: getting rid of input labels
> in package definitions.  Instead of writing: [...]
>    
> one can write:
> 
>     (native-inputs (list autoconf automake pkg-config guile-3.0))
> [...]

This concept LGTM (but I haven't looked closely at the patches), but
as noted on #guix, some issues with eliminating labels completely:

A package definition of P may require both Q@1.0 and Q@2.0 as inputs,
in which case a ‘label collision’ would be created if we generate
labels package-name. More specifically, I'm thinking of packaging
go-ipfs-migrations (or what's its name ...). It would be a good idea
to add an (additional?) test to actually try to migrate from
go-ipfs@first-version to go-ipfs@another-version.

Greetings,
Maxime.

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

Re: [PATCH RFC 0/4] Getting rid of input labels?

[Ludovic Courtès]

Hi Maxime,

Maxime Devos <maximedevos@telenet.be> skribis:

> Ludovic Courtès schreef op do 20-05-2021 om 16:58 [+0200]:
>> Hello Guix!
>> 
>> Here’s a proposal for a soft revolution: getting rid of input labels
>> in package definitions.  Instead of writing: [...]
>>    
>> one can write:
>> 
>>     (native-inputs (list autoconf automake pkg-config guile-3.0))
>> [...]
>
> This concept LGTM (but I haven't looked closely at the patches), but
> as noted on #guix, some issues with eliminating labels completely:
>
> A package definition of P may require both Q@1.0 and Q@2.0 as inputs,
> in which case a ‘label collision’ would be created if we generate
> labels package-name. More specifically, I'm thinking of packaging
> go-ipfs-migrations (or what's its name ...). It would be a good idea
> to add an (additional?) test to actually try to migrate from
> go-ipfs@first-version to go-ipfs@another-version.

Keep in mind that labels exist to make it easier to refer to a specific
input from the build side—in a phase, configure flag, etc.

In many cases, you don’t need the ability to refer to a specific input;
you just need all the inputs to contribute to search path environment
variables, and that’s enough.  A “label collision” does not matter at
all in this case.

In some cases, you do need to refer to a specific input, as in:

  #:configure-flags (list (string-append "--with-gmp-prefix="
                                         (assoc-ref %build-inputs "gmp")))

In this case, there are now two options:

  1. Arrange so that label is unique among your inputs, as is already
     the case.

  2. Use a gexp instead (possible on ‘core-updates’) like so:

       #:configure-flags #~(list (string-append "--with-gmp-prefix=" #$gmp))

     or, to allow for inheritance:

       #:configure-flags #~(list (string-append "--with-gmp-prefix="
                                                #$@(assoc-ref
                                                    (package-inputs this-package)
                                                    "gmp")))

     The second variant is ugly, but we could provide helpers to make it
     prettier.

Do you think there are unaddressed issues with go-ipfs-migrations?

Thanks for your feedback!

Ludo’.

Re: [PATCH RFC 0/4] Getting rid of input labels?

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 902 bytes --]

Ludovic Courtès schreef op wo 26-05-2021 om 15:43 [+0200]:
> Hi Maxime,
>[...]
> In many cases, you don’t need the ability to refer to a specific input;
> you just need all the inputs to contribute to search path environment
> variables, and that’s enough.  A “label collision” does not matter at
> all in this case.
> 
> In some cases, you do need to refer to a specific input, as in:
> 
> [...]

> In this case, there are now two options:
> 
>   1. Arrange so that label is unique among your inputs, as is already
>      the case.
> 
>   2. [...]
>
> Do you think there are unaddressed issues with go-ipfs-migrations?

As long as there remains a possibility of overriding the ‘default‘ label
generated from the package name, then everything seems ok for the
(not-yet-packaged) go-ipfs-migrations. This appears to remain the case,
so ok?

Greetings,
Maxime.


[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

Re: [PATCH RFC 0/4] Getting rid of input labels?

[Nicolas Goaziou]

Hello,

Ludovic Courtès <ludo@gnu.org> writes:

> Here’s a proposal for a soft revolution: getting rid of input labels
> in package definitions.  Instead of writing:
>
>     (native-inputs
>      `(("autoconf" ,autoconf)
>        ("automake" ,automake)
>        ("pkg-config" ,pkg-config)
>        ("guile" ,guile-3.0)))
>     
> one can write:
>
>     (native-inputs (list autoconf automake pkg-config guile-3.0))

Nice! Thank you.

>   • Packages such as ‘tzdata’ use labels to refer to non-package
>     inputs.  These cannot be converted to the automatic labeling
>     style, or not without extra changes.

Would it be possible to write something like

  (inputs (let ((tzcode (origin ...)))
            (list ... tzcode ...)))

?
>
>   • Currently, something like:
>
>       (inputs (list glib))
>
>     is converted to:
>
>       (inputs `(("glib" ,glib)))
>
>     Should it, instead, be converted to:
>
>      (inputs `(("glib" ,glib)
>                ("glib:bin" ,glib "bin")))
>
>     ?  This would make the concise style strictly less
>     expressive, but maybe good enough?

Could the new syntax accept both variables and specifications, e.g.,

   (list "glib:bin" foo "bar@2.3")

?

Regards,
-- 
Nicolas Goaziou

Re: [PATCH RFC 0/4] Getting rid of input labels?

[Ludovic Courtès]

Hello,

Nicolas Goaziou <mail@nicolasgoaziou.fr> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:

[...]

>>   • Packages such as ‘tzdata’ use labels to refer to non-package
>>     inputs.  These cannot be converted to the automatic labeling
>>     style, or not without extra changes.
>
> Would it be possible to write something like
>
>   (inputs (let ((tzcode (origin ...)))
>             (list ... tzcode ...)))
>
> ?

Yes, but the problem is that the automatically-assigned label for
<origin> records is “_” (a placeholder), because origins have no name,
unlike packages.

Thus, this phase:

    (replace 'unpack
       (lambda* (#:key source inputs #:allow-other-keys)
         (invoke "tar" "xvf" source)
         (invoke "tar" "xvf" (assoc-ref inputs "tzcode"))))

… needs to be written differently, because there’s no “tzcode” label.

One option on ‘core-updates’ is to use gexps:

    #~(modify-phases %standard-phases
        ;; …
        (replace 'unpack
           (lambda* (#:key source inputs #:allow-other-keys)
             (invoke "tar" "xvf" source)
             (invoke "tar" "xvf" #$tzcode))))

However, this style breaks common uses of ‘inherit’ and uses of the
inputs field: ‘tzcode’ here need not even be listed in ‘inputs’, and
consequently, you cannot easily inherit from ‘tzdata’ and give it a
different ‘tzcode’.

We need to find and encourage appropriate idioms for corner cases like
this.  One option is the status quo: keep using labels in those rare
cases.

A crazier option would be to interpret input lists, when possible, as
both input lists and formal parameter lists for ‘arguments’.  Assume a
package with:

  (inputs (list foo bar baz))

The ‘arguments’ field, which is currently a thunk, would magically be
turned into:

  (lambda (foo bar baz)
    …)

That way, arguments could refer to #$foo etc., and that’d just do the
right thing when inputs are overridden.

This would be reaching a level of magic that may not be wise, and it may
be hard to implement.

> Could the new syntax accept both variables and specifications, e.g.,
>
>    (list "glib:bin" foo "bar@2.3")
>
> ?

No!  I mean, yes it could, but no, I don’t think that’s a good idea.
:-)

In terms of API, I prefer clarity; in this case, I think inputs should
be a list of packages or other “lowerable” objects, rather than a list
of “anything” that could be magically interpreted at run time.

More importantly, I think package specs are a UI feature, and that
packages should be separate from UI concerns.  Specs are implemented in
(gnu packages), not in (guix …) for a reason: it’s a feature that makes
sense in the distro, not in the core Guix machinery where there’s no
“package set” to traverse.

I hope that makes sense!

Ludo’.

Re: [PATCH RFC 0/4] Getting rid of input labels?

[Ryan Prior]

On Wednesday, May 26th, 2021 at 2:02 PM, Ludovic Courtès <ludo@gnu.org> wrote:
> > Could the new syntax accept both variables and specifications, e.g.,
> >
> > (list "glib:bin" foo "bar@2.3")
> >
> > ?
>
> No! I mean, yes it could, but no, I don’t think that’s a good idea.
>
> :-)
>
> In terms of API, I prefer clarity; in this case, I think inputs should
>
> be a list of packages or other “lowerable” objects, rather than a list
>
> of “anything” that could be magically interpreted at run time.

I agree with this, a list of potentially ambiguous "any-type" inputs seems fraught.

I think there's an opportunity to avoid the need to "fall back" to the status quo, though. I picture a structure for inputs that has three cases, trivially decided based on data shape:

- a bare symbol, eg '(tzdata glib)
  this is translated to `(("tzdata" ,tzdata) ("glib" ,glib))
  works the exact same if the symbol is an =origin=, you get the name of the symbol quoted followed by the value of the symbol.

- a 2-tuple, eg '(tzdata ("gnome-lib" glib))
  when we encounter a 2-tuple, we use the first value as the label and the second as the value.
  so this becomes `(("tzdata" ,tzdata) ("gnome-lib" ,glib))

- a 3-tuple, eg '(tzdata ("glib:bin" glib "bin"))
  when we encounter a 3-tuple, we use the first value as the label, second as the value, and third as the output name.


Following this convention, the inputs for most packages will be a list of bare symbols, and packages which need custom labels and/or outputs for some inputs can get them with little effort.


Cheers,
Ryan

Re: [PATCH RFC 0/4] Getting rid of input labels?

[Ludovic Courtès]

Hi,

Ryan Prior <rprior@protonmail.com> skribis:

> I think there's an opportunity to avoid the need to "fall back" to the status quo, though. I picture a structure for inputs that has three cases, trivially decided based on data shape:
>
> - a bare symbol, eg '(tzdata glib)
>   this is translated to `(("tzdata" ,tzdata) ("glib" ,glib))
>   works the exact same if the symbol is an =origin=, you get the name of the symbol quoted followed by the value of the symbol.

A “bare symbol” cannot be translated into a reference to a variable in
the way you write.

I’m leaning towards either the new style:

  (list glib tzdata)

or the old style:

  (("tzdata" ,tzdata) ("glib" ,glib))

but not a mixture of both, which would require more code to be properly
interpreted, leading to slowdowns on the hot path and generally making
it more difficult to interpret what’s in there.

Thanks,
Ludo’.

Re: [PATCH RFC 0/4] Getting rid of input labels?

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 783 bytes --]

Hello!

Ludovic Courtès <ludo@gnu.org> skribis:

> Here’s a proposal for a soft revolution: getting rid of input labels
> in package definitions.  Instead of writing:
>
>     (native-inputs
>      `(("autoconf" ,autoconf)
>        ("automake" ,automake)
>        ("pkg-config" ,pkg-config)
>        ("guile" ,guile-3.0)))
>     
> one can write:
>
>     (native-inputs (list autoconf automake pkg-config guile-3.0))

I’m still looking into the feasibility of this change.  For it to work,
I think it’s better if the transition to the new style is as fast as
possible.  The attached script helps with that: it automatically
converts the source of packages where the conversion does not even
change the package derivation.  It generates diffs like this:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 1319 bytes --]

@@ -280,10 +280,9 @@ during long operations.")
         (base32 "106akalywfmnypzkdrhgz4n4740a8xayspybsw59kq06vz8i2qrc"))))
     (build-system python-build-system)
     (native-inputs
-     `(("python-mock" ,python-mock)
-       ("python-pytest" ,python-pytest)))
+     (list python-mock python-pytest))
     (propagated-inputs
-     `(("python-nltk" ,python-nltk-3.4)))
+     (list python-nltk-3.4))
     (home-page
      "https://github.com/yeraydiazdiaz/lunr.py")
     (synopsis "Full-text search library")
@@ -314,13 +313,13 @@ that best match text queries.")
              (substitute* "setup.py"
                (("==") ">=")))))))
     (propagated-inputs
-     `(("python-click" ,python-click)
-       ("python-jinja2" ,python-jinja2)
-       ("python-livereload" ,python-livereload)
-       ("python-lunr" ,python-lunr)
-       ("python-markdown" ,python-markdown)
-       ("python-pyyaml" ,python-pyyaml)
-       ("python-tornado" ,python-tornado)))
+     (list python-click
+           python-jinja2
+           python-livereload
+           python-lunr
+           python-markdown
+           python-pyyaml
+           python-tornado))
     (home-page "https://www.mkdocs.org")
     (synopsis "Project documentation with Markdown")
     (description "MkDocs is a static site generator geared towards building

[-- Attachment #3: Type: text/plain, Size: 1957 bytes --]


You can run the script to modify, say, all the ‘python*’ packages:

  ./pre-inst-env guile simplify-package-inputs.scm \
    $(./pre-inst-env guix package -A '^python' | cut -f1,2 |tr '\t' '@')

It runs in a minute and the resulting diff looks like this:

  100 files changed, 4423 insertions(+), 5180 deletions(-)

The script warns when it fails to convert a package or when a comment
could not be preserved during conversion (it tries to preserve margin
comments but it’s a bit of a hack since neither ‘read’ nor
‘pretty-print’ help with that):

--8<---------------cut here---------------start------------->8---
gnu/packages/wxwidgets.scm:318:5: warning: python2-wxpython: input label 'wxwidgets' does not match package name, bailing out
gnu/packages/wxwidgets.scm:315:5: warning: python2-wxpython: margin comment will be lost
gnu/packages/web.scm:6503:7: warning: python2-clf: non-trivial input, bailing out
gnu/packages/web.scm:6503:7: warning: python-clf: non-trivial input, bailing out
gnu/packages/tryton.scm:594:5: warning: python-trytond-party: input label 'python-stnum' does not match package name, bailing out
gnu/packages/tls.scm:612:5: warning: python-acme: margin comment will be lost
gnu/packages/time.scm:435:5: warning: python-arrow: margin comment will be lost
gnu/packages/sphinx.scm:133:21: warning: python2-sphinx: computed input list, bailing out
--8<---------------cut here---------------end--------------->8---

I don’t have hard figures but I think the majority of packages are
handled, which means we could do a big switch at once, or in a short
amount of time (so we can review removed comments and fix them up).

We could then forcefully convert some of the remaining cases, with the
understanding that the derivation would be different but presumably
valid; finally, there’d be the more complex cases that need to be
manually dealt with.

Thoughts?

Thanks,
Ludo’.


[-- Attachment #4: the script --]
[-- Type: text/plain, Size: 8376 bytes --]

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;;
;;; This script updates package definitions so they use the "simplified" style
;;; for input lists, as in:
;;;
;;;  (package
;;;    ;; ...
;;;    (inputs (list foo bar baz)))
;;;
;;; Code:

(use-modules (gnu packages)
             (guix packages)
             (guix utils)
             (guix i18n)
             (guix diagnostics)
             (ice-9 control)
             (ice-9 match)
             (ice-9 pretty-print)
             (srfi srfi-26))

(define (simplify-inputs location package str inputs)
  "Simplify the inputs field of PACKAGE (a string) at LOCATION; its current
value is INPUTS the corresponding source code is STR.  Return a string to
replace STR."
  (define (label-matches? label name)
    ;; Return true if LABEL matches NAME, a package name.
    (or (string=? label name)
        (and (string-prefix? "python-" label)
             (string-prefix? "python2-" name)
             (string=? (string-drop label (string-length "python-"))
                       (string-drop name (string-length "python2-"))))))

  (define (insert-margin-comments exp new-str)
    ;; Given NEW-STR, a pretty-printed representation of EXP, insert margin
    ;; comments that appeared in STR, the original source, when possible.
    (if (string-index str #\;)
        (let ((old-lines (string-split (string-trim-both str) #\newline))
              (new-lines (string-split new-str #\newline)))
          (match exp
            (('list symbols ...)
             (if (= (length old-lines) (length new-lines)
                    (length symbols))
                 (string-join
                  (map (lambda (symbol old-line new-line)
                         (match (string-index old-line #\;)
                           (#f new-line)
                           (index
                            (let ((comment (string-drop old-line index)))
                              (string-append new-line
                                             " "
                                             comment)))))
                       symbols old-lines new-lines)
                  "\n")
                 (begin
                   (warning location (G_ "~a: margin comment will be lost~%")
                            package)
                   new-str)))))
        new-str))

  (define (object->string obj)
    ;; Render OBJ as a string preserving surrounding indentation.  Trim extra
    ;; space on the first line and extra newline at the end.
    (insert-margin-comments
     obj
     (string-trim-both
      (call-with-output-string
        (lambda (port)
          (pretty-print obj port
                        #:width 80
                        #:per-line-prefix
                        (make-string (location-column location)
                                     #\space)))))))

  (let/ec return
    (object->string
     `(list ,@(map (lambda (exp input)
                     (define package* package)

                     (match input
                       ((or ((? string? label) (? package? package))
                            ((? string? label) (? package? package)
                             (? string?)))
                        ;; If LABEL doesn't match PACKAGE's name, then
                        ;; simplifying would incur a rebuild, and perhaps it
                        ;; would break build-side code relying on this
                        ;; specific label.
                        (if (label-matches? label (package-name package))
                            (match exp
                              ((label ('unquote symbol)) symbol)
                              ((label ('unquote symbol) output)
                               (list 'quasiquote
                                     (list (list 'unquote symbol)
                                           output)))
                              (_
                               ;; EXP doesn't look like INPUT.
                               (warning location (G_ "~a: complex expression, \
bailing out~%")
                                        package*)
                               (return str)))
                            (begin
                              (warning location (G_ "~a: input label \
'~a' does not match package name, bailing out~%")
                                       package* label)
                              (return str))))
                       (_
                        (warning location (G_ "~a: non-trivial input, \
bailing out~%")
                                 package*)
                        (return str))))
                   (match (call-with-input-string str read)
                     (('quasiquote (exp ...))
                      ;; If EXP and INPUTS have a different length, that means
                      ;; EXP is a non-trivial input list, for example with
                      ;; input-splicing, conditionals, etc.
                      (unless (= (length exp) (length inputs))
                        (warning location (G_ "~a: computed input list, \
bailing out~%")
                                 package)
                        (return str))
                      exp)
                     (('list _ ...)               ;already done
                      (return str))
                     (_
                      (warning location (G_ "~a: unsupported input style, \
bailing out~%")
                               package)
                      (return str)))
                   inputs)))))

(define (simplify-package-inputs package)
  "Edit the source code of PACKAGE to simplify its inputs field if needed."
  (for-each (lambda (field-name field)
              (match (field package)
                (()
                 #f)
                (inputs
                 (match (package-field-location package field-name)
                   (#f
                    ;; (unless (null? (field package))
                    ;;   (warning (package-location package)
                    ;;            (G_ "source location not found for '~a' of '~a'~%")
                    ;;            field-name (package-name package)))
                    #f)
                   (location
                    (edit-expression (location->source-properties location)
                                     (lambda (str)
                                       (simplify-inputs location
                                                        (package-name package)
                                                        str inputs))))))))
            '(inputs native-inputs propagated-inputs)
            (list package-inputs package-native-inputs
                  package-propagated-inputs)))


(define (package-location<? p1 p2)
  "Return true if P1's location is \"before\" P2's."
  (let ((loc1 (package-location p1))
        (loc2 (package-location p2)))
    (and loc1 loc2
         (if (string=? (location-file loc1) (location-file loc2))
             (< (location-line loc1) (location-line loc2))
             (string<? (location-file loc1) (location-file loc2))))))

(for-each simplify-package-inputs
          ;; Sort package by source code location so that we start editing
          ;; files from the bottom and going upward.  That way, the 'location'
          ;; field of <package> records is not invalidated as we modify files.
          (sort (map specification->package (cdr (command-line)))
                (negate package-location<?)))