diff mbox series

[bug#65230,v2,06/13] gnu-maintenance: Extract url->links procedure.

Message ID ae444e17b3e5983bbc44619113d2cc0435e88473.1692131377.git.maxim.cournoyer@gmail.com
State New
Headers show
Series [bug#65230,v2,01/13] gnu-maintenance: Make base-url argument of import-html-release required. | expand

Commit Message

Maxim Cournoyer Aug. 15, 2023, 8:29 p.m. UTC 
* guix/gnu-maintenance.scm (url->links): New procedure.
(import-html-release): Use it.
---

(no changes since v1)

 guix/gnu-maintenance.scm | 19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)
diff mbox series

Patch

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index a314923d3b..2e0fc3e8ab 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -483,6 +483,14 @@  (define (html-links sxml)
       (_
        links))))
 
+(define (url->links url)
+  "Return the unique links on the HTML page accessible at URL."
+  (let* ((uri   (string->uri url))
+         (port  (http-fetch/cached uri #:ttl 3600))
+         (sxml  (html->sxml port)))
+    (close-port port)
+    (delete-duplicates (html-links sxml))))
+
 (define* (import-html-release base-url package
                               #:key
                               (version #f)
@@ -499,12 +507,10 @@  (define* (import-html-release base-url package
 if any.  Otherwise, FILE->SIGNATURE must be a procedure; it is passed a source
 file URL and must return the corresponding signature URL, or #f it signatures
 are unavailable."
-  (let* ((uri   (string->uri (if (string-null? directory)
-                                 base-url
-                                 (string-append base-url directory "/"))))
-         (port  (http-fetch/cached uri #:ttl 3600))
-         (sxml  (html->sxml port))
-         (links (delete-duplicates (html-links sxml))))
+  (let* ((url (if (string-null? directory)
+                  base-url
+                  (string-append base-url directory "/")))
+         (links (url->links url)))
     (define (file->signature/guess url)
       (let ((base (basename url)))
         (any (lambda (link)
@@ -562,7 +568,6 @@  (define* (import-html-release base-url package
     (define candidates
       (filter-map url->release links))
 
-    (close-port port)
     (match candidates
       (() #f)
       ((first . _)