mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
c5a5ea63d3
* etc/teams/gnome/gnome-core-refresh (%names): Register pypgobject and pyatspi mappings. Change-Id: I5343870e33fbd25859f5fb39522953225c6236b9
122 lines
4.6 KiB
Scheme
Executable file
122 lines
4.6 KiB
Scheme
Executable file
#!/usr/bin/env -S guix repl --
|
|
!# ;-*- mode: scheme; -*-
|
|
;;; GNU Guix --- Functional package management for GNU
|
|
;;; Copyright © 2025 Maxim Cournoyer <maxim@guixotic.coop>
|
|
;;;
|
|
;;; 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 is a wrapper of 'guix refresh' that refreshes all the GNOME core
|
|
;;; packages listed in their release engineering (releng) list to their stable
|
|
;;; version. Set the PARTIAL_VERSIONS environment variable to update to
|
|
;;; compatible versions instead of exact ones. The GNOME_RELENG_VERSIONS_URI
|
|
;;; environment variable can also point to a different URL or file, for
|
|
;;; example to update to a past GNOME version. The script can be invoked as:
|
|
;;;
|
|
;;; $ ./pre-inst-env etc/teams/gnome/gnome-core-refresh --update
|
|
;;; or
|
|
;;; $ ./pre-inst-env env PARTIAL_VERSIONS=1 etc/teams/gnome/gnome-core-refresh -u
|
|
;;;
|
|
;;; Code:
|
|
|
|
(use-modules (gnu packages)
|
|
(guix diagnostics)
|
|
(guix http-client)
|
|
(guix scripts refresh)
|
|
(guix utils)
|
|
(ice-9 format)
|
|
(ice-9 exceptions)
|
|
(ice-9 match)
|
|
(ice-9 peg)
|
|
(ice-9 textual-ports)
|
|
(srfi srfi-1))
|
|
|
|
(define %gnome-releng-versions-uri
|
|
(make-parameter
|
|
(or (getenv "GNOME_RELENG_VERSIONS_URI")
|
|
"https://gitlab.gnome.org/GNOME/releng/-/raw/master/\
|
|
tools/versions-stable")))
|
|
|
|
(define (fetch-releng-content)
|
|
"Return an input port to the %GNOME-RELENG-VERSIONS-URI file."
|
|
(call-with-port (http-fetch/cached (%gnome-releng-versions-uri))
|
|
get-string-all))
|
|
|
|
(define-exception-type &releng-parser-error &error
|
|
make-releng-parser-error releng-parser-error?)
|
|
|
|
(define-peg-string-patterns "\
|
|
releng <-- (comment / entry)* !.
|
|
entry <-- suite C name C version C subdir NL
|
|
suite <-- text
|
|
name <-- text
|
|
version <-- text
|
|
subdir <-- text?
|
|
text <- (!NL !C .)*
|
|
comment < '#' (!NL .)* NL
|
|
C < ':'
|
|
NL < '\n'")
|
|
|
|
(define %names
|
|
'(("adwaita-fonts" . "font-adwaita")
|
|
("pygobject" . "python-pygobject")
|
|
("pyatspi" . "python-pyatspi")))
|
|
|
|
(define (parse-releng data)
|
|
"Return DATA, a string representing the content of a GNOME releng file, and
|
|
return the complete parse tree."
|
|
(let ((tree (peg:tree (match-pattern releng data))))
|
|
(match tree
|
|
(#f (raise-exception (make-releng-parser-error)))
|
|
(_ tree))))
|
|
|
|
(define (check-package-name name)
|
|
"Return #t if a package corresponding to NAME exists, else #f."
|
|
(catch 'quit
|
|
(lambda ()
|
|
(parameterize ((guix-warning-port (%make-void-port "w")))
|
|
(specification->package name)
|
|
#t))
|
|
(lambda _
|
|
(format (current-error-port) "TODO: package ~a~%" name)
|
|
#f)))
|
|
|
|
(define* (releng-tree->update-specs tree #:key (partial-versions?
|
|
(getenv "PARTIAL_VERSIONS")))
|
|
"Take TREE and return a list of package specifications. If
|
|
PARTIAL-VERSIONS? is true, the least significant digit in version is
|
|
stripped and the version is prefixed with the '~' character, so that 'guix
|
|
refresh' can automatically find the newest compatible version."
|
|
(match tree
|
|
(('releng ('entry ('suite "core") ('name name) ('version version) _) ...)
|
|
(filter-map (lambda (name version)
|
|
(let ((name (or (assoc-ref %names name) name)))
|
|
(and (check-package-name name)
|
|
(if partial-versions?
|
|
(let* ((parts (string-split version #\.))
|
|
(num-parts (length parts)))
|
|
(if (> num-parts 1)
|
|
(format #f "~a=~~~a" name
|
|
(version-prefix version
|
|
(1- num-parts)))
|
|
(format #f "~a=~a" name version)))
|
|
(format #f "~a=~a" name version)))))
|
|
name version))))
|
|
|
|
(apply guix-refresh (append (cdr (command-line))
|
|
(releng-tree->update-specs
|
|
(parse-releng (fetch-releng-content)))))
|