From 7015a2ba53c3f01fc361b99de4f66aec96d304a3 Mon Sep 17 00:00:00 2001
From: Rutherther <rutherther@ditigal.xyz>
Date: Sat, 12 Sep 2026 18:58:53 +0200
Subject: [PATCH] refactor: simplify non-grafted gc-root helper and disable it
 by default

---
 config.scm | 89 +++++++++++-------------------------------------------
 1 file changed, 18 insertions(+), 71 deletions(-)

diff --git a/config.scm b/config.scm
index 1932b3eb387754072de257de202865586d38b854..76d42218693e989a5b44334e5edd932544d01848 100644
--- a/config.scm
+++ b/config.scm
@@ -20,6 +20,7 @@
  (guix utils)
  (guix packages)
  (guix build-system gnu)
+ (guix build-system trivial)
  (gnu system accounts)
  (ruther services system)
  (ruther services bind)
@@ -417,93 +418,39 @@
              (ice-9 match)
              (guix records))
 
-(define-record-type <non-grafted>
-  (non-grafted derivation)
-  non-grafted?
-  (derivation non-grafted-derivation))
-
-(define-gexp-compiler (non-grafted-compiler (non-grafted <non-grafted>) system target)
-  (mlet* %store-monad ((drv (non-grafted-derivation non-grafted)))
-    (without-grafting
-     (gexp->derivation "non-grafted"
-                       #~(symlink #$drv #$output)))))
-
-(define-record-type* <drv-name>
-  drv-name-record drv-name
-  drv-name?
-  (derivation drv-name-derivation)
-  (override-grafts? drv-name-override-grafts?
-                    (default #f)))
-
-(define-gexp-compiler (drv-name-compiler (drv-name <drv-name>) system target)
-  (let ((drv-name-store (derivation->drv-name (drv-name-derivation drv-name))))
-    (if (drv-name-override-grafts? drv-name)
-        (without-grafting drv-name-store)
-        drv-name-store)))
+(define (non-grafted file)
+  (computed-file
+   "non-grafted"
+   #~(symlink
+      #$(with-parameters
+            ((%graft? #f))
+          file)
+      #$output)))
 
 (define <operating-system> (@@ (gnu system) <operating-system>))
 (define-gexp-compiler (os-compiler (os <operating-system>) system target)
   (operating-system-derivation os))
 
-;; I don't know why the inputs aren't getting grafted here, but they aren't, that's good here.
-(define (make-non-grafted-package pkgs)
-  (package
-    (name "non-grafted-pkg")
-    (version "0")
-    (synopsis #f)
-    (source #f)
-    (description #f)
-    (home-page #f)
-    (license #f)
-    (build-system (@ (guix build-system trivial) trivial-build-system))
-    ;; (inputs pkgs)
-    (arguments
-     (list
-      #:builder #~(begin
-                    (use-modules
-                     (srfi srfi-19))
-
-                    (mkdir #$output)
-
-                    (for-each (lambda (pkg)
-                                (symlink
-                                 pkg
-                                 (string-append #$output "/" (basename pkg))))
-                              '#$pkgs)
-
-                    (symlink #$guile-3.0:debug (string-append #$output "/" "guile-debug"))
-                    (symlink #$(libc-utf8-locales-for-target):static (string-append #$output "/" "guile-debug"))
-
-                    ;; (for-each (lambda (pkg)
-                    ;;             (unless (file-exists? (string-append #$output "/" (basename pkg)))
-                    ;;               (symlink
-                    ;;                pkg
-                    ;;                (string-append #$output "/" (basename pkg)))))
-                    ;;           (map cdr %build-inputs))
-                    )))))
-
 ;; Takes an operating system and gc roots its derivation
 (define (operating-system-with-build-inputs os)
   (operating-system
     (inherit os)
-    (services (operating-system-user-services os))
     (services
      (cons*
       (simple-service 'gc-root-system-derivation
                       gc-root-service-type
                       (list
-                       (drv-name (operating-system-derivation os) #t)
-                       (drv-name (operating-system-derivation os) #f)
-                       (non-grafted (operating-system-derivation os))
+                       (non-grafted os)
                        (libc-utf8-locales-for-target)
                        guile-3.0
-                       (make-non-grafted-package
-                        (list
-                         guile-3.0
-                         ;; `(,guile-3.0 "debug")
-                         (libc-utf8-locales-for-target)
-                         texinfo))))
+                       ;; (map
+                       ;;  non-grafted
+                       ;;  (list
+                       ;;   guile-3.0
+                       ;;   (libc-utf8-locales-for-target)
+                       ;;   texinfo))
+                       ))
       (operating-system-user-services os)))))
 
-(operating-system-with-build-inputs %ruther/base-laptop-os)
+;; (operating-system-with-build-inputs %ruther/base-laptop-os)
 %ruther/base-laptop-os