all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: Philip McGrath <philip@philipmcgrath.com>
To: 49280@debbugs.gnu.org
Cc: Philip McGrath <philip@philipmcgrath.com>
Subject: [bug#49280] [PATCH v2 2/3] gnu: racket: Unbundle racket-minimal.
Date: Mon, 19 Jul 2021 02:31:42 -0400	[thread overview]
Message-ID: <20210719063143.788661-2-philip@philipmcgrath.com> (raw)
In-Reply-To: <20210719063143.788661-1-philip@philipmcgrath.com>

This change takes advantage of improved support for layered
and tethered installations in Racket 8.2.

* 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)[source](snippet): Unbundle
`racket-minimal`.
[inputs]: Remove inputs that properly belong to `racket-minimal`.
[native-inputs]: Add `racket-minimal` and `extend-layer`.
[arguments]: Stop inheriting from `racket-minimal`. 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/patches/racket-sh-via-rktio.patch: Rename to ...
* gnu/packages/patches/racket-minimal-sh-via-rktio.patch: ... this
file to placate `guix lint`.
* gnu/local.mk (dist_patch_DATA): Update accordingly.
* gnu/packages/racket.scm (racket-minimal)[source]: Likewise.
---
 gnu/local.mk                                  |   2 +-
 ...atch => racket-minimal-sh-via-rktio.patch} |   0
 gnu/packages/racket.scm                       | 196 +++++++++++++++++-
 3 files changed, 191 insertions(+), 7 deletions(-)
 rename gnu/packages/patches/{racket-sh-via-rktio.patch => racket-minimal-sh-via-rktio.patch} (100%)

diff --git a/gnu/local.mk b/gnu/local.mk
index 62a5e41a46..93c022d1b8 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1673,7 +1673,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/ripperx-missing-file.patch		\
   %D%/packages/patches/rpcbind-CVE-2017-8779.patch		\
   %D%/packages/patches/rtags-separate-rct.patch			\
-  %D%/packages/patches/racket-sh-via-rktio.patch		\
+  %D%/packages/patches/racket-minimal-sh-via-rktio.patch	\
   %D%/packages/patches/remake-impure-dirs.patch			\
   %D%/packages/patches/retroarch-LIBRETRO_DIRECTORY.patch	\
   %D%/packages/patches/rnp-add-version.cmake.patch		\
diff --git a/gnu/packages/patches/racket-sh-via-rktio.patch b/gnu/packages/patches/racket-minimal-sh-via-rktio.patch
similarity index 100%
rename from gnu/packages/patches/racket-sh-via-rktio.patch
rename to gnu/packages/patches/racket-minimal-sh-via-rktio.patch
diff --git a/gnu/packages/racket.scm b/gnu/packages/racket.scm
index 6b2a011d51..c095de42b3 100644
--- a/gnu/packages/racket.scm
+++ b/gnu/packages/racket.scm
@@ -73,7 +73,7 @@
                  %installer-mirrors))
        (sha256 "13qfg56w554vdj5iwa8lpacy83s7bzhhyr44pjns68mkhj69ring")
        (patches (search-patches
-                 "racket-sh-via-rktio.patch"))))
+                 "racket-minimal-sh-via-rktio.patch"))))
     (home-page "https://racket-lang.org")
     (synopsis "Racket without bundled packages such as DrRacket")
     (inputs
@@ -183,10 +183,55 @@ DrRacket IDE, are not included.")
                  %installer-mirrors))
        (sha256
         (base32
-         "10sgzsraxzxp1k2y2wvz8rcjwvhbcd6k72l9lyqr34yazlwfdz26"))))
+         "10sgzsraxzxp1k2y2wvz8rcjwvhbcd6k72l9lyqr34yazlwfdz26"))
+       (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
-     `(;; sqlite and libraries for `racket/draw' are needed to build the doc.
-       ("cairo" ,cairo)
+     `(("cairo" ,cairo)
        ("fontconfig" ,fontconfig)
        ("glib" ,glib)
        ("glu" ,glu)
@@ -199,8 +244,67 @@ DrRacket IDE, are not included.")
        ("mpfr" ,mpfr)
        ("pango" ,pango)
        ("unixodbc" ,unixodbc)
-       ("libedit" ,libedit)
-       ,@(package-inputs racket-minimal)))
+       ("libedit" ,libedit)))
+    (native-inputs
+     `(("racket" ,racket-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))
+         (delete 'install))
+       ;; we still don't have these:
+       #:tests? #f))
     (synopsis "A programmable programming language in the Scheme family")
     (description
      "Racket is a general-purpose programming language in the Scheme family,
@@ -211,3 +315,83 @@ languages to complete language implementations.
 The main Racket distribution comes with many bundled packages, including the
 DrRacket IDE, libraries for GUI and web programming, and implementations of
 languages such as Typed Racket, R5RS and R6RS Scheme, Algol 60, and Datalog.")))
+
+
+(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





  reply	other threads:[~2021-07-19  7:16 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           ` Philip McGrath [this message]
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   ` [bug#49280] [PATCH 3/4] gnu: racket-next: Unbundle racket-next-minimal Philip McGrath
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

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20210719063143.788661-2-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 external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.