~ruther/guix-exprs

ref: da137f0b0d3faf6adf89f23fb9bd8a025e8fa063 guix-exprs/modules/ruther/environment.scm -rw-r--r-- 6.1 KiB
da137f0b — Rutherther feat: add make-interpreted-environment 2 months ago 
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136

(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)
  #: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,
;; 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)
                            (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)
                             (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))

                       (for-each mkdir-p output-binary-folders)
                       (for-each
                        (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
                        (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))))

(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))