me
/
guix
Archived
1
0
Fork 0
Code

upstream: Factorize 'package-archive-type'. 

* guix/upstream.scm (package-archive-type): New procedure.
(package-update/url-fetch): Use it.
master
Ludovic Courtès 2022-11-11 12:25:52 +01:00
parent 19206eee69
commit 692d987d0f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 15 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
guix/upstream.scm
View File

@ -78,6 +78,7 @@
lookup-updater lookup-updater
download-tarball download-tarball
package-archive-type
package-latest-release package-latest-release
package-latest-release* package-latest-release*
package-update package-update
@ -430,6 +431,19 @@ values: the item from LST1 and the item from LST2 that match PRED."
(() (()
(values #f #f))))) (values #f #f)))))
(define (package-archive-type package)
"If PACKAGE's source is a tarball or zip archive, return its archive type--a
string such as \"xz\". Otherwise return #f."
(match (and=> (package-source package) origin-actual-file-name)
(#f #f)
(file
(let ((extension (file-extension file)))
;; FILE might be "example-1.2-checkout", in which case we want to
;; ignore the extension.
(and (or (string-contains extension "z")
(string-contains extension "tar"))
extension)))))
(define* (package-update/url-fetch store package source (define* (package-update/url-fetch store package source
#:key key-download) #:key key-download)
"Return the version, tarball, and SOURCE, to update PACKAGE to "Return the version, tarball, and SOURCE, to update PACKAGE to
@ -437,17 +451,7 @@ SOURCE, an <upstream-source>."
(match source (match source
(($ <upstream-source> _ version urls signature-urls) (($ <upstream-source> _ version urls signature-urls)
(let*-values (((archive-type) (let*-values (((archive-type)
(match (and=> (package-source package) origin-uri) (package-archive-type package))
((? string? uri)
(let ((type (or (file-extension (basename uri)) "")))
;; Sometimes we have URLs such as
;; "https://github.com/…/tarball/v0.1", in which case
;; we must not consider "1" as the extension.
(and (or (string-contains type "z")
(string=? type "tar"))
type)))
(_
"gz")))
((url signature-url) ((url signature-url)
;; Try to find a URL that matches ARCHIVE-TYPE. ;; Try to find a URL that matches ARCHIVE-TYPE.
(find2 (lambda (url sig-url) (find2 (lambda (url sig-url)