[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#49280] [PATCH 3/4] gnu: racket-next: Unbundle racket-next-minimal.
From: |
Philip McGrath |
Subject: |
[bug#49280] [PATCH 3/4] gnu: racket-next: Unbundle racket-next-minimal. |
Date: |
Tue, 29 Jun 2021 17:57:41 -0400 |
This takes advantage of improvements since the Racket 8.1 release in support
for layered and tethered installation.
* gnu/packages/racket.scm (extend-layer): New private variable. This is a
script for configuring a new config-tethered layer chaining to an existing
Racket installation.
* gnu/packages/racket.scm (racket-next)[source](snippet): Unbundle
`racket-next-minimal`.
[inputs]: Stop inheriting from `racket`. Remove inputs that properly
beling to `racket-next-minimal`.
[native-inputs]: Add `racket-next-minimal` and `extend-layer`.
[arguments]: Stop inheriting from `racket`.
Add phase 'unpack-packages to move the sources and links file into place.
Replace 'configure phase using `extend-layer`.
Replace 'build phase using `raco setup`.
Delete 'install phase.
---
gnu/packages/racket.scm | 202 +++++++++++++++++++++++++++++++++++++++-
1 file changed, 201 insertions(+), 1 deletion(-)
diff --git a/gnu/packages/racket.scm b/gnu/packages/racket.scm
index 363f19825b..cf0240be5c 100644
--- a/gnu/packages/racket.scm
+++ b/gnu/packages/racket.scm
@@ -272,4 +272,204 @@ languages such as Typed Racket, R5RS and R6RS Scheme,
Algol 60, and Datalog.")))
(base32
"0ysvzgm0lx4b1p4k9balvcbvh2kapbfx91c9ls80ba062cd8y5qv"))
(uri (string-append %pre-release-installers
- "racket-src.tgz"))))))
+ "racket-src.tgz"))
+ (snippet
+ (with-imported-modules '((guix build utils)
+ (ice-9 match)
+ (ice-9 regex))
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 match)
+ (ice-9 regex))
+ ;; unbundle minimal Racket
+ (for-each delete-file-recursively
+ '("collects"
+ "doc"
+ "etc"
+ "README"
+ "src"))
+ ;; unbundle package sources included elsewhere
+ (define (substitute/delete file pattern)
+ (substitute
+ file
+ (list (cons pattern
+ (lambda (line matches)
+ ;; must match exactly once
+ (match matches
+ ((m)
+ (string-append (match:prefix m)
+ (match:suffix m)))))))))
+ (define (unbundle-pkg pkg)
+ (define quoted-pkg (regexp-quote pkg))
+ (with-directory-excursion "share"
+ (substitute/delete
+ "links.rktd"
+ (string-append
+ "[(][^()]+[(]#\"pkgs\" #\""
+ quoted-pkg
+ "\"[)][)]"))
+ (with-directory-excursion "pkgs"
+ (substitute/delete
+ "pkgs.rktd"
+ (string-append
+ "[(]\""
+ quoted-pkg
+ "\" \\. #s[(]"
+ "(pkg-info|[(]sc-pkg-info pkg-info 3[)])"
+ " [(][^()]+[)] [^()]+[)][)]"))
+ (delete-file-recursively pkg))))
+ (unbundle-pkg "racket-lib"))))))
+ (inputs
+ `(("cairo" ,cairo)
+ ("fontconfig" ,fontconfig)
+ ("glib" ,glib)
+ ("glu" ,glu)
+ ("gmp" ,gmp)
+ ("gtk+" ,gtk+) ; propagates gdk-pixbuf+svg
+ ("libjpeg" ,libjpeg-turbo)
+ ("libpng" ,libpng)
+ ("libx11" ,libx11)
+ ("mesa" ,mesa)
+ ("mpfr" ,mpfr)
+ ("pango" ,pango)
+ ("unixodbc" ,unixodbc)
+ ("libedit" ,libedit)))
+ (native-inputs
+ `(("racket" ,racket-next-minimal)
+ ("extend-layer" ,extend-layer)))
+ (arguments
+ `(#:phases
+ (modify-phases %standard-phases
+ (add-before 'configure 'unpack-packages
+ (lambda* (#:key native-inputs inputs outputs #:allow-other-keys)
+ (let ((racket (assoc-ref (or native-inputs inputs) "racket"))
+ (prefix (assoc-ref outputs "out")))
+ (mkdir-p (string-append prefix "/share/racket/pkgs"))
+ (copy-recursively
+ "share/links.rktd"
+ (string-append prefix "/share/racket/links.rktd"))
+ (copy-recursively
+ "share/pkgs"
+ (string-append prefix "/share/racket/pkgs"))
+ #t)))
+ (replace 'configure
+ (lambda* (#:key native-inputs inputs outputs #:allow-other-keys)
+ (let ((racket (assoc-ref (or native-inputs inputs) "racket"))
+ (prefix (assoc-ref outputs "out")))
+ (apply invoke
+ (string-append racket "/bin/racket")
+ (assoc-ref inputs "extend-layer")
+ racket
+ prefix
+ (map
+ (lambda (lib)
+ (string-append (assoc-ref inputs lib) "/lib"))
+ '("cairo"
+ "fontconfig"
+ "glib"
+ "glu"
+ "gmp"
+ "gtk+"
+ "libjpeg"
+ "libpng"
+ "libx11"
+ "mesa"
+ "mpfr"
+ "pango"
+ "unixodbc"
+ "libedit")))
+ #t)))
+ (replace 'build
+ (lambda* (#:key native-inputs inputs outputs #:allow-other-keys)
+ (invoke (string-append (assoc-ref (or native-inputs inputs)
+ "racket")
+ "/bin/racket")
+ "--config"
+ (string-append (assoc-ref outputs "out")
+ "/etc/racket")
+ "-l"
+ "raco"
+ "setup")
+ #t))
+ ;; we still don't have these:
+ (delete 'install))
+ #:tests? #f))))
+
+(define extend-layer
+ (scheme-file
+ "extend-layer.rkt"
+ `(module
+ extend-layer racket/base
+ (require racket/cmdline
+ racket/match
+ racket/file
+ racket/list
+ racket/pretty)
+ (define config-file-pth
+ "etc/racket/config.rktd")
+ (define (build-path-string . args)
+ (path->string (apply build-path args)))
+ (define rx:racket
+ ;; Guile's reader doesn't support #rx"racket"
+ (regexp "racket"))
+ (command-line
+ #:args (parent-layer prefix . lib-dir*)
+ (let* ([config
+ (for/fold
+ ([config (file->value (build-path parent-layer
+ config-file-pth))])
+ ([spec (in-list
+ '((lib-dir lib-search-dirs "lib/racket")
+ (share-dir share-search-dirs "share/racket")
+ (links-file
+ links-search-files
+ "share/racket/links.rktd")
+ (pkgs-dir pkgs-search-dirs "share/racket/pkgs")
+ (bin-dir bin-search-dirs "bin")
+ (man-dir man-search-dirs "share/man")
+ (doc-dir doc-search-dirs "share/doc/racket")
+ (include-dir
+ include-search-dirs
+ "include/racket")))])
+ (match-define (list main-key search-key pth) spec)
+ (hash-set*
+ config
+ main-key
+ (build-path-string prefix pth)
+ search-key
+ (list* #f
+ (hash-ref config
+ main-key
+ (build-path-string parent-layer pth))
+ (filter values (hash-ref config search-key null)))))]
+ [config
+ (hash-set config
+ 'apps-dir
+ (build-path-string prefix "share/applications"))]
+ [config
+ ;; place new foreign lib-search-dirs before old
+ ;; foreign dirs, but after Racket layers
+ (let-values
+ ([(rkt extra)
+ (partition (lambda (pth)
+ (or (not pth)
+ (regexp-match? rx:racket pth)))
+ (hash-ref config 'lib-search-dirs))])
+ (hash-set config
+ 'lib-search-dirs
+ (append rkt
+ lib-dir*
+ extra)))]
+ [bin-dir
+ (hash-ref config 'bin-dir)]
+ [config
+ (hash-set* config
+ 'config-tethered-console-bin-dir bin-dir
+ 'config-tethered-gui-bin-dir bin-dir)]
+ [new-config-pth
+ (build-path prefix config-file-pth)])
+ (make-parent-directory* new-config-pth)
+ (call-with-output-file*
+ new-config-pth
+ (lambda (out)
+ (pretty-write config out))))))))
--
2.30.2