From: Philip McGrath <philip@philipmcgrath.com>
To: 49280@debbugs.gnu.org
Cc: Philip McGrath <philip@philipmcgrath.com>
Subject: [bug#49280] [PATCH 3/4] gnu: racket-next: Unbundle racket-next-minimal.
Date: Tue, 29 Jun 2021 17:57:41 -0400 [thread overview]
Message-ID: <20210629215742.3112654-3-philip@philipmcgrath.com> (raw)
In-Reply-To: <20210629215742.3112654-1-philip@philipmcgrath.com>
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
next prev parent reply other threads:[~2021-06-29 21:59 UTC|newest]
Thread overview: 23+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-06-29 21:52 [bug#49280] [PATCH 0/4] gnu: racket: Add racket-next. Bootstrap from C Philip McGrath
2021-06-29 21:57 ` [bug#49280] [PATCH 1/4] gnu: racket: Fix lib-search-dirs configuration Philip McGrath
2021-06-29 21:57 ` [bug#49280] [PATCH 2/4] gnu: racket: Add racket-next and racket-next-minimal Philip McGrath
2021-07-08 21:25 ` [bug#49280] [PATCH 0/4] gnu: racket: Add racket-next. Bootstrap from C Ludovic Courtès
2021-07-18 21:35 ` Philip McGrath
2021-07-19 6:31 ` [bug#49280] [PATCH v2 1/3] gnu: racket: Update to 8.2 Philip McGrath
2021-07-19 6:31 ` [bug#49280] [PATCH v2 2/3] gnu: racket: Unbundle racket-minimal Philip McGrath
2021-07-30 21:33 ` [bug#49280] [PATCH v2 0/3] gnu: racket: Update to 8.2. Bootstrap from C Ludovic Courtès
2021-07-19 6:31 ` [bug#49280] [PATCH v2 3/3] gnu: racket-minimal: " Philip McGrath
2021-07-19 18:48 ` Philip McGrath
2021-07-19 19:46 ` [bug#49280] [PATCH v2 1/3] gnu: racket: Update to 8.2 Leo Prikler
2021-07-19 21:46 ` Philip McGrath
2021-07-20 9:40 ` Leo Prikler
2021-07-25 8:22 ` Philip McGrath
2021-07-25 13:03 ` Leo Prikler
2021-07-25 18:04 ` Philip McGrath
2021-07-30 23:05 ` bug#49280: [PATCH v2 0/3] gnu: racket: Update to 8.2. Bootstrap from C Ludovic Courtès
2021-07-30 21:22 ` [bug#49280] " Ludovic Courtès
2021-07-30 21:31 ` [bug#49280] References to unversioned source tarballs Ludovic Courtès
2021-07-30 22:08 ` Philip McGrath
2021-06-29 21:57 ` Philip McGrath [this message]
2021-06-29 21:57 ` [bug#49280] [PATCH 4/4] gnu: racket-next-minimal: Bootstrap from C Philip McGrath
2021-07-08 21:43 ` [bug#49280] [PATCH 0/4] gnu: racket: Add racket-next. " Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210629215742.3112654-3-philip@philipmcgrath.com \
--to=philip@philipmcgrath.com \
--cc=49280@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).