01/02: system: hurd: Create system profile for guix development.

[guix-commits]

janneke pushed a commit to branch wip-hurd-vm
in repository guix.

commit b4be88fbd59f6e5cd48ede0e418fe2a481fa21ec
Author: Jan (janneke) Nieuwenhuizen <address@hidden>
AuthorDate: Fri Apr 17 07:51:14 2020 +0200

    system: hurd: Create system profile for guix development.
    
    Doing
    
        guix build -f gnu/system/hurd.scm
    
    now produces a VM with a system profile that includes the minimal 
requirements
    to do guix development from git.
    
    * gnu/system/hurd.scm (%hurd-os-development): New variable that includes
    git-minimal and guix build dependencies.
    (cross-hurd-image): Add new keyword parameter `os'; use it instead of global
    %hurd-os and use %base-packages/hurd via os.
    Return thunk for development.
---
 gnu/system/hurd.scm | 39 ++++++++++++++++++++++++++++++++++-----
 1 file changed, 34 insertions(+), 5 deletions(-)

diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index fa2d6fa..3db2eef 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -19,7 +19,10 @@
 
 (define-module (gnu system hurd)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
   #:use-module (guix gexp)
+  #:use-module (guix packages)
   #:use-module (guix profiles)
   #:use-module (guix utils)
   #:use-module (gnu bootloader grub)
@@ -34,6 +37,7 @@
   #:use-module (gnu packages less)
   #:use-module (gnu packages package-management)
   #:use-module (gnu packages ssh)
+  #:use-module (gnu packages version-control)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu services hurd)
@@ -109,6 +113,28 @@
     (pam-services '())
     (setuid-programs '())))
 
+(define (package-node-edges package) ;c&p from guix/scripts/graph.scm
+  "Return the list of dependencies of PACKAGE."
+  (match (package-direct-inputs package)
+    (((labels packages . outputs) ...)
+     ;; Filter out origins and other non-package dependencies.
+     (filter package? packages))))
+
+(define (disjoin . predicates)
+  (lambda (. arguments)
+    (any (cut apply <> arguments) predicates)))
+
+(define %hurd-os-development
+  (operating-system
+    (inherit %hurd-os)
+    (packages (append (list git-minimal)
+                      (filter (negate (compose
+                                       (disjoin (cut member <> '("graphviz" 
"po4a"))
+                                                (cut string-prefix? 
"bootstrap/" <>))
+                                       package-name))
+                              (package-node-edges guix))
+                      %base-packages/hurd))))
+
 (define operating-system-accounts
   (@@ (gnu system) operating-system-accounts))
 
@@ -207,7 +233,7 @@ fi\n")))
     (scheme-file "shepherd.conf" config)))
 
 
-(define* (cross-hurd-image #:key (hurd hurd) (gnumach gnumach))
+(define* (cross-hurd-image #:key (hurd hurd) (gnumach gnumach) (os %hurd-os))
   "Return a cross-built GNU/Hurd image."
 
   (define (cross-built thing)
@@ -223,7 +249,7 @@ fi\n")))
 
   (define system-profile
     (map-manifest-entries cross-built-entry
-                          (packages->manifest %base-packages/hurd)))
+                          (packages->manifest (operating-system-packages os))))
 
   (define grub.cfg
     (let ((hurd (cross-built hurd))
@@ -278,15 +304,15 @@ sshd:x:2:2:sshd:/var/empty:/bin/no-sh
   ;; XXX This still gives 64bit .go files
   ;; (define shepherd.conf
   ;;   (with-parameters ((%current-target-system "i586-pc-gnu"))
-  ;;     (shepherd-configuration-file (hurd-shepherd-services %hurd-os))))
+  ;;     (shepherd-configuration-file (hurd-shepherd-services os))))
 
   (define shepherd.conf
     (with-parameters ((%current-target-system "i586-pc-gnu"))
-      (hurd-shepherd-configuration-file (hurd-shepherd-services %hurd-os))))
+      (hurd-shepherd-configuration-file (hurd-shepherd-services os))))
 
   (define boot-activation
     (with-parameters ((%current-target-system "i586-pc-gnu"))
-      (operating-system-activation-script %hurd-os)))
+      (operating-system-activation-script os)))
 
   (define hurd-directives
     `((directory "/servers")
@@ -370,3 +396,6 @@ sshd:x:2:2:sshd:/var/empty:/bin/no-sh
 
 ;; Return this thunk so one can type "guix build -f gnu/system/hurd.scm".
 cross-hurd-image
+
+;; Return the development thunk so "guix build -f gnu/system/hurd.scm"
+(lambda _ (cross-hurd-image #:os %hurd-os-development))