[PATCH 1/3] utils: Add 'edit-expression'.

[PATCH 1/3] utils: Add 'edit-expression'.

[宋文武]

* guix/utils.scm (edit-expression): New procedure.
* tests/utils.scm (edit-expression): New test.
---
 guix/utils.scm  | 37 +++++++++++++++++++++++++++++++++++++
 tests/utils.scm | 13 +++++++++++++
 2 files changed, 50 insertions(+)

diff --git a/guix/utils.scm b/guix/utils.scm
index de54179..1318dac 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -86,6 +86,7 @@
             split
             cache-directory
             readlink*
+            edit-expression
 
             filtered-port
             compressed-port
@@ -318,6 +319,42 @@ a list of command-line arguments passed to the compression program."
         (unless (every (compose zero? cdr waitpid) pids)
           (error "compressed-output-port failure" pids))))))
 
+(define* (edit-expression source-properties proc #:key (encoding "UTF-8"))
+  "Edit the expression specified by SOURCE-PROPERTIES using PROC, which should
+be a procedure that take the original expression in string and returns a new
+one.  ENCODING will be used to interpret all port I/O, it default to UTF-8."
+  (with-fluids ((%default-port-encoding encoding))
+    (let*-values (((file line column)
+                   (values
+                    (assoc-ref source-properties 'filename)
+                    (assoc-ref source-properties 'line)
+                    (assoc-ref source-properties 'column)))
+                  ((start end) ; start and end byte positions of the expression
+                   (call-with-input-file file
+                     (lambda (port)
+                       (values
+                        (begin (while (not (and (= line (port-line port))
+                                                (= column (port-column port))))
+                                 (when (eof-object? (read-char port))
+                                   (error 'end-of-file file)))
+                               (ftell port))
+                        (begin (read port)
+                               (ftell port))))))
+                  ((pre-bv expr post-bv)
+                   (call-with-input-file file
+                     (lambda (port)
+                       (values (get-bytevector-n port start)
+                               (get-string-n port (- end start))
+                               (get-bytevector-all port))))))
+      (with-atomic-file-output file
+        (lambda (port)
+          (put-bytevector port pre-bv)
+          (display (proc expr) port)
+          ;; post-bv maybe the end-of-file object.
+          (when (not (eof-object? post-bv))
+            (put-bytevector port post-bv))
+          #t)))))
+
 \f
 ;;;
 ;;; Advisory file locking.
diff --git a/tests/utils.scm b/tests/utils.scm
index 6b77255..d0ee02a 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -333,6 +333,19 @@
                "This is a journey\r\nInto the sound\r\nA journey ...\n")))
     (get-string-all (canonical-newline-port port))))
 
+
+(test-equal "edit-expression"
+  "(display \"GNU Guix\")\n(newline)\n"
+  (begin
+    (call-with-output-file temp-file
+      (lambda (port)
+        (display "(display \"xiuG UNG\")\n(newline)\n" port)))
+    (edit-expression `((filename . ,temp-file)
+                       (line     . 0)
+                       (column   . 9))
+                     string-reverse)
+    (call-with-input-file temp-file get-string-all)))
+
 (test-end)
 
 (false-if-exception (delete-file temp-file))
-- 
2.6.3

[PATCH 2/3] utils: Add 'location->source-properties'.

[宋文武]

* guix/utils (location-source->properties): New procedure.
---
 guix/utils.scm | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/guix/utils.scm b/guix/utils.scm
index 1318dac..50f4bcd 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -60,6 +60,7 @@
             location-line
             location-column
             source-properties->location
+            location->source-properties
 
             nix-system->gnu-triplet
             gnu-triplet->nix-system
@@ -892,3 +893,10 @@ etc."
     ;; In accordance with the GCS, start line and column numbers at 1.  Note
     ;; that unlike LINE and `port-column', COL is actually 1-indexed here...
     (location file (and line (+ line 1)) col)))
+
+(define (location->source-properties loc)
+  "Return the source property association list based on the info in LOC,
+a location object."
+  `((line     . ,(and=> (location-line loc) 1-))
+    (column   . ,(location-column loc))
+    (filename . ,(location-file loc))))
-- 
2.6.3

[PATCH 3/3] gnu-maintenance: update-package-source: Only update the desired package.

[宋文武]

Fixes <http://bugs.gnu.org/22693>.
Suggested by Andy Wingo.

* guix/upstream.scm (update-package-source): Rewrite in terms of 'edit-expression'.
---
 guix/upstream.scm | 68 +++++++++++++++++++------------------------------------
 1 file changed, 23 insertions(+), 45 deletions(-)

diff --git a/guix/upstream.scm b/guix/upstream.scm
index cea23fe..02c50c0 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -22,8 +22,6 @@
   #:use-module (guix utils)
   #:use-module ((guix download)
                 #:select (download-to-store))
-  #:use-module ((guix build utils)
-                #:select (substitute))
   #:use-module (guix gnupg)
   #:use-module (guix packages)
   #:use-module (guix ui)
@@ -205,52 +203,32 @@ and 'interactive' (default)."
   "Modify the source file that defines PACKAGE to refer to VERSION,
 whose tarball has SHA256 HASH (a bytevector).  Return the new version string
 if an update was made, and #f otherwise."
-  (define (new-line line matches replacement)
-    ;; Iterate over MATCHES and return the modified line based on LINE.
-    ;; Replace each match with REPLACEMENT.
-    (let loop ((m* matches)                       ; matches
-               (o  0)                             ; offset in L
-               (r  '()))                          ; result
-      (match m*
-        (()
-         (let ((r (cons (substring line o) r)))
-           (string-concatenate-reverse r)))
-        ((m . rest)
-         (loop rest
-               (match:end m)
-               (cons* replacement
-                      (substring line o (match:start m))
-                      r))))))
-
-  (define (update-source file old-version version
-                         old-hash hash)
-    ;; Update source file FILE, replacing occurrences OLD-VERSION by VERSION
-    ;; and occurrences of OLD-HASH by HASH (base32 representation thereof).
-
-    ;; TODO: Currently this is a bit of a sledgehammer: if VERSION occurs in
-    ;; different unrelated places, we may modify it more than needed, for
-    ;; instance.  We should try to make changes only within the sexp that
-    ;; corresponds to the definition of PACKAGE.
+  (define (update-expression expr old-version version old-hash hash)
+    ;; Update package expression EXPR, replacing occurrences OLD-VERSION by
+    ;; VERSION and occurrences of OLD-HASH by HASH (base32 representation
+    ;; thereof).
     (let ((old-hash (bytevector->nix-base32-string old-hash))
           (hash     (bytevector->nix-base32-string hash)))
-      (substitute file
-                  `((,(regexp-quote old-version)
-                     . ,(cut new-line <> <> version))
-                    (,(regexp-quote old-hash)
-                     . ,(cut new-line <> <> hash))))
-      version))
-
-  (let ((name (package-name package))
-        (loc  (package-field-location package 'version)))
-    (if loc
-        (let ((old-version (package-version package))
-              (old-hash    (origin-sha256 (package-source package)))
-              (file        (and=> (location-file loc)
-                                  (cut search-path %load-path <>))))
+      (string-replace-substring
+       (string-replace-substring expr old-hash hash)
+       old-version version)))
+
+  (let ((name        (package-name package))
+        (version-loc (package-field-location package 'version)))
+    (if version-loc
+        (let* ((loc         (package-location package))
+               (old-version (package-version package))
+               (old-hash    (origin-sha256 (package-source package)))
+               (file        (and=> (location-file loc)
+                                   (cut search-path %load-path <>))))
           (if file
-              (update-source file
-                             old-version version
-                             old-hash hash)
+              (and (edit-expression
+                    ;; Be sure to use absolute filename.
+                    (assq-set! (location->source-properties loc)
+                               'filename file)
+                    (cut update-expression <>
+                         old-version version old-hash hash))
+                   version)
               (begin
                 (warning (_ "~a: could not locate source file")
                          (location-file loc))
-- 
2.6.3

Re: [PATCH 1/3] utils: Add 'edit-expression'.

[Andy Wingo]

Looking really good!  A couple nits.

On Wed 06 Apr 2016 12:37, 宋文武 <iyzsong@gmail.com> writes:

> diff --git a/guix/utils.scm b/guix/utils.scm
> index de54179..1318dac 100644
> --- a/guix/utils.scm
> +++ b/guix/utils.scm
> +(define* (edit-expression source-properties proc #:key (encoding "UTF-8"))
> +  "Edit the expression specified by SOURCE-PROPERTIES using PROC, which should
> +be a procedure that take the original expression in string and returns a new
> +one.  ENCODING will be used to interpret all port I/O, it default to UTF-8."
> +  (with-fluids ((%default-port-encoding encoding))
> +    (let*-values (((file line column)
> +                   (values
> +                    (assoc-ref source-properties 'filename)
> +                    (assoc-ref source-properties 'line)
> +                    (assoc-ref source-properties 'column)))
> +                  ((start end) ; start and end byte positions of the expression
> +                   (call-with-input-file file
> +                     (lambda (port)
> +                       (values
> +                        (begin (while (not (and (= line (port-line port))
> +                                                (= column (port-column port))))
> +                                 (when (eof-object? (read-char port))
> +                                   (error 'end-of-file file)))
> +                               (ftell port))
> +                        (begin (read port)
> +                               (ftell port))))))

I think this would be clearer as let*:

  (let* ((file (assoc-ref source-properties 'filename))
         ...
         (port (open-input-file file))
         (start (begin ... (ftell port)))
         ...

> +                  ((pre-bv expr post-bv)
> +                   (call-with-input-file file
> +                     (lambda (port)
> +                       (values (get-bytevector-n port start)
> +                               (get-string-n port (- end start))
> +                               (get-bytevector-all port))))))

But especially here: `values' is not begin, and it doesn't have a
defined order of evaluation.

I suggest instead of opening the file again, just (seek port 0
SEEK_SET), and there you go.

Also I suggest calling it "str" or something because it's not the
expression -- it's the string representation of the expression.

> +      (with-atomic-file-output file
> +        (lambda (port)
> +          (put-bytevector port pre-bv)
> +          (display (proc expr) port)

Here you may want to verify that the result of (proc expr) is readable
as a Scheme expression, to prevent problems down the line.  e.g.

  (let ((str* (proc str)))
    (call-with-input-string str*
      (lambda (port)
        (let lp ()
          (let ((exp (read port)))
            (unless (eof-object? exp)
              (lp)))))))

Dunno, as you like :)

Finally it could be that the file has some other encoding because of a
"coding: foo" directive or something; probably best to explicitly
(set-port-encoding! output-port (port-encoding input-port)) or
something before writing to the port.

All that said -- looks good to me, thank you for putting in the effort!

Andy

[PATCH][UPDATE] utils: Add 'edit-expression'.

[宋文武]

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

Andy Wingo <wingo@igalia.com> writes:

> Looking really good!  A couple nits.
>
> On Wed 06 Apr 2016 12:37, 宋文武 <iyzsong@gmail.com> writes:
>
>> diff --git a/guix/utils.scm b/guix/utils.scm
>> index de54179..1318dac 100644
>> --- a/guix/utils.scm
>> +++ b/guix/utils.scm
>> +(define* (edit-expression source-properties proc #:key (encoding "UTF-8"))
>> +  "Edit the expression specified by SOURCE-PROPERTIES using PROC, which should
>> +be a procedure that take the original expression in string and returns a new
>> +one.  ENCODING will be used to interpret all port I/O, it default to UTF-8."
>> +  (with-fluids ((%default-port-encoding encoding))
>> +    (let*-values (((file line column)
>> +                   (values
>> +                    (assoc-ref source-properties 'filename)
>> +                    (assoc-ref source-properties 'line)
>> +                    (assoc-ref source-properties 'column)))
>> +                  ((start end) ; start and end byte positions of the expression
>> +                   (call-with-input-file file
>> +                     (lambda (port)
>> +                       (values
>> +                        (begin (while (not (and (= line (port-line port))
>> +                                                (= column (port-column port))))
>> +                                 (when (eof-object? (read-char port))
>> +                                   (error 'end-of-file file)))
>> +                               (ftell port))
>> +                        (begin (read port)
>> +                               (ftell port))))))
>
> I think this would be clearer as let*:
>
>   (let* ((file (assoc-ref source-properties 'filename))
>          ...
>          (port (open-input-file file))
>          (start (begin ... (ftell port)))
>          ...
>
>> +                  ((pre-bv expr post-bv)
>> +                   (call-with-input-file file
>> +                     (lambda (port)
>> +                       (values (get-bytevector-n port start)
>> +                               (get-string-n port (- end start))
>> +                               (get-bytevector-all port))))))
>
> But especially here: `values' is not begin, and it doesn't have a
> defined order of evaluation.
Oh, thanks!
>
> I suggest instead of opening the file again, just (seek port 0
> SEEK_SET), and there you go.
OK.
>
> Also I suggest calling it "str" or something because it's not the
> expression -- it's the string representation of the expression.
>
>> +      (with-atomic-file-output file
>> +        (lambda (port)
>> +          (put-bytevector port pre-bv)
>> +          (display (proc expr) port)
>
> Here you may want to verify that the result of (proc expr) is readable
> as a Scheme expression, to prevent problems down the line.  e.g.
>
>   (let ((str* (proc str)))
>     (call-with-input-string str*
>       (lambda (port)
>         (let lp ()
>           (let ((exp (read port)))
>             (unless (eof-object? exp)
>               (lp)))))))
>
> Dunno, as you like :)
I think a simple ‘(call-with-input-string str* read)’ is enough, since
the original expression was from a read.  Also I think it can be emtpy
string (return ‘#<eof>’) to remove the expression.
>
> Finally it could be that the file has some other encoding because of a
> "coding: foo" directive or something; probably best to explicitly
> (set-port-encoding! output-port (port-encoding input-port)) or
> something before writing to the port.
OK, but it seems safe here, since ‘#:guess-encoding’ is default to ‘#f’,
so the I/O ports will both using ‘%default-port-encoding’.


Updated patch:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-utils-Add-edit-expression.patch --]
[-- Type: text/x-patch, Size: 4023 bytes --]

From 7f48e10a37afc9b45daf76db7632d232bed0940b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E5=AE=8B=E6=96=87=E6=AD=A6?= <iyzsong@gmail.com>
Date: Wed, 6 Apr 2016 17:35:13 +0800
Subject: [PATCH] utils: Add 'edit-expression'.

* guix/utils.scm (edit-expression): New procedure.
* tests/utils.scm (edit-expression): New test.
---
 guix/utils.scm  | 40 ++++++++++++++++++++++++++++++++++++++++
 tests/utils.scm | 13 +++++++++++++
 2 files changed, 53 insertions(+)

diff --git a/guix/utils.scm b/guix/utils.scm
index de54179..d82589c 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -41,6 +41,7 @@
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
+  #:use-module ((ice-9 iconv) #:select (bytevector->string))
   #:use-module (system foreign)
   #:export (bytevector->base16-string
             base16-string->bytevector
@@ -86,6 +87,7 @@
             split
             cache-directory
             readlink*
+            edit-expression
 
             filtered-port
             compressed-port
@@ -318,6 +320,44 @@ a list of command-line arguments passed to the compression program."
         (unless (every (compose zero? cdr waitpid) pids)
           (error "compressed-output-port failure" pids))))))
 
+(define* (edit-expression source-properties proc #:key (encoding "UTF-8"))
+  "Edit the expression specified by SOURCE-PROPERTIES using PROC, which should
+be a procedure that take the original expression in string and returns a new
+one.  ENCODING will be used to interpret all port I/O, it default to UTF-8.
+Return #t on success."
+  (with-fluids ((%default-port-encoding encoding))
+    (let* ((file   (assq-ref source-properties 'filename))
+           (line   (assq-ref source-properties 'line))
+           (column (assq-ref source-properties 'column))
+           (in     (open-input-file file))
+           ;; The start byte position of the expression.
+           (start  (begin (while (not (and (= line (port-line in))
+                                           (= column (port-column in))))
+                            (when (eof-object? (read-char in))
+                              (error (format #f "~a: end of file~%" in))))
+                          (ftell in)))
+           ;; The end byte position of the expression.
+           (end    (begin (read in) (ftell in))))
+      (seek in 0 SEEK_SET) ; read from the beginning of the file.
+      (let* ((pre-bv  (get-bytevector-n in start))
+             ;; The expression in string form.
+             (str     (bytevector->string
+                       (get-bytevector-n in (- end start))
+                       (port-encoding in)))
+             (post-bv (get-bytevector-all in))
+             (str*    (proc str)))
+        ;; Verify the edited expression is still a scheme expression.
+        (call-with-input-string str* read)
+        ;; Replace the file with edited expression.
+        (with-atomic-file-output file
+          (lambda (out)
+            (put-bytevector out pre-bv)
+            (display str* out)
+            ;; post-bv maybe the end-of-file object.
+            (when (not (eof-object? post-bv))
+              (put-bytevector out post-bv))
+            #t))))))
+
 \f
 ;;;
 ;;; Advisory file locking.
diff --git a/tests/utils.scm b/tests/utils.scm
index 6b77255..d0ee02a 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -333,6 +333,19 @@
                "This is a journey\r\nInto the sound\r\nA journey ...\n")))
     (get-string-all (canonical-newline-port port))))
 
+
+(test-equal "edit-expression"
+  "(display \"GNU Guix\")\n(newline)\n"
+  (begin
+    (call-with-output-file temp-file
+      (lambda (port)
+        (display "(display \"xiuG UNG\")\n(newline)\n" port)))
+    (edit-expression `((filename . ,temp-file)
+                       (line     . 0)
+                       (column   . 9))
+                     string-reverse)
+    (call-with-input-file temp-file get-string-all)))
+
 (test-end)
 
 (false-if-exception (delete-file temp-file))
-- 
2.6.3


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



Thanks for the guide and review!