From 08b8d5406119df521a3d4179d307564cf4f0cdd8 Mon Sep 17 00:00:00 2001
From: Daniel Ziltener <dziltener@lyrion.ch>
Date: Fri, 1 Dec 2023 14:22:33 +0100
Subject: [PATCH] .

---
 config.org                  | 189 +++++++++++++++++++++++++++++++++++-
 config.scm                  | 130 +++++++++++++------------
 home/home-configuration.scm |   6 +-
 library.org                 |  39 ++++++++
 4 files changed, 297 insertions(+), 67 deletions(-)
 create mode 100644 library.org

diff --git a/config.org b/config.org
index b9b949b..7e98856 100644
--- a/config.org
+++ b/config.org
@@ -1,20 +1,38 @@
 #+TITLE: GUIX System Configuration
+#+AUTHOR: Daniel Ziltener
+#+PROPERTY: header-args:scheme :comments both
+
+#+begin_src emacs-lisp :results none
+  (org-babel-lob-ingest "./library.org")
+#+end_src
 
 * Modules
 
 #+NAME: module-list
 - gnu
-- gnu services avahi
 - gnu services base
+- gnu services dbus
 - gnu services desktop
+- gnu services linux
 - gnu services networking
 - gnu services pm
+- gnu services virtualization
+- gnu services xorg
 - gnu system nss
 
+#+begin_src scheme :noweb yes :exports none :results code :tangle config.scm
+  <<list-to-use(use-call="use-modules",entries=module-list)>>
+#+end_src
+
 ** Service Modules
 
 #+NAME: service-module-list
 - desktop
+- xorg
+
+#+begin_src scheme :noweb yes :exports none :results code :tangle config.scm
+  <<list-to-use(use-call="use-service-modules",entries=service-module-list)>>
+#+end_src
 
 **  Package Modules
 
@@ -22,7 +40,174 @@
 - bootloaders
 - certs
 - emacs
-- swayfx
+- emacs-xyz
+- fonts
+- readline
+- terminals
+- version-control
 - wm
 - xorg
 
+#+begin_src scheme :noweb yes :exports none :results code :tangle config.scm
+  <<list-to-use(use-call="use-package-modules",entries=package-module-list)>>
+#+end_src
+
+* Configuration Definitions
+
+** File System
+
+The variable ~%local-filesystem~ extracts the file system definitions from the installer-provided
+=config.scm= file.
+
+#+begin_src scheme :tangle config.scm
+  (define %local-filesystem
+    (call-with-input-file "/etc/config.scm"
+      (lambda (port)
+        (read port)
+        (read port)
+        (eval (cadar (last-pair (read port)))
+              (interaction-environment)))))
+#+end_src
+
+As a sibling to the former, the variable ~%local-swap~ does the same with the swap partition.
+
+#+begin_src scheme :tangle config.scm
+  (define %local-swap
+    (call-with-input-file "/etc/config.scm"
+      (lambda (port)
+        (read port)
+        (read port)
+        (let* ((os-list (read port))
+               (os-list-length (length os-list)))
+          (eval
+           (cdr
+            (list-ref os-list
+                      (- os-list-length 2)))
+           (interaction-environment))))))
+#+end_src
+
+** Packages
+
+#+NAME: root-packages
+- emacs
+- emacs-desktop-environment
+- font-terminus
+- git
+- nss-certs
+- readline
+- swayfx
+
+#+NAME: root-package-block
+#+begin_src scheme :noweb no-export
+  (packages
+   (append
+    <<org-to-scheme-sym-list(input=root-packages)>>
+    %base-packages))
+#+end_src
+
+** Services
+
+#+NAME: root-services-block
+#+begin_src scheme :noweb yes :exports none :results code
+  (services
+   (append
+    (modify-services
+     %desktop-services
+     (delete login-service-type)
+     (delete mingetty-service-type)
+     (delete console-font-service-type))
+    <<root-simple-service-block>>
+    <<greeter-service>>
+    <<screen-lock-service>>
+    ))
+#+end_src
+
+*** Simple Services
+
+These services are unmodified, or have just few settings.
+
+#+NAME: root-simple-services
+| Service     | Options                                              |
+|-------------+------------------------------------------------------|
+| tlp         | ()                                                   |
+| thermald    | ((adaptive? t))                                      |
+| bluetooth   | ()                                                   |
+| earlyoom    | ((minimum-available-memory 5) (minimum-free-swap 5)) |
+| inputattach | ()                                                   |
+| libvirt     | ((unix-sock-group "libvirt"))                        |
+| fstrim      | ()                                                   |
+| fprintd     | ()                                                   |
+
+#+NAME: root-simple-service-block
+#+begin_src scheme :noweb yes :exports none :results code
+  <<service-converter(input=root-simple-services)>>
+#+end_src
+
+*** Greeter Service
+
+=greetd= is a broken mess, yet here we are.
+
+#+NAME: greeter-service
+#+begin_src scheme
+  (service greetd-service-type
+           (greetd-configuration
+            (greeter-supplementary-groups
+             (list "video" "input"))
+            (terminals
+             (list
+              (greetd-terminal-configuration
+               (terminal-vt "7")
+               (terminal-switch #t)
+               (default-session-command
+                 (greetd-wlgreet-session
+                  (command
+                   (file-append swayfx "/bin/sway")))))
+              (greetd-terminal-configuration
+               (terminal-vt "8"))))))
+#+end_src
+
+*** Screen Locker Service
+
+For some reason, this service runs on root level for Guix.
+
+#+NAME: screen-lock-service
+#+begin_src scheme
+  (service screen-locker-service-type
+           (screen-locker-configuration
+            (name "swaylock")
+            (program
+             (file-append swaylock-effects "/bin/swaylock"))
+            (using-setuid? #f)))
+#+end_src
+
+* Operating System
+
+This is the full operating system specification.
+
+#+begin_src scheme :noweb no-export :results code :tangle config.scm
+  (operating-system
+   (host-name "ziltis-machine")
+   (timezone "Europe/Berlin")
+   (locale "de_DE.utf8")
+   (keyboard-layout
+    (keyboard-layout "de" #:options '("caps:swapescape")))
+   (bootloader
+    (bootloader-configuration
+     (bootloader grup-efi-bootloader)
+     (targets
+      '("/boot/efi"))
+     (keyboard-layout keyboard-layout)))
+   (file-systems %local-filesystem)
+   (swap-devices %local-swap)
+   (users
+    (cons*
+     (user-account
+      (name "zilti")
+      (group "users")
+      (supplementary-groups
+       '("wheel" "netdev" "audio" "video" "libvirt")))
+     %base-user-accounts))
+    <<root-package-block>>
+    <<root-services-block>>
+   (name-service-switch %mdns-host-lookup-nss))
+#+end_src
diff --git a/config.scm b/config.scm
index 386ff60..a3d78df 100644
--- a/config.scm
+++ b/config.scm
@@ -1,10 +1,5 @@
-;; -*- mode: guix-scheme -*-
-
 (use-modules
  (gnu)
- (gnu image)
- (gnu services authentication)
- (gnu services avahi)
  (gnu services base)
  (gnu services dbus)
  (gnu services desktop)
@@ -15,19 +10,21 @@
  (gnu services xorg)
  (gnu system nss))
 
-(use-service-modules desktop
-                     xorg)
+(use-service-modules
+ (desktop)
+ (xorg))
 
-(use-package-modules bootloaders
-                     certs
-                     emacs
-                     emacs-xyz
-                     fonts
-                     readline
-                     terminals
-                     version-control
-                     wm
-                     xorg)
+(use-package-modules
+ (bootloaders)
+ (certs)
+ (emacs)
+ (emacs-xyz)
+ (fonts)
+ (readline)
+ (terminals)
+ (version-control)
+ (wm)
+ (xorg))
 
 (define %local-filesystem
   (call-with-input-file "/etc/config.scm"
@@ -37,67 +34,75 @@
       (eval (cadar (last-pair (read port)))
             (interaction-environment)))))
 
+(define %local-swap
+  (call-with-input-file "/etc/config.scm"
+    (lambda (port)
+      (read port)
+      (read port)
+      (let* ((os-list (read port))
+             (os-list-length (length os-list)))
+        (eval
+         (cdr
+          (list-ref os-list
+                    (- os-list-length 2)))
+         (interaction-environment))))))
+
 (operating-system
  (host-name "ziltis-machine")
  (timezone "Europe/Berlin")
  (locale "de_DE.utf8")
  (keyboard-layout
-  (keyboard-layout "de" #:options
-                   '("caps:swapescape")))
+  (keyboard-layout "de" #:options '("caps:swapescape")))
  (bootloader
   (bootloader-configuration
-   (bootloader grub-efi-bootloader)
+   (bootloader grup-efi-bootloader)
    (targets
     '("/boot/efi"))
    (keyboard-layout keyboard-layout)))
  (file-systems %local-filesystem)
- (swap-devices
-  (list
-   (swap-space
-    (target "/dev/disk/by-partlabel/swap")
-    (discard? #t))))
+ (swap-devices %local-swap)
  (users
   (cons*
    (user-account
     (name "zilti")
     (group "users")
     (supplementary-groups
-     '("wheel"
-       "netdev"
-       "audio"
-       "video"
-       "libvirt")))
+     '("wheel" "netdev" "audio" "video" "libvirt")))
    %base-user-accounts))
- (packages
-  (append
-   (list
-    nss-certs
-    readline
-    emacs
-    emacs-desktop-environment
-    font-terminus
-    git
-    swayfx)
-   %base-packages))
- (services
-  (append
-   (modify-services
-    %desktop-services
-    (delete login-service-type)
-    (delete mingetty-service-type)
-    (delete console-font-service-type))
-   (list
-    (service tlp-service-type)
-    (service thermald-service-type
-             (thermald-configuration
-              (adaptive? #t)))
-    (service bluetooth-service-type)
-    (service inputattach-service-type)
-    (service fstrim-service-type)
-    (service earlyoom-service-type
-             (earlyoom-configuration
-              (minimum-available-memory 5)
-              (minimum-free-swap 5)))
+  (packages
+   (append
+    (list emacs emacs-desktop-environment font-terminus git nss-certs readline swayfx)
+    
+    %base-packages))
+  (services
+   (append
+    (modify-services
+     %desktop-services
+     (delete login-service-type)
+     (delete mingetty-service-type)
+     (delete console-font-service-type))
+    (list
+     (tlp-service-type
+      (tlp-configuration))
+     (thermald-service-type
+      (thermald-configuration
+       (adaptive? t)))
+     (bluetooth-service-type
+      (bluetooth-configuration))
+     (earlyoom-service-type
+      (earlyoom-configuration
+       (minimum-available-memory 5)
+       (minimum-free-swap 5)))
+     (inputattach-service-type
+      (inputattach-configuration))
+     (libvirt-service-type
+      (libvirt-configuration
+       (unix-sock-group "libvirt")))
+     (fstrim-service-type
+      (fstrim-configuration))
+     (fprintd-service-type
+      (fprintd-configuration)))
+    
     (service greetd-service-type
              (greetd-configuration
               (greeter-supplementary-groups
@@ -113,14 +118,11 @@
                      (file-append swayfx "/bin/sway")))))
                 (greetd-terminal-configuration
                  (terminal-vt "8"))))))
-    (service fprintd-service-type)
     (service screen-locker-service-type
              (screen-locker-configuration
               (name "swaylock")
               (program
                (file-append swaylock-effects "/bin/swaylock"))
               (using-setuid? #f)))
-    (service libvirt-service-type
-             (libvirt-configuration
-              (unix-sock-group "libvirt"))))))
+    ))
  (name-service-switch %mdns-host-lookup-nss))
diff --git a/home/home-configuration.scm b/home/home-configuration.scm
index 9915f85..9727d06 100644
--- a/home/home-configuration.scm
+++ b/home/home-configuration.scm
@@ -30,6 +30,7 @@
  (packages
   (specifications->packages
    (list "chicken"
+         "fuzzel"
          "icecat"
          "kitty"
          "pinentry-qt"
@@ -101,7 +102,10 @@
                    (list
                     (channel
                      (name 'ziltis-channel)
-                     (url "https://gitea.lyrion.ch/zilti/guixchannel.git"))))
+                     (url "https://gitea.lyrion.ch/zilti/guixchannel"))
+                    (channel
+                     (name 'nongnu-guix)
+                     (url "https://gitlab.com/nonguix/nonguix"))))
    (service home-openssh-service-type
             (home-openssh-configuration
              (hosts
diff --git a/library.org b/library.org
new file mode 100644
index 0000000..93a24bd
--- /dev/null
+++ b/library.org
@@ -0,0 +1,39 @@
+#+TITLE: Babel Library
+
+This library contains code blocks to be used by other files in this repository.
+
+* Converting Lists
+
+Converting org lists into guix ~use-~ calls.
+
+#+NAME: list-to-use
+#+begin_src emacs-lisp :var use-call="use-modules" :var entries='() :results code
+  `(,(make-symbol use-call)
+    ,@(mapcar (lambda (x)
+                (mapcar (lambda (y) (make-symbol y))
+                        (split-string x)))
+              entries))
+#+end_src
+
+Converting Org lists into Scheme symbol lists.
+
+#+NAME: org-to-scheme-sym-list
+#+begin_src emacs-lisp :var input='() :results code
+  `(list
+    ,@(mapcar (lambda (x) (make-symbol x)) input))
+#+end_src
+
+* Converting Tables
+
+#+NAME: service-converter
+#+begin_src emacs-lisp :var input='() :colnames yes :results code
+  `(list
+    ,@(mapcar
+       (lambda (row)
+         (let ((service-name (cl-first row))
+               (configuration (cl-second row)))
+           `(,(make-symbol (s-concat service-name "-service-type"))
+             (,(make-symbol (s-concat service-name "-configuration"))
+              ,@(car (read-from-string configuration))))))
+       input))
+#+end_src