From da137f0b0d3faf6adf89f23fb9bd8a025e8fa063 Mon Sep 17 00:00:00 2001
From: Rutherther <rutherther@ditigal.xyz>
Date: Tue, 15 Jul 2025 21:54:14 +0800
Subject: [PATCH] feat: add make-interpreted-environment

Add easy way for creating an environment with an interpterer,
and expose make-python-environment and make-guile-environment
---
 modules/ruther/environment.scm | 95 +++++++++++++++++++++++++++-------
 1 file changed, 75 insertions(+), 20 deletions(-)

diff --git a/modules/ruther/environment.scm b/modules/ruther/environment.scm
index 2fc74a93ff59e2a46eae5aaae30333e5b78f91f3..df6813944b4364aa824d7369e67b56c0afe5b8e0 100644
--- a/modules/ruther/environment.scm
+++ b/modules/ruther/environment.scm
@@ -1,10 +1,16 @@
 (define-module (ruther environment)
   #:use-module (guix profiles)
+  #:use-module (gnu packages)
   #:use-module (guix gexp)
   #:use-module (guix packages)
   #:use-module (guix build-system trivial)
   #:use-module (gnu packages bash)
-  #:export (make-environment))
+  #:use-module (gnu packages python)
+  #:use-module (gnu packages guile)
+  #:export (make-environment
+             make-interpreted-environment
+             make-python-environment
+             make-guile-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,
@@ -37,7 +43,29 @@
                      (mkdir-p #$output)
 
                      ;; Iterate all binary-paths under profile and make scripts in output
-                     (let ((profile-path #$profile))
+                     (let* ((profile-path #$profile)
+                            (not-directory? (lambda (base-path)
+                                              (lambda (path)
+                                                (let ((s (stat (string-append base-path "/" path))))
+                                                  (not (eq? (stat:type s) 'directory))))))
+                            (binary-folders (list #$@binary-paths))
+                            (profile-binary-folders (map (lambda (folder)
+                                                           (string-append profile-path "/" folder))
+                                                    binary-folders))
+                            (output-binary-folders (map (lambda (folder)
+                                                           (string-append #$output "/" folder))
+                                                    binary-folders))
+                            (binaries (apply append (map (lambda (folder)
+                                                           (map
+                                                            (lambda (file)
+                                                              (string-append folder "/" file))
+                                                            (scandir (string-append profile-path "/" folder)
+                                                                     (not-directory? (string-append profile-path "/" folder)))))
+                                                         binary-folders)))
+                            (profile-binaries (map (lambda (binary)
+                                                     (string-append profile-path "/" binary))
+                                                   binaries)))
+
                        (define (make-wrapper-script source-file input-file output-file)
                          (call-with-output-file output-file
                            (lambda (port)
@@ -47,25 +75,14 @@
                              (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 mkdir-p output-binary-folders)
                        (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)
+                        (lambda (binary)
+                          (make-wrapper-script
+                           (string-append profile-path "/etc/profile")
+                           (string-append profile-path "/" binary)
+                           (string-append #$output "/" (dirname binary) "/" (#$rename-function (basename binary)))))
+                        (filter #$filter-function binaries))
 
                        ;; Iterate all extra-paths and symlink them to output.
                        (for-each
@@ -79,3 +96,41 @@
      (description #f)
      (home-page #f)
      (license #f))))
+
+(define* (make-interpreted-environment
+          target-name
+          interpreter-package
+          interpreter-binary-name
+          packages-specifications)
+  (make-environment
+    (concatenate-manifests
+     (list (specifications->manifest packages-specifications)
+           (packages->manifest (list interpreter-package))))
+    #:name target-name
+    #:extra-paths '()
+    #:rename-function
+    #~(lambda (file)
+        #$target-name)
+    #:filter-function
+    #~(lambda (file)
+        (string=? (string-append "bin/" #$interpreter-binary-name) file))))
+
+(define* (make-python-environment
+          target-name
+          python-packages
+          #:key (python python))
+  (make-interpreted-environment
+   target-name
+   python
+   "python3"
+   python-packages))
+
+(define* (make-guile-environment
+          target-name
+          guile-packages
+          #:key (guile guile))
+  (make-interpreted-environment
+   target-name
+   python
+   "guile"
+   guile-packages))