GNU bug report logs - #76661
[PATCH 1/1] guix appstream: New script.

Previous Next

Full log

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Noé Lopez <noe <at> xn--no-cja.eu>
To: guix-patches <at> gnu.org
Cc: Noé Lopez <noe <at> xn--no-cja.eu>
Subject: [PATCH 1/1] guix appstream: New script.
Date: Sat,  1 Mar 2025 17:44:46 +0100

From: Noé Lopez <noelopez <at> free.fr>

* Makefile.am (MODULES): Add (guix scripts appstream).
* guix/import/utils.scm (license->spdx-string): New function.
* guix/scripts/appstream.scm: New script.

Change-Id: Ie6246b0d46d2796664944657349edd3de3f6596c
---
 Makefile.am                |   1 +
 guix/import/utils.scm      |  14 +++++
 guix/scripts/appstream.scm | 125 +++++++++++++++++++++++++++++++++++++
 3 files changed, 140 insertions(+)
 create mode 100644 guix/scripts/appstream.scm

diff --git a/Makefile.am b/Makefile.am
index f759803b8b..95529ca88d 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -319,6 +319,7 @@ MODULES =					\
   guix/import/texlive.scm   			\
   guix/import/utils.scm				\
   guix/scripts.scm				\
+  guix/scripts/appstream.scm			\
   guix/scripts/download.scm			\
   guix/scripts/perform-download.scm		\
   guix/scripts/build.scm			\
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 6f5efa790e..5d63415435 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -72,6 +72,7 @@ (define-module (guix import utils)
             package->definition
 
             spdx-string->license
+            license->spdx-string
             license->symbol
 
             snake-case
@@ -308,6 +309,19 @@ (define (spdx-string->license str)
           ;; GNU licenses (see above).  Here, we handle other uses of +.
           (spdx-string->license (string-drop-right str 1))))))
 
+(define (license->spdx-string license)
+  "Convert LICENSE to an SPDX license identifier. Return #f if LICENSE does not match
+any known SPDX license identifiers."
+  (let ((license (license->symbol license)))
+    (let loop ((licenses %spdx-license-identifiers))
+      (cond
+       ((null? licenses)
+        #f)
+       ((eq? license (cdr (car licenses)))
+        (car (car licenses)))
+       (else
+        (loop (cdr licenses)))))))
+
 (define (license->symbol license)
   "Convert LICENSE object to a prefixed symbol representing the variable the
 object is bound to in the (guix licenses) module, such as 'license:gpl3+, or
diff --git a/guix/scripts/appstream.scm b/guix/scripts/appstream.scm
new file mode 100644
index 0000000000..6ba60d811b
--- /dev/null
+++ b/guix/scripts/appstream.scm
@@ -0,0 +1,125 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Noé Lopez <noelopez <at> free.fr>
+;;;
+;;; 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/>.
+
+(define-module (guix scripts appstream)
+  #:use-module ((gnu packages package-management) #:select (current-guix))
+  #:use-module ((guix config) #:select (%system))
+  #:use-module ((guix import utils) #:select (license->spdx-string))
+  #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (gnu packages)
+  #:use-module (guix gexp)
+  #:use-module (guix modules)
+  #:use-module (guix monads)
+  #:use-module (guix packages)
+  #:use-module (guix progress)
+  #:use-module (guix store)
+  #:use-module (guix scripts)
+  #:use-module (guix ui)
+  #:use-module (ice-9 match)
+  #:use-module (sxml simple)
+  #:use-module (srfi srfi-37)
+  #:export (guix-appstream))
+
+(define %repo-id (string-append "guix-" (package-version (current-guix))))
+
+(define (appstream-catalog reporter)
+  (sxml->xml (packages->catalog reporter)))
+
+(define (packages->catalog reporter)
+  (let ((components
+         (fold-packages
+          (lambda (package result)
+            (reporter)
+            (cons (package->component package) result))
+          '())))
+    `(components (@ (version "0.14")
+                    (origin ,%repo-id))
+                 ,components)))
+
+(define (package->component package)
+  `(component (@ (type "desktop-application"))   ;apps don’t appear in gnome software if we don’t set this…
+    ;; FIXME: version?
+    (id ,(string-append (package-name package))) ;ideally should be rDNS
+    (name ,(package-name package))
+    (pkgname ,(package-name package))
+    (project_license ,(licenses->project-license (package-license package)))
+    (summary ,(package-synopsis-string package))
+    ;;FIXME: handle markup https://www.freedesktop.org/software/appstream/docs/chap-CatalogData.html#tag-ct-description
+    (description ,(package-description-string package))
+    (url (@ (type "homepage"))
+            ,(package-home-page package))))
+
+(define (licenses->project-license licenses)
+  (cond
+   ((list? licenses)
+    (string-join (map license->project-license licenses) " AND ")) ;could be OR, but we don’t know
+   (else
+    (license->project-license licenses))))
+
+(define (license->project-license license)
+  (cond
+   ((eq? license #f)
+    "LicenseRef-proprietary")           ;shouldn’t happen, of course
+   (else
+    (or (license->spdx-string license)
+        (license-ref-for-uri (license:license-uri license))))))
+
+(define (license-ref-for-uri uri)
+  (if uri
+    (string-append "LicenseRef=" uri)
+    "LicenseRef"))
+
+(define package-count (length (all-packages)))
+(define progress-bar (progress-reporter/bar package-count (G_ "Processing packages")))
+
+
+(define (show-help)
+  (display (G_ "Usage: guix appstream [OPTION]...
+Generate an appstream catalog of all available packages."))
+  (newline)
+  (display (G_ "
+  -h, --help             display this help and exit"))
+  (display (G_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+(define %options
+  ;; Specification of the command-line options.
+  (list (option '(#\h "help") #f #f
+                (lambda args
+                  (leave-on-EPIPE (show-help))
+                  (exit 0)))
+        (option '(#\V "version") #f #f
+                (lambda args
+                  (show-version-and-exit "guix appstream")))))
+
+(define-command (guix-appstream . args)
+  (synopsis "generate an appstream catalog")
+
+  (define opts
+    (parse-command-line args %options '(())
+                        #:build-options? #f))
+  (define output-file (string-append %repo-id ".xml"))
+
+  (call-with-progress-reporter progress-bar
+    (lambda (reporter)
+      (with-output-to-file output-file
+        (lambda ()
+          (appstream-catalog reporter)))))
+  (simple-format #t (G_ "Created ~a with ~a packages~%") output-file package-count))
-- 
2.48.1

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.