mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2026-04-06 21:20:33 +02:00
f051e75598
Takes an operating-system and generates a manifest out of the packages that can be found in the records. This script is not finished completely, it still requires manual work after generation of the manifest. And it will not generate a complete manifest! This is because the scripts contain additional dependencies that aren't captured anywhere lower in the operating-system record. * etc/teams/release/os-manifest-generator.scm: Add script. Change-Id: Ib9a5683a60e7fef1ce049b1c6c5ec4fc77ce6c58 Signed-off-by: Efraim Flashner <efraim@flashner.co.il>
95 lines
3.2 KiB
Scheme
95 lines
3.2 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
|
;;;
|
|
;;; 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/>.
|
|
|
|
(use-modules (guix packages)
|
|
(guix gexp)
|
|
(gnu services)
|
|
(gnu tests install)
|
|
(ice-9 match)
|
|
(guix utils)
|
|
(srfi srfi-26)
|
|
(srfi srfi-1))
|
|
|
|
;; TODO find a better way to check for thunked fields
|
|
(define* (thunked-field? field obj)
|
|
(and
|
|
(procedure? obj)
|
|
(eq?
|
|
(car (procedure-minimum-arity obj))
|
|
1)
|
|
; Uhhh
|
|
(string-suffix? "(x)>"
|
|
(format #f "~a" obj))))
|
|
|
|
;; Prints names of all packages, prepending the service they
|
|
;; come from.
|
|
(define* (print-all-packages obj #:optional (pred package?))
|
|
(match obj
|
|
((? pred)
|
|
(format #t "\"~a\"~%" (package-name obj))
|
|
(list obj))
|
|
((? gexp?)
|
|
(list))
|
|
((a . b)
|
|
(append (print-all-packages a pred)
|
|
(print-all-packages b pred)))
|
|
((_ ...)
|
|
(apply append
|
|
(map (cut print-all-packages <> pred)
|
|
obj)))
|
|
(#(_ ...)
|
|
(print-all-packages (vector->list obj) proc))
|
|
((or (? service-type?)
|
|
(? origin?))
|
|
(list))
|
|
((? record?)
|
|
(let* ((record-type (record-type-descriptor obj))
|
|
(record-fields (record-type-fields record-type)))
|
|
(when (service? obj)
|
|
(format #t ";; ~a-service~%" (service-type-name (service-kind obj))))
|
|
(apply append
|
|
(map (lambda (field)
|
|
(let* ((accessor (record-accessor record-type field))
|
|
(field-obj (accessor obj)))
|
|
(if (thunked-field? field field-obj)
|
|
(print-all-packages (field-obj obj) pred)
|
|
(print-all-packages field-obj pred))))
|
|
record-fields))))
|
|
((? parameter?)
|
|
(list))
|
|
(_
|
|
(list))))
|
|
|
|
(define full-installer-os
|
|
((@@ (gnu tests install) installation-target-desktop-os-for-gui-tests)))
|
|
|
|
(define minimal-installer-os
|
|
((@@ (gnu tests install) installation-target-os-for-gui-tests)))
|
|
|
|
(display "Full os packages:")
|
|
(print-all-packages full-installer-os)
|
|
(display "Minimal os packages:")
|
|
(print-all-packages minimal-installer-os)
|
|
|
|
;; Note that the printed packages will contain duplicates.
|
|
;; I recommend to first put packages out of the profile service
|
|
;; and out of packages field (they will be above service packages)
|
|
;; at the bottom of the list and then filtering only unique lines, ie.
|
|
;; with `awk '!a[$0]++'`. And lastly removing services that no longer
|
|
;; have packages and also the packages that are already in minimal manifest
|
|
;; (in case of desktop manifest)
|