From 14ac0b6f85f5b38df9edc0c6edfe896154e4fdf5 Mon Sep 17 00:00:00 2001
From: Rutherther <rutherther@ditigal.xyz>
Date: Tue, 15 Jul 2025 14:57:31 +0800
Subject: [PATCH] feat: Add make-environment

A procedure to make a package that encapsulates a profile.
This is to stop the propagation of propagated-inputs into a profile.
As an example, multiple python library versions can be used like this
inside of one profile, where each python library version is
encapsulated in a separate environment.
---
 modules/ruther/environment.scm | 81 ++++++++++++++++++++++++++++++++++
 1 file changed, 81 insertions(+)
 create mode 100644 modules/ruther/environment.scm

diff --git a/modules/ruther/environment.scm b/modules/ruther/environment.scm
new file mode 100644
index 0000000000000000000000000000000000000000..2fc74a93ff59e2a46eae5aaae30333e5b78f91f3
--- /dev/null
+++ b/modules/ruther/environment.scm
@@ -0,0 +1,81 @@
+(define-module (ruther environment)
+  #:use-module (guix profiles)
+  #:use-module (guix gexp)
+  #:use-module (guix packages)
+  #:use-module (guix build-system trivial)
+  #:use-module (gnu packages bash)
+  #:export (make-environment))
+
+;; Makes a package that uses the given environment, and wraps the binaries in it.
+;; TODO: replace the paths (only in text files!!! not in binaries...) in all extra-paths files,
+;; so instead of symlinking some of the files might have to be just copied and substituted.
+;; this also means it might come in handy to create all directories instead and symlink only the files.
+(define* (make-environment manifest
+                           #:key
+                           (name "environment")
+                           (binary-paths '("bin"))
+                           (extra-paths '("share/info" "share/man" "share/doc" "share/applications"))
+                           (rename-function #~identity)
+                           (filter-function #~(const #t)))
+  "Takes a manifest, makes a package that will have all the binaries the profile has, wrapped to use etc/profile
+"
+  (let ((profile (profile (content manifest))))
+    (package
+     (name name)
+     (version "0")
+     (source #f)
+     (build-system trivial-build-system)
+     (inputs
+      (list bash))
+     (arguments
+      (list
+       #:modules '((guix build utils))
+       #:builder #~(begin
+                     (use-modules (guix build utils)
+                                  (ice-9 format)
+                                  (ice-9 ftw))
+                     (mkdir-p #$output)
+
+                     ;; Iterate all binary-paths under profile and make scripts in output
+                     (let ((profile-path #$profile))
+                       (define (make-wrapper-script source-file input-file output-file)
+                         (call-with-output-file output-file
+                           (lambda (port)
+                             (format port "!#~a/bin/bash~%"
+                                     #$(this-package-input "bash"))
+                             (format port "source ~a~%" source-file)
+                             (format port "exec ~a \"$@\"~%" input-file)))
+                         (chmod output-file #o555))
+
+                       (define (not-directory? base-path)
+                         (lambda (path)
+                           (let ((s (stat (string-append base-path "/" path))))
+                             (not (eq? (stat:type s) 'directory)))))
+
+                       (for-each
+                        (lambda (binary-path)
+                          (mkdir-p (string-append #$output "/" binary-path))
+                          ;; list the files, make scripts in #$output/<binary-path> that call them, with source #$profile/etc/profile prepended
+                          (for-each
+                           (lambda (file-name)
+                             (when (#$filter-function file-name)
+                               (make-wrapper-script
+                                (string-append profile-path "/etc/profile")
+                                (string-append profile-path "/" binary-path "/" file-name)
+                                (string-append #$output "/" binary-path "/" (#$rename-function file-name)))))
+                           (scandir (string-append profile-path "/" binary-path)
+                                    (not-directory? (string-append profile-path "/" binary-path)))))
+                        '#$binary-paths)
+
+                       ;; Iterate all extra-paths and symlink them to output.
+                       (for-each
+                        (lambda (extra-path)
+                          (when (string-contains extra-path "/")
+                            (mkdir-p (string-append #$output "/" (dirname extra-path))))
+                          (symlink (string-append #$profile "/" extra-path)
+                                   (string-append #$output "/" extra-path)))
+                        '#$extra-paths)))))
+     (synopsis #f)
+     (description #f)
+     (home-page #f)
+     (license #f))))