File: bash-without-bash.scm

package info (click to toggle)
gash 0.3.1-1
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 924 kB
  • sloc: lisp: 6,226; makefile: 262; sh: 133
file content (116 lines) | stat: -rw-r--r-- 4,776 bytes parent folder | download
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
;;; Gash -- Guile As SHell
;;; Copyright © 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Gash.
;;;
;;; Gash 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.
;;;
;;; Gash 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 Gash.  If not, see <http://www.gnu.org/licenses/>.

(use-modules ((gnu packages bash) #:select (bash-minimal))
             (gnu packages bootstrap)
             (guix build-system)
             (guix build-system trivial)
             (guix packages)
             (guix store)
             (guix utils)
             (ice-9 match))

(define gash
  (load (string-append (current-source-directory) "/../../guix.scm")))

(define %bootstrap-gash
  (package
    (inherit gash)
    (build-system trivial-build-system)
    (arguments
     `(#:guile ,%bootstrap-guile
       #:modules ((guix build utils))
       #:builder
       (let* ((out     (assoc-ref %outputs "out"))
              (source (assoc-ref %build-inputs "source"))
              (guile-dir (assoc-ref %build-inputs "guile"))
              (guile (string-append guile-dir "/bin/guile"))
              (moddir (string-append out "/share/guile/site/"
                                     (effective-version)))
              (godir (string-append out "/lib/guile/"
                                    (effective-version) "/site-ccache")))
         (use-modules (guix build utils))
         (format #t "Copying source files~%")
         (copy-recursively source "source" #:log #f)
         (format #t "Entering source directory~%")
         (chdir "source")
         (add-to-load-path (getcwd))
         (format #t "Configuring gash/config.scm.in~%")
         (copy-file "gash/config.scm.in" "gash/config.scm")
         (substitute* "gash/config.scm"
           (("@VERSION@") ,(package-version gash)))
         (format #t "Configuring scripts/gash.in~%")
         (copy-file "scripts/gash.in" "scripts/gash")
         (substitute* "scripts/gash"
           (("@GUILE@") guile)
           (("@MODDIR@") moddir)
           (("@GODIR@") godir))
         (for-each (lambda (scm)
                     (let ((go (string-append (string-drop-right scm 3) "go"))
                           (dir (dirname scm)))
                       (format #t "Compiling ~a~%" scm)
                       (compile-file scm #:output-file go)
                       (format #t "Installing ~a~%" scm)
                       (install-file scm (string-append moddir "/" dir))
                       (format #t "Installing ~a~%" go)
                       (install-file go (string-append godir "/" dir))))
                   (find-files "gash" "\\.scm$"))
         (format #t "Installing scripts/gash~%")
         (install-file "scripts/gash" (string-append out "/bin"))
         (chmod (string-append out "/bin/gash") #o555)
         (symlink (string-append out "/bin/gash")
                  (string-append out "/bin/sh"))
         (symlink (string-append out "/bin/gash")
                  (string-append out "/bin/bash")))))
    (inputs `(("guile" ,%bootstrap-guile)))
    (native-inputs '())))

(define %bootstrap-coreutils&co-without-bash
  (package
    (inherit %bootstrap-coreutils&co)
    (arguments
     (substitute-keyword-arguments (package-arguments %bootstrap-coreutils&co)
       ((#:builder _ #f)
        `(let ((source (assoc-ref %build-inputs "source"))
               (out (assoc-ref %outputs "out")))
           (use-modules (guix build utils))
           (copy-recursively source out)
           (delete-file (string-append out "/bin/sh"))
           (delete-file (string-append out "/bin/bash"))))))
    (inputs
     `(("source" ,%bootstrap-coreutils&co)))))

(define (%bootstrap-coreutils&co? x)
  (eq? %bootstrap-coreutils&co x))

(define %boot0-inputs
  (map (match-lambda
         (("coreutils&co" (? %bootstrap-coreutils&co? value))
          `("coreutils&co" ,%bootstrap-coreutils&co-without-bash))
         (("bash" _)
          `("bash" ,%bootstrap-gash))
         (x x))
       ((@@ (gnu packages commencement) %boot0-inputs))))

(package-with-bootstrap-guile
 (package-with-explicit-inputs (package
                                 (inherit bash-minimal)
                                 (name "bash-boot0"))
                               %boot0-inputs
                               #:guile %bootstrap-guile))