guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

38/197: installer: Correct bugs generating the configuration.


From: Danny Milosavljevic
Subject: 38/197: installer: Correct bugs generating the configuration.
Date: Mon, 3 Jul 2017 20:36:56 -0400 (EDT)

dannym pushed a commit to branch wip-installer-2
in repository guix.

commit 8735eb12a041d6606f2570afaa64b46e5e235639
Author: John Darrington <address@hidden>
Date:   Mon Dec 26 20:19:22 2016 +0100

    installer: Correct bugs generating the configuration.
    
    * gnu/system/installer/configure.scm (generate-guix-config): Add 
use-modules,
    and correct errors in the file-system stanza.
---
 gnu/system/installer/configure.scm | 83 +++++++++++++++++++++++---------------
 1 file changed, 50 insertions(+), 33 deletions(-)

diff --git a/gnu/system/installer/configure.scm 
b/gnu/system/installer/configure.scm
index 69a3bce..1013116 100644
--- a/gnu/system/installer/configure.scm
+++ b/gnu/system/installer/configure.scm
@@ -102,39 +102,56 @@
 
 
 (define (generate-guix-config p)
-  (pretty-print
-   `(operating-system
-      (timezone ,time-zone)
-      (host-name ,host-name)
-      (locale "POSIX")
-      ,(let ((grub-mount-point
-              (find-mount-device "/boot/grub"
-                                 mount-points)))
-         (if grub-mount-point
-             `(bootloader
-               (grub-configuration
-                (device
-                 ,(disk-name
-                   (assoc-ref
-                    (partition-volume-pairs)
-                    (find-partition grub-mount-point))))
-                (timeout 2)))))
-
-      (file-systems
-       (cons*
-        ,(map (lambda (x)
-                (let ((z (find-partition (car x))))
-                  `(filesystem
-                    (device ,(car x))
-                    (title 'device)
-                    (mount-point ,(cdr x))
-                    (type ,(partition-fs z)))))
-              mount-points)
-        %base-file-systems))
-      (users (cons* %base-user-accounts))
-      (packages (cons* nss-certs %base-packages))
-      (services (cons* %desktop-services))
-      (name-service-switch %mdns-host-lookup-nss)) p))
+  (let ((grub-mount-point
+         (find-mount-device "/boot/grub"
+                            mount-points)))
+    
+    (pretty-print `(use-modules
+                    (gnu)
+                    ,(when grub-mount-point
+                       `(gnu system grub))
+
+                    (gnu system nss))
+                  p)
+    (newline p)
+
+    (pretty-print 
+     `(use-service-modules desktop) p)
+    (newline p)
+
+    (pretty-print
+     `(use-package-modules certs) p)
+    (newline p)
+
+    (pretty-print
+     `(operating-system
+        (timezone ,time-zone)
+        (host-name ,host-name)
+        (locale "en_US.UTF-8")
+        ,(when grub-mount-point
+           `(bootloader
+             (grub-configuration
+              (device
+               ,(disk-name
+                 (assoc-ref
+                  (partition-volume-pairs)
+                  (find-partition grub-mount-point))))
+              (timeout 2))))
+        
+        (file-systems
+         ,(append (list 'cons*)
+                  (map (lambda (x)
+                         (let ((z (find-partition (car x))))
+                           `(file-system
+                              (device ,(car x))
+                              (title 'device)
+                              (mount-point ,(cdr x))
+                              (type ,(partition-fs z))))) mount-points)
+                  (list '%base-file-systems)))
+        (users (cons* %base-user-accounts))
+        (packages (cons* nss-certs %base-packages))
+        (services (cons* %desktop-services))
+        (name-service-switch %mdns-host-lookup-nss)) p)))
 
 
 (define (configure-page-init p)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]