environ.scm 5.85 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
;;; Guix-kernel -- Guix kernel for Jupyter
;;; Copyright (C) 2018  Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
;;;
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

17
18
19
20
21
22
23
24
(define-module (guix-kernel environ)
  #:use-module (gnu packages)
  #:use-module (guix licenses)
  #:use-module (guix packages)
  #:use-module (guix records)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix monads)
25
  #:use-module (guix profiles)
26
27
  #:use-module (guix derivations)
  #:use-module (guix build utils)
28
  #:use-module (srfi srfi-1)
29
  #:use-module (srfi srfi-11)
30
  #:use-module (srfi srfi-26)
31
  #:export (guile->bin-path
32
            guile-current-version->path
33
34
            guile-current-load-path->args-list
            guile-current-load-compiled-path->args-list
35

36
            package-in-list->path
37
38
39
            make-new-environment

            env->str))                  ;Export for tests.
40

41
42
(define (store) (open-connection))

43
44
45
;;
;; Guix package.
;;
46

47
48
49
50
51
52
(define (m-package-by-name->package-path name)
  (mlet %store-monad ((drv (package->derivation
                            (specification->package name))))
    (mbegin %store-monad
      (built-derivations (list drv))
      (return (derivation->output-path drv)))))
53

54
55
56
57
(define (package-name->path name)
  "Return store path for package coresponding to NAME."
  (run-with-store (store) (m-package-by-name->package-path name)))

58
59
60
61
62
63
64
65
66
67
68
69
70
71
;;
;; Profile.
;;

(define (m-build-profile->path lst)
  (mlet* %store-monad ((man -> (specifications->manifest lst))
                       (drv    (profile-derivation man)))
    (mbegin %store-monad
      (built-derivations (list drv))
      (return (derivation->output-path drv)))))

(define (new-profile->path packages)
  (run-with-store (store) (m-build-profile->path packages)))

72
73
74
75
76
;;
;; Guile.
;;

(define (guile->bin-path guile)
77
  "Return path to guile executable file. GUILE is package specification."
78
  (string-append guile "/bin/guile"))
79

80
81
(define (guile-current-version->path)
  "Return path to current guile executable file."
82
  (guile->bin-path (package-name->path (string-append "guile" "@" (version)))))
83

84
85
86
87
88
89
90
91
92
93
(define (guile-current-load-path->args-list)
  "Return list of load path with '-L' prefix for each path."
  (append-map (cut list "-L" <>)
              %load-path))

(define (guile-current-load-compiled-path->args-list)
  "Return list of load compiled path with '-C' prefix for each path."
  (append-map (cut list "-C" <>)
              %load-compiled-path))

94
95
96
97
98
99
100
101
102
103
104
105
;;
;; Create environment.
;;

(define (package-in-list->path packages name)
  "Return path for package NAME in PACKAGES list."
  (cond
   ((null? packages) #f)
   ((equal? (car (string-split (car packages) #\@)) name)
    (package-name->path (car packages)))
   (else (package-in-list->path (cdr packages) name))))

106
107
108
(define (make-profile packages)
  "Create profile with all PACKAGES, and return profile path."
  (new-profile->path packages))
109
110
111
112
113

(define (env->str name value)
  (string-append (string-upcase name) "="
                 (if (not value) "" value)))

114
115
116
(define (env-profile->str name profile suffix)
  (env->str name (string-append profile suffix)))

117
(define (make-new-environment environ name packages)
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
  (let* ((home    (env->str "HOME"    (getenv "HOME")))
         (user    (env->str "USER"    (getenv "USER")))
         (logname (env->str "LOGNAME" (getenv "LOGNAME")))
         (term    (env->str "TERM"    (getenv "TERM")))
         (pwd     (env->str "PWD"     (getenv "PWD")))
         (pager   (env->str "PAGER"   (getenv "PAGER")))
         (shell   (env->str "SHELL"   (getenv "SHELL")))
         ;; Modified variables.
         (ps1  (env->str "PS1" (string-append "'Jupyter Guix Kernel ["
                                              name "] -> '")))
         (jenv (env->str "JUPYTER_ENV" name)) ;Environment name.
         ;; Paths.
         (profile  (make-profile packages))
         (path     (env-profile->str "PATH"     profile "/bin"))
         (cpath    (env-profile->str "CPATH"    profile "/include"))
         (infopath (env-profile->str "INFOPATH" profile "/share/info"))
         (manpath  (env-profile->str "MANPATH"  profile "/share/man"))
         (libpath  (env-profile->str "LIBRARY_PATH" profile "/lib"))
         (alocal   (env-profile->str "ALOCAL_PATH"  profile "/shaer/alocal"))
         ;; Jupyter kernels path.
         (jupyter  (env-profile->str "JUPYTER_PATH" profile "/share/jupyter"))
         ;; Guile paths.
         (effective       (effective-version))
         (guile-load-path (env-profile->str "GUILE_LOAD_PATH"
                                            profile
                                            (string-append "/share/guile/site/"
                                                           effective)))
         (guile-compiled  (env-profile->str "GUILE_LOAD_COMPILED_PATH"
                                            profile
                                            (string-append "/lin/guile/"
                                                           effective
                                                           "/site-ccache"))))
    ;; List of environment variables.
    (list home user logname term pwd pager shell ps1 jenv
          ;; Paths.
          path cpath infopath manpath libpath alocal
          ;; Jupyter kernels path.
          jupyter
          ;; Guile paths.
          guile-load-path guile-compiled)))