123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118 |
- (define-module (guix import gnome)
- #:use-module (guix upstream)
- #:use-module (guix utils)
- #:use-module (guix packages)
- #:use-module (guix http-client)
- #:use-module (json)
- #:use-module (srfi srfi-1)
- #:use-module (srfi srfi-11)
- #:use-module (srfi srfi-34)
- #:use-module (web uri)
- #:use-module (ice-9 match)
- #:export (%gnome-updater))
- (define (jsonish->upstream-source name jsonish)
- "Return an <upstream-source> object for package NAME, using JSONISH as the
- source for metadata."
- (match jsonish
- ((version . dictionary)
- (upstream-source
- (package name)
- (version version)
- (urls (filter-map (lambda (extension)
- (match (assoc-ref dictionary extension)
- (#f
- #f)
- ((? string? relative-url)
- (string-append "mirror://gnome/sources/"
- name "/" relative-url))))
- '("tar.lz" "tar.xz" "tar.bz2" "tar.gz")))))))
- (define (latest-gnome-release package)
- "Return the latest release of PACKAGE, a GNOME package, or #f if it could
- not be determined."
- (define %not-dot
- (char-set-complement (char-set #\.)))
- (define (even-minor-version? version)
- (match (string-tokenize version %not-dot)
- (((= string->number major) (= string->number minor) . rest)
- (and minor (even? minor)))
- (((= string->number major) . _)
-
- major)))
- (define upstream-name
-
- (package-upstream-name package))
- (guard (c ((http-get-error? c)
- (if (= 404 (http-get-error-code c))
- #f
- (raise c))))
- (let* ((port (http-fetch/cached
- (string->uri (string-append
- "https://ftp.gnome.org/pub/gnome/sources/"
- upstream-name "/cache.json"))
-
-
- #:ttl (* 60 10)
-
- #:log-port (%make-void-port "w")))
- (json (json->scm port)))
- (close-port port)
- (match json
- (#(4 releases _ ...)
- (let* ((releases (assoc-ref releases upstream-name))
- (latest (fold (match-lambda*
- (((key . value) result)
- (cond ((even-minor-version? key)
- (match result
- (#f
- (cons key value))
- ((newest . _)
- (if (version>? key newest)
- (cons key value)
- result))))
- (else
- result))))
- #f
- releases)))
- (and latest
- (jsonish->upstream-source upstream-name latest))))))))
- (define %gnome-updater
- (upstream-updater
- (name 'gnome)
- (description "Updater for GNOME packages")
- (pred (url-prefix-predicate "mirror://gnome/"))
- (latest latest-gnome-release)))
|